diff --git a/lisp/sparc-arch.c b/lisp/sparc-arch.c new file mode 100644 index 0000000000000000000000000000000000000000..c74d9c5dd4517068c6fc4fa60ec0f53c35362177 --- /dev/null +++ b/lisp/sparc-arch.c @@ -0,0 +1,298 @@ +#include <stdio.h> +#include <machine/trap.h> + +#include "lisp.h" +#include "internals.h" +#include "globals.h" +#include "validate.h" +#include "os.h" +#include "arch.h" +#include "lispregs.h" +#include "signal.h" +#include "interrupt.h" + +char *arch_init() +{ + return NULL; +} + +os_vm_address_t arch_get_bad_addr(int signal, int code, + struct sigcontext *context) +{ + unsigned long badinst; + int rs1; + + /* On the sparc, we have to decode the instruction. */ + + /* Make sure it's not the pc thats bogus, and that it was lisp code */ + /* that caused the fault. */ + if ((context->sc_pc & 3) != 0 || + ((context->sc_pc < READ_ONLY_SPACE_START || + context->sc_pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) && + ((lispobj *)context->sc_pc < current_dynamic_space && + (lispobj *)context->sc_pc >= + current_dynamic_space + DYNAMIC_SPACE_SIZE))) + return NULL; + + badinst = *(unsigned long *)context->sc_pc; + + if ((badinst >> 30) != 3) + /* All load/store instructions have op = 11 (binary) */ + return NULL; + + rs1 = (badinst>>14)&0x1f; + + if (badinst & (1<<13)) { + /* r[rs1] + simm(13) */ + int simm13 = badinst & 0x1fff; + + if (simm13 & (1<<12)) + simm13 |= -1<<13; + + return (os_vm_address_t)(SC_REG(context, rs1) + simm13); + } + else { + /* r[rs1] + r[rs2] */ + int rs2 = badinst & 0x1f; + + return (os_vm_address_t)(SC_REG(context, rs1) + SC_REG(context, rs2)); + } + +} + +void arch_skip_instruction(context) +struct sigcontext *context; +{ + /* Skip the offending instruction */ + context->sc_pc = context->sc_npc; + context->sc_npc += 4; +} + +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 (SC_REG(scp, reg_ALLOC) & 4); +} + +void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) +{ + SC_REG(scp, reg_ALLOC) |= 1; +} + +unsigned long arch_install_breakpoint(void *pc) +{ + unsigned long *ptr = (unsigned long *)pc; + unsigned long result = *ptr; + *ptr = trap_Breakpoint; + return result; +} + +void arch_remove_breakpoint(void *pc, unsigned long orig_inst) +{ + *(unsigned long *)pc = 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) +{ + unsigned long *pc = (unsigned long *)scp->sc_pc; + unsigned long *npc = (unsigned long *)scp->sc_npc; + + orig_sigmask = scp->sc_mask; + scp->sc_mask = BLOCKABLE; + + *pc = orig_inst; + skipped_break_addr = pc; + displaced_after_inst = *npc; + *npc = trap_AfterBreakpoint; + + sigreturn(scp); +} + +static void sigill_handler(signal, code, scp) +int signal, code; +struct sigcontext *scp; +{ + int badinst; + + sigsetmask(scp->sc_mask); + + if (code == T_UNIMP_INSTR) { + int trap; + + trap = *(unsigned long *)(scp->sc_pc) & 0x3fffff; + + switch (trap) { + case trap_PendingInterrupt: + 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, trap == 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); + scp->sc_npc=scp->sc_pc + 4; + break; + + case trap_AfterBreakpoint: + *skipped_break_addr = trap_Breakpoint; + skipped_break_addr = NULL; + *(unsigned long *)scp->sc_pc = displaced_after_inst; + scp->sc_mask = orig_sigmask; + break; + + default: + interrupt_handle_now(signal, code, scp); + break; + } + } + else if (code >= T_SOFTWARE_TRAP + 16 & code < T_SOFTWARE_TRAP + 32) + interrupt_internal_error(signal, code, scp, FALSE); + else + interrupt_handle_now(signal, code, scp); +} + +static void sigemt_handler(signal, code, scp) + int signal, code; + struct sigcontext *scp; +{ + unsigned long badinst; + boolean subtract, immed; + int rd, rs1, op1, rs2, op2, result; + + badinst = *(unsigned long *)scp->sc_pc; + if ((badinst >> 30) != 2 || ((badinst >> 20) & 0x1f) != 0x11) { + /* It wasn't a tagged add. Pass the signal into lisp. */ + interrupt_handle_now(signal, code, scp); + return; + } + + /* Extract the parts of the inst. */ + subtract = badinst & (1<<19); + rs1 = (badinst>>14) & 0x1f; + op1 = SC_REG(scp, rs1); + + /* If the first arg is $ALLOC then it is really a signal-pending note */ + /* for the pseudo-atomic noise. */ + if (rs1 == reg_ALLOC) { + /* Perform the op anyway. */ + op2 = badinst & 0x1fff; + if (op2 & (1<<12)) + op2 |= -1<<13; + if (subtract) + result = op1 - op2; + else + result = op1 + op2; + SC_REG(scp, reg_ALLOC) = result & ~7; + interrupt_handle_pending(scp); + return; + } + + if ((op1 & 3) != 0) { + /* The first arg wan't a fixnum. */ + interrupt_internal_error(signal, code, scp, FALSE); + return; + } + + if (immed = badinst & (1<<13)) { + op2 = badinst & 0x1fff; + if (op2 & (1<<12)) + op2 |= -1<<13; + } + else { + rs2 = badinst & 0x1f; + op2 = SC_REG(scp, rs2); + } + + if ((op2 & 3) != 0) { + /* The second arg wan't a fixnum. */ + interrupt_internal_error(signal, code, scp, FALSE); + return; + } + + rd = (badinst>>25) & 0x1f; + if (rd != 0) { + /* Don't bother computing the result unless we are going to use it. */ + if (subtract) + result = (op1>>2) - (op2>>2); + else + result = (op1>>2) + (op2>>2); + + current_dynamic_space_free_pointer = + (lispobj *) SC_REG(scp, reg_ALLOC); + + SC_REG(scp, rd) = alloc_number(result); + + SC_REG(scp, reg_ALLOC) = + (unsigned long) current_dynamic_space_free_pointer; + } + + arch_skip_instruction(scp); +} + +void arch_install_interrupt_handlers() +{ + interrupt_install_low_level_handler(SIGILL,sigill_handler); + interrupt_install_low_level_handler(SIGEMT,sigemt_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); +} diff --git a/lisp/sparc-lispregs.h b/lisp/sparc-lispregs.h new file mode 100644 index 0000000000000000000000000000000000000000..d85d9f095dbe51e6d7632807388403490967450c --- /dev/null +++ b/lisp/sparc-lispregs.h @@ -0,0 +1,77 @@ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-lispregs.h,v 1.1 1992/09/08 20:21:10 wlott Exp $ */ + +#ifdef LANGUAGE_ASSEMBLY + +#define GREG(num) %g ## num +#define OREG(num) %o ## num +#define LREG(num) %l ## num +#define IREG(num) %i ## num + +#else + +#define GREG(num) (num) +#define OREG(num) ((num)+8) +#define LREG(num) ((num)+16) +#define IREG(num) ((num)+24) + +#endif + +#define NREGS (32) + +#define reg_ZERO GREG(0) +#define reg_ALLOC GREG(1) +#define reg_NIL GREG(2) +#define reg_CSP GREG(3) +#define reg_CFP GREG(4) +#define reg_BSP GREG(5) +#define reg_NFP GREG(6) +#define reg_CFUNC GREG(7) + +#define reg_NL0 OREG(0) +#define reg_NL1 OREG(1) +#define reg_NL2 OREG(2) +#define reg_NL3 OREG(3) +#define reg_NL4 OREG(4) +#define reg_NL5 OREG(5) +#define reg_NSP OREG(6) +#define reg_NARGS OREG(7) + +#define reg_A0 LREG(0) +#define reg_A1 LREG(1) +#define reg_A2 LREG(2) +#define reg_A3 LREG(3) +#define reg_A4 LREG(4) +#define reg_A5 LREG(5) +#define reg_OCFP LREG(6) +#define reg_LRA LREG(7) + +#define reg_FDEFN IREG(0) +#define reg_LEXENV IREG(1) +#define reg_L0 IREG(2) +#define reg_L1 IREG(3) +#define reg_L2 IREG(4) +#define reg_CODE IREG(5) +#define reg_LIP IREG(7) + +#define REGNAMES \ + "ZERO", "ALLOC", "NULL", "CSP", \ + "CFP", "BSP", "NFP", "CFUNC", \ + "NL0", "NL1", "NL2", "NL3", \ + "NL4", "NL5", "NSP", "NARGS", \ + "A0", "A1", "A2", "A3", \ + "A4", "A5", "OCFP", "LRA", \ + "FDEFN", "LEXENV", "L0", "L1", \ + "L2", "CODE", "???", "LIP" + +#define BOXED_REGISTERS { \ + reg_A0, reg_A1, reg_A2, reg_A3, reg_A4, reg_A5, reg_FDEFN, reg_LEXENV, \ + reg_NFP, reg_OCFP, reg_LRA, reg_L0, reg_L1, reg_CODE \ +} + +#ifndef LANGUAGE_ASSEMBLY + +#define SC_REG(sc, n) (((int *)((sc)->sc_g1))[n]) +#define SC_PC(sc) ((sc)->sc_pc) +#define SC_NPC(sc) ((sc)->sc_npc) + +#endif diff --git a/lisp/sparc-validate.h b/lisp/sparc-validate.h new file mode 100644 index 0000000000000000000000000000000000000000..e790de13b2199f60b7c95c3fb761e562019d4b73 --- /dev/null +++ b/lisp/sparc-validate.h @@ -0,0 +1,19 @@ + +#define READ_ONLY_SPACE_START (0x01000000) +#define READ_ONLY_SPACE_SIZE (0x04000000) + +#define STATIC_SPACE_START (0x05000000) +#define STATIC_SPACE_SIZE (0x02000000) + +#define DYNAMIC_0_SPACE_START (0x07000000) +#define DYNAMIC_1_SPACE_START (0x0b000000) +#define DYNAMIC_SPACE_SIZE (0x04000000) + +#define CONTROL_STACK_START (0x00e00000) +#define CONTROL_STACK_SIZE (0x00080000) + +#define BINDING_STACK_START (0x00f00000) +#define BINDING_STACK_SIZE (0x00080000) + +#define NUMBER_STACK_START (0xf0000000) +#define NUMBER_STACK_SIZE (0x00100000) diff --git a/lisp/sunos-os.h b/lisp/sunos-os.h new file mode 100644 index 0000000000000000000000000000000000000000..8d2eb79c3ba92957fabc3fee4b387be1e5ffd6e2 --- /dev/null +++ b/lisp/sunos-os.h @@ -0,0 +1,13 @@ +#include <sys/types.h> +#include <sys/mman.h> + +typedef unsigned long os_vm_address_t; +typedef long 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 diff --git a/lisp/undefineds.c b/lisp/undefineds.c new file mode 100644 index 0000000000000000000000000000000000000000..5770670229c1c6d23c0165263c03b495a1db23f2 --- /dev/null +++ b/lisp/undefineds.c @@ -0,0 +1,18 @@ +/* Routines that must be linked into the core for lisp to work. */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.c,v 1.1 1992/09/08 20:19:03 wlott Exp $ */ + +#ifdef sun +#ifndef MACH +#define SUNOS +#endif +#endif + +typedef int func(); + +extern func +#include "undefineds.h" +; + +static func *foo[] = { +#include "undefineds.h" +}; diff --git a/lisp/undefineds.h b/lisp/undefineds.h new file mode 100644 index 0000000000000000000000000000000000000000..fd755012d06ced7149671d3307cd0db47a2044fe --- /dev/null +++ b/lisp/undefineds.h @@ -0,0 +1,157 @@ +/* Routines that must be linked into the core for lisp to work. */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.1 1992/09/08 20:19:21 wlott Exp $ */ + +/* Pick up all the syscalls. */ +accept, +access, +acct, +adjtime, +bind, +brk, +chdir, +chmod, +chown, +chroot, +close, +connect, +creat, +dup, +dup2, +execve, +exit, +fchmod, +fchown, +fcntl, +flock, +fork, +fstat, +fsync, +ftruncate, +getdtablesize, +getegid, +geteuid, +getgid, +getgroups, +gethostid, +gethostname, +getitimer, +getpagesize, +getpeername, +getpgrp, +getpid, +getppid, +getpriority, +getrlimit, +getrusage, +getsockname, +getsockopt, +gettimeofday, +getuid, +ioctl, +kill, +killpg, +link, +listen, +lseek, +lstat, +mkdir, +mknod, +mount, +open, +pipe, +profil, +ptrace, +#if !defined(SUNOS) && !defined(parisc) +quota, +#endif +read, +readlink, +readv, +reboot, +recv, +recvfrom, +recvmsg, +rename, +rmdir, +sbrk, +select, +send, +sendmsg, +sendto, +setgroups, +#ifndef SUNOS +sethostid, +#endif +sethostname, +setitimer, +setpgrp, +setpriority, +#if !defined(SUNOS) && !defined(parisc) +setquota, +#endif +setregid, +setreuid, +setrlimit, +setsockopt, +settimeofday, +shutdown, +sigblock, +sigpause, +#ifndef ibmrt +sigreturn, +#endif +sigsetmask, +sigstack, +sigvec, +socket, +socketpair, +stat, +swapon, +symlink, +sync, +syscall, +truncate, +umask, +#if !defined(SUNOS) && !defined(parisc) +umount, +#endif +unlink, +utimes, +vfork, +vhangup, +wait, +wait3, +write, +writev, + +/* Math routines. */ +cos, +sin, +tan, +acos, +asin, +atan, +atan2, +sinh, +cosh, +tanh, +asinh, +acosh, +atanh, +exp, +expm1, +log, +log10, +log1p, +pow, +cbrt, +sqrt, +hypot, + +/* Network support. */ +gethostbyname, +gethostbyaddr, + +/* Other random things. */ +getwd, +ttyname