Changeset 15327

Timestamp:

06/11/20 12:25:31 (3 years ago)

Author:

Mark Evenson

Message:

Restore svref optimizations for SIMPLE-VECTOR sorts

Fixes <https://abcl.org/trac/ticket/196>.

File:

• trunk/abcl/src/org/armedbear/lisp/sort.lisp (modified) (4 diffs)

trunk/abcl/src/org/armedbear/lisp/sort.lisp

@@ -99 +99 @@
        (loop 
          (if (funcall ,predicate ,k-b ,k-a)
-       (progn 
-;;         (setf (svref ,aux ,i-aux) ,v-b ;; FIXME Ticket #196
-         (setf (aref ,aux ,i-aux) ,v-b
-         ,i-aux (+ ,i-aux 1)
-         ,i-b (+ ,i-b 1))
+       (progn
+                           ,(if (subtypep type 'simple-vector)
+              `(setf (svref ,aux ,i-aux) ,v-b 
+                                       ,i-aux (+ ,i-aux 1)
+               ,i-b (+ ,i-b 1))
+                                `(setf (aref ,aux ,i-aux) ,v-b
+                                       ,i-aux (+ ,i-aux 1)
+               ,i-b (+ ,i-b 1)))
          (when (= ,i-b ,end-b) (return))
          (setf ,v-b (,ref ,b ,i-b)
@@ -109 +112 @@
                `(,k-b (funcall ,key ,v-b))
                `(,k-b ,v-b))))
-       (progn 
-;;         (setf (svref ,aux ,i-aux) ,v-a ;; FIXME Ticket #196
-         (setf (aref ,aux ,i-aux) ,v-a
-         ,i-aux (+ ,i-aux 1)
-         ,i-a (+ ,i-a 1))
+       (progn
+                           ,(if (subtypep type 'simple-vector)
+              `(setf (svref ,aux ,i-aux) ,v-a 
+               ,i-aux (+ ,i-aux 1)
+               ,i-a (+ ,i-a 1))
+                                `(setf (aref ,aux ,i-aux) ,v-a
+                                       ,i-aux (+ ,i-aux 1)
+               ,i-a (+ ,i-a 1)))
          (when (= ,i-a ,end-a)
            (setf ,a ,b 
@@ -125 +131 @@
                `(,k-a ,v-a))))))))
       (loop
-;;        (setf (svref ,aux ,i-aux) ,v-a ;; FIXME Ticket #196
-        (setf (aref ,aux ,i-aux) ,v-a
-        ,i-a (+ ,i-a 1))
+              ,(if (subtypep type 'simple-vector)
+             `(setf (svref ,aux ,i-aux) ,v-a 
+                          ,i-a (+ ,i-a 1))
+             `(setf (aref ,aux ,i-aux) ,v-a
+                          ,i-a (+ ,i-a 1)))
         (when (= ,i-a ,end-a) (return))
         (setf ,v-a (,ref ,a ,i-a)
@@ -164 +172 @@
                 ,mid ,end ,aux ,start ,predicate)))))
    (let ((,maux (make-array ,mend)))
-;;     (declare (type simple-vector ,maux))
-     (declare (type vector ,maux))
+           (declare (type ,maux ,type))
      (,merge-sort-call ,msequence ,mstart ,mend ,mpredicate ,mkey ,maux nil))))))