made debugger handle errors in printing *DEBUG-CONDITION*

[sbcl.git] / src / code / debug-int.lisp

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 96d064c..a4d95df 100644 (file)
--- 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?
 \f
@@ -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
@@ -2474,13 +2466,13 @@
            ;; Check that the pointer is valid. XXX Could do a better
            ;; job. FIXME: e.g. by calling out to an is_valid_pointer
            ;; routine in the C runtime support code
-           (or (< (sb!impl::read-only-space-start) val
-                  (* sb!impl::*read-only-space-free-pointer*
+           (or (< sb!vm:read-only-space-start val
+                  (* sb!vm:*read-only-space-free-pointer*
                      sb!vm:word-bytes))
-               (< (sb!impl::static-space-start) val
-                  (* sb!impl::*static-space-free-pointer*
+               (< sb!vm:static-space-start val
+                  (* sb!vm:*static-space-free-pointer*
                      sb!vm:word-bytes))
-               (< (sb!impl::current-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