1.0.4.80: make ADJUST-ARRAY interrupt-safe

 * WITHOUT-INTERRUPTS while using the temp-vector that is also bound
   to the thread-local *ZAP-ARRAY-DATA-TEMP*, so that interrupt handlers
   calling ADJUST-ARRAY cannot stomp on the data.

   Also zero out the temp-vector immediately, and be a bit more sensible
   about filling it.

 * STABLE-SORT has been audited for interrupt-safety vrt. its cached
   temporary vector, and is already OK.

 * Squeeze a mighty 1050 words out of the core by using empty vectors
   for both of the above to start with.

diff --git a/NEWS b/NEWS
index 0f25da1..ddd86f9 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -22,6 +22,7 @@ changes in sbcl-1.0.5 relative to sbcl-1.0.4:
     to global variables using SYMBOL-VALUE and a constant argument.
   * enhancement: SIGINT now causes a specific condition
     SB-SYS:INTERACTIVE-INTERRUPT to be signalled.
+  * bug fix: ADJUST-ARRAY is now interrupt-safe.
   * bug fix: adding and removing fd-handlers is now interrupt-safe.
   * bug fix: inlined calls to C now ensure 16byte stack alignment on
     x86/Darwin.

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 6296eb4..877ce6d 100644 (file)
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -966,44 +966,62 @@ of specialized arrays is supported."
 ;;;
 ;;; DX is probably a bad idea, because a with a big array it would
 ;;; be fairly easy to blow the stack.
-;;;
-;;; Rebound per thread.
-(defvar *zap-array-data-temp* (make-array 1000 :initial-element t))
+(defvar *zap-array-data-temp* (vector))
+(declaim (simple-vector *zap-array-data-temp*))
 
-(defun zap-array-data-temp (length element-type initial-element
-                            initial-element-p)
+(defun zap-array-data-temp (length initial-element initial-element-p)
   (declare (fixnum length))
-  (when (> length (the fixnum (length *zap-array-data-temp*)))
-    (setf *zap-array-data-temp*
-          (make-array length :initial-element t)))
-  (when initial-element-p
-    (unless (typep initial-element element-type)
-      (error "~S can't be used to initialize an array of type ~S."
-             initial-element element-type))
-    (fill (the simple-vector *zap-array-data-temp*) initial-element
-          :end length))
-  *zap-array-data-temp*)
+  (let ((tmp *zap-array-data-temp*))
+    (declare (simple-vector tmp))
+    (cond ((> length (length tmp))
+           (setf *zap-array-data-temp*
+                 (if initial-element-p
+                     (make-array length :initial-element initial-element)
+                     (make-array length))))
+          (initial-element-p
+           (fill tmp initial-element :end length))
+          (t
+           tmp))))
 
 ;;; This does the grinding work for ADJUST-ARRAY. It zaps the data
 ;;; from the OLD-DATA in an arrangement specified by the OLD-DIMS to
 ;;; the NEW-DATA in an arrangement specified by the NEW-DIMS. OFFSET
 ;;; is a displaced offset to be added to computed indices of OLD-DATA.
