1.1.13: will be tagged as "sbcl-1.1.13"
[sbcl.git] / src / runtime / ppc-arch.c
index ac6b3d9..281de3c 100644 (file)
@@ -1,3 +1,14 @@
+/*
+ * 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 "sbcl.h"
 #include "globals.h"
 #include "validate.h"
 #include "os.h"
+#include "interrupt.h"
 #include "lispregs.h"
 #include "signal.h"
 #include "interrupt.h"
 #include "interr.h"
+#include "breakpoint.h"
+#include "alloc.h"
 
 #if defined(LISP_FEATURE_GENCGC)
 #include "gencgc-alloc-region.h"
 #endif
 
+#ifdef LISP_FEATURE_SB_THREAD
+#include "pseudo-atomic.h"
+#endif
+
   /* The header files may not define PT_DAR/PT_DSISR.  This definition
      is correct for all versions of ppc linux >= 2.0.30
 
 #endif
 #endif
 
+/* Magic encoding for the instruction used for traps. */
+#define TRAP_INSTRUCTION(trap) ((3<<26) | (6 << 21) | (trap))
+
 void arch_init() {
 }
 
 os_vm_address_t
 arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *context)
 {
-    unsigned long pc =  (unsigned long)(*os_context_pc_addr(context));
     os_vm_address_t addr;
 
-#if defined(LISP_FEATURE_NETBSD)
+#if defined(LISP_FEATURE_NETBSD) || defined(LISP_FEATURE_OPENBSD)
     addr = (os_vm_address_t) (code->si_addr);
 #else
     addr = (os_vm_address_t) (*os_context_register_addr(context,PT_DAR));
@@ -73,19 +93,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)) & 4);
+#ifdef LISP_FEATURE_SB_THREAD
+    struct thread *thread = arch_os_get_current_thread();
+
+    if (foreign_function_call_active_p(thread)) {
+        return get_pseudo_atomic_atomic(thread);
+    } else return
+#else
+    /* 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_p(arch_os_get_current_thread())) &&
+#endif
+        ((*os_context_register_addr(context,reg_ALLOC)) & flag_PseudoAtomic);
 }
 
 void
 arch_set_pseudo_atomic_interrupted(os_context_t *context)
 {
-    *os_context_register_addr(context,reg_ALLOC) |= 1;
+#ifdef LISP_FEATURE_SB_THREAD
+    struct thread *thread = arch_os_get_current_thread();
+
+    if (foreign_function_call_active_p(thread)) {
+        set_pseudo_atomic_interrupted(thread);
+    } else
+#endif
+        *os_context_register_addr(context,reg_ALLOC)
+            |= flag_PseudoAtomicInterrupted;
 }
 
 void
 arch_clear_pseudo_atomic_interrupted(os_context_t *context)
 {
-    *os_context_register_addr(context,reg_ALLOC) &= ~1;
+#ifdef LISP_FEATURE_SB_THREAD
+    struct thread *thread = arch_os_get_current_thread();
+
+    if (foreign_function_call_active_p(thread)) {
+        clear_pseudo_atomic_interrupted(thread);
+    } else
+#endif
+        *os_context_register_addr(context,reg_ALLOC)
+            &= ~flag_PseudoAtomicInterrupted;
 }
 
 unsigned int
@@ -93,7 +148,7 @@ arch_install_breakpoint(void *pc)
 {
     unsigned int *ptr = (unsigned int *)pc;
     unsigned int result = *ptr;
-    *ptr = (3<<26) | (5 << 21) | trap_Breakpoint;
+    *ptr = TRAP_INSTRUCTION(trap_Breakpoint);
     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int));
     return result;
 }
@@ -125,12 +180,33 @@ arch_remove_breakpoint(void *pc, unsigned int orig_inst)
 static unsigned int *skipped_break_addr, displaced_after_inst;
 static sigset_t orig_sigmask;
 
+static boolean
+should_branch(os_context_t *context, unsigned int orig_inst)
+{
+    /* orig_inst is a conditional branch instruction.  We need to
+     * know if the branch will be taken if executed in context. */
+    int ctr = *os_context_ctr_addr(context);
+    int cr = *os_context_cr_addr(context);
+    int bo_field = (orig_inst >> 21) & 0x1f;
+    int bi_field = (orig_inst >> 16) & 0x1f;
+    int ctr_ok;
+
+    if (!(bo_field & 4)) ctr--; /* Decrement CTR if necessary. */
+
+    ctr_ok = (bo_field & 4) || ((ctr == 0) == ((bo_field & 2) == 2));
+    return ctr_ok && ((bo_field & 0x10) ||
+                      !(((cr >> (31-bi_field)) ^ (bo_field >> 3)) & 1));
+}
+
 void
