X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=7411bc59a10f25a2997d59c9e1a2bde051de75f5;hb=cdd026dddac3eaddbaa0221503e49e2673d54545;hp=5059ce960ec3bb10c6596c12af2870aade1340ae;hpb=e7b2c507c364da9395ad1f9591210dac44f24afd;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 5059ce9..7411bc5 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -527,16 +527,19 @@
     #!-stack-grows-downward-not-upward
     (and (sap< x (current-sp))
          (sap<= control-stack-start x)
-         (or (not aligned) (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask))))
+         (or (not aligned) (zerop (logand (sap-int x)
+                                          (1- (ash 1 sb!vm:word-shift))))))
     #!+stack-grows-downward-not-upward
     (and (sap>= x (current-sp))
          (sap> control-stack-end x)
-         (or (not aligned) (zerop (logand (sap-int x) sb!vm:fixnum-tag-mask))))))
+         (or (not aligned) (zerop (logand (sap-int x)
+                                          (1- (ash 1 sb!vm:word-shift))))))))
 
 (declaim (inline component-ptr-from-pc))
 (sb!alien:define-alien-routine component-ptr-from-pc (system-area-pointer)
   (pc system-area-pointer))
 
+#!+gencgc (declaim (inline valid-lisp-pointer-p))
 #!+gencgc
 (sb!alien:define-alien-routine valid-lisp-pointer-p sb!alien:int
   (pointer system-area-pointer))
@@ -1992,11 +1995,11 @@ register."
        #!-gencgc
        (and (logbitp 0 val)
             (or (< sb!vm:read-only-space-start val
-                   (* sb!vm:*read-only-space-free-pointer*
-                      sb!vm:n-word-bytes))
+                   (ash sb!vm:*read-only-space-free-pointer*
+                        sb!vm:n-fixnum-tag-bits))
                 (< sb!vm:static-space-start val
-                   (* sb!vm:*static-space-free-pointer*
-                      sb!vm:n-word-bytes))
+                   (ash sb!vm:*static-space-free-pointer*
+                        sb!vm:n-fixnum-tag-bits))
                 (< (current-dynamic-space-start) val
                    (sap-int (dynamic-space-free-pointer))))))
       (values (%make-lisp-obj val) t)
@@ -3149,20 +3152,10 @@ register."
      #!-(or x86 x86-64)
      (let ((new-lra (make-lisp-obj (+ (sap-int dst-start)
                                       sb!vm:other-pointer-lowtag))))
-       #!-(or gencgc ppc)
-       (progn
-         ;; Set the offset from the LRA to the enclosing component.
-         ;; This does not need to be done on GENCGC targets, as the
-         ;; pointer validation done in MAKE-LISP-OBJ requires that it
-         ;; already have been set before we get here.  It does not
-         ;; need to be done on CHENEYGC PPC as it's easier to use the
-         ;; same fun_end_breakpoint_guts on both, including the LRA
-         ;; header.
-         (set-header-data
-          new-lra
-          (logandc2 (+ sb!vm:code-constants-offset bogus-lra-constants 1)
-                    1))
-         (sb!vm:sanctify-for-execution code-object))
+       ;; We used to set the header value of the LRA here to the
+       ;; offset from the enclosing component to the LRA header, but
+       ;; MAKE-LISP-OBJ actually checks the value before we get a
+       ;; chance to set it, so it's now done in arch-assem.S.
        (values new-lra code-object (sap- trap-loc src-start))))))
 
 ;;;; miscellaneous