1.0.26.6: use private operations on futexes

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

diff --git a/src/code/alloc.lisp b/src/code/alloc.lisp
index e325f37..5ae0275 100644 (file)
--- 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))))