X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=47dc21538c8aa3beb89004abfeb392104f7f4fce;hb=70769503c505c22bddef3bc7885b91b9d503607f;hp=66f2c871f42636bd54c4c9dad8cb7d4b327e0b18;hpb=525226cca55f02667e0946670d2168ad5aeb9036;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 66f2c87..47dc215 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -823,6 +823,7 @@ escaped) (if up-frame (1+ (frame-number up-frame)) 0) escaped)))))) + #!+(or x86 x86-64) (defun compute-calling-frame (caller ra up-frame) (declare (type system-area-pointer caller ra)) @@ -992,14 +993,14 @@ register." (or (fun-code-header object) :undefined-function) (let ((lowtag (lowtag-of object))) - (if (= lowtag sb!vm:other-pointer-lowtag) - (let ((widetag (widetag-of object))) - (cond ((= widetag sb!vm:code-header-widetag) - object) - ((= widetag sb!vm:return-pc-header-widetag) - (lra-code-header object)) - (t - nil)))))))) + (when (= lowtag sb!vm:other-pointer-lowtag) + (let ((widetag (widetag-of object))) + (cond ((= widetag sb!vm:code-header-widetag) + object) + ((= widetag sb!vm:return-pc-header-widetag) + (lra-code-header object)) + (t + nil)))))))) ;;;; frame utilities @@ -3044,7 +3045,7 @@ register." ;;; returns the overwritten bits. You must call this in a context in ;;; which GC is disabled, so that Lisp doesn't move objects around ;;; that C is pointing to. -(sb!alien:define-alien-routine "breakpoint_install" sb!alien:unsigned-long +(sb!alien:define-alien-routine "breakpoint_install" sb!alien:unsigned-int (code-obj sb!alien:unsigned-long) (pc-offset sb!alien:int)) @@ -3054,11 +3055,11 @@ register." (sb!alien:define-alien-routine "breakpoint_remove" sb!alien:void (code-obj sb!alien:unsigned-long) (pc-offset sb!alien:int) - (old-inst sb!alien:unsigned-long)) + (old-inst sb!alien:unsigned-int)) (sb!alien:define-alien-routine "breakpoint_do_displaced_inst" sb!alien:void (scp (* os-context-t)) - (orig-inst sb!alien:unsigned-long)) + (orig-inst sb!alien:unsigned-int)) ;;;; breakpoint handlers (layer between C and exported interface) @@ -3136,19 +3137,19 @@ register." ;; no more breakpoints active at this location, then the normal ;; instruction has been put back, and we do not need to ;; DO-DISPLACED-INST. - (let ((data (breakpoint-data component offset nil))) - (when (and data (breakpoint-data-breakpoints data)) - ;; The breakpoint is still active, so we need to execute the - ;; displaced instruction and leave the breakpoint instruction - ;; behind. The best way to do this is different on each machine, - ;; so we just leave it up to the C code. - (breakpoint-do-displaced-inst signal-context - (breakpoint-data-instruction data)) - ;; Some platforms have no usable sigreturn() call. If your - ;; implementation of arch_do_displaced_inst() _does_ sigreturn(), - ;; it's polite to warn here - #!+(and sparc solaris) - (error "BREAKPOINT-DO-DISPLACED-INST returned?")))) + (setf data (breakpoint-data component offset nil)) + (when (and data (breakpoint-data-breakpoints data)) + ;; The breakpoint is still active, so we need to execute the + ;; displaced instruction and leave the breakpoint instruction + ;; behind. The best way to do this is different on each machine, + ;; so we just leave it up to the C code. + (breakpoint-do-displaced-inst signal-context + (breakpoint-data-instruction data)) + ;; Some platforms have no usable sigreturn() call. If your + ;; implementation of arch_do_displaced_inst() _does_ sigreturn(), + ;; it's polite to warn here + #!+(and sparc solaris) + (error "BREAKPOINT-DO-DISPLACED-INST returned?"))) (defun invoke-breakpoint-hooks (breakpoints component offset) (let* ((debug-fun (debug-fun-from-pc component offset))