1.0.11.6: canonicalize whitespaces only on updated files

[sbcl.git] / src / code / room.lisp

diff --git a/src/code/room.lisp b/src/code/room.lisp
index 6e0ed5a..5f6d93c 100644 (file)
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -88,8 +88,10 @@
       (make-room-info :name 'closure
                       :kind :closure))
 
+;; FIXME: This looks rather brittle. Can we get more of these numbers
+;; from somewhere sensible?
 (dolist (stuff '((simple-bit-vector-widetag . -3)
-                 (simple-vector-widetag . 2)
+                 (simple-vector-widetag . #.sb!vm:word-shift)
                  (simple-array-unsigned-byte-2-widetag . -2)
                  (simple-array-unsigned-byte-4-widetag . -1)
                  (simple-array-unsigned-byte-7-widetag . 0)
@@ -179,7 +181,9 @@
   (multiple-value-bind (start end) (space-bounds space)
     (- (sap-int end) (sap-int start))))
 
-;;; Round SIZE (in bytes) up to the next dualword (eight byte) boundary.
+;;; Round SIZE (in bytes) up to the next dualword boundary. A dualword
+;;; is eight bytes on platforms with 32-bit word size and 16 bytes on
+;;; platforms with 64-bit word size.
 #!-sb-fluid (declaim (inline round-to-dualword))
 (defun round-to-dualword (size)
   (declare (fixnum size))
@@ -295,13 +299,13 @@
                     (eq (room-info-kind info) :lowtag))
                 (let ((size (* cons-size n-word-bytes)))
                   (funcall fun
-                           (make-lisp-obj (logior (sap-int current)
+                           (%make-lisp-obj (logior (sap-int current)
                                                   list-pointer-lowtag))
                            list-pointer-lowtag
                            size)
                   (setq current (sap+ current size))))
                ((eql header-widetag closure-header-widetag)
-                (let* ((obj (make-lisp-obj (logior (sap-int current)
+                (let* ((obj (%make-lisp-obj (logior (sap-int current)
                                                    fun-pointer-lowtag)))
                        (size (round-to-dualword
                               (* (the fixnum (1+ (get-closure-length obj)))
@@ -309,7 +313,7 @@
                   (funcall fun obj header-widetag size)
                   (setq current (sap+ current size))))
                ((eq (room-info-kind info) :instance)
-                (let* ((obj (make-lisp-obj
+                (let* ((obj (%make-lisp-obj
                              (logior (sap-int current) instance-pointer-lowtag)))
                        (size (round-to-dualword
                               (* (+ (%instance-length obj) 1) n-word-bytes))))
@@ -318,7 +322,7 @@
                   (aver (zerop (logand size lowtag-mask)))
                   (setq current (sap+ current size))))
                (t
-                (let* ((obj (make-lisp-obj
+                (let* ((obj (%make-lisp-obj
                              (logior (sap-int current) other-pointer-lowtag)))
                        (size (ecase (room-info-kind info)
                                (:fixed
@@ -789,7 +793,8 @@
           (when (or (eq (symbol-name obj) object)
                     (eq (symbol-package obj) object)
                     (eq (symbol-plist obj) object)
-                    (eq (symbol-value obj) object))
+                    (and (boundp obj)
+                         (eq (symbol-value obj) object)))
             (maybe-call fun obj)))))
      space)))