X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=a4d95df3a7f9c1400108cfe373beefb2ba8d4cef;hb=5dc28680e9cb2d598da02aed512aa49ea81fdade;hp=0bead790d61bf77bd94ff0c950b84427f807c4dc;hpb=3358092524adbaecaa483d6510fb3d7031441ccb;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 0bead79..a4d95df 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -12,9 +12,6 @@ (in-package "SB!DI") -(file-comment - "$Header$") - ;;; FIXME: There are an awful lot of package prefixes in this code. ;;; Couldn't we have SB-DI use the SB-C and SB-VM packages? @@ -674,18 +671,15 @@ #!-sb-fluid (declaim (inline cstack-pointer-valid-p)) (defun cstack-pointer-valid-p (x) (declare (type system-area-pointer x)) - #!-x86 + #!-x86 ; stack grows toward high address values (and (sap< x (current-sp)) - (sap<= #!-gengc (sb!alien:alien-sap - (sb!alien:extern-alien "control_stack" (* t))) + (sap<= #!-gengc (int-sap control-stack-start) #!+gengc (mutator-control-stack-base) x) (zerop (logand (sap-int x) #b11))) - #!+x86 ;; stack grows to low address values + #!+x86 ; stack grows toward low address values (and (sap>= x (current-sp)) - (sap> (sb!alien:alien-sap (sb!alien:extern-alien "control_stack_end" - (* t))) - x) + (sap> (int-sap control-stack-end) x) (zerop (logand (sap-int x) #b11)))) #!+(or gengc x86) @@ -729,9 +723,7 @@ ;; Not the first page which is unmapped. (>= (sap-int ra) 4096) ;; Not a Lisp stack pointer. - (or (sap< ra (current-sp)) - (sap>= ra (sb!alien:alien-sap - (sb!alien:extern-alien "control_stack_end" (* t))))))) + (not (cstack-pointer-valid-p ra)))) ;;; Try to find a valid previous stack. This is complex on the x86 as ;;; it can jump between C and Lisp frames. To help find a valid frame @@ -2480,7 +2472,7 @@ (< sb!vm:static-space-start val (* sb!vm:*static-space-free-pointer* sb!vm:word-bytes)) - (< (sb!vm:dynamic-space-start) val + (< sb!vm:dynamic-space-start val (sap-int (dynamic-space-free-pointer)))))) (make-lisp-obj val) :invalid-object)) @@ -3518,6 +3510,7 @@ ;;; debugging-tool break instruction. This does NOT handle all breaks; ;;; for example, it does not handle breaks for internal errors. (defun handle-breakpoint (offset component signal-context) + (/show0 "entering HANDLE-BREAKPOINT") (let ((data (breakpoint-data component offset nil))) (unless data (error "unknown breakpoint in ~S at offset ~S" @@ -3541,6 +3534,7 @@ ;;; This handles code-location and debug-function :FUNCTION-START ;;; breakpoints. (defun handle-breakpoint-aux (breakpoints data offset component signal-context) + (/show0 "entering HANDLE-BREAKPOINT-AUX") (unless breakpoints (error "internal error: breakpoint that nobody wants")) (unless (member data *executing-breakpoint-hooks*) @@ -3583,6 +3577,7 @@ bpt))))) (defun handle-function-end-breakpoint (offset component context) + (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT") (let ((data (breakpoint-data component offset nil))) (unless data (error "unknown breakpoint in ~S at offset ~S" @@ -3597,6 +3592,7 @@ ;;; [old C code] or HANDLE-FUNCTION-END-BREAKPOINT calls this directly ;;; [new C code]. (defun handle-function-end-breakpoint-aux (breakpoints data signal-context) + (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT-AUX") (delete-breakpoint-data data) (let* ((scp (locally