X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Falloc.lisp;h=4bdb9fea4f26799c80a07a39c40aff672616fbc2;hb=37200d73dfca16507809778574092cfb998711d5;hp=e325f375ce5679fd10cf818be7842071ae47022b;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/alloc.lisp b/src/code/alloc.lisp
index e325f37..4bdb9fe 100644
--- a/src/code/alloc.lisp
+++ b/src/code/alloc.lisp
@@ -23,9 +23,7 @@
            (type (unsigned-byte #.n-word-bits) words)
            (type index length))
   (handler-case
-      ;; FIXME: Is WITHOUT-GCING enough to do lisp-side allocation
-      ;; to static space, or should we have WITHOUT-INTERRUPTS here
-      ;; as well?
+      ;; WITHOUT-GCING implies WITHOUT-INTERRUPTS
       (without-gcing
         (let* ((pointer *static-space-free-pointer*) ; in words
                (free (* pointer n-word-bytes))
@@ -38,15 +36,14 @@
           (unless (> static-space-end new-free)
             (error 'simple-storage-condition
                    :format-control "Not enough memory left in static space to ~
-                                   allocate vector."))
+                                    allocate vector."))
           (store-word widetag
                       vector 0 other-pointer-lowtag)
           (store-word (ash length word-shift)
                       vector vector-length-slot other-pointer-lowtag)
           (store-word 0 new-free)
-          (prog1
-              (make-lisp-obj vector)
-            (setf *static-space-free-pointer* new-pointer))))
+          (setf *static-space-free-pointer* new-pointer)
+          (%make-lisp-obj vector)))
     (serious-condition (c)
       ;; unwind from WITHOUT-GCING
       (error c))))