X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fsort.lisp;h=076a9b9e3f65c71b605786d0abe74164583ccaee;hb=77bf768d096845986af71ca5055c94c4abd626ed;hp=d73ed34ab102b1cb28be4178f1c024da8077ea0c;hpb=a682f4c392bc874a6a898632889319ebdd8821fc;p=sbcl.git

diff --git a/src/code/sort.lisp b/src/code/sort.lisp
index d73ed34..076a9b9 100644
--- a/src/code/sort.lisp
+++ b/src/code/sort.lisp
@@ -23,7 +23,7 @@
   #!+sb-doc
   "Destructively sort SEQUENCE. PREDICATE should return non-NIL if
    ARG1 is to precede ARG2."
-  (declare (dynamic-extent args))
+  (declare (truly-dynamic-extent args))
   (let ((predicate-fun (%coerce-callable-to-fun predicate)))
     (seq-dispatch sequence
       (stable-sort-list sequence
@@ -31,8 +31,9 @@
                         (if key (%coerce-callable-to-fun key) #'identity))
       (let ((key-fun-or-nil (and key (%coerce-callable-to-fun key))))
         (with-array-data ((vector (the vector sequence))
-                          (start 0)
-                          (end (length sequence)))
+                          (start)
+                          (end)
+                          :check-fill-pointer t)
           (sort-vector vector start end predicate-fun key-fun-or-nil))
         sequence)
       (apply #'sb!sequence:sort sequence predicate args))))
@@ -42,7 +43,7 @@
   #!+sb-doc
   "Destructively sort SEQUENCE. PREDICATE should return non-NIL if
    ARG1 is to precede ARG2."
-  (declare (dynamic-extent args))
+  (declare (truly-dynamic-extent args))
   (let ((predicate-fun (%coerce-callable-to-fun predicate)))
     (seq-dispatch sequence
       (stable-sort-list sequence
@@ -237,12 +238,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 (truncate array-dimension-limit 2)
+                                           (logand 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
@@ -294,11 +297,6 @@
 
 ) ; EVAL-when
 
-;;; temporary vector for stable sorting vectors, allocated for each new thread
-(defvar *merge-sort-temp-vector* (make-array 50))
-
-(declaim (simple-vector *merge-sort-temp-vector*))
-
 (defun stable-sort-simple-vector (vector pred key)
   (declare (type simple-vector vector)
            (type function pred)