gencgc: More precise conservatism for pointers to boxed pages.
[sbcl.git] / src / runtime / alpha-arch.c
index 8cd654a..2f1c559 100644 (file)
@@ -28,7 +28,6 @@
 #include "interrupt.h"
 #include "interr.h"
 #include "breakpoint.h"
-#include "monitor.h"
 
 extern char call_into_lisp_LRA[], call_into_lisp_end[];
 
@@ -43,22 +42,22 @@ arch_init(void)
      * page size is. */
 
     if (mmap((os_vm_address_t) call_into_lisp_LRA_page,os_vm_page_size,
-            OS_VM_PROT_ALL,MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED,-1,0)
-       == (os_vm_address_t) -1)
-       perror("mmap");
-    
+             OS_VM_PROT_ALL,MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED,-1,0)
+        == (os_vm_address_t) -1)
+        perror("mmap");
+
     /* call_into_lisp_LRA is a collection of trampolines written in asm -
      * see alpha-assem.S.  We copy it to call_into_lisp_LRA_page where
-     * VOPs and things can find it. (I don't know why they can't find it 
+     * VOPs and things can find it. (I don't know why they can't find it
      * where it was to start with.) */
     bcopy(call_into_lisp_LRA,(void *)call_into_lisp_LRA_page,os_vm_page_size);
 
     os_flush_icache((os_vm_address_t)call_into_lisp_LRA_page,
-                   os_vm_page_size);
+                    os_vm_page_size);
     return;
 }
 
-os_vm_address_t 
+os_vm_address_t
 arch_get_bad_addr (int sig, siginfo_t *code, os_context_t *context)
 {
     unsigned int badinst;
@@ -66,18 +65,18 @@ arch_get_bad_addr (int sig, siginfo_t *code, os_context_t *context)
     /* Instructions are 32 bit quantities. */
     unsigned int *pc ;
     /*  fprintf(stderr,"arch_get_bad_addr %d %p %p\n",
-       sig, code, context); */
+        sig, code, context); */
     pc= (unsigned int *)(*os_context_pc_addr(context));
 
     if (((unsigned long)pc) & 3) {
-       return NULL;            /* In what case would pc be unaligned?? */
+        return NULL;            /* In what case would pc be unaligned?? */
     }
 
     if ( (pc < READ_ONLY_SPACE_START ||
-         pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) && 
-        (pc < current_dynamic_space ||
-         pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE))
-       return NULL;
+          pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) &&
+         (pc < current_dynamic_space ||
+          pc >= current_dynamic_space + dynamic_space_size))
+        return NULL;
 
     return context->uc_mcontext.sc_traparg_a0;
 }
@@ -88,7 +87,10 @@ arch_skip_instruction(os_context_t *context)
     /* This may be complete rubbish, as (at least for traps) pc points
      * _after_ the instruction that caused us to be here anyway.
      */
-    ((char*)*os_context_pc_addr(context)) +=4; }
+    char **pcptr;
+    pcptr = (char **) os_context_pc_addr(context);
+    *pcptr += 4;
+}
 
 unsigned char *
 arch_internal_error_arguments(os_context_t *context)
@@ -99,40 +101,54 @@ arch_internal_error_arguments(os_context_t *context)
 boolean
 arch_pseudo_atomic_atomic(os_context_t *context)
 {
-    return ((*os_context_register_addr(context,reg_ALLOC)) & 1);
+    /* FIXME: this foreign_function_call_active test is dubious at
+     * best. If a foreign call is made in a pseudo atomic section
+     * (?) or more likely a pseudo atomic section is in a foreign
+     * call then an interrupt is executed immediately. Maybe it
+     * has to do with C code not maintaining pseudo atomic
+     * properly. MG - 2005-08-10
+     *
+     * 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)) & 1);
 }
 
 void arch_set_pseudo_atomic_interrupted(os_context_t *context)
 {
     /* On coming out of an atomic section, we subtract 1 from
      * reg_Alloc, then try to store something at that address.  So,
-     * to signal that it was interrupted and a signal should be handled, 
+     * to signal that it was interrupted and a signal should be handled,
      * we set bit 63 of reg_ALLOC here so that the end-of-atomic code
      * will raise SIGSEGV (no ram mapped there).  We catch the signal
-     * (see the appropriate *-os.c) and call interrupt_handle_pending() 
+     * (see the appropriate *-os.c) and call interrupt_handle_pending()
      * for the saved signal instead */
 
     *os_context_register_addr(context,reg_ALLOC) |=  (1L<<63);
 }
 