-arch_do_displaced_inst(os_context_t *context,unsigned int orig_inst)
+arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
 {
     /* not sure how we ensure that we get the breakpoint reinstalled
      * after doing this -dan */
     unsigned int *pc = (unsigned int *)(*os_context_pc_addr(context));
+    unsigned int *next_pc;
+    int op = orig_inst >> 26;
+    int sub_op = (orig_inst & 0x7fe) >> 1;  /* XL-form sub-opcode */
 
     orig_sigmask = *os_context_sigmask_addr(context);
     sigaddset_blockable(os_context_sigmask_addr(context));
@@ -138,6 +214,54 @@ arch_do_displaced_inst(os_context_t *context,unsigned int orig_inst)
     *pc = orig_inst;
     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
+     * instruction by defaulting to the next instruction in the stream
+     * and then checking for branch instructions.  FIXME: This will
+     * probably screw up if it attempts to step a trap instruction. */
+    next_pc = pc + 1;
+
+    if (op == 18) {
+        /* Branch  I-form */
+        unsigned int displacement = orig_inst & 0x03fffffc;
+        /* Sign extend */
+        if (displacement & 0x02000000) {
+            displacement |= 0xc0000000;
+        }
+        if (orig_inst & 2) { /* Absolute Address */
+            next_pc = (unsigned int *)displacement;
+        } else {
+            next_pc = (unsigned int *)(((unsigned int)pc) + displacement);
+        }
+    } else if ((op == 16)
+               && should_branch(context, orig_inst)) {
+        /* Branch Conditional  B-form */
+        unsigned int displacement = orig_inst & 0x0000fffc;
+        /* Sign extend */
+        if (displacement & 0x00008000) {
+            displacement |= 0xffff0000;
+        }
+        if (orig_inst & 2) { /* Absolute Address */
+            next_pc = (unsigned int *)displacement;
+        } else {
+            next_pc = (unsigned int *)(((unsigned int)pc) + displacement);
+        }
+    } else if ((op == 19) && (sub_op == 16)
+               && should_branch(context, orig_inst)) {
+        /* Branch Conditional to Link Register  XL-form */
+        next_pc = (unsigned int *)
+            ((*os_context_lr_addr(context)) & ~3);
+    } else if ((op == 19) && (sub_op == 528)
+               && should_branch(context, orig_inst)) {
+        /* Branch Conditional to Count Register  XL-form */
+        next_pc = (unsigned int *)
+            ((*os_context_ctr_addr(context)) & ~3);
+    }
+
+    /* Set the "after" breakpoint. */
+    displaced_after_inst = *next_pc;
+    *next_pc = TRAP_INSTRUCTION(trap_AfterBreakpoint);
+    os_flush_icache((os_vm_address_t)next_pc, sizeof(unsigned int));
 }
 
 #ifdef LISP_FEATURE_GENCGC
