X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=270c9d9b8e17f0f25bb3d55c31d928ddd7cd5ea4;hb=2b596efa9a6b08a22bbdcdf88198c5d2af1d0335;hp=c705a48207b8c0efd65c1aafff3fe2f4c6004819;hpb=040e4e707e4f7bc9bda2ab78774fd9205c44ee1f;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index c705a48..270c9d9 100644 --- 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")) @@ -886,7 +888,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 +939,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