-unsigned long arch_install_breakpoint(void *pc)
+void arch_clear_pseudo_atomic_interrupted(os_context_t *context)
+{
+    *os_context_register_addr(context, reg_ALLOC) &= ~(1L<<63);
+}
+
+unsigned int arch_install_breakpoint(void *pc)
 {
     unsigned int *ptr = (unsigned int *)pc;
-    unsigned long result = (unsigned long) *ptr;
+    unsigned int result = *ptr;
     *ptr = BREAKPOINT_INST;
-    
-    os_flush_icache((os_vm_address_t)ptr, sizeof(unsigned long));
-    
+
+    os_flush_icache((os_vm_address_t)ptr, sizeof(unsigned int));
+
     return result;
 }
 
-void arch_remove_breakpoint(void *pc, unsigned long orig_inst)
+void arch_remove_breakpoint(void *pc, unsigned int orig_inst)
 {
-    /* was (unsigned int) but gcc complains.  Changed to mirror
-     * install_breakpoint() above */
-    unsigned long *ptr=(unsigned long *)pc;
+    unsigned int *ptr = (unsigned int *)pc;
     *ptr = orig_inst;
-    os_flush_icache((os_vm_address_t)pc, sizeof(unsigned long));
+    os_flush_icache((os_vm_address_t)pc, sizeof(unsigned int));
 }
 
 static unsigned int *skipped_break_addr, displaced_after_inst,
@@ -142,78 +158,78 @@ static unsigned int *skipped_break_addr, displaced_after_inst,
 /* This returns a PC value.  Lisp code is all in the 32-bit-addressable
  * space, so we should be ok with an unsigned int. */
 unsigned int
-emulate_branch(os_context_t *context,unsigned long orig_inst)
+emulate_branch(os_context_t *context, unsigned int orig_inst)
 {
     int op = orig_inst >> 26;
     int reg_a = (orig_inst >> 21) & 0x1f;
     int reg_b = (orig_inst >> 16) & 0x1f;
     int disp =
-       (orig_inst&(1<<20)) ?
-       orig_inst | (-1 << 21) :
-       orig_inst&0x1fffff;
+        (orig_inst&(1<<20)) ?
+        orig_inst | (-1 << 21) :
+        orig_inst&0x1fffff;
     int next_pc = *os_context_pc_addr(context);
-    int branch = 0; /* was NULL;              */
+    int branch = 0; /* was NULL;               */
 
     switch(op) {
     case 0x1a: /* jmp, jsr, jsr_coroutine, ret */
-       *os_context_register_addr(context,reg_a) =
-           *os_context_pc_addr(context);
-       *os_context_pc_addr(context) =
-           *os_context_register_addr(context,reg_b)& ~3;
-       break;
+        *os_context_register_addr(context,reg_a) =
+            *os_context_pc_addr(context);
+        *os_context_pc_addr(context) =
+            *os_context_register_addr(context,reg_b)& ~3;
+        break;
     case 0x30: /* br */
-       *os_context_register_addr(context,reg_a)=*os_context_pc_addr(context);
-       branch = 1;
-       break;
+        *os_context_register_addr(context,reg_a)=*os_context_pc_addr(context);
+        branch = 1;
+        break;
     case 0x31: /* fbeq */
-       if (*(os_context_float_register_addr(context,reg_a))==0) branch = 1;
-       break;
+        if (*(os_context_float_register_addr(context,reg_a))==0) branch = 1;
+        break;
     case 0x32: /* fblt */
-       if (*os_context_float_register_addr(context,reg_a)<0) branch = 1;
-       break;
+        if (*os_context_float_register_addr(context,reg_a)<0) branch = 1;
+        break;
     case 0x33: /* fble */
-       if (*os_context_float_register_addr(context,reg_a)<=0) branch = 1;
-       break;
+        if (*os_context_float_register_addr(context,reg_a)<=0) branch = 1;
+        break;
     case 0x34: /* bsr */
-       *os_context_register_addr(context,reg_a)=*os_context_pc_addr(context);
-       branch = 1;
-       break;
+        *os_context_register_addr(context,reg_a)=*os_context_pc_addr(context);
+        branch = 1;
+        break;
     case 0x35: /* fbne */
-       if (*os_context_register_addr(context,reg_a)!=0) branch = 1;
-       break;
+        if (*os_context_register_addr(context,reg_a)!=0) branch = 1;
+        break;
     case 0x36: /* fbge */
-       if (*os_context_float_register_addr(context,reg_a)>=0) branch = 1;
-       break;
+        if (*os_context_float_register_addr(context,reg_a)>=0) branch = 1;
+        break;
     case 0x37: /* fbgt */
-       if (*os_context_float_register_addr(context,reg_a)>0) branch = 1;
-       break;
+        if (*os_context_float_register_addr(context,reg_a)>0) branch = 1;
+        break;
     case 0x38: /* blbc */
-       if ((*os_context_register_addr(context,reg_a)&1) == 0) branch = 1;
-       break;
+        if ((*os_context_register_addr(context,reg_a)&1) == 0) branch = 1;
+        break;
     case 0x39: /* beq */
-       if (*os_context_register_addr(context,reg_a)==0) branch = 1;
-       break;
+        if (*os_context_register_addr(context,reg_a)==0) branch = 1;
+        break;
     case 0x3a: /* blt */
-       if (*os_context_register_addr(context,reg_a)<0) branch = 1;
-       break;
+        if (*os_context_register_addr(context,reg_a)<0) branch = 1;
+        break;
     case 0x3b: /* ble */
-       if (*os_context_register_addr(context,reg_a)<=0) branch = 1;
-       break;
+        if (*os_context_register_addr(context,reg_a)<=0) branch = 1;
+        break;
     case 0x3c: /* blbs */
-       if ((*os_context_register_addr(context,reg_a)&1)!=0) branch = 1;
-       break;
+        if ((*os_context_register_addr(context,reg_a)&1)!=0) branch = 1;
+        break;
     case 0x3d: /* bne */
-       if (*os_context_register_addr(context,reg_a)!=0) branch = 1;
-       break;
+        if (*os_context_register_addr(context,reg_a)!=0) branch = 1;
+        break;
     case 0x3e: /* bge */
-       if (*os_context_register_addr(context,reg_a)>=0) branch = 1;
-       break;
+        if (*os_context_register_addr(context,reg_a)>=0) branch = 1;
+        break;
     case 0x3f: /* bgt */
-       if (*os_context_register_addr(context,reg_a)>0) branch = 1;
-       break;
+        if (*os_context_register_addr(context,reg_a)>0) branch = 1;
+        break;
     }
     if (branch)
-       next_pc += disp*4;
+        next_pc += disp*4;
     return next_pc;
 }
 
