X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=c0a1517a3ee459f1f7bf2cb2719d687db445e862;hb=86210c4e406c1b2ff10cc3bac0e71435867db48b;hp=83c7872284cf2a1f1550a49d36342342c6b8c437;hpb=c713eb2b521b048ff2c927ec52b861787d289f85;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index 83c7872..c0a1517 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -524,15 +524,15 @@ (defun get-lisp-obj-address (thing) (get-lisp-obj-address thing)) (defun fun-word-offset (fun) (fun-word-offset fun)) -#!-sb-fluid (declaim (inline cstack-pointer-valid-p)) -(defun cstack-pointer-valid-p (x) +#!-sb-fluid (declaim (inline control-stack-pointer-valid-p)) +(defun control-stack-pointer-valid-p (x) (declare (type system-area-pointer x)) - #!-x86 ; stack grows toward high address values + #!-stack-grows-downward-not-upward (and (sap< x (current-sp)) (sap<= (int-sap control-stack-start) x) (zerop (logand (sap-int x) #b11))) - #!+x86 ; stack grows toward low address values + #!+stack-grows-downward-not-upward (and (sap>= x (current-sp)) (sap> (int-sap control-stack-end) x) (zerop (logand (sap-int x) #b11)))) @@ -575,10 +575,13 @@ (defun ra-pointer-valid-p (ra) (declare (type system-area-pointer ra)) (and - ;; Not the first page which is unmapped. + ;; not the first page (which is unmapped) + ;; + ;; FIXME: Where is this documented? Is it really true of every CPU + ;; architecture? Is it even necessarily true in current SBCL? (>= (sap-int ra) 4096) - ;; Not a Lisp stack pointer. - (not (cstack-pointer-valid-p ra)))) + ;; not a Lisp stack pointer + (not (control-stack-pointer-valid-p ra)))) ;;; Try to find a valid previous stack. This is complex on the x86 as ;;; it can jump between C and Lisp frames. To help find a valid frame @@ -594,7 +597,7 @@ (fixnum depth)) ;;(format t "*CC ~S ~S~%" fp depth) (cond - ((not (cstack-pointer-valid-p fp)) + ((not (control-stack-pointer-valid-p fp)) #+nil (format t "debug invalid fp ~S~%" fp) nil) (t @@ -604,9 +607,9 @@ 4)))) (c-ocfp (sap-ref-sap fp (* 0 sb!vm:n-word-bytes))) (c-ra (sap-ref-sap fp (* 1 sb!vm:n-word-bytes)))) - (cond ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp) + (cond ((and (sap> lisp-ocfp fp) (control-stack-pointer-valid-p lisp-ocfp) (ra-pointer-valid-p lisp-ra) - (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp) + (sap> c-ocfp fp) (control-stack-pointer-valid-p c-ocfp) (ra-pointer-valid-p c-ra)) #+nil (format t "*C Both valid ~S ~S ~S ~S~%" @@ -621,11 +624,11 @@ (format t "debug: both still valid ~S ~S ~S ~S~%" lisp-ocfp lisp-ra c-ocfp c-ra)) - #+freebsd + #!+freebsd (if (sap> lisp-ocfp c-ocfp) (values lisp-ra lisp-ocfp) (values c-ra c-ocfp)) - #-freebsd + #!-freebsd (values lisp-ra lisp-ocfp)) (lisp-path-fp ;; The lisp convention is looking good. @@ -640,12 +643,12 @@ #+nil (format t "debug: no valid2 fp found ~S ~S~%" lisp-ocfp c-ocfp) nil)))) - ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp) + ((and (sap> lisp-ocfp fp) (control-stack-pointer-valid-p lisp-ocfp) (ra-pointer-valid-p lisp-ra)) ;; The lisp convention is looking good. #+nil (format t "*C lisp-ocfp ~S ~S~%" lisp-ocfp lisp-ra) (values lisp-ra lisp-ocfp)) - ((and (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp) + ((and (sap> c-ocfp fp) (control-stack-pointer-valid-p c-ocfp) #!-linux (ra-pointer-valid-p c-ra)) ;; The C convention is looking good. #+nil (format t "*C c-ocfp ~S ~S~%" c-ocfp c-ra) @@ -705,7 +708,7 @@ frame))) (bogus-debug-fun (let ((fp (frame-pointer frame))) - (when (cstack-pointer-valid-p fp) + (when (control-stack-pointer-valid-p fp) #!+x86 (multiple-value-bind (ra ofp) (x86-call-context fp) (compute-calling-frame ofp ra frame)) @@ -791,7 +794,7 @@ #!-x86 (defun compute-calling-frame (caller lra up-frame) (declare (type system-area-pointer caller)) - (when (cstack-pointer-valid-p caller) + (when (control-stack-pointer-valid-p caller) (multiple-value-bind (code pc-offset escaped) (if lra (multiple-value-bind (word-offset code) @@ -835,7 +838,7 @@ (defun compute-calling-frame (caller ra up-frame) (declare (type system-area-pointer caller ra)) (/noshow0 "entering COMPUTE-CALLING-FRAME") - (when (cstack-pointer-valid-p caller) + (when (control-stack-pointer-valid-p caller) (/noshow0 "in WHEN") ;; First check for an escaped frame. (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller) @@ -2048,7 +2051,7 @@ (sb!vm:context-float-register escaped (sb!c:sc-offset-offset sc-offset) 'double-float) (sb!vm:context-float-register - escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 2 #-sparc 1) + escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 2 #!-sparc 1) 'double-float)) :invalid-value-for-unescaped-register-storage)) #!+long-float @@ -2858,7 +2861,7 @@ (do ((frame frame (frame-down frame))) ((not frame) nil) (when (and (compiled-frame-p frame) - (#-x86 eq #+x86 sap= + (#!-x86 eq #!+x86 sap= lra (get-context-value frame lra-save-offset lra-sc-offset))) (return t))))) @@ -3136,9 +3139,9 @@ (breakpoint-do-displaced-inst signal-context (breakpoint-data-instruction data)) ;; Some platforms have no usable sigreturn() call. If your - ;; implementation of arch_do_displaced_inst() doesn't sigreturn(), - ;; add it to this list. - #!-(or hpux irix x86 alpha) + ;; implementation of arch_do_displaced_inst() _does_ sigreturn(), + ;; it's polite to warn here + #!+(and sparc solaris) (error "BREAKPOINT-DO-DISPLACED-INST returned?")))) (defun invoke-breakpoint-hooks (breakpoints component offset)