0.8.9.6.netbsd.2:

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

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 9dbacc8..d05a3da 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -507,7 +507,7 @@
 ;;;; frames
 
 ;;; This is used in FIND-ESCAPED-FRAME and with the bogus components
-;;; and LRAs used for :FUN-END breakpoints. When a components
+;;; and LRAs used for :FUN-END breakpoints. When a component's
 ;;; debug-info slot is :BOGUS-LRA, then the REAL-LRA-SLOT contains the
 ;;; real component to continue executing, as opposed to the bogus
 ;;; component which appeared in some frame's LRA location.
@@ -527,14 +527,15 @@
 #!-sb-fluid (declaim (inline control-stack-pointer-valid-p))
 (defun control-stack-pointer-valid-p (x)
   (declare (type system-area-pointer x))
-  (let* ((control-stack-start
-         (descriptor-sap sb!vm::*control-stack-start*))
+  (let* (#!-stack-grows-downward-not-upward
+        (control-stack-start
+         (descriptor-sap *control-stack-start*))
+        #!+stack-grows-downward-not-upward
         (control-stack-end
-         (descriptor-sap sb!vm::*control-stack-end*)))
+         (descriptor-sap *control-stack-end*)))
     #!-stack-grows-downward-not-upward
     (and (sap< x (current-sp))
-        (sap<= control-stack-start
-               x)
+        (sap<= control-stack-start x)
         (zerop (logand (sap-int x) #b11)))
     #!+stack-grows-downward-not-upward
     (and (sap>= x (current-sp))
@@ -827,7 +828,7 @@
                           "undefined function"))
                         (:foreign-function
                          (make-bogus-debug-fun
-                          "foreign function call land"))
+                          (format nil "foreign function call land:")))
                         ((nil)
                          (make-bogus-debug-fun
                           "bogus stack frame"))
@@ -873,7 +874,8 @@
                       "undefined function"))
                     (:foreign-function
                      (make-bogus-debug-fun
-                      "foreign function call land"))
+                      (format nil "foreign function call land: ra=#x~X"
+                                  (sap-int ra))))
                     ((nil)
                      (make-bogus-debug-fun
                       "bogus stack frame"))
@@ -1188,8 +1190,7 @@
      (fun-debug-fun (%closure-fun fun)))
     (#.sb!vm:funcallable-instance-header-widetag
      (fun-debug-fun (funcallable-instance-fun fun)))
-    ((#.sb!vm:simple-fun-header-widetag
-      #.sb!vm:closure-fun-header-widetag)
+    (#.sb!vm:simple-fun-header-widetag
       (let* ((name (%simple-fun-name fun))
             (component (fun-code-header fun))
             (res (find-if
@@ -3289,14 +3290,3 @@
     ;; (There used to be more cases back before sbcl-0.7.0, when
     ;; we did special tricks to debug the IR1 interpreter.)
     ))
-
-(defun print-code-locations (function)
-  (let ((debug-fun (fun-debug-fun function)))
-    (do-debug-fun-blocks (block debug-fun)
-      (do-debug-block-locations (loc block)
-       (fill-in-code-location loc)
-       (format t "~S code location at ~W"
-               (compiled-code-location-kind loc)
-               (compiled-code-location-pc loc))
-       (sb!debug::print-code-location-source-form loc 0)
-       (terpri)))))