@@ -222,16 +238,16 @@ static sigset_t orig_sigmask;
 /* Perform the instruction that we overwrote with a breakpoint.  As we
  * don't have a single-step facility, this means we have to:
  * - put the instruction back
- * - put a second breakpoint at the following instruction, 
+ * - put a second breakpoint at the following instruction,
  *   set after_breakpoint and continue execution.
  *
  * When the second breakpoint is hit (very shortly thereafter, we hope)
- * sigtrap_handler gets called again, but follows the AfterBreakpoint 
- * arm, which 
- * - puts a bpt back in the first breakpoint place (running across a 
+ * sigtrap_handler gets called again, but follows the AfterBreakpoint
+ * arm, which
+ * - puts a bpt back in the first breakpoint place (running across a
  *   breakpoint shouldn't cause it to be uninstalled)
  * - replaces the second bpt with the instruction it was meant to be
- * - carries on 
+ * - carries on
  *
  * Clear?
  */
@@ -257,37 +273,52 @@ void arch_do_displaced_inst(os_context_t *context,unsigned int orig_inst)
 
     /* Put the original instruction back. */
     *pc = orig_inst;
-    os_flush_icache((os_vm_address_t)pc, sizeof(unsigned long));
+    os_flush_icache((os_vm_address_t)pc, sizeof(unsigned int));
     skipped_break_addr = pc;
 
-    /* Figure out where we will end up after running the displaced 
+    /* Figure out where we will end up after running the displaced
      * instruction */
     if (op == 0x1a || (op&0xf) == 0x30) /* a branch */
-       /* The cast to long is just to shut gcc up. */
-       next_pc = (unsigned int *)((long)emulate_branch(context,orig_inst));
+        /* The cast to long is just to shut gcc up. */
+        next_pc = (unsigned int *)((long)emulate_branch(context,orig_inst));
     else
-       next_pc = pc+1;
-    
+        next_pc = pc+1;
+
     /* Set the after breakpoint. */
     displaced_after_inst = *next_pc;
     *next_pc = BREAKPOINT_INST;
     after_breakpoint=1;