-;;; NEW-LENGTH, ELEMENT-TYPE, INITIAL-ELEMENT, and INITIAL-ELEMENT-P
-;;; are used when OLD-DATA and NEW-DATA are EQ; in this case, a
-;;; temporary must be used and filled appropriately. When OLD-DATA and
-;;; NEW-DATA are not EQ, NEW-DATA has already been filled with any
-;;; specified initial-element.
 (defun zap-array-data (old-data old-dims offset new-data new-dims new-length
                        element-type initial-element initial-element-p)
   (declare (list old-dims new-dims))
-  (setq old-dims (nreverse old-dims))
-  (setq new-dims (reverse new-dims))
-  (if (eq old-data new-data)
-      (let ((temp (zap-array-data-temp new-length element-type
-                                       initial-element initial-element-p)))
-        (zap-array-data-aux old-data old-dims offset temp new-dims)
-        (dotimes (i new-length) (setf (aref new-data i) (aref temp i))))
-      (zap-array-data-aux old-data old-dims offset new-data new-dims)))
+  ;; OLD-DIMS comes from array-dimensions, which returns a fresh list
+  ;; at least in SBCL.
+  ;; NEW-DIMS comes from the user.
+  (setf old-dims (nreverse old-dims)
+        new-dims (reverse new-dims))
+  (cond ((eq old-data new-data)
+         ;; NEW-LENGTH, ELEMENT-TYPE, INITIAL-ELEMENT, and
+         ;; INITIAL-ELEMENT-P are used when OLD-DATA and NEW-DATA are
+         ;; EQ; in this case, a temporary must be used and filled
+         ;; appropriately. specified initial-element.
+         (when initial-element-p
+           ;; FIXME: transforming this TYPEP to someting a bit faster
+           ;; would be a win...
+           (unless (typep initial-element element-type)
+             (error "~S can't be used to initialize an array of type ~S."
+                    initial-element element-type)))
+         (without-interrupts
+           ;; Need to disable interrupts while using the temp-vector.
+           ;; An interrupt handler that also happened to call
+           ;; ADJUST-ARRAY could otherwise stomp on our data here.
+           (let ((temp (zap-array-data-temp new-length
+                                            initial-element initial-element-p)))
+             (declare (simple-vector temp))
+             (zap-array-data-aux old-data old-dims offset temp new-dims)
+             (dotimes (i new-length)
+               (setf (aref new-data i) (aref temp i)
+                     ;; zero out any garbage right away
+                     (aref temp i) 0)))))
+        (t
+         ;; When OLD-DATA and NEW-DATA are not EQ, NEW-DATA has
+         ;; already been filled with any
+         (zap-array-data-aux old-data old-dims offset new-data new-dims))))
 
 (defun zap-array-data-aux (old-data old-dims offset new-data new-dims)
   (declare (fixnum offset))

diff --git a/src/code/sort.lisp b/src/code/sort.lisp
index d73ed34..e285dab 100644 (file)
--- a/src/code/sort.lisp
+++ b/src/code/sort.lisp
@@ -237,12 +237,14 @@
             (,start-1 0))  ; one n-len subsequence to be merged with the next
        (declare (fixnum ,vector-len ,n ,temp-len ,unsorted ,start-1)
                 (simple-vector ,temp))
-       (if (> ,vector-len ,temp-len)
-           (setf ,temp (make-array (max ,vector-len
-                                        (min most-positive-fixnum
-                                             (+ ,temp-len ,temp-len))))
-                 *merge-sort-temp-vector* ,temp))
-       ;; rebind, in case PRED or KEY calls STABLE-SORT
+       (when (> ,vector-len ,temp-len)
+         (setf ,temp (make-array (max ,vector-len
+                                      (min most-positive-fixnum
+                                           (+ ,temp-len ,temp-len))))
+               *merge-sort-temp-vector* ,temp))
+       ;; Rebind, in case PRED or KEY calls STABLE-SORT. This is also
+       ;; interrupt safe: we bind before we put any data of our own in
+       ;; the temp vector.
        (let ((*merge-sort-temp-vector* (vector)))
          (loop
             ;; for each n, we start taking n-runs from the start of the vector
@@ -295,8 +297,7 @@
 ) ; EVAL-when
 
 ;;; temporary vector for stable sorting vectors, allocated for each new thread
-(defvar *merge-sort-temp-vector* (make-array 50))
-
+(defvar *merge-sort-temp-vector* (vector))
 (declaim (simple-vector *merge-sort-temp-vector*))
 
 (defun stable-sort-simple-vector (vector pred key)

diff --git a/version.lisp-expr b/version.lisp-expr
index 245a14e..7680589 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.4.79"
+"1.0.4.80"