From 6eab504b0bbed5d07501e5bf12b87a3654b333db Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sat, 3 Jan 2009 16:26:22 +0000 Subject: [PATCH] 1.0.24.18: new HPUX specific files * Also more separation of linux stuff versus common stuff (hpux vs linux). * Patch by Larry Valkama. --- src/code/hpux-os.lisp | 43 +++++++++ src/runtime/hppa-arch.c | 124 ++++++++++++++++++------ src/runtime/hppa-assem.S | 225 ++++++++++++++++++++++++------------------- src/runtime/hppa-hpux-os.c | 91 +++++++++++++++++ src/runtime/hppa-hpux-os.h | 17 ++++ src/runtime/hppa-linux-os.h | 4 + src/runtime/hppa-lispregs.h | 13 +-- src/runtime/hpux-os.c | 154 +++++++++++++++++++++++++++++ src/runtime/hpux-os.h | 18 ++++ version.lisp-expr | 2 +- 10 files changed, 548 insertions(+), 143 deletions(-) create mode 100644 src/code/hpux-os.lisp create mode 100644 src/runtime/hppa-hpux-os.c create mode 100644 src/runtime/hppa-hpux-os.h create mode 100644 src/runtime/hpux-os.c create mode 100644 src/runtime/hpux-os.h diff --git a/src/code/hpux-os.lisp b/src/code/hpux-os.lisp new file mode 100644 index 0000000..ed904e8 --- /dev/null +++ b/src/code/hpux-os.lisp @@ -0,0 +1,43 @@ +;;;; OS interface functions for SBCL under HPUX + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!SYS") + +;;; Check that target machine features are set up consistently with +;;; this file. +#!-hpux (error "missing :HPUX feature") + +(defun software-type () + #!+sb-doc + "Return a string describing the supporting software." + (values "HPUX")) + +(defun software-version () + #!+sb-doc + "Return a string describing version of the supporting software, or NIL + if not available." + (or *software-version* + (setf *software-version* + (string-trim '(#\newline) + (with-output-to-string (stream) + (sb!ext:run-program "/bin/uname" `("-r") + :output stream)))))) + +;;; Return system time, user time and number of page faults. +(defun get-system-info () + (multiple-value-bind + (err? utime stime maxrss ixrss idrss isrss minflt majflt) + (sb!unix:unix-getrusage sb!unix:rusage_self) + (declare (ignore maxrss ixrss idrss isrss minflt)) + (unless err? ; FIXME: nonmnemonic (reversed) name for ERR? + (error "Unix system call getrusage failed: ~A." (strerror utime))) + (values utime stime majflt))) + diff --git a/src/runtime/hppa-arch.c b/src/runtime/hppa-arch.c index bf9a464..3da86ae 100644 --- a/src/runtime/hppa-arch.c +++ b/src/runtime/hppa-arch.c @@ -29,11 +29,17 @@ void arch_init(void) return; } +static inline unsigned int +os_context_pc(os_context_t *context) +{ + return (unsigned int)(*os_context_pc_addr(context)); +} + os_vm_address_t arch_get_bad_addr(int signal, siginfo_t *siginfo, os_context_t *context) { - return siginfo->si_addr; + return (os_vm_address_t)siginfo->si_addr; #if 0 -#ifdef hpux +#ifdef LISP_FEATURE_HPUX struct save_state *state; os_vm_address_t addr; @@ -86,25 +92,41 @@ boolean arch_pseudo_atomic_atomic(os_context_t *context) * The foreign_function_call_active used to live at each call-site * to arch_pseudo_atomic_atomic, but this seems clearer. * --NS 2007-05-15 */ - return (!foreign_function_call_active) - && ((*os_context_register_addr(context,reg_ALLOC)) & 4); + + // FIX-lav: use accessor macro instead + return (!foreign_function_call_active) && + *(&((ucontext_t *) context)->uc_mcontext.ss_wide.ss_64.ss_gr7) & 4; } void arch_set_pseudo_atomic_interrupted(os_context_t *context) { - *os_context_register_addr(context,reg_ALLOC) |= 1; + + *(&((ucontext_t *) context)->uc_mcontext.ss_wide.ss_64.ss_gr7) |= 1; +/* on hpux do we need to watch out for the barbarian ? */ +#ifdef LISP_FEATURE_HPUX + *((os_context_register_t *) &((ucontext_t *) context)->uc_mcontext.ss_flags) + |= SS_MODIFIEDWIDE; +#endif } /* FIXME: untested */ void arch_clear_pseudo_atomic_interrupted(os_context_t *context) { - *os_context_register_addr(context,reg_ALLOC) &= ~1; + *(&((ucontext_t *) context)->uc_mcontext.ss_wide.ss_64.ss_gr7) &= ~1; +#ifdef LISP_FEATURE_HPUX + *((os_context_register_t *) &((ucontext_t *) context)->uc_mcontext.ss_flags) + |= SS_MODIFIEDWIDE; +#endif } void arch_skip_instruction(os_context_t *context) { - ((char *) *os_context_pc_addr(context)) = ((char *) *os_context_npc_addr(context)); - ((char *) *os_context_npc_addr(context)) += 4; + *((unsigned int *) os_context_pc_addr(context)) = *((unsigned int *) os_context_npc_addr(context)); + *((unsigned int *) os_context_npc_addr(context)) += 4; +#ifdef LISP_FEATURE_HPUX + *((os_context_register_t *) &((ucontext_t *) context)->uc_mcontext.ss_flags) + |= SS_MODIFIEDWIDE; +#endif } unsigned int arch_install_breakpoint(void *pc) @@ -127,9 +149,10 @@ void arch_remove_breakpoint(void *pc, unsigned int orig_inst) void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) { + fprintf(stderr, "arch_do_displaced_inst() WARNING: stub.\n"); /* FIXME: Fill this in */ #if 0 -#ifdef hpux +#ifdef LISP_FEATURE_HPUX /* We change the next-pc to point to a breakpoint instruction, restore */ /* the original instruction, and exit. We would like to be able to */ /* sigreturn, but we can't, because this is hpux. */ @@ -156,7 +179,8 @@ void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst) #endif } -#ifdef hpux +#ifdef LISP_FEATURE_HPUX +#if 0 static void restore_breakpoint(struct sigcontext *scp) { /* We just single-stepped over an instruction that we want to replace */ @@ -191,6 +215,9 @@ static void restore_breakpoint(struct sigcontext *scp) } } #endif +#endif + + void arch_handle_breakpoint(os_context_t *context) @@ -208,6 +235,19 @@ arch_handle_fun_end_breakpoint(os_context_t *context) handle_fun_end_breakpoint(context); *os_context_pc_addr(context) = pc; *os_context_npc_addr(context) = pc + 4; + *((os_context_register_t *) &((ucontext_t *) context)->uc_mcontext.ss_flags) + |= SS_MODIFIEDWIDE; +} + + +//FIX-lav: this whole is copied from mips +void +arch_handle_single_step_trap(os_context_t *context, int trap) +{ + unsigned int code = *((u32 *)(os_context_pc(context))); + int register_offset = code >> 11 & 0x1f; + handle_single_step_trap(context, trap, register_offset); + arch_skip_instruction(context); } static void @@ -216,20 +256,31 @@ sigtrap_handler(int signal, siginfo_t *siginfo, void *void_context) os_context_t *context = arch_os_get_context(&void_context); unsigned int bad_inst; -#if 0 - printf("sigtrap_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh, - SC_REG(scp,reg_ALLOC)); -#endif - bad_inst = *(unsigned int *)(*os_context_pc_addr(context) & ~3); if (bad_inst & 0xfc001fe0) interrupt_handle_now(signal, siginfo, context); else { int im5 = bad_inst & 0x1f; - handle_trap(context, trap); + handle_trap(context, im5); } } +static void +sigill_handler(int signal, siginfo_t *siginfo, void *void_context) +{ + os_context_t *context = arch_os_get_context(&void_context); + unsigned int bad_inst; + + bad_inst = *(unsigned int *)(*os_context_pc_addr(context) & ~3); + if (bad_inst == 9) { /* pending-interrupt */ + arch_clear_pseudo_atomic_interrupted(context); + arch_skip_instruction(context); + interrupt_handle_pending(context); + } else { + handle_trap(context,bad_inst); + } +} + static void sigfpe_handler(int signal, siginfo_t *siginfo, void *void_context) { os_context_t *context = arch_os_get_context(&void_context); @@ -237,11 +288,6 @@ static void sigfpe_handler(int signal, siginfo_t *siginfo, void *void_context) int opcode, r1, r2, t; long op1, op2, res; -#if 0 - printf("sigfpe_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh, - SC_REG(scp,reg_ALLOC)); -#endif - switch (siginfo->si_code) { case FPE_INTOVF: /*I_OVFLO: */ badinst = *(unsigned int *)(*os_context_pc_addr(context) & ~3); @@ -274,7 +320,7 @@ static void sigfpe_handler(int signal, siginfo_t *siginfo, void *void_context) /* Add or subtract immediate. */ op1 = ((badinst >> 3) & 0xff) | ((-badinst&1)<<8); r2 = (badinst >> 16) & 0x1f; - op2 = fixnum_value(*os_context_register_addr(context, r1)); + op2 = fixnum_value(*os_context_register_addr(context, r2)); t = (badinst >> 21) & 0x1f; if (opcode == 0x2d) res = op1 + op2; @@ -283,7 +329,6 @@ static void sigfpe_handler(int signal, siginfo_t *siginfo, void *void_context) } else goto not_interesting; - /* ?? What happens here if we hit the end of dynamic space? */ dynamic_space_free_pointer = (lispobj *) *os_context_register_addr(context, reg_ALLOC); *os_context_register_addr(context, t) = alloc_number(res); @@ -292,15 +337,20 @@ static void sigfpe_handler(int signal, siginfo_t *siginfo, void *void_context) arch_skip_instruction(context); break; - - case 0: /* I_COND: ?? Maybe tagged add?? FIXME */ +//#ifdef LINUX +// case 0: +//#endif + case FPE_COND: badinst = *(unsigned int *)(*os_context_pc_addr(context) & ~3); if ((badinst&0xfffff800) == (0xb000e000|reg_ALLOC<<21|reg_ALLOC<<16)) { - /* It is an ADDIT,OD i,ALLOC,ALLOC instruction that trapped. */ - /* That means that it is the end of a pseudo-atomic. So do the */ - /* add stripping off the pseudo-atomic-interrupted bit, and then */ - /* tell the machine-independent code to process the pseudo- */ - /* atomic. */ + /* It is an ADDIT,OD i,ALLOC,ALLOC instruction that trapped. + * That means that it is the end of a pseudo-atomic. So do the + * add stripping off the pseudo-atomic-interrupted bit, and then + * tell the machine-independent code to process the pseudo- + * atomic. We cant skip the instruction because it holds + * extra-bytes that we must add to reg_alloc in context. + * It is so because we optimized away 'addi ,extra-bytes reg_alloc' + */ int immed = (badinst>>1)&0x3ff; if (badinst & 1) immed |= -1<<10; @@ -375,7 +425,7 @@ static void sigbus_handler(int signal, siginfo_t *siginfo, void *void_context) /* Add or subtract immediate. */ op1 = ((badinst >> 3) & 0xff) | ((-badinst&1)<<8); r2 = (badinst >> 16) & 0x1f; - op2 = fixnum_value(*os_context_register_addr(context, r1)); + op2 = fixnum_value(*os_context_register_addr(context, r2)); t = (badinst >> 21) & 0x1f; if (opcode == 0x2d) res = op1 + op2; @@ -399,11 +449,23 @@ static void sigbus_handler(int signal, siginfo_t *siginfo, void *void_context) } } +static void +ignore_handler(int signal, siginfo_t *siginfo, void *void_context) +{ +} +/* this routine installs interrupt handlers that will + * bypass the lisp interrupt handlers */ void arch_install_interrupt_handlers(void) { undoably_install_low_level_interrupt_handler(SIGTRAP,sigtrap_handler); + undoably_install_low_level_interrupt_handler(SIGILL,sigill_handler); undoably_install_low_level_interrupt_handler(SIGFPE,sigfpe_handler); /* FIXME: beyond 2.4.19-pa4 this shouldn't be necessary. */ undoably_install_low_level_interrupt_handler(SIGBUS,sigbus_handler); +#ifdef LISP_FEATURE_HPUX + undoably_install_low_level_interrupt_handler(SIGXCPU,ignore_handler); + undoably_install_low_level_interrupt_handler(SIGXFSZ,ignore_handler); +#endif } + diff --git a/src/runtime/hppa-assem.S b/src/runtime/hppa-assem.S index 107140a..fd2068f 100644 --- a/src/runtime/hppa-assem.S +++ b/src/runtime/hppa-assem.S @@ -2,47 +2,54 @@ #include "sbcl.h" #include "lispregs.h" +#include "genesis/closure.h" +#include "genesis/fdefn.h" +#include "genesis/simple-fun.h" +#include "genesis/return-pc.h" +#include "genesis/static-symbols.h" +#include "genesis/funcallable-instance.h" + + .level 2.0 + .text .import $global$,data + .import $$dyncall,MILLICODE .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 dynamic_space_free_pointer,data +/* .import return_from_lisp_function,data */ -/* .space $TEXT$ - .subspace $CODE$ - .import $$dyncall,MILLICODE -*/ /* * Call-into-lisp */ .export call_into_lisp -call_into_lisp: +call_into_lisp: .proc .callinfo entry_gr=18,save_rp .entry /* %arg0=function, %arg1=cfp, %arg2=nargs */ - stw %rp,-0x14(%sr0,%sp) - stwm %r3,0x40(%sr0,%sp) - stw %r4,-0x3c(%sr0,%sp) - stw %r5,-0x38(%sr0,%sp) - stw %r6,-0x34(%sr0,%sp) - stw %r7,-0x30(%sr0,%sp) - stw %r8,-0x2c(%sr0,%sp) - stw %r9,-0x28(%sr0,%sp) - stw %r10,-0x24(%sr0,%sp) - stw %r11,-0x20(%sr0,%sp) - stw %r12,-0x1c(%sr0,%sp) - stw %r13,-0x18(%sr0,%sp) - stw %r14,-0x14(%sr0,%sp) - stw %r15,-0x10(%sr0,%sp) - stw %r16,-0xc(%sr0,%sp) - stw %r17,-0x8(%sr0,%sp) - stw %r18,-0x4(%sr0,%sp) + stw %rp,-0x14(%sr0,%sp) + stwm %r3,0x40(%sr0,%sp) + stw %r4,-0x3c(%sr0,%sp) + stw %r5,-0x38(%sr0,%sp) + stw %r6,-0x34(%sr0,%sp) + stw %r7,-0x30(%sr0,%sp) + stw %r8,-0x2c(%sr0,%sp) + stw %r9,-0x28(%sr0,%sp) + stw %r10,-0x24(%sr0,%sp) + stw %r11,-0x20(%sr0,%sp) + stw %r12,-0x1c(%sr0,%sp) + stw %r13,-0x18(%sr0,%sp) + stw %r14,-0x14(%sr0,%sp) + stw %r15,-0x10(%sr0,%sp) + stw %r16,-0xc(%sr0,%sp) + stw %r17,-0x8(%sr0,%sp) + stw %r18,-0x4(%sr0,%sp) /* Clear the descriptor regs, moving in args as approporate. */ copy %r0,reg_CODE @@ -96,8 +103,8 @@ call_into_lisp: ldw 20(reg_CFP),reg_A5 /* Calculate the LRA. */ - ldil L%lra+OTHER_POINTER_LOWTAG,reg_LRA - ldo R%lra+OTHER_POINTER_LOWTAG(reg_LRA),reg_LRA + ldil L%lra-RETURN_PC_RETURN_POINT_OFFSET,reg_LRA + ldo R%lra-RETURN_PC_RETURN_POINT_OFFSET(reg_LRA),reg_LRA /* Indirect the closure */ ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_CODE @@ -111,13 +118,15 @@ break_here: break 0,0 .align 8 -lra: - .word RETURN_PC_HEADER_WIDETAG - copy reg_OCFP,reg_CSP +lra: + nop /* a few nops because we dont know where we land */ + nop /* the return convention would govern this */ + nop + nop /* Copy CFP (%r4) into someplace else and restore r4. */ copy reg_CFP,reg_NL1 - ldw -64(0,%sp),%r4 + ldw -0x3c(0,%sp),%r4 /* Copy the return value. */ copy reg_A0,%ret0 @@ -144,26 +153,24 @@ lra: /* Turn off pseudo-atomic and check for traps. */ addit,od -4,reg_ALLOC,reg_ALLOC - - ldw -0x54(%sr0,%sp),%rp - ldw -0x4(%sr0,%sp),%r18 - ldw -0x8(%sr0,%sp),%r17 - ldw -0xc(%sr0,%sp),%r16 - ldw -0x10(%sr0,%sp),%r15 - ldw -0x14(%sr0,%sp),%r14 - ldw -0x18(%sr0,%sp),%r13 - ldw -0x1c(%sr0,%sp),%r12 - ldw -0x20(%sr0,%sp),%r11 - ldw -0x24(%sr0,%sp),%r10 - ldw -0x28(%sr0,%sp),%r9 - ldw -0x2c(%sr0,%sp),%r8 - ldw -0x30(%sr0,%sp),%r7 - ldw -0x34(%sr0,%sp),%r6 - ldw -0x38(%sr0,%sp),%r5 - ldw -0x3c(%sr0,%sp),%r4 - bv %r0(%rp) - ldwm -0x40(%sr0,%sp),%r3 - + ldw -0x54(%sr0,%sp),%rp + ldw -0x4(%sr0,%sp),%r18 + ldw -0x8(%sr0,%sp),%r17 + ldw -0xc(%sr0,%sp),%r16 + ldw -0x10(%sr0,%sp),%r15 + ldw -0x14(%sr0,%sp),%r14 + ldw -0x18(%sr0,%sp),%r13 + ldw -0x1c(%sr0,%sp),%r12 + ldw -0x20(%sr0,%sp),%r11 + ldw -0x24(%sr0,%sp),%r10 + ldw -0x28(%sr0,%sp),%r9 + ldw -0x2c(%sr0,%sp),%r8 + ldw -0x30(%sr0,%sp),%r7 + ldw -0x34(%sr0,%sp),%r6 + ldw -0x38(%sr0,%sp),%r5 + ldw -0x3c(%sr0,%sp),%r4 + bv %r0(%rp) + ldwm -0x40(%sr0,%sp),%r3 /* And thats all. */ .exit @@ -174,22 +181,22 @@ lra: * 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. - */ +call_into_c: + /* Set up a lisp stack frame. */ copy reg_CFP, reg_OCFP copy reg_CSP, reg_CFP addi 32, reg_CSP, reg_CSP - stw reg_OCFP, 0(0,reg_CFP) + stw reg_OCFP, 0(0,reg_CFP) ; save old cfp + stw reg_CFP, 4(0,reg_CFP) ; save old csp + /* convert raw return PC into a fixnum PC-offset, because we dont + have ahold of an lra object */ sub reg_LIP, reg_CODE, reg_NL5 addi 3-OTHER_POINTER_LOWTAG, reg_NL5, reg_NL5 - stw reg_NL5, 4(0,reg_CFP) - stw reg_CODE, 8(0,reg_CFP) + stw reg_NL5, 8(0,reg_CFP) + stw reg_CODE, 0xc(0,reg_CFP) - /* Turn on pseudo-atomic. */ + /* set pseudo-atomic flag */ addi 4, reg_ALLOC, reg_ALLOC /* Store the lisp state. */ @@ -213,10 +220,10 @@ call_into_c: /* in order to be able to call incrementally linked (ld -A) functions, we have to do some mild trickery here */ - copy reg_CFUNC,%r22 - bl $$dyncall,%r31 - copy %r31, %r2 - + copy reg_CFUNC, %r22 + bl $$dyncall,%r31 + copy %r31, %r2 +call_into_c_return: /* Clear the callee saves descriptor regs. */ copy %r0, reg_A5 copy %r0, reg_L0 @@ -245,26 +252,37 @@ call_into_c: /* Restore CODE. Even though it is in a callee saves register * it might have been GC'ed. */ - ldw 8(0,reg_CFP), reg_CODE + ldw 0xc(0,reg_CFP), reg_CODE /* Restore the return pc. */ - ldw 4(0,reg_CFP), reg_NL0 + ldw 8(0,reg_CFP), reg_NL0 addi OTHER_POINTER_LOWTAG-3, reg_NL0, reg_NL0 +/* + addi -3, reg_NL0, reg_NL0 + ldi OTHER_POINTER_LOWTAG, reg_NL1 + sub reg_NL0, reg_NL1, 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) + ldw 4(0,reg_CFP), reg_CSP + ldw 0(0,reg_CFP), reg_OCFP copy reg_OCFP, reg_CFP - + be 0(5,reg_LIP) + nop /* * Stuff to sanctify a block of memory for execution. + * FIX why does this code work: parisc2.0 guide tells + * us that we should add an sync after fdc and fic and + * then let seven nops be executed before executing the + * sanctified code. */ + .EXPORT sanctify_for_execution -sanctify_for_execution: +sanctify_for_execution: .proc .callinfo .entry @@ -276,7 +294,7 @@ sanctify_for_execution: ldsid (%arg0),%r1 mtsp %r1,%sr1 ldi 32,%r1 ; bytes per cache line -sanctify_loop: +sanctify_loop: fdc 0(%sr1,%arg0) comb,< %arg0,%arg1,sanctify_loop fic,m %r1(%sr1,%arg0) @@ -289,34 +307,11 @@ sanctify_loop: /* - * Trampolines. - */ - - .EXPORT closure_tramp -closure_tramp: - /* reg_FDEFN holds the fdefn object. */ - ldw FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV - ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0 - addi SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP - bv,n 0(reg_LIP) - - .EXPORT undefined_tramp -undefined_tramp: - break trap_Error,0 - .byte 4 - .byte UNDEFINED_FUN_ERROR - .byte 254 - .byte (0x20 + sc_DescriptorReg) - .byte 1 - .align 4 - - -/* * Core saving/restoring support */ .export call_on_stack -call_on_stack: +call_on_stack: /* %arg0 = fn to invoke, %arg1 = new stack base */ /* Compute the new stack pointer. */ @@ -333,7 +328,7 @@ call_on_stack: break 0,0 .export save_state -save_state: +save_state: .proc .callinfo entry_gr=18,entry_fr=21,save_rp,calls .entry @@ -380,7 +375,7 @@ save_state: copy %r31, %r2 .export _restore_state -_restore_state: +_restore_state: ldw -0xd4(%sr0,%sp),%rp ldw -0x34(%sr0,%sp),%r18 @@ -416,7 +411,7 @@ _restore_state: .procend .export restore_state -restore_state: +restore_state: .proc .callinfo copy %arg0,%sp @@ -426,17 +421,20 @@ restore_state: - .export SingleStepTraps -SingleStepTraps: +/* FIX, add support for singlestep break trap_SingleStepBreakpoint,0 break trap_SingleStepBreakpoint,0 +*/ + .export SingleStepTraps +SingleStepTraps: + /* Missing !! NOT there's a break 0,0 in the new version here!!! */ .align 8 .export fun_end_breakpoint_guts -fun_end_breakpoint_guts: +fun_end_breakpoint_guts: .word RETURN_PC_HEADER_WIDETAG /* multiple value return point -- just jump to trap. */ b,n fun_end_breakpoint_trap @@ -451,9 +449,36 @@ fun_end_breakpoint_guts: copy reg_NULL, reg_A5 .export fun_end_breakpoint_trap -fun_end_breakpoint_trap: +fun_end_breakpoint_trap: break trap_FunEndBreakpoint,0 b,n fun_end_breakpoint_trap .export fun_end_breakpoint_end -fun_end_breakpoint_end: +fun_end_breakpoint_end: + +/* FIX-lav: these are found in assem-rtns.lisp too, but + genesis.lisp has problem referencing them, so we keep + these old versions too. Lisp code cant jump to them + because it is an inter space jump but lisp do intra + space jumps */ + + .align 8 + .EXPORT closure_tramp +closure_tramp: + /* reg_FDEFN holds the fdefn object. */ + ldw FDEFN_FUN_OFFSET(0,reg_FDEFN),reg_LEXENV + ldw CLOSURE_FUN_OFFSET(0,reg_LEXENV),reg_L0 + addi SIMPLE_FUN_CODE_OFFSET, reg_L0, reg_LIP + bv,n 0(reg_LIP) + + .align 8 + .EXPORT undefined_tramp +undefined_tramp: + break trap_Error,0 + .byte 4 + .byte UNDEFINED_FUN_ERROR + .byte 254 + .byte (0x20 + sc_DescriptorReg) + .byte 1 + .align 4 + diff --git a/src/runtime/hppa-hpux-os.c b/src/runtime/hppa-hpux-os.c new file mode 100644 index 0000000..166baf3 --- /dev/null +++ b/src/runtime/hppa-hpux-os.c @@ -0,0 +1,91 @@ +/* + * This is the HPPA HPUX incarnation of arch-dependent OS-dependent + * routines. See also "hppa-os.c". + */ + +/* + * This software is part of the SBCL system. See the README file for + * more information. + * + * This software is derived from the CMU CL system, which was + * written at Carnegie Mellon University and released into the + * public domain. The software is in the public domain and is + * provided with absolutely no warranty. See the COPYING and CREDITS + * files for more information. + */ + +#include +#include +#include +#include "sbcl.h" +#include "./signal.h" +#include "os.h" +#include "arch.h" +#include "globals.h" +#include "interrupt.h" +#include "interr.h" +#include "lispregs.h" +#include +#include + +#include +#include +#include +#include +#include + +#include "validate.h" +size_t os_vm_page_size; + +#ifdef LISP_FEATURE_SB_THREAD +#error "Define threading support functions" +#else +int arch_os_thread_init(struct thread *thread) { + return 1; /* success */ +} +int arch_os_thread_cleanup(struct thread *thread) { + return 1; /* success */ +} +#endif + +/* for hpux read /usr/include/machine/save_state.h + * os_context_register_addr() may not be used + * to modify registers without setting a state-flag too */ +os_context_register_t * +os_context_register_addr(os_context_t *context, int offset) +{ + return (os_context_register_t *) + ((unsigned int)(&((ucontext_t *) context)->uc_mcontext.ss_wide.ss_64)) + (offset * 2) + 1; +} + +os_context_register_t * +os_context_pc_addr(os_context_t *context) +{ + /* Why do I get all the silly ports? -- CSR, 2002-08-11 */ + return ((unsigned int) &((ucontext_t *) context)->uc_mcontext.ss_wide.ss_64.ss_pcoq_head + 4); +} + +os_context_register_t * +os_context_npc_addr(os_context_t *context) +{ + return ((unsigned int) &((ucontext_t *) context)->uc_mcontext.ss_wide.ss_64.ss_pcoq_tail + 4); +} + +sigset_t * +os_context_sigmask_addr(os_context_t *context) +{ + return &(((ucontext_t *)context)->uc_subcontext.__uc_sigmask); +} + +void +os_restore_fp_control(os_context_t *context) +{ + /* FIXME: Probably do something. */ +} + +void +os_flush_icache(os_vm_address_t address, os_vm_size_t length) +{ + /* FIXME: Maybe this is OK. */ + sanctify_for_execution(address,length); +} diff --git a/src/runtime/hppa-hpux-os.h b/src/runtime/hppa-hpux-os.h new file mode 100644 index 0000000..4025e83 --- /dev/null +++ b/src/runtime/hppa-hpux-os.h @@ -0,0 +1,17 @@ +#ifndef _HPPA_HPUX_OS_H +#define _HPPA_HPUX_OS_H + +typedef struct ucontext_t os_context_t; +typedef unsigned long os_context_register_t; + +static inline os_context_t *arch_os_get_context(void **void_context) +{ + return (os_context_t *) *void_context; +} + +unsigned long os_context_fp_control(os_context_t *context); +void os_restore_fp_control(os_context_t *context); + +#define REGISTER_ACCESS(context,offset) ((os_context_register_t *) ((unsigned int)(&((ucontext_t *) context)->uc_mcontext.ss_wide.ss_64)) + (offset * 2) + 1) + +#endif /* _HPPA_HPUX_OS_H */ diff --git a/src/runtime/hppa-linux-os.h b/src/runtime/hppa-linux-os.h index 961ec44..818d469 100644 --- a/src/runtime/hppa-linux-os.h +++ b/src/runtime/hppa-linux-os.h @@ -14,4 +14,8 @@ static inline os_context_t *arch_os_get_context(void **void_context) unsigned long os_context_fp_control(os_context_t *context); void os_restore_fp_control(os_context_t *context); +#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) + #endif /* _HPPA_LINUX_OS_H */ diff --git a/src/runtime/hppa-lispregs.h b/src/runtime/hppa-lispregs.h index 9d779e8..39b7cfb 100644 --- a/src/runtime/hppa-lispregs.h +++ b/src/runtime/hppa-lispregs.h @@ -47,17 +47,8 @@ "NL2", "NL1", "NL0", "DP", "NL4", "NL5", "NSP", "LIP" #define BOXED_REGISTERS { \ - reg_CODE, reg_FDEFN, reg_LEXENV, reg_NARGS, reg_OCFP, reg_LRA, \ + reg_CODE, reg_FDEFN, reg_LEXENV, reg_OCFP, reg_LRA, \ reg_A0, reg_A1, reg_A2, reg_A3, reg_A4, reg_A5, \ - reg_L0, reg_L1, reg_L2 \ + reg_L0, reg_L1, reg_L2, reg_NFP \ } -#ifdef hpux -#define SC_REG(sc, n) (((unsigned long *)(&(sc)->sc_sl.sl_ss.ss_flags))[n]) -#define SC_PC(sc) ((sc)->sc_sl.sl_ss.ss_pcoq_head) -#define SC_NPC(sc) ((sc)->sc_sl.sl_ss.ss_pcoq_tail) -#else -#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) -#endif diff --git a/src/runtime/hpux-os.c b/src/runtime/hpux-os.c new file mode 100644 index 0000000..ff59edc --- /dev/null +++ b/src/runtime/hpux-os.c @@ -0,0 +1,154 @@ +#include +#include +#include +#include + +#include +#include +#include +#include + +#include "sbcl.h" +#include "os.h" +#include "arch.h" +#include "interr.h" +#include "interrupt.h" +#include "globals.h" +#include "validate.h" +#include "target-arch-os.h" + +#ifdef LISP_FEATURE_GENCGC +#error gencgc not ported to hpux +#endif + +#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK +#error C_STACK_IS_CONTROL_STACK isnt supported +#endif + +size_t os_vm_page_size; + +void +os_init(char *argv[], char *envp[]) +{ + os_vm_page_size = getpagesize(); +} + +os_vm_address_t +os_validate(os_vm_address_t addr, os_vm_size_t len) +{ + os_vm_address_t actual; + int flags = MAP_PRIVATE | MAP_ANONYMOUS; + if (addr) flags |= MAP_FIXED; + + actual = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); + + if (actual == MAP_FAILED) { + perror("mmap"); + lose("os_validate(): mmap() failure\n"); + } + + if (addr && (addr!=actual)) { + fprintf(stderr, "mmap: wanted %lu bytes at %p, actually mapped at %p\n", + (unsigned long) len, addr, actual); + return 0; + } + + return actual; +} + +void +os_invalidate(os_vm_address_t addr, os_vm_size_t len) +{ + if (munmap(addr,len) == -1) { + perror("munmap"); + lose("os_invalidate(): mmap() failure\n"); + } +} + +os_vm_address_t +os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) +{ + os_vm_address_t actual; + actual = mmap(addr, len, + OS_VM_PROT_ALL, + MAP_PRIVATE | MAP_FILE | MAP_FIXED, + fd, (off_t) offset); + if (actual == MAP_FAILED || (addr && (addr != actual))) { + perror("mmap"); + lose("os_map(): mmap() failure\n"); + } + return actual; +} + +void +os_protect(os_vm_address_t addr, os_vm_size_t len, os_vm_prot_t prot) +{ + if (mprotect(addr, len, prot) == -1) { + perror("mprotect"); + } +} + +boolean +is_valid_lisp_addr(os_vm_address_t addr) +{ + struct thread *th; + size_t ad = (size_t) addr; + + if ((READ_ONLY_SPACE_START <= ad && ad < READ_ONLY_SPACE_END) + || (STATIC_SPACE_START <= ad && ad < STATIC_SPACE_END) + || (DYNAMIC_0_SPACE_START <= ad && ad < DYNAMIC_0_SPACE_END) + || (DYNAMIC_1_SPACE_START <= ad && ad < DYNAMIC_1_SPACE_END) + ) + return 1; + for_each_thread(th) { + if((size_t)(th->control_stack_start) <= ad + && ad < (size_t)(th->control_stack_end)) + return 1; + if((size_t)(th->binding_stack_start) <= ad + && ad < (size_t)(th->binding_stack_start + BINDING_STACK_SIZE)) + return 1; + } + return 0; +} + +/* + * any OS-dependent special low-level handling for signals + */ + +static void +sigsegv_handler(int signal, siginfo_t *info, void* void_context) +{ + os_context_t *context = arch_os_get_context(&void_context); + os_vm_address_t addr = arch_get_bad_addr(signal, info, context); + + if (!cheneygc_handle_wp_violation(context, addr)) + if (!handle_guard_page_triggered(context, addr)) + interrupt_handle_now(signal, info, context); + *((os_context_register_t *) &((ucontext_t *) context)->uc_mcontext.ss_flags) + |= SS_MODIFIEDWIDE; +} + +void +os_install_interrupt_handlers(void) +{ + undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT, + sigsegv_handler); +} + +char * +os_get_runtime_executable_path() +{ + return copied_string("NOPE"); +} + +/* when inside call_into_lisp, we will first jump to the stub + * and then the stub will jump into the lisp function. Then + * the lisp function will return to the stub function and + * the stub will return to the call_into_lisp function. + */ +void *return_from_lisp_stub; +void +setup_return_from_lisp_stub (void *addr) +{ + return_from_lisp_stub = addr; +} diff --git a/src/runtime/hpux-os.h b/src/runtime/hpux-os.h new file mode 100644 index 0000000..bc4d404 --- /dev/null +++ b/src/runtime/hpux-os.h @@ -0,0 +1,18 @@ +#include /* warnings in os-common */ +#include +#include +#include /* recognize signal_t */ +#include "target-arch-os.h" +#include "target-arch.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 SIG_MEMORY_FAULT SIGSEGV + diff --git a/version.lisp-expr b/version.lisp-expr index 8b0fec1..2112b35 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.24.17" +"1.0.24.18" -- 1.7.10.4