From: Alastair Bridgewater <nyef_sbcl@lisphacker.com>
Date: Wed, 23 Dec 2009 13:35:11 +0000 (-0500)
Subject: Clean up all use of the *-space-free-pointers.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=e57523089c7ad0ce2c874c03ecfe721d299efbfb;p=sbcl.git

Clean up all use of the *-space-free-pointers.

  * These are symbols whose value slots contain unboxed word-aligned
byte pointers.  Thus, they appear to lisp as fixnums.  They are not,
however, guaranteed to be word pointers.

  * Shift by n-fixnum-tag-bits instead of shifting by word-shift or
scaling by n-word-bytes in order to obtain byte pointers.
---

diff --git a/contrib/sb-introspect/introspect.lisp b/contrib/sb-introspect/introspect.lisp
index d85c015..3af8709 100644
--- a/contrib/sb-introspect/introspect.lisp
+++ b/contrib/sb-introspect/introspect.lisp
@@ -842,12 +842,12 @@ Experimental: interface subject to change."
                (let* ((addr (sb-kernel:get-lisp-obj-address object))
                       (space
                        (cond ((< sb-vm:read-only-space-start addr
-                                 (* 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))
                               :read-only)
                              ((< sb-vm:static-space-start addr
-                                 (* sb-vm:*static-space-free-pointer*
-                                    sb-vm:n-word-bytes))
+                                 (ash sb-vm:*static-space-free-pointer*
+                                      sb-vm:n-fixnum-tag-bits))
                               :static)
                              ((< (sb-kernel:current-dynamic-space-start) addr
                                  (sb-sys:sap-int (sb-kernel:dynamic-space-free-pointer)))
diff --git a/src/code/alloc.lisp b/src/code/alloc.lisp
index fa25d4e..c7b76f9 100644
--- a/src/code/alloc.lisp
+++ b/src/code/alloc.lisp
@@ -25,21 +25,20 @@
   ;; WITHOUT-GCING implies WITHOUT-INTERRUPTS
   (or
    (without-gcing
-     (let* ((pointer *static-space-free-pointer*) ; in words
-            (free (* pointer n-word-bytes))
-            (vector (logior free other-pointer-lowtag)) ; in bytes, yay
+     (let* ((pointer (ash *static-space-free-pointer* n-fixnum-tag-bits))
+            (vector (logior pointer other-pointer-lowtag))
             ;; rounded to dual word boundary
             (nwords (logandc2 (+ lowtag-mask (+ words vector-data-offset 1))
                               lowtag-mask))
-            (new-pointer (+ *static-space-free-pointer* nwords))
-            (new-free (* new-pointer n-word-bytes)))
-       (when (> static-space-end new-free)
+            (new-pointer (+ pointer (ash nwords word-shift))))
+       (when (> static-space-end new-pointer)
          (store-word widetag
                      vector 0 other-pointer-lowtag)
-         (store-word (ash length word-shift)
+         (store-word (fixnumize length)
                      vector vector-length-slot other-pointer-lowtag)
-         (store-word 0 new-free)
-         (setf *static-space-free-pointer* new-pointer)
+         (store-word 0 new-pointer)
+         (setf *static-space-free-pointer*
+               (ash new-pointer (- n-fixnum-tag-bits)))
          (%make-lisp-obj vector))))
    (error 'simple-storage-condition
           :format-control "Not enough memory left in static space to ~
diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 7569118..9df9a29 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -1993,11 +1993,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)
diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index 148547c..517cb0d 100644
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -36,11 +36,11 @@
           (current-dynamic-space-start))))
 
 (defun static-space-usage ()
-  (- (* sb!vm:*static-space-free-pointer* sb!vm:n-word-bytes)
+  (- (ash sb!vm:*static-space-free-pointer* sb!vm:n-fixnum-tag-bits)
      sb!vm:static-space-start))
 
 (defun read-only-space-usage ()
-  (- (* 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:read-only-space-start))
 
 (defun control-stack-usage ()
diff --git a/src/code/room.lisp b/src/code/room.lisp
index 3877c29..a9ee633 100644
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -171,10 +171,10 @@
   (ecase space
     (:static
      (values (int-sap static-space-start)
-             (int-sap (* *static-space-free-pointer* n-word-bytes))))
+             (int-sap (ash *static-space-free-pointer* n-fixnum-tag-bits))))
     (:read-only
      (values (int-sap read-only-space-start)
-             (int-sap (* *read-only-space-free-pointer* n-word-bytes))))
+             (int-sap (ash *read-only-space-free-pointer* n-fixnum-tag-bits))))
     (:dynamic
      (values (int-sap (current-dynamic-space-start))
              (dynamic-space-free-pointer)))))