0.8.0.78.vector-nil-string.7:

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

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index c705a48..b3bfefe 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))
@@ -886,7 +887,6 @@
                             (if up-frame (1+ (frame-number up-frame)) 0)
                             escaped)))))
 
-#!+x86
 (defun nth-interrupt-context (n)
   (declare (type (unsigned-byte 32) n)
           (optimize (speed 3) (safety 0)))
@@ -938,45 +938,43 @@
 (defun find-escaped-frame (frame-pointer)
   (declare (type system-area-pointer frame-pointer))
   (dotimes (index *free-interrupt-context-index* (values nil 0 nil))
-    (sb!alien:with-alien
-     ((lisp-interrupt-contexts (array (* os-context-t) nil) :extern))
-     (let ((scp (sb!alien:deref lisp-interrupt-contexts index)))
-       (when (= (sap-int frame-pointer)
-                (sb!vm:context-register scp sb!vm::cfp-offset))
-         (without-gcing
-          (let ((code (code-object-from-bits
-                       (sb!vm:context-register scp sb!vm::code-offset))))
-            (when (symbolp code)
-              (return (values code 0 scp)))
-            (let* ((code-header-len (* (get-header-data code)
-                                       sb!vm:n-word-bytes))
-                   (pc-offset
+    (let ((scp (nth-interrupt-context index)))
+      (when (= (sap-int frame-pointer)
+              (sb!vm:context-register scp sb!vm::cfp-offset))
+       (without-gcing
+        (let ((code (code-object-from-bits
+                     (sb!vm:context-register scp sb!vm::code-offset))))
+          (when (symbolp code)
+            (return (values code 0 scp)))
+          (let* ((code-header-len (* (get-header-data code)
+                                     sb!vm:n-word-bytes))
+                 (pc-offset
                     (- (sap-int (sb!vm:context-pc scp))
                        (- (get-lisp-obj-address code)
                           sb!vm:other-pointer-lowtag)
                        code-header-len)))
-              ;; Check to see whether we were executing in a branch
-              ;; delay slot.
-              #!+(or pmax sgi) ; pmax only (and broken anyway)
-              (when (logbitp 31 (sb!alien:slot scp '%mips::sc-cause))
-                (incf pc-offset sb!vm:n-word-bytes))
-              (unless (<= 0 pc-offset
-                          (* (code-header-ref code sb!vm:code-code-size-slot)
-                             sb!vm:n-word-bytes))
-                ;; We were in an assembly routine. Therefore, use the
-                ;; LRA as the pc.
-                (setf pc-offset
-                      (- (sb!vm:context-register scp sb!vm::lra-offset)
-                         (get-lisp-obj-address code)
-                         code-header-len)))
-               (return
-                (if (eq (%code-debug-info code) :bogus-lra)
-                    (let ((real-lra (code-header-ref code
-                                                     real-lra-slot)))
-                      (values (lra-code-header real-lra)
-                              (get-header-data real-lra)
-                              nil))
-                  (values code pc-offset scp)))))))))))
+            ;; Check to see whether we were executing in a branch
+            ;; delay slot.
+            #!+(or pmax sgi) ; pmax only (and broken anyway)
+            (when (logbitp 31 (sb!alien:slot scp '%mips::sc-cause))
+              (incf pc-offset sb!vm:n-word-bytes))
+            (unless (<= 0 pc-offset
+                        (* (code-header-ref code sb!vm:code-code-size-slot)
+                           sb!vm:n-word-bytes))
+              ;; We were in an assembly routine. Therefore, use the
+              ;; LRA as the pc.
+              (setf pc-offset
+                    (- (sb!vm:context-register scp sb!vm::lra-offset)
+                       (get-lisp-obj-address code)
+                       code-header-len)))
+            (return
+              (if (eq (%code-debug-info code) :bogus-lra)
+                  (let ((real-lra (code-header-ref code
+                                                   real-lra-slot)))
+                    (values (lra-code-header real-lra)
+                            (get-header-data real-lra)
+                            nil))
+                  (values code pc-offset scp))))))))))
 
 ;;; Find the code object corresponding to the object represented by
 ;;; bits and return it. We assume bogus functions correspond to the