From: Nikodemus Siivola Date: Sat, 10 Dec 2011 17:07:53 +0000 (+0200) Subject: faster VECTOR-SUBSEQ* X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=fb2d28ba0ccab2afb9e68b4de722ba2179bcea8e;p=sbcl.git 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 --- 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 --- 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 --- 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)) -;;;; 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 --- 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 --- 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 --- 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)))))