Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/runtime hppa-hpux-os.c, NONE, 1.1 hppa-hpux-os.h, NONE, 1.1 hpux-os.c, NONE, 1.1 hpux-os.h, NONE, 1.1 hppa-arch.c, 1.14, 1.15 hppa-assem.S, 1.2, 1.3 hppa-linux-os.h, 1.3, 1.4 hppa-lispregs.h, 1.2, 1.3
Update of /cvsroot/sbcl/sbcl/src/runtime In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv2351/src/runtime Modified Files: hppa-arch.c hppa-assem.S hppa-linux-os.h hppa-lispregs.h Added Files: hppa-hpux-os.c hppa-hpux-os.h hpux-os.c hpux-os.h Log Message: 1.0.24.18: new HPUX specific files * Also more separation of linux stuff versus common stuff (hpux vs linux). * Patch by Larry Valkama. --- NEW FILE: hppa-hpux-os.c --- /* * 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 <stdio.h> #include <sys/param.h> #include <sys/file.h> #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 <sys/socket.h> #include <sys/utsname.h> #include <sys/types.h> #include <signal.h> #include <sys/time.h> #include <sys/stat.h> #include <unistd.h> #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); } --- NEW FILE: hppa-hpux-os.h --- #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 */ --- NEW FILE: hpux-os.c --- #include <stdio.h> #include <stdlib.h> #include <signal.h> #include <sys/file.h> #include <unistd.h> #include <errno.h> #include <sys/param.h> #include <sys/utsname.h> #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; } --- NEW FILE: hpux-os.h --- #include <strings.h> /* warnings in os-common */ #include <sys/types.h> #include <sys/mman.h> #include <sys/newsig.h> /* 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 Index: hppa-arch.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/hppa-arch.c,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- hppa-arch.c 15 May 2007 14:14:33 -0000 1.14 +++ hppa-arch.c 3 Jan 2009 16:26:22 -0000 1.15 @@ -29,11 +29,17 @@ 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 @@ * 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_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 @@ #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 @@ } } #endif +#endif + + void arch_handle_breakpoint(os_context_t *context) @@ -208,6 +235,19 @@ 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 @@ 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 @@ 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 @@ /* 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 @@ } 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 @@ 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 @@ /* 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 +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 } + Index: hppa-assem.S =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/hppa-assem.S,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- hppa-assem.S 31 Aug 2002 09:52:16 -0000 1.2 +++ hppa-assem.S 3 Jan 2009 16:26:22 -0000 1.3 @@ -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 @@ 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 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 @@ /* 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 @@ * 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 @@ /* 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 @@ /* 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 @@ 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 @@ /* - * 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 @@ 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 @@ copy %r31, %r2 .export _restore_state -_restore_state: +_restore_state: ldw -0xd4(%sr0,%sp),%rp ldw -0x34(%sr0,%sp),%r18 @@ -416,7 +411,7 @@ .procend .export restore_state -restore_state: +restore_state: .proc .callinfo copy %arg0,%sp @@ -426,17 +421,20 @@ - .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 @@ 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 + Index: hppa-linux-os.h =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/hppa-linux-os.h,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- hppa-linux-os.h 25 Jul 2007 21:37:31 -0000 1.3 +++ hppa-linux-os.h 3 Jan 2009 16:26:22 -0000 1.4 @@ -14,4 +14,8 @@ 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 */ Index: hppa-lispregs.h =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/hppa-lispregs.h,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- hppa-lispregs.h 14 Jul 2005 15:41:11 -0000 1.2 +++ hppa-lispregs.h 3 Jan 2009 16:26:22 -0000 1.3 @@ -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 |