0.pre8.33
[sbcl.git] / src / code / debug-int.lisp
index c705a48..9dbacc8 100644 (file)
                             (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)))
 (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