X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=19da16e258dec6c7962cacb28a1cb4ce2733c32b;hb=c593dc26733b179db6c12c7085ed76b762ac256b;hp=234bcbf9ac785e56abd3175ffe5dfc9103b8e3c2;hpb=db97ea04895820f70c90bdeb0399aa0229410b5d;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 234bcbf..19da16e 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -515,7 +515,7 @@
 (defun fun-word-offset (fun) (fun-word-offset fun))
 
 #!-sb-fluid (declaim (inline control-stack-pointer-valid-p))
-(defun control-stack-pointer-valid-p (x)
+(defun control-stack-pointer-valid-p (x &optional (aligned t))
   (declare (type system-area-pointer x))
   (let* (#!-stack-grows-downward-not-upward
          (control-stack-start
@@ -526,11 +526,11 @@
     #!-stack-grows-downward-not-upward
     (and (sap< x (current-sp))
          (sap<= control-stack-start x)
-         (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask)))
+         (or (not aligned) (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask))))
     #!+stack-grows-downward-not-upward
     (and (sap>= x (current-sp))
          (sap> control-stack-end x)
-         (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask)))))
+         (or (not aligned) (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask))))))
 
 (declaim (inline component-ptr-from-pc))
 (sb!alien:define-alien-routine component-ptr-from-pc (system-area-pointer)