From: Christophe Rhodes Date: Wed, 2 May 2007 13:07:18 +0000 (+0000) Subject: 1.0.5.18: trapping-based stepper on the Sparc X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=f0f8bc6c184e849782fc784230f8e235d3659d5d;p=sbcl.git 1.0.5.18: trapping-based stepper on the Sparc ... 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. --- diff --git a/NEWS b/NEWS index 029605f..cc058db 100644 --- 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 diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 14cb3e9..0366b5b 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -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) diff --git a/src/code/error.lisp b/src/code/error.lisp index a7b2f9a..0e663cf 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -178,7 +178,7 @@ (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) () diff --git a/src/compiler/sparc/call.lisp b/src/compiler/sparc/call.lisp index 428f6dd..9c1094d 100644 --- a/src/compiler/sparc/call.lisp +++ b/src/compiler/sparc/call.lisp @@ -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)) diff --git a/src/compiler/sparc/parms.lisp b/src/compiler/sparc/parms.lisp index 792612e..11c5b1e 100644 --- a/src/compiler/sparc/parms.lisp +++ b/src/compiler/sparc/parms.lisp @@ -139,9 +139,6 @@ 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) diff --git a/src/runtime/breakpoint.c b/src/runtime/breakpoint.c index 7892dc1..c678192 100644 --- a/src/runtime/breakpoint.c +++ b/src/runtime/breakpoint.c @@ -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)); diff --git a/src/runtime/sparc-arch.c b/src/runtime/sparc-arch.c index 6f0d90a..9095f02 100644 --- a/src/runtime/sparc-arch.c +++ b/src/runtime/sparc-arch.c @@ -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 diff --git a/tests/step.impure.lisp b/tests/step.impure.lisp index 00aa7e0..8842874 100644 --- a/tests/step.impure.lisp +++ b/tests/step.impure.lisp @@ -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) diff --git a/version.lisp-expr b/version.lisp-expr index a7ced81..65c02b9 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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"