* Also more separation of linux stuff versus common stuff (hpux vs linux).
* Patch by Larry Valkama.
--- /dev/null
+;;;; 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)))
+
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;
* 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)
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. */
#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 */
}
}
#endif
+#endif
+
+
void
arch_handle_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
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);
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);
/* 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;
}
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);
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;
/* 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;
}
}
+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
}
+
#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
-*/
\f
/*
* 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
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
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
/* 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
* 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. */
/* 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
/* 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
\f
/*
* 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
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)
\f
/*
- * 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
-
-\f
-/*
* 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. */
break 0,0
.export save_state
-save_state:
+save_state:
.proc
.callinfo entry_gr=18,entry_fr=21,save_rp,calls
.entry
copy %r31, %r2
.export _restore_state
-_restore_state:
+_restore_state:
ldw -0xd4(%sr0,%sp),%rp
ldw -0x34(%sr0,%sp),%r18
.procend
.export restore_state
-restore_state:
+restore_state:
.proc
.callinfo
copy %arg0,%sp
- .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
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
+
--- /dev/null
+/*
+ * 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);
+}
--- /dev/null
+#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 */
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 */
"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
--- /dev/null
+#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;
+}
+\f
+/*
+ * 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;
+}
--- /dev/null
+#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
+
;;; 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"
projects / sbcl.git / commitdiff