From 5c119c97cb1504dfdd5260fe8bcf1b8ac89ea3aa Mon Sep 17 00:00:00 2001 From: Thiemo Seufer Date: Wed, 2 May 2007 23:04:37 +0000 Subject: [PATCH 1/1] 1.0.5.27: Stepper support for MIPS. --- NEWS | 1 + src/compiler/mips/call.lisp | 59 +++++++++++++++++++++++++++++++++++++----- src/compiler/mips/insts.lisp | 6 ++++- src/compiler/mips/parms.lisp | 3 --- src/runtime/mips-arch.c | 17 +++++++++--- src/runtime/win32-os.c | 2 +- tests/step.impure.lisp | 2 +- version.lisp-expr | 2 +- 8 files changed, 75 insertions(+), 17 deletions(-) diff --git a/NEWS b/NEWS index cc058db..1d2fec2 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,7 @@ changes in sbcl-1.0.6 relative to sbcl-1.0.5: (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.) + * enhancement: Stepping support on MIPS. * 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/compiler/mips/call.lisp b/src/compiler/mips/call.lisp index 439541f..8ceb602 100644 --- a/src/compiler/mips/call.lisp +++ b/src/compiler/mips/call.lisp @@ -656,10 +656,7 @@ default-value-8 step-instrumenting) (: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 @@ -700,6 +697,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))) @@ -714,6 +713,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 @@ -779,7 +779,29 @@ default-value-8 (move cfp-tn csp-tn))) (trace-table-entry trace-table-call-site)))) ((nil) - (inst nop)))))) + (inst nop))))) + (insert-step-instrumenting (callable-tn) + ;; Conditionally insert a conditional trap: + (when step-instrumenting + ;; Get the symbol-value of SB!IMPL::*STEPPING* + (inst lw stepping null-tn + (- (+ symbol-value-slot + (truncate (static-symbol-offset 'sb!impl::*stepping*) + n-word-bytes)) + other-pointer-lowtag)) + ;; If it's not null, trap. + (inst beq stepping step-done-label) + (inst nop) + ;; CONTEXT-PC will be pointing here when the + ;; interrupt is handled, not after the BREAK. + (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 break (logior single-step-around-trap + (ash (reg-tn-encoding callable-tn) + 5))) + (emit-label step-done-label)))) ,@(if named `((sc-case name @@ -793,6 +815,10 @@ default-value-8 (- (ash (tn-offset name) word-shift) other-pointer-lowtag)) (do-next-filler))) + ;; The step instrumenting must be done after + ;; FUNCTION is loaded, but before ENTRY-POINT is + ;; calculated. + (insert-step-instrumenting name-pass) (inst lw entry-point name-pass (- (ash fdefn-raw-addr-slot word-shift) other-pointer-lowtag)) @@ -812,6 +838,10 @@ default-value-8 (- (ash closure-fun-slot word-shift) fun-pointer-lowtag)) (do-next-filler) + ;; The step instrumenting must be done before + ;; after FUNCTION is loaded, but before ENTRY-POINT + ;; is calculated. + (insert-step-instrumenting function) (inst addu entry-point function (- (ash simple-fun-code-offset word-shift) fun-pointer-lowtag)))) @@ -1257,8 +1287,23 @@ 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))) + ;; Get the symbol-value of SB!IMPL::*STEPPING* + (inst lw stepping null-tn + (- (+ symbol-value-slot + (truncate (static-symbol-offset 'sb!impl::*stepping*) + n-word-bytes)) + other-pointer-lowtag)) + ;; If it's not null, trap. + (inst beq stepping DONE) + (inst nop) + ;; CONTEXT-PC will be pointing here when the interrupt is handled, + ;; not after the BREAK. + (note-this-location vop :step-before-vop) + ;; CALLEE-REGISTER-OFFSET isn't needed for before-traps, so we + ;; can just use a bare SINGLE-STEP-BEFORE-TRAP as the code. + (inst break single-step-before-trap) + DONE)) diff --git a/src/compiler/mips/insts.lisp b/src/compiler/mips/insts.lisp index a6b7c72..8e21fd8 100644 --- a/src/compiler/mips/insts.lisp +++ b/src/compiler/mips/insts.lisp @@ -1085,7 +1085,11 @@ (#.object-not-list-trap (nt "Object not list trap")) (#.object-not-instance-trap - (nt "Object not instance trap")))))) + (nt "Object not instance trap")) + (#.single-step-around-trap + (nt "Single step around trap")) + (#.single-step-before-trap + (nt "Single step before trap")))))) (define-instruction break (segment code &optional (subcode 0)) (:declare (type (unsigned-byte 10) code subcode)) diff --git a/src/compiler/mips/parms.lisp b/src/compiler/mips/parms.lisp index c133443..1932004 100644 --- a/src/compiler/mips/parms.lisp +++ b/src/compiler/mips/parms.lisp @@ -128,9 +128,6 @@ pseudo-atomic object-not-list object-not-instance - ;; Stepper actually not implemented on Mips, 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/mips-arch.c b/src/runtime/mips-arch.c index 1d6b127..6da8579 100644 --- a/src/runtime/mips-arch.c +++ b/src/runtime/mips-arch.c @@ -386,19 +386,30 @@ arch_handle_after_breakpoint(os_context_t *context) *os_context_sigmask_addr(context) = orig_sigmask; } +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 >> 11 & 0x1f; + handle_single_step_trap(context, trap, register_offset); + arch_skip_instruction(context); +} + static void sigtrap_handler(int signal, siginfo_t *info, void *void_context) { os_context_t *context = arch_os_get_context(&void_context); unsigned int code = (os_context_insn(context) >> 6) & 0xfffff; - /* FIXME: WTF is this magic number? Needs to become a #define - * and go into handle_trap. */ + /* FIXME: This magic number is pseudo-atomic-trap from parms.lisp. + * Genesis should provide the proper #define, but it specialcases + * pseudo-atomic-trap to work around some oddity on SPARC. + * Eventually this should go into handle_trap. */ if (code==0x10) { arch_clear_pseudo_atomic_interrupted(context); arch_skip_instruction(context); interrupt_handle_pending(context); } else - handle_trap(context,code); + handle_trap(context,code & 0x1f); } #define FIXNUM_VALUE(lispobj) (((int)lispobj) >> N_FIXNUM_TAG_BITS) diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c index 394ed3e..1d9635f 100644 --- a/src/runtime/win32-os.c +++ b/src/runtime/win32-os.c @@ -341,7 +341,7 @@ handle_exception(EXCEPTION_RECORD *exception_record, } if (exception_record->ExceptionCode == EXCEPTION_BREAKPOINT) { - unsigned char trap; + unsigned char trap; /* This is just for info in case the monitor wants to print an * approximation. */ current_control_stack_pointer = diff --git a/tests/step.impure.lisp b/tests/step.impure.lisp index 8842874..4ee3952 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 sparc) +#-(or x86 x86-64 ppc sparc mips) (sb-ext:quit :unix-status 104) (defun fib (x) diff --git a/version.lisp-expr b/version.lisp-expr index 85c4185..6fb9dc7 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.26" +"1.0.5.27" -- 1.7.10.4