From 9e508b594433a9312890e4ae60d62302bd10b483 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 13 Apr 2007 12:32:14 +0000 Subject: [PATCH] 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. --- NEWS | 1 + src/code/array.lisp | 74 ++++++++++++++++++++++++++++++++------------------- src/code/sort.lisp | 17 ++++++------ version.lisp-expr | 2 +- 4 files changed, 57 insertions(+), 37 deletions(-) diff --git a/NEWS b/NEWS index 0f25da1..ddd86f9 100644 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4