1.0.5.18: trapping-based stepper on the Sparc
authorChristophe Rhodes <csr21@cantab.net>
Wed, 2 May 2007 13:07:18 +0000 (13:07 +0000)
committerChristophe Rhodes <csr21@cantab.net>
Wed, 2 May 2007 13:07:18 +0000 (13:07 +0000)
... implement instrumentation for :before and :around cases;
... as suggested by Juho, use NTH-INTERRUPT-CONTEXT rather than
allocating a SAP in a signal handler;
... actually run the tests on sparc too.

NEWS
src/code/debug-int.lisp
src/code/error.lisp
src/compiler/sparc/call.lisp
src/compiler/sparc/parms.lisp
src/runtime/breakpoint.c
src/runtime/sparc-arch.c
tests/step.impure.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 029605f..cc058db 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,8 @@ changes in sbcl-1.0.6 relative to sbcl-1.0.5:
   * enhancement: when a symbol name conflict error arises, the
     conflicting symbols are always printed with a package prefix.
     (thanks to Kevin Reid)
+  * enhancement: stepping is now once again supported on the SPARC.  (It is
+    also now more likely to work on CheneyGC builds on the PPC.)
   * incompatible change: PURIFY no longer copies the data from the 
     dynamic space into the static and read-only spaces on platforms
     that use the generational garbage collector
index 14cb3e9..0366b5b 100644 (file)
@@ -3351,8 +3351,8 @@ register."
 ;;; or replace the function that's about to be called with a wrapper
 ;;; which will signal the condition.
 