-    os_flush_icache((os_vm_address_t)next_pc, sizeof(unsigned long));
+    os_flush_icache((os_vm_address_t)next_pc, sizeof(unsigned int));
+}
+
+void
+arch_handle_breakpoint(os_context_t *context)
+{
+        *os_context_pc_addr(context) -=4;
+        handle_breakpoint(context);
+}
+
+void
+arch_handle_fun_end_breakpoint(os_context_t *context)
+{
+    *os_context_pc_addr(context) -=4;
+    *os_context_pc_addr(context) =
+        (int)handle_fun_end_breakpoint(context);
+}
+
+void
+arch_handle_single_step_trap(os_context_t *context, int trap)
+{
+    unsigned int code = *((u32 *) (*os_context_pc_addr(context)));
+    int register_offset = code >> 5 & 0x1f;
+    handle_single_step_trap(context, trap, register_offset);
+    arch_skip_instruction(context);
 }
 
 static void
 sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
 {
     unsigned int code;
-    sigset_t *mask;
-#ifdef LISP_FEATURE_LINUX
-    os_restore_fp_control(context);
-#endif
-
-    /* Don't disallow recursive breakpoint traps.  Otherwise, we can't */
-    /* use debugger breakpoints anywhere in here. */
-    mask=(os_context_sigmask_addr(context));
-    sigsetmask(mask); 
 
     /* this is different from how CMUCL does it.  CMUCL used "call_pal
      * PAL_gentrap", which doesn't do anything on Linux (unless NL0
@@ -297,58 +328,27 @@ sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
      * breakpoint or a "system service" */
 
     if ((*(unsigned int*)(*os_context_pc_addr(context)-4))==BREAKPOINT_INST) {
-       if (after_breakpoint) {
-           /* see comments above arch_do_displaced_inst.  This is where
-            * we reinsert the breakpoint that we removed earlier */
-
-           *os_context_pc_addr(context) -=4;
-           *skipped_break_addr = BREAKPOINT_INST;
-           os_flush_icache((os_vm_address_t)skipped_break_addr,
-                           sizeof(unsigned long));
-           skipped_break_addr = NULL;
-           *(unsigned int *)*os_context_pc_addr(context) =
-               displaced_after_inst;
-           os_flush_icache((os_vm_address_t)*os_context_pc_addr(context), sizeof(unsigned long));
-           *os_context_sigmask_addr(context)= orig_sigmask;
-           after_breakpoint=0; /* false */
-           return;
-       } else 
-           code = trap_Breakpoint;
+        if (after_breakpoint) {
+            /* see comments above arch_do_displaced_inst.  This is where
+             * we reinsert the breakpoint that we removed earlier */
+
+            *os_context_pc_addr(context) -=4;
+            *skipped_break_addr = BREAKPOINT_INST;
+            os_flush_icache((os_vm_address_t)skipped_break_addr,
+                            sizeof(unsigned int));
+            skipped_break_addr = NULL;
+            *(unsigned int *)*os_context_pc_addr(context) =
+                displaced_after_inst;
+            os_flush_icache((os_vm_address_t)*os_context_pc_addr(context), sizeof(unsigned int));
+            *os_context_sigmask_addr(context)= orig_sigmask;
+            after_breakpoint=0; /* false */
+            return;
+        } else
+            code = trap_Breakpoint;
     } else
-       /* a "system service" */
+        /* a "system service" */
     code=*((u32 *)(*os_context_pc_addr(context)));
-    
-    switch (code) {
-      case trap_PendingInterrupt:
-       arch_skip_instruction(context);
-       interrupt_handle_pending(context);
-       break;
-
-      case trap_Halt:
-       fake_foreign_function_call(context);
-       lose("%%primitive halt called; the party is over.\n");
-
-      case trap_Error:
-      case trap_Cerror:
-       interrupt_internal_error(signal, siginfo, context, code==trap_Cerror);
-       break;
-
-    case trap_Breakpoint:       /* call lisp-level handler */
-        *os_context_pc_addr(context) -=4;
-       handle_breakpoint(signal, siginfo, context);
-       break;
-
-      case trap_FunEndBreakpoint:
-        *os_context_pc_addr(context) -=4;
-       *os_context_pc_addr(context) =
-           (int)handle_fun_end_breakpoint(signal, siginfo, context);
-       break;
-
-      default:
-       fprintf(stderr, "unidentified breakpoint/trap %d\n",code);
-       interrupt_handle_now(signal, siginfo, context);
-       break;
-    }
+    handle_trap(context, code);
 }
 
 unsigned long
@@ -368,46 +368,3 @@ void arch_install_interrupt_handlers()
 {
     undoably_install_low_level_interrupt_handler(SIGTRAP, sigtrap_handler);
 }
-
-extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
-
-lispobj funcall0(lispobj function)
-{
-    lispobj *args = current_control_stack_pointer;
-
-    return call_into_lisp(function, args, 0);
-}
-
-lispobj funcall1(lispobj function, lispobj arg0)
-{
-    lispobj *args = current_control_stack_pointer;
-
-    current_control_stack_pointer += 1;
-    args[0] = arg0;
-
-    return call_into_lisp(function, args, 1);
-}
-
-lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1)
-{
-    lispobj *args = current_control_stack_pointer;
-
-    current_control_stack_pointer += 2;
-    args[0] = arg0;
-    args[1] = arg1;
-
-    return call_into_lisp(function, args, 2);
-}
-
-lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
-{
-    lispobj *args = current_control_stack_pointer;
-
-    current_control_stack_pointer += 3;
-    args[0] = arg0;
-    args[1] = arg1;
-    args[2] = arg2;
-
-    return call_into_lisp(function, args, 3);
-}
-