X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Fdebug-int.lisp;h=a7ce184fff7a3ace4e0e8d8c3f10dfa457fa70b3;hb=0051cc0532da9f68a0ba5db5c07ebee1c91ee4d8;hp=44aa628c5f048031e213379500b234cec5da9500;hpb=e365f2f7a9c66d307b48fee70778f4eaa84bdcc0;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 44aa628..a7ce184 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -527,18 +527,18 @@
 #!-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
-	  (sap+
-	   (descriptor-sap sb!vm::*binding-stack-start*) -4)))
-  #!-stack-grows-downward-not-upward
-  (and (sap< x (current-sp))
-	 (sap<= control-stack-start
-	      x)
-       (zerop (logand (sap-int x) #b11)))
-  #!+stack-grows-downward-not-upward
-  (and (sap>= x (current-sp))
+	  (descriptor-sap *control-stack-end*)))
+    #!-stack-grows-downward-not-upward
+    (and (sap< x (current-sp))
+	 (sap<= control-stack-start x)
+	 (zerop (logand (sap-int x) #b11)))
+    #!+stack-grows-downward-not-upward
+    (and (sap>= x (current-sp))
 	 (sap> control-stack-end x)
 	 (zerop (logand (sap-int x) #b11)))))
 
@@ -887,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)))
@@ -939,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