From: Juho Snellman Date: Tue, 17 Apr 2007 04:19:28 +0000 (+0000) Subject: 1.0.4.92: faster generic array access X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=9769174fc3e1a9d840712a694f61c6051e161cd7;p=sbcl.git 1.0.4.92: faster generic array access * Replace the typecase-based HAIRY-DATA-VECTOR-* with a table-driven dispatch on widetags * Move bounds checking of one-dimension AREFs into HAIRY-DATA-VECTOR-* from the caller, so that we can avoid doing a full ARRAY-DIMENSION in the common case. * 3-5x speedup on generic array accesses --- diff --git a/NEWS b/NEWS index a16f505..c6cb951 100644 --- a/NEWS +++ b/NEWS @@ -18,6 +18,11 @@ changes in sbcl-1.0.5 relative to sbcl-1.0.4: variants no longer cons. * optimization: Direct calls to CHAR-{EQUAL,LESSP,GREATERP} and their NOT- variants no longer cons. + * optimization: EQUAL hash tables no longer use SXHASH for objects + of all data types, but instead use an EQL hash for types for which + EQUAL is the same as EQL + * optimization: the non-inlined generic versions of AREF and (SETF AREF) + are significantly faster * enhancement: XREF information is now collected to references made to global variables using SYMBOL-VALUE and a constant argument. * enhancement: SIGINT now causes a specific condition @@ -54,9 +59,6 @@ changes in sbcl-1.0.5 relative to sbcl-1.0.4: * bug fix: modifying the contents of an array could change the return value of SXHASH on that array, which is only allowed for strings and bit vectors (bug introduced in 0.9.16) - * optimization: EQUAL hash tables no longer use SXHASH for objects - of all data types, but instead use an EQL hash for types for which - EQUAL is the same as EQL * improvement: the x86-64/darwin port now passes all tests and should be considered non-experimental. * improvement: a style-warning is signaled for CASE (etc) clauses with diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 08ef19f..e5c4c78 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1262,7 +1262,8 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "GET-CLOSURE-LENGTH" "GET-HEADER-DATA" "GET-LISP-OBJ-ADDRESS" "LOWTAG-OF" "WIDETAG-OF" "GET-MACHINE-VERSION" "HAIRY-DATA-VECTOR-REF" - "HAIRY-DATA-VECTOR-SET" "HAIRY-TYPE" + "HAIRY-DATA-VECTOR-REF/CHECK-BOUNDS" "HAIRY-DATA-VECTOR-SET" + "HAIRY-DATA-VECTOR-SET/CHECK-BOUNDS""HAIRY-TYPE" "HAIRY-TYPE-CHECK-TEMPLATE-NAME" "HAIRY-TYPE-SPECIFIER" "HANDLE-CIRCULARITY" "HOST" "IGNORE-IT" "ILL-BIN" "ILL-BOUT" "ILL-IN" "ILL-OUT" "INDEX-OR-MINUS-1" @@ -1542,6 +1543,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%NUMERATOR" "CLASSOID-TYPEP" "DSD-READ-ONLY" "DSD-DEFAULT" "LAYOUT-INHERITS" "DD-LENGTH" "%CODE-ENTRY-POINTS" "%DENOMINATOR" "%SIMPLE-FUN-XREFS" + "%OTHER-POINTER-P" "STANDARD-CLASSOID" "CLASSOID-OF" "MAKE-STANDARD-CLASSOID" "CLASSOID-CELL-TYPEP" diff --git a/src/code/array.lisp b/src/code/array.lisp index 877ce6d..00444b0 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -316,21 +316,145 @@ of specialized arrays is supported." "Construct a SIMPLE-VECTOR from the given objects." (coerce (the list objects) 'simple-vector)) + ;;;; accessor/setter functions -(defun hairy-data-vector-ref (array index) - (with-array-data ((vector array) (index index) (end)) - (declare (ignore end)) - (etypecase vector . - #.(map 'list - (lambda (saetp) - (let* ((type (sb!vm:saetp-specifier saetp)) - (atype `(simple-array ,type (*)))) - `(,atype - (data-vector-ref (the ,atype vector) index)))) - (sort - (copy-seq - sb!vm:*specialized-array-element-type-properties*) - #'> :key #'sb!vm:saetp-importance))))) + +;;; Dispatch to an optimized routine the data vector accessors for +;;; each different specialized vector type. Do dispatching by looking +;;; up the widetag in the array rather than with the typecases, which +;;; as of 1.0.5 compiles to a naive sequence of linear TYPEPs. Also +;;; provide separate versions where bounds checking has been moved +;;; from the callee to the caller, since it's much cheaper to do once +;;; 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. +(macrolet ((define (accessor-name slow-accessor-name table-name extra-params + check-bounds) + `(progn + (defvar ,table-name) + (defun ,accessor-name (array index ,@extra-params) + (declare (optimize speed + ;; (SAFETY 0) is ok. All calls to + ;; these functions are generated by + ;; the compiler, so argument count + ;; checking isn't needed. Type checking + ;; is done implicitly via the widetag + ;; dispatch. + (safety 0))) + #1=(funcall (the function + (let ((tag 0)) + ;; WIDETAG-OF needs extra code to + ;; handle LIST and FUNCTION + ;; lowtags. We're only dispatching + ;; on other pointers, so let's do + ;; the lowtag extraction manually. + (when (sb!vm::%other-pointer-p array) + (setf tag (sb!sys:sap-ref-8 + (int-sap (get-lisp-obj-address array)) + (- sb!vm:other-pointer-lowtag)))) + ;; SYMBOL-GLOBAL-VALUE is a performance hack + ;; for threaded builds. + (svref (sb!vm::symbol-global-value ',table-name) + tag))) + array index ,@extra-params)) + (defun ,slow-accessor-name (array index ,@extra-params) + (declare (optimize speed (safety 0))) + (if (not (%array-displaced-p array)) + ;; The reasonably quick path of non-displaced complex + ;; arrays. + (let ((array (%array-data-vector array))) + #1#) + ;; The real slow path. + (with-array-data + ((vector array) + (index (locally + (declare (optimize (speed 1) (safety 1))) + (,@check-bounds index))) + (end) + :force-inline t) + (declare (ignore end)) + (,accessor-name vector index ,@extra-params))))))) + (define hairy-data-vector-ref slow-hairy-data-vector-ref + *data-vector-reffers* nil (progn)) + (define hairy-data-vector-set slow-hairy-data-vector-set + *data-vector-setters* (new-value) (progn)) + (define hairy-data-vector-ref/check-bounds + slow-hairy-data-vector-ref/check-bounds + *data-vector-reffers/check-bounds* nil + (%check-bound array (array-dimension array 0))) + (define hairy-data-vector-set/check-bounds + slow-hairy-data-vector-set/check-bounds + *data-vector-setters/check-bounds* (new-value) + (%check-bound array (array-dimension array 0)))) + +(defun hairy-ref-error (array index &optional new-value) + (declare (ignore index new-value)) + (error 'type-error + :datum array + :expected-type 'vector)) + +;;; Populate the dispatch tables. +(macrolet ((define-reffer (saetp check-form) + (let* ((type (sb!vm:saetp-specifier saetp)) + (atype `(simple-array ,type (*)))) + `(named-lambda optimized-data-vector-ref (vector index) + (declare (optimize speed (safety 0))) + (data-vector-ref (the ,atype vector) + (locally + (declare (optimize (safety 1))) + (the index + (,@check-form index))))))) + (define-setter (saetp check-form) + (let* ((type (sb!vm:saetp-specifier saetp)) + (atype `(simple-array ,type (*)))) + `(named-lambda optimized-data-vector-set (vector index new-value) + (declare (optimize speed (safety 0))) + (data-vector-set (the ,atype vector) + (locally + (declare (optimize (safety 1))) + (the index + (,@check-form index))) + (locally + ;; SPEED 1 needed to avoid the compiler + ;; from downgrading the type check to + ;; a cheaper one. + (declare (optimize (speed 1) + (safety 1))) + (the ,type new-value))) + ;; For specialized arrays, the return from + ;; data-vector-set would have to be reboxed to be a + ;; (Lisp) return value; instead, we use the + ;; already-boxed value as the return. + new-value))) + (define-reffers (symbol deffer check-form slow-path) + `(progn + (setf ,symbol (make-array sb!vm::widetag-mask + :initial-element #'hairy-ref-error)) + ,@(loop for widetag in '(sb!vm:complex-vector-widetag + sb!vm:complex-vector-nil-widetag + sb!vm:complex-bit-vector-widetag + sb!vm:complex-character-string-widetag + sb!vm:complex-base-string-widetag + sb!vm:simple-array-widetag + sb!vm:complex-array-widetag) + collect `(setf (svref ,symbol ,widetag) ,slow-path)) + ,@(loop for saetp across sb!vm:*specialized-array-element-type-properties* + for widetag = (sb!vm:saetp-typecode saetp) + collect `(setf (svref ,symbol ,widetag) + (,deffer ,saetp ,check-form)))))) + (defun !hairy-data-vector-reffer-init () + (define-reffers *data-vector-reffers* define-reffer + (progn) + #'slow-hairy-data-vector-ref) + (define-reffers *data-vector-setters* define-setter + (progn) + #'slow-hairy-data-vector-set) + (define-reffers *data-vector-reffers/check-bounds* define-reffer + (%check-bound vector (length vector)) + #'slow-hairy-data-vector-ref/check-bounds) + (define-reffers *data-vector-setters/check-bounds* define-setter + (%check-bound vector (length vector)) + #'slow-hairy-data-vector-set/check-bounds))) ;;; (Ordinary DATA-VECTOR-REF usage compiles into a vop, but ;;; DATA-VECTOR-REF is also FOLDABLE, and this ordinary function @@ -338,28 +462,6 @@ of specialized arrays is supported." (defun data-vector-ref (array index) (hairy-data-vector-ref array index)) -(defun hairy-data-vector-set (array index new-value) - (with-array-data ((vector array) (index index) (end)) - (declare (ignore end)) - (etypecase vector . - #.(map 'list - (lambda (saetp) - (let* ((type (sb!vm:saetp-specifier saetp)) - (atype `(simple-array ,type (*)))) - `(,atype - (data-vector-set (the ,atype vector) index - (the ,type new-value)) - ;; For specialized arrays, the return from - ;; data-vector-set would have to be - ;; reboxed to be a (Lisp) return value; - ;; instead, we use the already-boxed value - ;; as the return. - new-value))) - (sort - (copy-seq - sb!vm:*specialized-array-element-type-properties*) - #'> :key #'sb!vm:saetp-importance))))) - ;;; SUBSCRIPTS has a dynamic-extent list structure and is destroyed (defun %array-row-major-index (array subscripts &optional (invalid-index-error-p t)) diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index 6a7123c..1ce59d2 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -117,6 +117,9 @@ ;; this to be initialized, so we initialize it right away. (show-and-call !random-cold-init) + ;; Must be done before any non-opencoded array references are made. + (show-and-call !hairy-data-vector-reffer-init) + (show-and-call !character-database-cold-init) (show-and-call !character-name-database-cold-init) diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index ffc9dda..342fdc9 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -112,21 +112,27 @@ (assert-array-rank array (1- (length stuff))) (assert-new-value-type (car (last stuff)) array)) -(defoptimizer (hairy-data-vector-ref derive-type) ((array index)) - (extract-upgraded-element-type array)) -(defoptimizer (data-vector-ref derive-type) ((array index)) - (extract-upgraded-element-type array)) +(macrolet ((define (name) + `(defoptimizer (,name derive-type) ((array index)) + (extract-upgraded-element-type array)))) + (define hairy-data-vector-ref) + (define hairy-data-vector-ref/check-bounds) + (define data-vector-ref)) + #!+x86 (defoptimizer (data-vector-ref-with-offset derive-type) ((array index offset)) (extract-upgraded-element-type array)) -(defoptimizer (data-vector-set derive-type) ((array index new-value)) - (assert-new-value-type new-value array)) +(macrolet ((define (name) + `(defoptimizer (,name derive-type) ((array index new-value)) + (assert-new-value-type new-value array)))) + (define hairy-data-vector-set) + (define hairy-data-vector-set/check-bounds) + (define data-vector-set)) + #!+x86 (defoptimizer (data-vector-set-with-offset derive-type) ((array index offset new-value)) (assert-new-value-type new-value array)) -(defoptimizer (hairy-data-vector-set derive-type) ((array index new-value)) - (assert-new-value-type new-value array)) ;;; Figure out the type of the data vector if we know the argument ;;; element type. @@ -753,8 +759,49 @@ (with-row-major-index (array indices index new-value) (hairy-data-vector-set array index new-value))))) +;; For AREF of vectors we do the bounds checking in the callee. This +;; lets us do a significantly more efficient check for simple-arrays +;; without bloating the code. +(deftransform aref ((array index) (t t) * :node node) + (if (policy node (zerop insert-array-bounds-checks)) + `(hairy-data-vector-ref array index) + `(hairy-data-vector-ref/check-bounds array index))) + +(deftransform %aset ((array index new-value) (t t t) * :node node) + (if (policy node (zerop insert-array-bounds-checks)) + `(hairy-data-vector-set array index new-value) + `(hairy-data-vector-set/check-bounds array index new-value))) + +;;; But if we find out later that there's some useful type information +;;; available, switch back to the normal one to give other transforms +;;; a stab at it. +(macrolet ((define (name transform-to extra extra-type) + `(deftransform ,name ((array index ,@extra)) + (let ((type (lvar-type array)) + (element-type (extract-upgraded-element-type array))) + ;; If an element type has been declared, we want to + ;; use that information it for type checking (even + ;; if the access can't be optimized due to the array + ;; not being simple). + (when (eql element-type *wild-type*) + (when (or (not (array-type-p type)) + ;; If it's a simple array, we might be able + ;; to inline the access completely. + (not (null (array-type-complexp type)))) + (give-up-ir1-transform + "Upgraded element type of array is not known at compile time.")))) + `(,',transform-to array + (%check-bound array + (array-dimension array 0) + index) + ,@',extra)))) + (define hairy-data-vector-ref/check-bounds + hairy-data-vector-ref nil nil) + (define hairy-data-vector-set/check-bounds + hairy-data-vector-set (new-value) (*))) + (deftransform aref ((array index) ((or simple-vector - simple-unboxed-array) + (simple-unboxed-array 1)) index)) (let ((type (lvar-type array))) (unless (array-type-p type) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 609eb10..eca9eaf 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1444,6 +1444,11 @@ (defknown hairy-data-vector-ref (array index) t (foldable explicit-check)) (defknown hairy-data-vector-set (array index t) t (unsafe explicit-check)) +(defknown hairy-data-vector-ref/check-bounds (array index) t + (foldable explicit-check)) +(defknown hairy-data-vector-set/check-bounds (array index t) + t + (unsafe explicit-check)) (defknown %caller-frame-and-pc () (values t t) (flushable)) (defknown %with-array-data (array index (or index null)) (values (simple-array * (*)) index index index) diff --git a/src/compiler/generic/late-type-vops.lisp b/src/compiler/generic/late-type-vops.lisp index ae5cee1..2774689 100644 --- a/src/compiler/generic/late-type-vops.lisp +++ b/src/compiler/generic/late-type-vops.lisp @@ -29,6 +29,10 @@ (instance-pointer-lowtag) :mask lowtag-mask) +(!define-type-vops %other-pointer-p nil nil nil + (other-pointer-lowtag) + :mask lowtag-mask) + (!define-type-vops bignump check-bignum bignum object-not-bignum-error (bignum-widetag)) diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp index 95fae73..f1d56dc 100644 --- a/src/compiler/generic/parms.lisp +++ b/src/compiler/generic/parms.lisp @@ -59,6 +59,12 @@ #!-sb-thread *stepping* + ;; Dispatch tables for generic array access + sb!impl::*data-vector-reffers* + sb!impl::*data-vector-setters* + sb!impl::*data-vector-reffers/check-bounds* + sb!impl::*data-vector-setters/check-bounds* + ;; hash table weaknesses :key :value diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 81ff030..50c203c 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -20,7 +20,7 @@ complex-rational-p complex-float-p complex-single-float-p complex-double-float-p #!+long-float complex-long-float-p complex-vector-p - base-char-p %standard-char-p %instancep + base-char-p %standard-char-p %instancep %other-pointer-p base-string-p simple-base-string-p #!+sb-unicode character-string-p #!+sb-unicode simple-character-string-p diff --git a/version.lisp-expr b/version.lisp-expr index 5a7dd21..4fac3a1 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.91" +"1.0.4.92"