X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Falloc.lisp;h=c7b76f9e004a79292345b834030a00d6316f640c;hb=18dc0069cd514c976042766ab9a785c970fe1603;hp=fa25d4e1b3f58712f474c7167fc5d5e7c92a8f24;hpb=5cff0e6cf16a878e29d7d4fb26a3252b1698c345;p=sbcl.git

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 ~