diff --git a/lisp/Config.alpha_osf1 b/lisp/Config.alpha_osf1 new file mode 100644 index 0000000000000000000000000000000000000000..d1dfc40d117905704f5da5bd0a2f1ef0c3741c8f --- /dev/null +++ b/lisp/Config.alpha_osf1 @@ -0,0 +1,14 @@ +CPPFLAGS = -I. -I/usr/hallgren/lib/gcc-lib/alpha-dec-osf1/2.4.5/include \ + -I/usr/include -I/usr/misc/.X11/include +CC = gcc # -Wall -Wstrict-prototypes -Wmissing-prototypes +LD = ld +CPP = cpp +CFLAGS = -Dosf1 -Dalpha +ASFLAGS = -g -Dosf1 -Dalpha +NM = alpha-nm +UNDEFSYMPATTERN=-Xlinker -u -Xlinker & +ASSEM_SRC = alpha-assem.S +ARCH_SRC = alpha-arch.c +OS_SRC = osf1-os.c os-common.c +OS_LINK_FLAGS=-static +OS_LIBS= diff --git a/lisp/alpha-arch.c b/lisp/alpha-arch.c new file mode 100644 index 0000000000000000000000000000000000000000..7d7f38762ebc30af0a50b89b22ef21e6c2e706a7 --- /dev/null +++ b/lisp/alpha-arch.c @@ -0,0 +1,194 @@ +#include <stdio.h> + +#include "lisp.h" +#include "globals.h" +#include "validate.h" +#include "os.h" +#include "internals.h" +#include "arch.h" +#include "lispregs.h" +#include "signal.h" +#include "alloc.h" +#include "interrupt.h" +#include "interr.h" +#include "breakpoint.h" + +extern char call_into_lisp_LRA[], call_into_lisp_end[]; + +char *arch_init(void) +{ + if(mmap((os_vm_address_t) call_into_lisp_LRA_page,OS_VM_DEFAULT_PAGESIZE, + OS_VM_PROT_ALL,MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED,-1,0) + == (os_vm_address_t) -1) + perror("mmap"); + bcopy(call_into_lisp_LRA,call_into_lisp_LRA_page,OS_VM_DEFAULT_PAGESIZE); + os_flush_icache(call_into_lisp_LRA_page,OS_VM_DEFAULT_PAGESIZE); + return NULL; +} + +os_vm_address_t arch_get_bad_addr(int sig, int code, struct sigcontext *scp) +{ + unsigned int badinst; + + if((scp->sc_pc & 3) != 0) return NULL; + + if( (scp->sc_pc < READ_ONLY_SPACE_START || + scp->sc_pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) && + ((lispobj *)scp->sc_pc < current_dynamic_space || + (lispobj *)scp->sc_pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE)) + return NULL; + + badinst = *(unsigned int *)scp->sc_pc; + + if((badinst>>27)!=0x16) return NULL; + + return scp->sc_regs[(badinst>>16)&0x1f] + (badinst&0xffff); +} + +void arch_skip_instruction(scp) +struct sigcontext *scp; +{ +} + +unsigned char *arch_internal_error_arguments(struct sigcontext *scp) +{ + return (unsigned char *)(scp->sc_pc+4); +} + +boolean arch_pseudo_atomic_atomic(struct sigcontext *scp) +{ + return (scp->sc_regs[reg_ALLOC] & 1); +} + +#define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000 + +void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) +{ + scp->sc_regs[reg_ALLOC] |= 2; +} + +unsigned long arch_install_breakpoint(void *pc) +{ +} + +void arch_remove_breakpoint(void *pc, unsigned long orig_inst) +{ +} + +static unsigned long *skipped_break_addr, displaced_after_inst; +static int orig_sigmask; + +void arch_do_displaced_inst(struct sigcontext *scp, + unsigned long orig_inst) +{ +} + +static void sigtrap_handler(int signal, int code, struct sigcontext *scp) +{ + /* Don't disallow recursive breakpoint traps. Otherwise, we can't */ + /* use debugger breakpoints anywhere in here. */ + sigsetmask(scp->sc_mask); + + code=*(u32 *)(scp->sc_pc); + + switch (code) { + case trap_PendingInterrupt: + arch_skip_instruction(scp); + interrupt_handle_pending(scp); + break; + + case trap_Halt: + fake_foreign_function_call(scp); + lose("%%primitive halt called; the party is over.\n"); + + case trap_Error: + case trap_Cerror: + interrupt_internal_error(signal, code, scp, code==trap_Cerror); + break; + + case trap_Breakpoint: + handle_breakpoint(signal, code, scp); + break; + + case trap_FunctionEndBreakpoint: + scp->sc_pc = (int)handle_function_end_breakpoint(signal, code, scp); + break; +/* + case trap_AfterBreakpoint: + *skipped_break_addr = (trap_Breakpoint << 16) | 0xd; + os_flush_icache((os_vm_address_t)skipped_break_addr, + sizeof(unsigned long)); + skipped_break_addr = NULL; + *(unsigned long *)scp->sc_pc = displaced_after_inst; + os_flush_icache((os_vm_address_t)scp->sc_pc, sizeof(unsigned long)); + scp->sc_mask = orig_sigmask; + break; +*/ + default: + interrupt_handle_now(signal, code, scp); + break; + } +} + +#define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2) + +static void sigfpe_handler(int signal, int code, struct sigcontext *scp) +{ +} + +void arch_install_interrupt_handlers() +{ + interrupt_install_low_level_handler(SIGILL,sigtrap_handler); + interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler); + interrupt_install_low_level_handler(SIGFPE,sigfpe_handler); +} + +extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); + +lispobj funcall0(lispobj function) +{ + lispobj *args = current_control_stack_pointer; + + return call_into_lisp(function, args, 0); +} + +lispobj funcall1(lispobj function, lispobj arg0) +{ + lispobj *args = current_control_stack_pointer; + + current_control_stack_pointer += 1; + args[0] = arg0; + + return call_into_lisp(function, args, 1); +} + +lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) +{ + lispobj *args = current_control_stack_pointer; + + current_control_stack_pointer += 2; + args[0] = arg0; + args[1] = arg1; + + return call_into_lisp(function, args, 2); +} + +lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) +{ + lispobj *args = current_control_stack_pointer; + + current_control_stack_pointer += 3; + args[0] = arg0; + args[1] = arg1; + args[2] = arg2; + + return call_into_lisp(function, args, 3); +} + + +/* This is apparently called by emulate_branch, but isn't defined. So */ +/* just do nothing and hope it works... */ + +void cacheflush(void) +{ +} diff --git a/lisp/alpha-assem.S b/lisp/alpha-assem.S new file mode 100644 index 0000000000000000000000000000000000000000..da7a3c93dc8115483924045bb209db0f67492aaa --- /dev/null +++ b/lisp/alpha-assem.S @@ -0,0 +1,250 @@ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alpha-assem.S,v 1.1 1994/03/27 15:29:25 hallgren Exp $ */ +#include <machine/regdef.h> +#include <machine/pal.h> + +#include "internals.h" +#include "lispregs.h" + +/* + * Function to transfer control into lisp. + */ + .text + .align 4 + .globl call_into_lisp + .ent call_into_lisp +call_into_lisp: +#define framesize 8*8 + ldgp gp, 0($27) /* ### */ + /* Save all the C regs. */ + lda sp,-framesize(sp) + stq ra, framesize-8*8(sp) + stq s0, framesize-8*7(sp) + stq s1, framesize-8*6(sp) + stq s2, framesize-8*5(sp) + stq s3, framesize-8*4(sp) + stq s4, framesize-8*3(sp) + stq s5, framesize-8*2(sp) + stq s6, framesize-8*1(sp) + .mask 0x0fc001fe, -framesize + .frame sp,framesize,ra + + /* Clear descriptor regs */ + ldil reg_CODE,0 + ldil reg_FDEFN,0 + mov a0,reg_LEXENV + sll a2,2,reg_NARGS + ldil reg_OCFP,0 + ldil reg_LRA,0 + ldil reg_L0,0 + ldil reg_L1,0 + + + /* Establish NIL. */ + ldil reg_NULL,NIL + + /* Start pseudo-atomic. */ + + /* No longer in foreign call. */ + stl zero,foreign_function_call_active + + /* Load lisp state. */ + ldl reg_ALLOC,current_dynamic_space_free_pointer + ldl reg_BSP,current_binding_stack_pointer + ldl reg_CSP,current_control_stack_pointer + ldl reg_OCFP,current_control_frame_pointer + mov a1,reg_CFP + + .set noat + ldil reg_L2,0 + /* End of pseudo-atomic. */ + + /* Establish lisp arguments. */ + ldl reg_A0,0(reg_CFP) + ldl reg_A1,4(reg_CFP) + ldl reg_A2,8(reg_CFP) + ldl reg_A3,12(reg_CFP) + ldl reg_A4,16(reg_CFP) + ldl reg_A5,20(reg_CFP) + + /* Calculate the LRA. */ + lda reg_LRA,call_into_lisp_LRA_page+type_OtherPointer + + /* Indirect the closure */ + ldl reg_CODE,CLOSURE_FUNCTION_OFFSET(reg_LEXENV) + addl reg_CODE,6*4-type_FunctionPointer,reg_LIP + + /* And into lisp we go. */ + jsr reg_ZERO,(reg_LIP) + + .set noreorder + .align 3 + .globl call_into_lisp_LRA +call_into_lisp_LRA: + + .word type_ReturnPcHeader + + mov reg_OCFP,reg_CSP + nop + + /* return value already there */ + mov reg_A0,v0 + + /* Turn on pseudo-atomic. */ + + /* Save LISP registers */ + stl reg_ALLOC,current_dynamic_space_free_pointer + stl reg_BSP,current_binding_stack_pointer + stl reg_CSP,current_control_stack_pointer + stl reg_CFP,current_control_frame_pointer + + /* Back in C land. [CSP is just a handy non-zero value.] */ + stl reg_CSP,foreign_function_call_active + + /* Turn off pseudo-atomic and check for traps. */ + + /* Restore C regs */ + ldq ra, framesize-8*8(sp) + ldq s0, framesize-8*7(sp) + ldq s1, framesize-8*6(sp) + ldq s2, framesize-8*5(sp) + ldq s3, framesize-8*4(sp) + ldq s4, framesize-8*3(sp) + ldq s5, framesize-8*2(sp) + ldq s6, framesize-8*1(sp) + + ret zero,(ra),1 + .globl call_into_lisp_end +call_into_lisp_end: + .end call_into_lisp + +/* + * Transfering control from Lisp into C + */ + .set noreorder + .text + .align 4 + .globl call_into_c + .ent call_into_c +call_into_c: + .mask 0x0fc001fe, -12 + .frame sp,12,ra + mov reg_CFP, reg_OCFP + mov reg_CSP, reg_CFP + addq reg_CFP, 32, reg_CSP + stl reg_OCFP, 0(reg_CFP) + subl reg_LIP, reg_CODE, reg_L1 + addl reg_L1, type_OtherPointer, reg_L1 + stl reg_L1, 4(reg_CFP) + stl reg_CODE, 8(reg_CFP) + stl reg_NULL, 12(reg_CFP) + + /* Set the pseudo-atomic flag. */ + addq reg_ALLOC,1,reg_ALLOC + + /* Get the top two register args and fix the NSP to point to arg 7 */ + ldq reg_NL4,0(reg_NSP) + ldq reg_NL5,8(reg_NSP) + addq reg_NSP,16,reg_NSP + + /* Save lisp state. */ + subq reg_ALLOC,1,reg_L1 + stl reg_L1, current_dynamic_space_free_pointer + stl reg_BSP, current_binding_stack_pointer + stl reg_CSP, current_control_stack_pointer + stl reg_CFP, current_control_frame_pointer + + /* Mark us as in C land. */ + stl reg_CSP, foreign_function_call_active + + /* Were we interrupted? */ + subq reg_ALLOC,1,reg_ALLOC + stl reg_ZERO,0(reg_ALLOC) + + /* Into C land we go. */ + jsr ra, (reg_CFUNC) + ldgp $29,0(ra) + + /* restore NSP */ + subq reg_NSP,16,reg_NSP + + /* Clear unsaved descriptor regs */ + mov reg_ZERO, reg_NARGS + mov reg_ZERO, reg_A0 + mov reg_ZERO, reg_A1 + mov reg_ZERO, reg_A2 + mov reg_ZERO, reg_A3 + mov reg_ZERO, reg_A4 + mov reg_ZERO, reg_A5 + mov reg_ZERO, reg_L0 + mov reg_ZERO, reg_L2 + + /* Turn on pseudo-atomic. */ + lda reg_ALLOC,1(reg_ZERO) + + /* Mark us at in Lisp land. */ + stl reg_ZERO, foreign_function_call_active + + /* Restore ALLOC, preserving pseudo-atomic-atomic */ + ldl reg_NL0,current_dynamic_space_free_pointer + addq reg_ALLOC,reg_NL0,reg_ALLOC + + /* Check for interrupt */ + subq reg_ALLOC,1,reg_ALLOC + stl reg_ZERO,0(reg_ALLOC) + + ldl reg_NULL, 12(reg_CFP) + + /* Restore LRA & CODE (they may have been GC'ed) */ + ldl reg_CODE, 8(reg_CFP) + ldl reg_NL0, 4(reg_CFP) + subq reg_NL0, type_OtherPointer, reg_NL0 + addq reg_CODE, reg_NL0, reg_NL0 + + mov reg_CFP, reg_CSP + mov reg_OCFP, reg_CFP + + ret zero, (reg_NL0), 1 + + .end call_into_c + + .text + .globl start_of_tramps +start_of_tramps: + +/* + * The undefined-function trampoline. + */ + .text + .globl undefined_tramp + .ent undefined_tramp_offset +undefined_tramp = /* ### undefined_tramp_offset-call_into_lisp_LRA*/ 0x140+call_into_lisp_LRA_page +undefined_tramp_offset: + call_pal PAL_gentrap + .long 10 + .byte 4 + .byte 23 + .byte 254 + .byte 238 + .byte 2 + .align 2 + .end undefined_tramp + + +/* + * The closure trampoline. + */ + .text + .globl closure_tramp + .ent closure_tramp_offset +closure_tramp = /* ### */ 0x150 + call_into_lisp_LRA_page +closure_tramp_offset: + ldl reg_LEXENV, FDEFN_FUNCTION_OFFSET(reg_FDEFN) + ldl reg_L0, CLOSURE_FUNCTION_OFFSET(reg_LEXENV) + addl reg_L0, FUNCTION_CODE_OFFSET, reg_LIP + jmp reg_ZERO,(reg_LIP) + .end closure_tramp + + .text + .globl end_of_tramps +end_of_tramps: + diff --git a/lisp/alpha-lispregs.h b/lisp/alpha-lispregs.h new file mode 100644 index 0000000000000000000000000000000000000000..dd4e68363ea7c4aedc574a518e7b1154290c7b12 --- /dev/null +++ b/lisp/alpha-lispregs.h @@ -0,0 +1,60 @@ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alpha-lispregs.h,v 1.1 1994/03/27 15:29:34 hallgren Exp $ */ + +#define NREGS (32) + +#ifdef LANGUAGE_ASSEMBLY +#define REG(num) $ ## num +#else +#define REG(num) num +#endif + +#define reg_LIP REG(0) +#define reg_A0 REG(1) +#define reg_A1 REG(2) +#define reg_A2 REG(3) +#define reg_A3 REG(4) +#define reg_A4 REG(5) +#define reg_A5 REG(6) +#define reg_L0 REG(7) +#define reg_NARGS REG(8) +#define reg_CSP REG(9) +#define reg_CFP REG(10) +#define reg_OCFP REG(11) +#define reg_BSP REG(12) +#define reg_LEXENV REG(13) +#define reg_CODE REG(14) +#define reg_NULL REG(15) +#define reg_NL0 REG(16) +#define reg_NL1 REG(17) +#define reg_NL2 REG(18) +#define reg_NL3 REG(19) +#define reg_NL4 REG(20) +#define reg_NL5 REG(21) +#define reg_ALLOC REG(22) +#define reg_FDEFN REG(23) +#define reg_CFUNC REG(24) +#define reg_NFP REG(25) +#define reg_LRA REG(26) +#define reg_L1 REG(27) +#define reg_L2 REG(28) +#define reg_GP REG(29) +#define reg_NSP REG(30) +#define reg_ZERO REG(31) + + +#define REGNAMES \ + "LIP", "NL0", "NL1", "NL2", "NL3", "NL4", "NL5", "L0", "NARGS", \ + "CSP", "CFP", "OCFP", "BSP", "LEXENV", "CODE", "FDEFN", "A0", "A1", \ + "A2", "A3", "A4", "A5", "ALLOC", "NULL", "CFUNC", "NFP", "LRA", "L1", \ + "L2", "GP", "NSP", "ZERO" + +#define BOXED_REGISTERS { \ + reg_CODE, reg_FDEFN, reg_LEXENV, reg_NARGS, reg_OCFP, reg_LRA, \ + reg_A0, reg_A1, reg_A2, reg_A3, reg_A4, reg_A5, \ + reg_L0, reg_L1, reg_L2 \ +} + +#define SC_REG(sc, n) ((sc)->sc_regs[n]) +#define SC_PC(sc) ((sc)->sc_pc) + +#define call_into_lisp_LRA_page 0x10000 diff --git a/lisp/alpha-nm b/lisp/alpha-nm new file mode 100755 index 0000000000000000000000000000000000000000..534388868f4d505614dba76c23bb8c37fc695543 --- /dev/null +++ b/lisp/alpha-nm @@ -0,0 +1,5 @@ +#!/bin/csh -f + +/bin/nm -Bgp $argv | sed "s/ U/0000000000000000 U/g" + +exit 0 diff --git a/lisp/alpha-validate.h b/lisp/alpha-validate.h new file mode 100644 index 0000000000000000000000000000000000000000..bb780997dffe4530c1b856b5f12fd80f0694d7b0 --- /dev/null +++ b/lisp/alpha-validate.h @@ -0,0 +1,16 @@ + +#define READ_ONLY_SPACE_START (0x20000000) +#define READ_ONLY_SPACE_SIZE (0x04000000) + +#define STATIC_SPACE_START (0x28000000) +#define STATIC_SPACE_SIZE (0x04000000) + +#define DYNAMIC_0_SPACE_START (0x30000000) +#define DYNAMIC_1_SPACE_START (0x38000000) +#define DYNAMIC_SPACE_SIZE (0x04000000) + +#define CONTROL_STACK_START (0x50000000) +#define CONTROL_STACK_SIZE (0x00100000) + +#define BINDING_STACK_START (0x70000000) +#define BINDING_STACK_SIZE (0x00100000) diff --git a/lisp/osf1-os.c b/lisp/osf1-os.c new file mode 100644 index 0000000000000000000000000000000000000000..83093d4dd47612731006d3f808b3f3675f720bad --- /dev/null +++ b/lisp/osf1-os.c @@ -0,0 +1,118 @@ +/* + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/osf1-os.c,v 1.1 1994/03/27 15:30:51 hallgren Exp $ + * + * OS-dependent routines. This file (along with os.h) exports an + * OS-independent interface to the operating system VM facilities. + * Suprisingly, this interface looks a lot like the Mach interface + * (but simpler in some places). For some operating systems, a subset + * of these functions will have to be emulated. + * + * This is the OSF1 version. By Sean Hallgren. + * + */ + +#include <stdio.h> +#include <sys/file.h> +#include <errno.h> +#include "./signal.h" +#include "os.h" +#include "arch.h" +#include "interrupt.h" +#include "lispregs.h" +#include <sys/types.h> +#include <sys/sysinfo.h> +#include <sys/proc.h> + +vm_size_t os_vm_page_size; + +void +os_init() +{ + int buf[2] = {SSIN_UACPROC, UAC_SIGBUS|UAC_NOPRINT}; + int error; + os_vm_page_size=OS_VM_DEFAULT_PAGESIZE; + if(setsysinfo(SSI_NVPAIRS,buf,1,NULL,NULL)==-1) + perror("setsysinfo"); +} + +os_vm_address_t +os_validate(os_vm_address_t addr, os_vm_size_t len) +{ + int flags = MAP_PRIVATE|MAP_ANONYMOUS; + + if(addr) flags|=MAP_FIXED; + else flags|=MAP_VARIABLE; + + if((addr=mmap(addr,len,OS_VM_PROT_ALL,flags,-1,0)) == (os_vm_address_t) -1) + perror("mmap"); + + return addr; +} + +void +os_invalidate(os_vm_address_t addr, os_vm_size_t len) +{ + if(munmap(addr,len) == -1) + perror("munmap"); +} + +os_vm_address_t +os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) +{ + if((addr=mmap(addr,len,OS_VM_PROT_ALL,MAP_PRIVATE|MAP_FILE|MAP_FIXED,fd, + (off_t) offset)) == (os_vm_address_t) -1) + perror("mmap"); + + return addr; +} + +void +os_flush_icache(os_vm_address_t address, os_vm_size_t length) +{ +} + +void +os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) +{ + if(mprotect(address, length, prot) == -1) + perror("mprotect"); +} + +boolean +valid_addr(os_vm_address_t addr) +{ + int ret; + os_vm_address_t newaddr; + newaddr=os_trunc_to_page(addr); + if((ret=mvalid(newaddr,newaddr-addr+4,OS_VM_PROT_ALL)) == 0) + return TRUE; + else if(errno==EINVAL) + perror("mvalid"); + return FALSE; +} + +static void +sigbus_handler(int signal, int code, struct sigcontext *context) +{ + context->sc_pc -= 4; /* pc is +4 on bus error!?!!? */ + if(arch_get_bad_addr(signal,code,context) && + context->sc_regs[reg_ALLOC] & 2) { + context->sc_regs[reg_ALLOC] -= 2; + interrupt_handle_pending(context); + } else + interrupt_handle_now(signal,code,context); +} + +static void +sigsegv_handler(int signal, int code, struct sigcontext *context) +{ + if(!interrupt_maybe_gc(signal, code, context)) + interrupt_handle_now(signal, code, context); +} + +void +os_install_interrupt_handlers(void) +{ + interrupt_install_low_level_handler(SIGSEGV,sigsegv_handler); + interrupt_install_low_level_handler(SIGBUS,sigbus_handler); +} diff --git a/lisp/osf1-os.h b/lisp/osf1-os.h new file mode 100644 index 0000000000000000000000000000000000000000..a94e0ccea1b96f5dbda7f15542ba750026644756 --- /dev/null +++ b/lisp/osf1-os.h @@ -0,0 +1,14 @@ +#include <sys/types.h> +#include <sys/mman.h> + +typedef caddr_t os_vm_address_t; +typedef size_t os_vm_size_t; +typedef off_t os_vm_offset_t; +typedef int os_vm_prot_t; + +#define OS_VM_PROT_READ PROT_READ +#define OS_VM_PROT_WRITE PROT_WRITE +#define OS_VM_PROT_EXECUTE PROT_EXEC + +#define OS_VM_DEFAULT_PAGESIZE 8192 +