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

diff --git a/src/code/alloc.lisp b/src/code/alloc.lisp
index e325f37..5ae0275 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))
@@ -35,18 +33,19 @@
                                  lowtag-mask))
                (new-pointer (+ *static-space-free-pointer* nwords))
                (new-free (* new-pointer n-word-bytes)))
+          ;; FIXME: don't signal while in WITHOUT-GCING, the handler
+          ;; risks deadlock with SIG_STOP_FOR_GC.
           (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))))