;;;; 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.
#!-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)))))
(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