1.0.27.22: better signaling from MAKE-STATIC-VECTOR

 * Patch by Daniel Lowe.

diff --git a/src/code/alloc.lisp b/src/code/alloc.lisp
index 5ae0275..fa25d4e 100644 (file)
--- a/src/code/alloc.lisp
+++ b/src/code/alloc.lisp
@@ -22,31 +22,26 @@
   (declare (type (unsigned-byte #.n-widetag-bits) widetag)
            (type (unsigned-byte #.n-word-bits) words)
            (type index length))
-  (handler-case
-      ;; WITHOUT-GCING implies WITHOUT-INTERRUPTS
-      (without-gcing
-        (let* ((pointer *static-space-free-pointer*) ; in words
-               (free (* pointer n-word-bytes))
-               (vector (logior free other-pointer-lowtag)) ; in bytes, yay
-               ;; 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)))
-          ;; 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."))
-          (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)
-          (setf *static-space-free-pointer* new-pointer)
-          (%make-lisp-obj vector)))
-    (serious-condition (c)
-      ;; unwind from WITHOUT-GCING
-      (error c))))
+  ;; 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
+            ;; 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)
+         (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)
+         (setf *static-space-free-pointer* new-pointer)
+         (%make-lisp-obj vector))))
+   (error 'simple-storage-condition
+          :format-control "Not enough memory left in static space to ~
+                           allocate vector.")))
 

diff --git a/version.lisp-expr b/version.lisp-expr
index 217b7f3..e1e7347 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.27.21"
+"1.0.27.22"