-(defun handle-single-step-trap (context-sap kind callee-register-offset)
-  (let ((context (sb!alien:sap-alien context-sap (* os-context-t))))
+(defun handle-single-step-trap (kind callee-register-offset)
+  (let ((context (nth-interrupt-context (1- *free-interrupt-context-index*))))
     ;; The following calls must get tail-call eliminated for
     ;; *STEP-FRAME* to get set correctly on non-x86.
     (if (= kind single-step-before-trap)
index a7b2f9a..0e663cf 100644 (file)
 (define-condition breakpoint-error (system-condition error) ()
   (:report
    (lambda (condition stream)
-     (format stream "Uhandled breakpoint/trap at #x~X."
+     (format stream "Unhandled breakpoint/trap at #x~X."
              (system-condition-address condition)))))
 
 (define-condition interactive-interrupt (system-condition serious-condition) ()
index 428f6dd..9c1094d 100644 (file)
@@ -624,10 +624,7 @@ default-value-8
 
      (:ignore
       ,@(unless (or variable (eq return :tail)) '(arg-locs))
-      ,@(unless variable '(args))
-      ;; Step instrumentation for full calls not implemented yet.
-      ;; See the PPC backend for an example.
-      step-instrumenting)
+      ,@(unless variable '(args)))
 
      (:temporary (:sc descriptor-reg
                   :offset ocfp-offset
@@ -667,6 +664,8 @@ default-value-8
      ,@(when (eq return :fixed)
          '((:temporary (:scs (descriptor-reg) :from :eval) move-temp)))
 
+     (:temporary (:scs (descriptor-reg) :to :eval) stepping)
+
      ,@(unless (eq return :tail)
          '((:temporary (:scs (non-descriptor-reg)) temp)
            (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)))
@@ -680,6 +679,7 @@ default-value-8
        (let* ((cur-nfp (current-nfp-tn vop))
               ,@(unless (eq return :tail)
                   '((lra-label (gen-label))))
+              (step-done-label (gen-label))
               (filler
                (remove nil
                        (list :load-nargs
@@ -741,7 +741,26 @@ default-value-8
                                     '(if (> nargs register-arg-count)
                                          (move cfp-tn new-fp)
                                          (move cfp-tn csp-tn))))))
-                      ((nil))))))
+                      ((nil)))))
+                (insert-step-instrumenting (callable-tn)
+                  ;; Conditionally insert a conditional trap:
+                  (when step-instrumenting
+                    ;; Get the symbol-value of SB!IMPL::*STEPPING*
+                    (load-symbol-value stepping sb!impl::*stepping*)
+                    (inst cmp stepping null-tn)
+                    ;; If it's not null, trap.
+                    (inst b :eq step-done-label)
+                    (inst nop)
+                    ;; FIXME: this doesn't look right.
+                    (note-this-location vop :step-before-vop)
+                    ;; Construct a trap code with the low bits from
+                    ;; SINGLE-STEP-AROUND-TRAP and the high bits from
+                    ;; the register number of CALLABLE-TN.
+                    (inst unimp (logior single-step-around-trap
+                                        (ash (reg-tn-encoding callable-tn)
+                                             5)))
+                    (emit-label step-done-label))))
+
 
            ,@(if named
                  `((sc-case name
@@ -753,6 +772,7 @@ default-value-8
                       (loadw name-pass code-tn (tn-offset name)
                              other-pointer-lowtag)
                       (do-next-filler)))
+                   (insert-step-instrumenting name-pass)
                    (loadw function name-pass fdefn-raw-addr-slot
                           other-pointer-lowtag)
                    (do-next-filler))
@@ -767,7 +787,8 @@ default-value-8
                       (do-next-filler)))
                    (loadw function lexenv closure-fun-slot
                           fun-pointer-lowtag)
-                   (do-next-filler)))
+                   (do-next-filler)
+                   (insert-step-instrumenting function)))
            (loop
              (if filler
                  (do-next-filler)
@@ -1208,8 +1229,14 @@ default-value-8
 ;;; Single-stepping
 
 (define-vop (step-instrument-before-vop)
+  (:temporary (:scs (descriptor-reg)) stepping)
   (:policy :fast-safe)
   (:vop-var vop)
   (:generator 3
-    ;; Stub! See the PPC backend for an example.
-    (note-this-location vop :step-before-vop)))
+    (load-symbol-value stepping sb!impl::*stepping*)
+    (inst cmp stepping null-tn)
+    (inst b :eq DONE)
+    (inst nop)
+    (note-this-location vop :step-before-vop)
+    (inst unimp single-step-before-trap)
+    DONE))
index 792612e..11c5b1e 100644 (file)
   breakpoint
   fun-end-breakpoint
   after-breakpoint
-  ;; Stepper actually not implemented on Sparc, but these constants
-  ;; are still needed to avoid undefined variable warnings during sbcl
-  ;; build.
   single-step-around
   single-step-before)
 
index 7892dc1..c678192 100644 (file)
@@ -188,20 +188,13 @@ void *handle_fun_end_breakpoint(os_context_t *context)
 void
 handle_single_step_trap (os_context_t *context, int kind, int register_offset)
 {
-    lispobj context_sap;
-
-    /* Allocate the SAP object while the interrupts are still
-     * disabled. */
-    context_sap = alloc_sap(context);
-
     fake_foreign_function_call(context);
 
 #ifndef LISP_FEATURE_WIN32
     thread_sigmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
 #endif
 
-    funcall3(SymbolFunction(HANDLE_SINGLE_STEP_TRAP),
-             context_sap,
+    funcall2(SymbolFunction(HANDLE_SINGLE_STEP_TRAP),
              make_fixnum(kind),
              make_fixnum(register_offset));
 
index 6f0d90a..9095f02 100644 (file)
@@ -231,6 +231,15 @@ arch_handle_after_breakpoint(os_context_t *context)
     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 sigill_handler(int signal, siginfo_t *siginfo, void *void_context)
 {
     os_context_t *context = arch_os_get_context(&void_context);
@@ -249,7 +258,7 @@ static void sigill_handler(int signal, siginfo_t *siginfo, void *void_context)
         unsigned int* pc = (unsigned int*) siginfo->si_addr;
 
         inst = *pc;
-        trap = inst & 0x3fffff;
+        trap = inst & 0x1f;
         handle_trap(context,trap);
     }
     else if ((siginfo->si_code) == ILL_ILLTRP
index 00aa7e0..8842874 100644 (file)
@@ -14,7 +14,7 @@
 (in-package :cl-user)
 
 ;; No stepper support on some platforms.
-#-(or x86 x86-64 ppc)
+#-(or x86 x86-64 ppc sparc)
 (sb-ext:quit :unix-status 104)
 
 (defun fib (x)
index a7ced81..65c02b9 100644 (file)
@@ -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.5.17"
+"1.0.5.18"