@@ -176,15 +300,15 @@ allocation_trap_p(os_context_t * context)
         && (4 == ((inst >> 1) & 0x3ff))) {
         /*
          * We got the instruction.  Now, look back to make sure it was
-         * proceeded by what we expected.  2 instructions back should be
-         * an ADD or ADDI instruction.
+         * proceeded by what we expected.  The previous instruction
+         * should be an ADD or ADDI instruction.
          */
         unsigned int add_inst;
 
-        add_inst = pc[-3];
+        add_inst = pc[-1];
 #if 0
         fprintf(stderr, "   add inst at %p:  inst = 0x%08x\n",
-                pc - 3, add_inst);
+                pc - 1, add_inst);
 #endif
         opcode = add_inst >> 26;
         if ((opcode == 31) && (266 == ((add_inst >> 1) & 0x1ff))) {
@@ -207,14 +331,11 @@ handle_allocation_trap(os_context_t * context)
 {
     unsigned int *pc;
     unsigned int inst;
-    unsigned int or_inst;
     unsigned int target, target_ptr, end_addr;
     unsigned int opcode;
     int size;
-    int immed;
     boolean were_in_lisp;
     char *memory;
-    sigset_t block;
 
     target = 0;
     size = 0;
@@ -223,11 +344,9 @@ handle_allocation_trap(os_context_t * context)
     fprintf(stderr, "In handle_allocation_trap\n");
 #endif
 
-    /*
-     * I don't think it's possible for us NOT to be in lisp when we get
-     * here.  Remove this later?
-     */
-    were_in_lisp = !foreign_function_call_active;
+    /* I don't think it's possible for us NOT to be in lisp when we get
+     * here.  Remove this later? */
+    were_in_lisp = !foreign_function_call_active_p(arch_os_get_current_thread());
 
     if (were_in_lisp) {
         fake_foreign_function_call(context);
@@ -270,7 +389,7 @@ handle_allocation_trap(os_context_t * context)
      * is the size of the allocation.  Get it and call alloc to allocate
      * new space.
      */
-    inst = pc[-3];
+    inst = pc[-1];
     opcode = inst >> 26;
 #if 0
     fprintf(stderr, "  add inst  = 0x%08x, opcode = %d\n", inst, opcode);
@@ -334,7 +453,13 @@ handle_allocation_trap(os_context_t * context)
             dynamic_space_free_pointer);
 #endif
 
-    memory = (char *) alloc(size);
+    {
+        struct interrupt_data *data =
+            arch_os_get_current_thread()->interrupt_data;
+        data->allocation_trap_context = context;
+        memory = (char *) alloc(size);
+        data->allocation_trap_context = 0;
+    }
 
 #if 0
     fprintf(stderr, "alloc returned %p\n", memory);
@@ -353,28 +478,73 @@ handle_allocation_trap(os_context_t * context)
 #endif
 
     *os_context_register_addr(context, target) = (unsigned long) memory;
+#ifndef LISP_FEATURE_SB_THREAD
+    /* This is handled by the fake_foreign_function_call machinery on
+     * threaded targets. */
     *os_context_register_addr(context, reg_ALLOC) =
       (unsigned long) dynamic_space_free_pointer
       | (*os_context_register_addr(context, reg_ALLOC)
          & LOWTAG_MASK);
+#endif
 
     if (were_in_lisp) {
         undo_fake_foreign_function_call(context);
     }
 
+    /* Skip the allocation trap and the write of the updated free
+     * pointer back to the allocation region.  This is two
+     * instructions when threading is enabled and four instructions
+     * otherwise. */
+#ifdef LISP_FEATURE_SB_THREAD
+    (*os_context_pc_addr(context)) = pc + 2;
+#else
+    (*os_context_pc_addr(context)) = pc + 4;
+#endif
 
 }
 #endif
 
+void
+arch_handle_breakpoint(os_context_t *context)
+{
+    handle_breakpoint(context);
+}
+
+void
+arch_handle_fun_end_breakpoint(os_context_t *context)
+{
+    *os_context_pc_addr(context)
+        =(int)handle_fun_end_breakpoint(context);
+}
+
+void
+arch_handle_after_breakpoint(os_context_t *context)
+{
+    *skipped_break_addr = TRAP_INSTRUCTION(trap_Breakpoint);
+    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_context_sigmask_addr(context)= orig_sigmask;
+    os_flush_icache((os_vm_address_t) *os_context_pc_addr(context),
+                    sizeof(unsigned int));
+}
+
+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;
 
-#ifdef LISP_FEATURE_LINUX
-    os_restore_fp_control(context);
-#endif
     code=*((u32 *)(*os_context_pc_addr(context)));
     if (code == ((3 << 26) | (0x18 << 21) | (reg_NL3 << 16))) {
         arch_clear_pseudo_atomic_interrupted(context);
@@ -389,10 +559,6 @@ sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
     /* Is this an allocation trap? */
     if (allocation_trap_p(context)) {
         handle_allocation_trap(context);
-        arch_skip_instruction(context);
-#ifdef LISP_FEATURE_DARWIN
-        DARWIN_FIX_CONTEXT(context);
-#endif
         return;
     }
 #endif
@@ -400,126 +566,22 @@ sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
     if ((code >> 16) == ((3 << 10) | (6 << 5))) {
         /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */
         int trap = code & 0x1f;
-
-        switch (trap) {
-        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, code, context, trap == trap_Cerror);
-            break;
-
-        case trap_PendingInterrupt:
-            /* This is supposed run after WITHOUT-INTERRUPTS if there
-             * were pending signals. */
-            arch_skip_instruction(context);
-            interrupt_handle_pending(context);
-            break;
-
-        case trap_Breakpoint:
-            handle_breakpoint(signal, code, context);
-            break;
-
-        case trap_FunEndBreakpoint:
-            *os_context_pc_addr(context)
-                =(int)handle_fun_end_breakpoint(signal, code, context);
-            break;
-
-        case trap_AfterBreakpoint:
-            *skipped_break_addr = trap_Breakpoint;
-            skipped_break_addr = NULL;
-            *(unsigned int *)*os_context_pc_addr(context)
-                = displaced_after_inst;
-            *os_context_sigmask_addr(context)= orig_sigmask;
-
-            os_flush_icache((os_vm_address_t) *os_context_pc_addr(context),
-                            sizeof(unsigned int));
-            break;
-
-        case trap_SingleStepAround:
-        case trap_SingleStepBefore:
-            {
-                int register_offset = code >> 5 & 0x1f;
-
-                handle_single_step_trap(context, trap, register_offset);
-
-                arch_skip_instruction(context);
-                break;
-            }
-        default:
-            interrupt_handle_now(signal, code, context);
-            break;
-        }
-#ifdef LISP_FEATURE_DARWIN
-        DARWIN_FIX_CONTEXT(context);
-#endif
+        handle_trap(context,trap);
         return;
     }
     if (((code >> 26) == 3) && (((code >> 21) & 31) == 24)) {
-        interrupt_internal_error(signal, code, context, 0);
-#ifdef LISP_FEATURE_DARWIN
-        DARWIN_FIX_CONTEXT(context);
-#endif
+        interrupt_internal_error(context, 0);
         return;
     }
 
-    interrupt_handle_now(signal, code, context);
-#ifdef LISP_FEATURE_DARWIN
-    /* Work around G5 bug */
-    DARWIN_FIX_CONTEXT(context);
-#endif
+    interrupt_handle_now(signal, (siginfo_t *)code, context);
 }
 
 
 void arch_install_interrupt_handlers()
 {
-    undoably_install_low_level_interrupt_handler(SIGILL,sigtrap_handler);
-    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);
+    undoably_install_low_level_interrupt_handler(SIGILL, sigtrap_handler);
+    undoably_install_low_level_interrupt_handler(SIGTRAP, sigtrap_handler);
 }
 
 void
@@ -612,9 +674,6 @@ arch_write_linkage_table_jmp(void* reloc_addr, void *target_addr)
   inst = (19 << 26) | (20 << 21) | (528 << 1);
   *inst_ptr++ = inst;
 
-
-  *inst_ptr++ = inst;
-
   os_flush_icache((os_vm_address_t) reloc_addr, (char*) inst_ptr - (char*) reloc_addr);
 }