diff --git a/lisp/hppa-arch.c b/lisp/hppa-arch.c new file mode 100644 index 0000000000000000000000000000000000000000..b86b5c3b54baa6558cbdad8cbdbcb6a4d7190506 --- /dev/null +++ b/lisp/hppa-arch.c @@ -0,0 +1,251 @@ +#include <stdio.h> +#include <mach.h> +#include <machine/trap.h> + +#include "lisp.h" +#include "globals.h" +#include "validate.h" +#include "os.h" +#include "arch.h" +#include "lispregs.h" +#include "signal.h" +#include "internals.h" +#include "breakpoint.h" + +char *arch_init(void) +{ + return NULL; +} + +os_vm_address_t arch_get_bad_addr(struct sigcontext *scp) +{ + struct hp800_thread_state *state; + os_vm_address_t addr; + + state = (struct hp800_thread_state *)(scp->sc_ap); + + if (state == NULL) + return NULL; + + /* Check the instruction address first. */ + addr = scp->sc_pcoqh & ~3; + if (addr < 0x1000) + return addr; + + /* Otherwise, it must have been a data fault. */ + return state->cr21; +} + +unsigned char *arch_internal_error_arguments(struct sigcontext *scp) +{ + return (unsigned char *)((scp->sc_pcoqh&~0x3)+4); +} + +boolean arch_pseudo_atomic_atomic(struct sigcontext *scp) +{ + /* Pseudo-atomic-atomic is implemented by oring 0x4 into ALLOC. */ + + if (SC_REG(scp, reg_ALLOC) & 0x4) + return TRUE; + else + return FALSE; +} + +void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) +{ + /* Pseudo-atomic-atomic is implemented by oring 0x1 into ALLOC. */ + + SC_REG(scp, reg_ALLOC) |= 1; +} + +void arch_skip_instruction(struct sigcontext *scp) +{ + /* Skip the offending instruction */ + scp->sc_pcoqh = scp->sc_pcoqt; + scp->sc_pcoqt += 4; +} + +unsigned long arch_install_breakpoint(void *pc) +{ + unsigned long *ulpc = (unsigned long *)pc; + unsigned long orig_inst = *ulpc; + + *ulpc = trap_Breakpoint; + return orig_inst; +} + +void arch_remove_breakpoint(void *pc, unsigned long orig_inst) +{ + unsigned long *ulpc = (unsigned long *)pc; + + *ulpc = orig_inst; +} + +void arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst) +{ + /* We set the recovery counter to cover one instruction, put the */ + /* original instruction back in, and then resume. We will then trap */ + /* after executing that one instruction, at which time we can put */ + /* the breakpoint back in. */ + + ((struct hp800_thread_state *)scp->sc_ap)->cr0 = 1; + scp->sc_ps |= 0x10; + *(unsigned long *)SC_PC(scp) = orig_inst; + + undo_fake_foreign_function_call(scp); + + sigreturn(scp); +} + +static void sigtrap_handler(int signal, int code, struct sigcontext *scp) +{ + unsigned long bad_inst; + + sigsetmask(scp->sc_mask); + + printf("sigtrap_handler, pc=0x%08x\n", scp->sc_pcoqh); + + bad_inst = *(unsigned long *)(scp->sc_pcoqh & ~3); + + if (bad_inst & 0xfc001fe0) + interrupt_handle_now(signal, code, scp); + else { + int im5 = bad_inst & 0x1f; + + switch (im5) { + 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, im5==trap_Cerror); + break; + + case trap_Breakpoint: + sigsetmask(scp->sc_mask); + fake_foreign_function_call(scp); + handle_breakpoint(signal, code, scp); + undo_fake_foreign_function_call(scp); + break; + + case trap_FunctionEndBreakpoint: + sigsetmask(scp->sc_mask); + fake_foreign_function_call(scp); + { + void *pc; + pc = handle_function_end_breakpoint(signal, code, scp); + scp->sc_pcoqh = (unsigned long)pc; + scp->sc_pcoqt = (unsigned long)pc + 4; + } + undo_fake_foreign_function_call(scp); + break; + + default: + interrupt_handle_now(signal, code, scp); + break; + } + } +} + +static void sigfpe_handler(int signal, int code, struct sigcontext *scp) +{ + if (code == I_OVFLO) { + unsigned long badinst = *(unsigned long *)(SC_PC(scp)&~3); + int opcode = badinst >> 26; + int r1, r2, t; + long op1, op2, res; + + if (opcode == 2) { + /* reg/reg inst. */ + r1 = (badinst >> 16) & 0x1f; + op1 = fixnum_value(SC_REG(scp, r1)); + r2 = (badinst >> 21) & 0x1f; + op2 = fixnum_value(SC_REG(scp, r2)); + t = badinst & 0x1f; + + switch ((badinst >> 5) & 0x7f) { + case 0x70: + /* Add and trap on overflow. */ + res = op1 + op2; + break; + + case 0x60: + /* Subtract and trap on overflow. */ + res = op1 - op2; + break; + + default: + goto not_interesting; + } + } + else if ((opcode & 0x37) == 0x25 && (badinst & (1<<11))) { + /* Add or subtract immediate. */ + op1 = ((badinst >> 3) & 0xff) | ((-badinst&1)<<8); + r2 = (badinst >> 16) & 0x1f; + op2 = fixnum_value(SC_REG(scp, r1)); + t = (badinst >> 21) & 0x1f; + if (opcode == 0x2d) + res = op1 + op2; + else + res = op1 - op2; + } + else + goto not_interesting; + + current_dynamic_space_free_pointer = (lispobj *)SC_REG(scp, reg_ALLOC); + SC_REG(scp, t) = alloc_number(res); + SC_REG(scp, reg_ALLOC) + = (unsigned long)current_dynamic_space_free_pointer; + arch_skip_instruction(scp); + } + else + not_interesting: + interrupt_handle_now(signal, code, scp); +} + +void arch_install_interrupt_handlers(void) +{ + interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler); + interrupt_install_low_level_handler(SIGFPE,sigfpe_handler); +} + +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/hppa-assem.S b/lisp/hppa-assem.S new file mode 100644 index 0000000000000000000000000000000000000000..118379a2b2d0ff51df0af9f9d3ec75be8c8a12c0 --- /dev/null +++ b/lisp/hppa-assem.S @@ -0,0 +1,293 @@ +#define LANGUAGE_ASSEMBLY + +#include <machine/asm.h> + +#include "internals.h" +#include "lispregs.h" + + .import $global$,data + .import foreign_function_call_active,data + .import current_control_stack_pointer,data + .import current_control_frame_pointer,data + .import current_binding_stack_pointer,data + .import current_dynamic_space_free_pointer,data + + .space $TEXT$ + .subspa $CODE$ + + +/* + * Call-into-lisp + */ + + .export call_into_lisp +call_into_lisp + .proc + .callinfo entry_gr=18,save_rp + .enter + /* arg0=function, arg1=cfp, arg2=nargs */ + + /* Clear the descriptor regs, moving in args as approporate. */ + copy r0,reg_CODE + copy r0,reg_FDEFN + copy arg0,reg_LEXENV + zdep arg2,29,30,reg_NARGS + copy r0,reg_OCFP + copy r0,reg_LRA + copy r0,reg_A0 + copy r0,reg_A1 + copy r0,reg_A2 + copy r0,reg_A3 + copy r0,reg_A4 + copy r0,reg_A5 + copy r0,reg_L0 + copy r0,reg_L1 + copy r0,reg_L2 + + /* Establish NIL. */ + ldil L%NIL,reg_NULL + ldo R%NIL(reg_NULL),reg_NULL + + /* Turn on pseudo-atomic. */ + ldo 4(r0),reg_ALLOC + + /* No longer in foreign function call land. */ + addil L%foreign_function_call_active-$global$,dp + stw r0,R%foreign_function_call_active-$global$(0,r1) + + /* Load lisp state. */ + addil L%current_dynamic_space_free_pointer-$global$,dp + ldw R%current_dynamic_space_free_pointer-$global$(0,r1),r1 + add reg_ALLOC,r1,reg_ALLOC + addil L%current_binding_stack_pointer-$global$,dp + ldw R%current_binding_stack_pointer-$global$(0,r1),reg_BSP + addil L%current_control_stack_pointer-$global$,dp + ldw R%current_control_stack_pointer-$global$(0,r1),reg_CSP + addil L%current_control_frame_pointer-$global$,dp + ldw R%current_control_frame_pointer-$global$(0,r1),reg_OCFP + copy arg1,reg_CFP + + /* End of pseudo-atomic. */ + addit,od -4,reg_ALLOC,reg_ALLOC + + /* Establish lisp arguments. */ + ldw 0(reg_CFP),reg_A0 + ldw 4(reg_CFP),reg_A1 + ldw 8(reg_CFP),reg_A2 + ldw 12(reg_CFP),reg_A3 + ldw 16(reg_CFP),reg_A4 + ldw 20(reg_CFP),reg_A5 + + /* Calculate the LRA. */ + ldil L%lra+type_OtherPointer,reg_LRA + ldo R%lra+type_OtherPointer(reg_LRA),reg_LRA + + /* Indirect the closure */ + ldw CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_CODE + addi 6*4-type_FunctionPointer,reg_CODE,reg_LIP + + /* And into lisp we go. */ + .export break_here +break_here + be,n 0(sr4,reg_LIP) + + .align 8 +lra + .word type_ReturnPcHeader + copy reg_OCFP,reg_CSP + + /* Copy CFP (r4) into someplace else and restore r4. */ + copy reg_CFP,reg_NL1 + ldw -64(0,sp),r4 + + /* Copy the return value. */ + copy reg_A0,ret0 + + /* Turn on pseudo-atomic. */ + addi 4,reg_ALLOC,reg_ALLOC + + /* Store the lisp state. */ + copy reg_ALLOC,reg_NL0 + depi 0,31,3,reg_NL0 + addil L%current_dynamic_space_free_pointer-$global$,dp + stw reg_NL0,R%current_dynamic_space_free_pointer-$global$(0,r1) + addil L%current_binding_stack_pointer-$global$,dp + stw reg_BSP,R%current_binding_stack_pointer-$global$(0,r1) + addil L%current_control_stack_pointer-$global$,dp + stw reg_CSP,R%current_control_stack_pointer-$global$(0,r1) + addil L%current_control_frame_pointer-$global$,dp + stw reg_NL1,R%current_control_frame_pointer-$global$(0,r1) + + /* Back in C land. [CSP is just a handy non-zero value.] */ + addil L%foreign_function_call_active-$global$,dp + stw reg_CSP,R%foreign_function_call_active-$global$(0,r1) + + /* Turn off pseudo-atomic and check for traps. */ + addit,od -4,reg_ALLOC,reg_ALLOC + + /* And thats all. */ + .leave + .procend + + +/* + * Call-into-C + */ + + + .export call_into_c +call_into_c + /* Set up a lisp stack frame. Note: we convert the raw return pc into + * a fixnum pc-offset because we don't have ahold of an lra object. + */ + copy reg_CFP, reg_OCFP + copy reg_CSP, reg_CFP + addi 32, reg_CSP, reg_CSP + stw reg_OCFP, 0(0,reg_CFP) + sub reg_LIP, reg_CODE, reg_NL5 + addi 3-type_OtherPointer, reg_NL5, reg_NL5 + stw reg_NL5, 4(0,reg_CFP) + stw reg_CODE, 8(0,reg_CFP) + + /* Turn on pseudo-atomic. */ + addi 4, reg_ALLOC, reg_ALLOC + + /* Store the lisp state. */ + copy reg_ALLOC,reg_NL5 + depi 0,31,3,reg_NL5 + addil L%current_dynamic_space_free_pointer-$global$,dp + stw reg_NL5,R%current_dynamic_space_free_pointer-$global$(0,r1) + addil L%current_binding_stack_pointer-$global$,dp + stw reg_BSP,R%current_binding_stack_pointer-$global$(0,r1) + addil L%current_control_stack_pointer-$global$,dp + stw reg_CSP,R%current_control_stack_pointer-$global$(0,r1) + addil L%current_control_frame_pointer-$global$,dp + stw reg_CFP,R%current_control_frame_pointer-$global$(0,r1) + + /* Back in C land. [CSP is just a handy non-zero value.] */ + addil L%foreign_function_call_active-$global$,dp + stw reg_CSP,R%foreign_function_call_active-$global$(0,r1) + + /* Turn off pseudo-atomic and check for traps. */ + addit,od -4,reg_ALLOC,reg_ALLOC + + /* Now we can call the C function. */ + ble 0(4,reg_CFUNC) + copy r31, r2 + + /* Clear the callee saves descriptor regs. */ + copy r0, reg_A5 + copy r0, reg_L0 + copy r0, reg_L1 + copy r0, reg_L2 + + /* Turn on pseudo-atomic. */ + ldi 4, reg_ALLOC + + /* Turn off foreign function call. */ + addil L%foreign_function_call_active-$global$,dp + stw r0,R%foreign_function_call_active-$global$(0,r1) + + /* Load ALLOC. */ + addil L%current_dynamic_space_free_pointer-$global$,dp + ldw R%current_dynamic_space_free_pointer-$global$(0,r1),r1 + add reg_ALLOC,r1,reg_ALLOC + + /* We don't need to load OCFP, CFP, CSP, or BSP because they are + * in caller saves registers. + */ + + /* End of pseudo-atomic. */ + addit,od -4,reg_ALLOC,reg_ALLOC + + /* Restore CODE. Even though it is in a callee saves register + * it might have been GC'ed. + */ + ldw 8(0,reg_CFP), reg_CODE + + /* Restore the return pc. */ + ldw 4(0,reg_CFP), reg_NL0 + addi type_OtherPointer-3, reg_NL0, reg_NL0 + add reg_CODE, reg_NL0, reg_LIP + + /* Pop the lisp stack frame, and back we go. */ + copy reg_CFP, reg_CSP + be 0(4,reg_LIP) + copy reg_OCFP, reg_CFP + + + +/* + * Trampolines. + */ + + .EXPORT closure_tramp +closure_tramp + /* reg_FDEFN holds the fdefn object. */ + ldw FDEFN_FUNCTION_OFFSET(0,reg_FDEFN),reg_LEXENV + ldw CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_L0 + addi FUNCTION_HEADER_CODE_OFFSET, reg_L0, reg_LIP + bv,n 0(reg_LIP) + + .EXPORT undefined_tramp +undefined_tramp + break trap_Error,0 + .byte 4 + .byte 23 + .byte 254 + .byte 46 + .byte 1 + .align 4 + + +/* + * Core saving/restoring support + */ + + .export call_on_stack +call_on_stack + /* arg0 = fn to invoke, arg1 = new stack base */ + + /* Compute the new stack pointer. */ + addi 64,arg1,sp + + /* Zero out the previous stack pointer. */ + stw r0,-4(0,sp) + + /* Invoke the function. */ + ble 0(4,arg0) + copy r31, r2 + + /* Flame out. */ + break 0,0 + + .export save_state +save_state + .proc + .callinfo entry_gr=18,entry_fr=21,save_rp,calls + .enter + + /* Remember the function we want to invoke */ + copy arg0,r19 + + /* Pass the new stack pointer in as arg0 */ + copy sp,arg0 + + /* Leave arg1 as arg1. */ + + /* do the call. */ + ble 0(4,r19) + copy r31, r2 + +_restore_state + .leave + .procend + + .export restore_state +restore_state + .proc + .callinfo + copy arg0,sp + b _restore_state + copy arg1,ret0 + .procend diff --git a/lisp/hppa-assem.s b/lisp/hppa-assem.s new file mode 100644 index 0000000000000000000000000000000000000000..118379a2b2d0ff51df0af9f9d3ec75be8c8a12c0 --- /dev/null +++ b/lisp/hppa-assem.s @@ -0,0 +1,293 @@ +#define LANGUAGE_ASSEMBLY + +#include <machine/asm.h> + +#include "internals.h" +#include "lispregs.h" + + .import $global$,data + .import foreign_function_call_active,data + .import current_control_stack_pointer,data + .import current_control_frame_pointer,data + .import current_binding_stack_pointer,data + .import current_dynamic_space_free_pointer,data + + .space $TEXT$ + .subspa $CODE$ + + +/* + * Call-into-lisp + */ + + .export call_into_lisp +call_into_lisp + .proc + .callinfo entry_gr=18,save_rp + .enter + /* arg0=function, arg1=cfp, arg2=nargs */ + + /* Clear the descriptor regs, moving in args as approporate. */ + copy r0,reg_CODE + copy r0,reg_FDEFN + copy arg0,reg_LEXENV + zdep arg2,29,30,reg_NARGS + copy r0,reg_OCFP + copy r0,reg_LRA + copy r0,reg_A0 + copy r0,reg_A1 + copy r0,reg_A2 + copy r0,reg_A3 + copy r0,reg_A4 + copy r0,reg_A5 + copy r0,reg_L0 + copy r0,reg_L1 + copy r0,reg_L2 + + /* Establish NIL. */ + ldil L%NIL,reg_NULL + ldo R%NIL(reg_NULL),reg_NULL + + /* Turn on pseudo-atomic. */ + ldo 4(r0),reg_ALLOC + + /* No longer in foreign function call land. */ + addil L%foreign_function_call_active-$global$,dp + stw r0,R%foreign_function_call_active-$global$(0,r1) + + /* Load lisp state. */ + addil L%current_dynamic_space_free_pointer-$global$,dp + ldw R%current_dynamic_space_free_pointer-$global$(0,r1),r1 + add reg_ALLOC,r1,reg_ALLOC + addil L%current_binding_stack_pointer-$global$,dp + ldw R%current_binding_stack_pointer-$global$(0,r1),reg_BSP + addil L%current_control_stack_pointer-$global$,dp + ldw R%current_control_stack_pointer-$global$(0,r1),reg_CSP + addil L%current_control_frame_pointer-$global$,dp + ldw R%current_control_frame_pointer-$global$(0,r1),reg_OCFP + copy arg1,reg_CFP + + /* End of pseudo-atomic. */ + addit,od -4,reg_ALLOC,reg_ALLOC + + /* Establish lisp arguments. */ + ldw 0(reg_CFP),reg_A0 + ldw 4(reg_CFP),reg_A1 + ldw 8(reg_CFP),reg_A2 + ldw 12(reg_CFP),reg_A3 + ldw 16(reg_CFP),reg_A4 + ldw 20(reg_CFP),reg_A5 + + /* Calculate the LRA. */ + ldil L%lra+type_OtherPointer,reg_LRA + ldo R%lra+type_OtherPointer(reg_LRA),reg_LRA + + /* Indirect the closure */ + ldw CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_CODE + addi 6*4-type_FunctionPointer,reg_CODE,reg_LIP + + /* And into lisp we go. */ + .export break_here +break_here + be,n 0(sr4,reg_LIP) + + .align 8 +lra + .word type_ReturnPcHeader + copy reg_OCFP,reg_CSP + + /* Copy CFP (r4) into someplace else and restore r4. */ + copy reg_CFP,reg_NL1 + ldw -64(0,sp),r4 + + /* Copy the return value. */ + copy reg_A0,ret0 + + /* Turn on pseudo-atomic. */ + addi 4,reg_ALLOC,reg_ALLOC + + /* Store the lisp state. */ + copy reg_ALLOC,reg_NL0 + depi 0,31,3,reg_NL0 + addil L%current_dynamic_space_free_pointer-$global$,dp + stw reg_NL0,R%current_dynamic_space_free_pointer-$global$(0,r1) + addil L%current_binding_stack_pointer-$global$,dp + stw reg_BSP,R%current_binding_stack_pointer-$global$(0,r1) + addil L%current_control_stack_pointer-$global$,dp + stw reg_CSP,R%current_control_stack_pointer-$global$(0,r1) + addil L%current_control_frame_pointer-$global$,dp + stw reg_NL1,R%current_control_frame_pointer-$global$(0,r1) + + /* Back in C land. [CSP is just a handy non-zero value.] */ + addil L%foreign_function_call_active-$global$,dp + stw reg_CSP,R%foreign_function_call_active-$global$(0,r1) + + /* Turn off pseudo-atomic and check for traps. */ + addit,od -4,reg_ALLOC,reg_ALLOC + + /* And thats all. */ + .leave + .procend + + +/* + * Call-into-C + */ + + + .export call_into_c +call_into_c + /* Set up a lisp stack frame. Note: we convert the raw return pc into + * a fixnum pc-offset because we don't have ahold of an lra object. + */ + copy reg_CFP, reg_OCFP + copy reg_CSP, reg_CFP + addi 32, reg_CSP, reg_CSP + stw reg_OCFP, 0(0,reg_CFP) + sub reg_LIP, reg_CODE, reg_NL5 + addi 3-type_OtherPointer, reg_NL5, reg_NL5 + stw reg_NL5, 4(0,reg_CFP) + stw reg_CODE, 8(0,reg_CFP) + + /* Turn on pseudo-atomic. */ + addi 4, reg_ALLOC, reg_ALLOC + + /* Store the lisp state. */ + copy reg_ALLOC,reg_NL5 + depi 0,31,3,reg_NL5 + addil L%current_dynamic_space_free_pointer-$global$,dp + stw reg_NL5,R%current_dynamic_space_free_pointer-$global$(0,r1) + addil L%current_binding_stack_pointer-$global$,dp + stw reg_BSP,R%current_binding_stack_pointer-$global$(0,r1) + addil L%current_control_stack_pointer-$global$,dp + stw reg_CSP,R%current_control_stack_pointer-$global$(0,r1) + addil L%current_control_frame_pointer-$global$,dp + stw reg_CFP,R%current_control_frame_pointer-$global$(0,r1) + + /* Back in C land. [CSP is just a handy non-zero value.] */ + addil L%foreign_function_call_active-$global$,dp + stw reg_CSP,R%foreign_function_call_active-$global$(0,r1) + + /* Turn off pseudo-atomic and check for traps. */ + addit,od -4,reg_ALLOC,reg_ALLOC + + /* Now we can call the C function. */ + ble 0(4,reg_CFUNC) + copy r31, r2 + + /* Clear the callee saves descriptor regs. */ + copy r0, reg_A5 + copy r0, reg_L0 + copy r0, reg_L1 + copy r0, reg_L2 + + /* Turn on pseudo-atomic. */ + ldi 4, reg_ALLOC + + /* Turn off foreign function call. */ + addil L%foreign_function_call_active-$global$,dp + stw r0,R%foreign_function_call_active-$global$(0,r1) + + /* Load ALLOC. */ + addil L%current_dynamic_space_free_pointer-$global$,dp + ldw R%current_dynamic_space_free_pointer-$global$(0,r1),r1 + add reg_ALLOC,r1,reg_ALLOC + + /* We don't need to load OCFP, CFP, CSP, or BSP because they are + * in caller saves registers. + */ + + /* End of pseudo-atomic. */ + addit,od -4,reg_ALLOC,reg_ALLOC + + /* Restore CODE. Even though it is in a callee saves register + * it might have been GC'ed. + */ + ldw 8(0,reg_CFP), reg_CODE + + /* Restore the return pc. */ + ldw 4(0,reg_CFP), reg_NL0 + addi type_OtherPointer-3, reg_NL0, reg_NL0 + add reg_CODE, reg_NL0, reg_LIP + + /* Pop the lisp stack frame, and back we go. */ + copy reg_CFP, reg_CSP + be 0(4,reg_LIP) + copy reg_OCFP, reg_CFP + + + +/* + * Trampolines. + */ + + .EXPORT closure_tramp +closure_tramp + /* reg_FDEFN holds the fdefn object. */ + ldw FDEFN_FUNCTION_OFFSET(0,reg_FDEFN),reg_LEXENV + ldw CLOSURE_FUNCTION_OFFSET(0,reg_LEXENV),reg_L0 + addi FUNCTION_HEADER_CODE_OFFSET, reg_L0, reg_LIP + bv,n 0(reg_LIP) + + .EXPORT undefined_tramp +undefined_tramp + break trap_Error,0 + .byte 4 + .byte 23 + .byte 254 + .byte 46 + .byte 1 + .align 4 + + +/* + * Core saving/restoring support + */ + + .export call_on_stack +call_on_stack + /* arg0 = fn to invoke, arg1 = new stack base */ + + /* Compute the new stack pointer. */ + addi 64,arg1,sp + + /* Zero out the previous stack pointer. */ + stw r0,-4(0,sp) + + /* Invoke the function. */ + ble 0(4,arg0) + copy r31, r2 + + /* Flame out. */ + break 0,0 + + .export save_state +save_state + .proc + .callinfo entry_gr=18,entry_fr=21,save_rp,calls + .enter + + /* Remember the function we want to invoke */ + copy arg0,r19 + + /* Pass the new stack pointer in as arg0 */ + copy sp,arg0 + + /* Leave arg1 as arg1. */ + + /* do the call. */ + ble 0(4,r19) + copy r31, r2 + +_restore_state + .leave + .procend + + .export restore_state +restore_state + .proc + .callinfo + copy arg0,sp + b _restore_state + copy arg1,ret0 + .procend diff --git a/lisp/hppa-lispregs.h b/lisp/hppa-lispregs.h new file mode 100644 index 0000000000000000000000000000000000000000..6c9a1d625f8fd06ab3e8e46fef3904bfa6f28905 --- /dev/null +++ b/lisp/hppa-lispregs.h @@ -0,0 +1,59 @@ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/hppa-lispregs.h,v 1.1 1992/09/04 08:16:35 wlott Exp $ */ + +#define NREGS (32) + +#ifdef LANGUAGE_ASSEMBLY +#define REG(num) num +#else +#define REG(num) num +#endif + +#define reg_ZERO REG(0) +#define reg_NFP REG(1) +#define reg_CFUNC REG(2) +#define reg_CSP REG(3) +#define reg_CFP REG(4) +#define reg_BSP REG(5) +#define reg_NULL REG(6) +#define reg_ALLOC REG(7) +#define reg_CODE REG(8) +#define reg_FDEFN REG(9) +#define reg_LEXENV REG(10) +#define reg_NARGS REG(11) +#define reg_OCFP REG(12) +#define reg_LRA REG(13) +#define reg_A0 REG(14) +#define reg_A1 REG(15) +#define reg_A2 REG(16) +#define reg_A3 REG(17) +#define reg_A4 REG(18) +#define reg_A5 REG(19) +#define reg_L0 REG(20) +#define reg_L1 REG(21) +#define reg_L2 REG(22) +#define reg_NL3 REG(23) +#define reg_NL2 REG(24) +#define reg_NL1 REG(25) +#define reg_NL0 REG(26) +#define reg_DP REG(27) +#define reg_NL4 REG(28) +#define reg_NL5 REG(29) +#define reg_NSP REG(30) +#define reg_LIP REG(31) + + +#define REGNAMES \ + "ZERO", "NFP", "CFUNC", "CSP", "CFP", "BSP", "NULL", "ALLOC", \ + "CODE", "FDEFN", "LEXENV", "NARGS", "OCFP", "LRA", "A0", "A1", \ + "A2", "A3", "A4", "A5", "L0", "L1", "L2", "NL3", \ + "NL2", "NL1", "NL0", "DP", "NL4", "NL5", "NSP", "LIP" + +#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) (((unsigned long *)((sc)->sc_ap))[n]) +#define SC_PC(sc) ((sc)->sc_pcoqh) +#define SC_NPC(sc) ((sc)->sc_pcoqt) diff --git a/lisp/hppa-validate.h b/lisp/hppa-validate.h new file mode 100644 index 0000000000000000000000000000000000000000..693f241fa4aa02299a1ab04a7aa2a6501ad2b3c6 --- /dev/null +++ b/lisp/hppa-validate.h @@ -0,0 +1,20 @@ + +#define READ_ONLY_SPACE_START (0x20000000) +#define READ_ONLY_SPACE_SIZE (0x08000000) + +#define STATIC_SPACE_START (0x28000000) +#define STATIC_SPACE_SIZE (0x08000000) + +#define DYNAMIC_0_SPACE_START (0x30000000) +#define DYNAMIC_1_SPACE_START (0x38000000) +#define DYNAMIC_SPACE_SIZE (0x08000000) + +#define CONTROL_STACK_START (0x50000000) +#define CONTROL_STACK_SIZE (0x00100000) + +#define BINDING_STACK_START (0x70000000) +#define BINDING_STACK_SIZE (0x00100000) + +#define NUMBER_STACK_START (0x60000000) +#define NUMBER_STACK_SIZE (0x00100000) +#define NUMBER_STACK_GROWS_UP