faster VECTOR-SUBSEQ*

  Use a WITH-ARRAY-DATA to get to the underlying vector, and use a widetag
  dispatch table to pick the correct SUBSEQ implementation for the underlying
  type.

  This is actually just as fast even for simple strings as STRING-SUBSEQ*, so
  throw it out.

  Also make inlining SUBSEQ conditional on SPEED > SPACE now that the
  out-of-line version doesn't suck so much.

  Fixes lp#902537.

diff --git a/NEWS b/NEWS
index 5558322..297d20b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -33,6 +33,8 @@ changes relative to sbcl-1.0.54:
   * enhancement: SBCL now provides either an explicit :BIG-ENDIAN or
     :LITTLE-ENDIAN in *FEATURES*, instead of :BIG-ENDIAN being implied by lack
     of the :LITTLE-ENDIAN feature. (Thanks to Luís Oliveira, lp#901661)
+  * optimization: SUBSEQ on vectors of unknown element type is substantially
+    faster. (lp#902537)
   * optimization: specialized arrays with non-zero :INITIAL-ELEMENT can
     be stack-allocated. (lp#902351) 
   * optimization: the compiler is smarter about representation selection for

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 7312ffb..764a683 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1700,7 +1700,6 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "SPECIALIZABLE" "SPECIALIZABLE-VECTOR" "SPECIFIER-TYPE"
                "STACK-REF" "STREAM-DESIGNATOR" "STRING-DESIGNATOR"
                "STRING-FILL*"
-               "STRING-SUBSEQ*"
                "STRUCTURE-RAW-SLOT-TYPE-AND-SIZE" "SUB-GC"
                "SYMBOLS-DESIGNATOR"
                "%INSTANCE-LENGTH"

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 565c086..c4a0e26 100644 (file)
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -317,7 +317,7 @@ of specialized arrays is supported."
   (coerce (the list objects) 'simple-vector))
 \f
 
-;;;; accessor/setter functions
+;;;; accessor/setter and subseq functions
 
 ;;; Dispatch to an optimized routine the data vector accessors for
 ;;; each different specialized vector type. Do dispatching by looking
@@ -328,6 +328,9 @@ of specialized arrays is supported."
 ;;; the type information is available. Finally, for each of these
 ;;; routines also provide a slow path, taken for arrays that are not
 ;;; vectors or not simple.
+;;;
+;;; Similarly for SUBSEQ, except we don't have the slow-path at all:
+;;; VECTOR-SUBEQ* takes care of that.
 (macrolet ((def (name table-name)
              `(progn
                 (defglobal ,table-name (make-array ,(1+ sb!vm:widetag-mask)))
@@ -340,7 +343,8 @@ of specialized arrays is supported."
   (def !find-data-vector-setter %%data-vector-setters%%)
   (def !find-data-vector-setter/check-bounds %%data-vector-setters/check-bounds%%)
   (def !find-data-vector-reffer %%data-vector-reffers%%)
-  (def !find-data-vector-reffer/check-bounds %%data-vector-reffers/check-bounds%%))
+  (def !find-data-vector-reffer/check-bounds %%data-vector-reffers/check-bounds%%)
+  (def !find-vector-subseq-fun %%vector-subseq-funs%%))
 
 (macrolet ((%ref (accessor-getter extra-params)
              `(funcall (,accessor-getter array) array index ,@extra-params))
@@ -395,7 +399,34 @@ of specialized arrays is supported."
          :datum array
          :expected-type 'vector))
 
+(defun hairy-subseq-error (array start end)
+  (declare (ignore start end))
+  (error 'type-error
+         :datum array
+         :expected-type '(simple-array * (*))))
+
 ;;; Populate the dispatch tables.
+(macrolet ((def-subseq-funs ()
+             `(progn
+                (set '%%vector-subseq-funs%%
+                     (make-array (1+ sb!vm:widetag-mask)
+                                 :initial-element #'hairy-subseq-error))
+                ,@(map 'list
+                       (lambda (saetp)
+                         (let ((name (symbolicate "SUBSEQ/"
+                                                  (sb!vm:saetp-primitive-type-name saetp))))
+                           `(progn
+                              (defun ,name (vector start end)
+                                (declare (type (simple-array ,(sb!vm:saetp-specifier saetp) (*))
+                                               vector)
+                                         (index start end)
+                                         (optimize speed (safety 0)))
+                                (subseq vector start end))
+                              (setf (svref %%vector-subseq-funs%%
+                                           ,(sb!vm:saetp-typecode saetp))
+                                    #',name))))
+                       sb!vm:*specialized-array-element-type-properties*))))
+  (def-subseq-funs))
 (macrolet ((define-reffer (saetp check-form)
              (let* ((type (sb!vm:saetp-specifier saetp))
                     (atype `(simple-array ,type (*))))

diff --git a/src/code/seq.lisp b/src/code/seq.lisp
index d37da2c..d3e88e0 100644 (file)
--- a/src/code/seq.lisp
+++ b/src/code/seq.lisp
@@ -377,38 +377,17 @@
 ;;;; so we worry about dealing with END being supplied or defaulting
 ;;;; to NIL at this level.
 
-(defun string-subseq* (sequence start end)
-  (with-array-data ((data sequence)
-                    (start start)
-                    (end end)
-                    :force-inline t
-                    :check-fill-pointer t)
-    (declare (optimize (speed 3) (safety 0)))
-    (string-dispatch ((simple-array character (*))
-                      (simple-array base-char (*))
-                      (vector nil))
-        data
-        (subseq data start end))))
-
 (defun vector-subseq* (sequence start end)
   (declare (type vector sequence))
   (declare (type index start)
-           (type (or null index) end))
+           (type (or null index) end)
+           (optimize speed))
   (with-array-data ((data sequence)
                     (start start)
                     (end end)
                     :check-fill-pointer t
                     :force-inline t)
-    (let* ((copy (%make-sequence-like sequence (- end start)))
-           (setter (!find-data-vector-setter copy))
-           (reffer (!find-data-vector-reffer data)))
-      (declare (optimize (speed 3) (safety 0)))
-      (do ((old-index start (1+ old-index))
-           (new-index 0 (1+ new-index)))
-          ((= old-index end) copy)
-        (declare (index old-index new-index))
-        (funcall setter copy new-index
-                 (funcall reffer data old-index))))))
+    (funcall (!find-vector-subseq-fun data) data start end)))
 
 (defun list-subseq* (sequence start end)
   (declare (type list sequence)

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 354f64d..eff5751 100644 (file)
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -794,7 +794,14 @@ implementation it is ~S." *default-package-use-list*)
                                            (aver (= (length name) length))
                                            name)
                                           (t
-                                           (subseq name 0 length)))))
+                                           ;; This so that SUBSEQ is inlined,
+                                           ;; because we need it fixed for cold init.
+                                           (string-dispatch
+                                               ((simple-array base-char (*))
+                                                (simple-array character (*)))
+                                               name
+                                             (declare (optimize speed))
+                                             (subseq name 0 length))))))
                    (with-single-package-locked-error
                        (:package package "interning ~A" symbol-name)
                      (let ((symbol (make-symbol symbol-name)))

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 68306ee..24cce71 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -994,7 +994,8 @@
   (let ((type (lvar-type seq)))
     (cond
       ((and (array-type-p type)
-            (csubtypep type (specifier-type '(or (simple-unboxed-array (*)) simple-vector))))
+            (csubtypep type (specifier-type '(or (simple-unboxed-array (*)) simple-vector)))
+            (policy node (> speed space)))
        (let ((element-type (type-specifier (array-type-specialized-element-type type))))
          `(let* ((length (length seq))
                  (end (or end length)))
@@ -1009,8 +1010,6 @@
                                                        'start)
                                               'result 0 'size element-type)
               result))))
-      ((csubtypep type (specifier-type 'string))
-       '(string-subseq* seq start end))
       (t
        '(vector-subseq* seq start end)))))
 
@@ -1031,8 +1030,6 @@
                      (result (make-array length :element-type ',element-type)))
                 ,(maybe-expand-copy-loop-inline 'seq 0 'result 0 'length element-type)
                 result)))
-          ((csubtypep type (specifier-type 'string))
-           '(string-subseq* seq 0 nil))
           (t
            '(vector-subseq* seq 0 nil)))))