From 9b634117911815fbf4154546431b4dcf13e38b47 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Mon, 11 Jun 2007 04:23:08 +0000 Subject: [PATCH] 1.0.6.45: fix compilation speed regression from DATA-VECTOR-REF-WITH-OFFSET * Change the remaining x86oid DATA-VECTOR-REF VOPs to DATA-VECTOR-REF-WITH-OFFSETs. The VOPs only accept an offset of 0, and are thus functionally identical to the old ones. * This allows replacing the conditional deftransform from D-V-R to D-V-R-W-O with an unconditional source-transform. * Rewrite transformations with (OR (SIMPLE-UNBOXED-ARRAY (*)) SIMPLE-VECTOR) argument types to instead do the type tests in the body of the transform, since the test can be expressed in a cheaper way in the latter case. --- src/code/array.lisp | 3 ++ src/compiler/array-tran.lisp | 31 ++++++++++--------- src/compiler/fndb.lisp | 2 -- src/compiler/generic/array.lisp | 33 +++++++++++++++++++++ src/compiler/generic/vm-tran.lisp | 59 +++++++++++++++---------------------- src/compiler/x86-64/array.lisp | 36 +++++++++++++--------- src/compiler/x86/array.lisp | 36 +++++++++++++--------- version.lisp-expr | 2 +- 8 files changed, 120 insertions(+), 82 deletions(-) diff --git a/src/code/array.lisp b/src/code/array.lisp index 50f730a..286d197 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -482,6 +482,9 @@ of specialized arrays is supported." (defun data-vector-ref (array index) (hairy-data-vector-ref array index)) +(defun data-vector-ref-with-offset (array index offset) + (hairy-data-vector-ref array (+ index offset))) + ;;; 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/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 9b0612e..3579975 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -774,11 +774,22 @@ ;; 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. +;; without bloating the code. If we already know the type of the array +;; with sufficient precision, skip directly to DATA-VECTOR-REF. (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))) + (let ((type (lvar-type array))) + (cond ((and (array-type-p type) + (null (array-type-complexp type)) + (not (eql (extract-upgraded-element-type array) + *wild-type*)) + (eql (length (array-type-dimensions type)) 1)) + `(data-vector-ref array (%check-bound array + (array-dimension array 0) + index))) + ((policy node (zerop insert-array-bounds-checks)) + `(hairy-data-vector-ref array index)) + (t + `(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)) @@ -817,18 +828,6 @@ (define hairy-data-vector-set/check-bounds hairy-data-vector-set (new-value) (*))) -(deftransform aref ((array index) ((or simple-vector - (simple-unboxed-array 1)) - index)) - (let ((type (lvar-type array))) - (unless (array-type-p type) - ;; Not an exactly specified one-dimensional simple array -> punt - ;; to the complex version. - (give-up-ir1-transform))) - `(data-vector-ref array (%check-bound array - (array-dimension array 0) - index))) - ;;; Just convert into a HAIRY-DATA-VECTOR-REF (or ;;; HAIRY-DATA-VECTOR-SET) after checking that the index is inside the ;;; array total size. diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 5d2af7c..071c8e9 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1433,12 +1433,10 @@ (defknown %check-bound (array index fixnum) index (movable foldable flushable)) (defknown data-vector-ref (simple-array index) t (foldable explicit-check always-translatable)) -#!+(or x86 x86-64) (defknown data-vector-ref-with-offset (simple-array index fixnum) t (foldable explicit-check always-translatable)) (defknown data-vector-set (array index t) t (unsafe explicit-check always-translatable)) -#!+(or x86 x86-64) (defknown data-vector-set-with-offset (array index fixnum t) t (unsafe explicit-check always-translatable)) (defknown hairy-data-vector-ref (array index) t diff --git a/src/compiler/generic/array.lisp b/src/compiler/generic/array.lisp index 25df53b..29affad 100644 --- a/src/compiler/generic/array.lisp +++ b/src/compiler/generic/array.lisp @@ -49,6 +49,39 @@ (:save-p :compute-only) (:generator 1 (error-call vop nil-array-accessed-error object))) + +(define-vop (data-vector-ref-with-offset/simple-array-nil) + (:translate data-vector-ref-with-offset) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (unsigned-reg))) + (:info offset) + (:arg-types simple-array-nil positive-fixnum + (:constant (integer 0 0))) + (:results (value :scs (descriptor-reg))) + (:result-types *) + (:ignore index value offset) + (:vop-var vop) + (:save-p :compute-only) + (:generator 1 + (error-call vop nil-array-accessed-error object))) + +(define-vop (data-vector-set/simple-array-nil) + (:translate data-vector-set) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (unsigned-reg)) + (value :scs (descriptor-reg))) + (:info offset) + (:arg-types simple-array-nil positive-fixnum * + (:constant (integer 0 0))) + (:results (result :scs (descriptor-reg))) + (:result-types *) + (:ignore index value result offset) + (:vop-var vop) + (:save-p :compute-only) + (:generator 1 + (error-call vop nil-array-accessed-error object))) ;;; FIXME: There is probably plenty of other array stuff that looks ;;; the same or similar enough to be genericized. Do so, and move it diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 9d1108a..8530c1c 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -172,31 +172,26 @@ index))))) ;;; Transform data vector access to a form that opens up optimization -;;; opportunities. +;;; opportunities. On platforms that support DATA-VECTOR-REF-WITH-OFFSET +;;; DATA-VECTOR-REF is not supported at all. #!+(or x86 x86-64) -(deftransform data-vector-ref ((array index) ((or (simple-unboxed-array (*)) - simple-vector) - t)) - (let ((array-type (lvar-type array))) - (unless (array-type-p array-type) - (give-up-ir1-transform)) - (let* ((element-type (type-specifier (array-type-specialized-element-type array-type))) - (saetp (find-saetp element-type))) - (unless (>= (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits) - (give-up-ir1-transform)) - `(data-vector-ref-with-offset array index 0)))) +(define-source-transform data-vector-ref (array index) + `(data-vector-ref-with-offset ,array ,index 0)) #!+(or x86 x86-64) -(deftransform data-vector-ref-with-offset ((array index offset) - ((or (simple-unboxed-array (*)) - simple-vector) - t t)) +(deftransform data-vector-ref-with-offset ((array index offset)) (let ((array-type (lvar-type array))) - (unless (array-type-p array-type) + (when (or (not (array-type-p array-type)) + (eql (array-type-specialized-element-type array-type) + *wild-type*)) (give-up-ir1-transform)) + ;; It shouldn't be possible to get here with anything but a non-complex + ;; vector. + (aver (not (array-type-complexp array-type))) (let* ((element-type (type-specifier (array-type-specialized-element-type array-type))) (saetp (find-saetp element-type))) - (aver (>= (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits)) + (when (< (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits) + (give-up-ir1-transform)) (fold-index-addressing 'data-vector-ref-with-offset (sb!vm:saetp-n-bits saetp) sb!vm:other-pointer-lowtag @@ -263,29 +258,23 @@ ;;; Transform data vector access to a form that opens up optimization ;;; opportunities. #!+(or x86 x86-64) -(deftransform data-vector-set ((array index new-value) - ((or (simple-unboxed-array (*)) simple-vector) - t t)) - (let ((array-type (lvar-type array))) - (unless (array-type-p array-type) - (give-up-ir1-transform)) - (let* ((element-type (type-specifier (array-type-specialized-element-type array-type))) - (saetp (find-saetp element-type))) - (unless (>= (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits) - (give-up-ir1-transform)) - `(data-vector-set-with-offset array index 0 new-value)))) +(define-source-transform data-vector-set (array index new-value) + `(data-vector-set-with-offset ,array ,index 0 ,new-value)) #!+(or x86 x86-64) -(deftransform data-vector-set-with-offset ((array index offset new-value) - ((or (simple-unboxed-array (*)) - simple-vector) - t t t)) +(deftransform data-vector-set-with-offset ((array index offset new-value)) (let ((array-type (lvar-type array))) - (unless (array-type-p array-type) + (when (or (not (array-type-p array-type)) + (eql (array-type-specialized-element-type array-type) + *wild-type*)) + ;; We don't yet know the exact element type, but will get that + ;; knowledge after some more type propagation. (give-up-ir1-transform)) + (aver (not (array-type-complexp array-type))) (let* ((element-type (type-specifier (array-type-specialized-element-type array-type))) (saetp (find-saetp element-type))) - (aver (>= (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits)) + (when (< (sb!vm:saetp-n-bits saetp) sb!vm:n-byte-bits) + (give-up-ir1-transform)) (fold-index-addressing 'data-vector-set-with-offset (sb!vm:saetp-n-bits saetp) sb!vm:other-pointer-lowtag diff --git a/src/compiler/x86-64/array.lisp b/src/compiler/x86-64/array.lisp index 8d2a8c1..006d9dd 100644 --- a/src/compiler/x86-64/array.lisp +++ b/src/compiler/x86-64/array.lisp @@ -169,17 +169,19 @@ (let* ((elements-per-word (floor n-word-bits bits)) (bit-shift (1- (integer-length elements-per-word)))) `(progn - (define-vop (,(symbolicate 'data-vector-ref/ type)) + (define-vop (,(symbolicate 'data-vector-ref-with-offset/ type)) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (unsigned-reg))) - (:arg-types ,type positive-fixnum) + (:info offset) + (:arg-types ,type positive-fixnum (:constant (integer 0 0))) (:results (result :scs (unsigned-reg) :from (:argument 0))) (:result-types positive-fixnum) (:temporary (:sc unsigned-reg :offset ecx-offset) ecx) (:generator 20 + (aver (zerop offset)) (move ecx index) (inst shr ecx ,bit-shift) (inst mov result @@ -197,15 +199,16 @@ (inst shl ecx ,(1- (integer-length bits))))) (inst shr result :cl) (inst and result ,(1- (ash 1 bits))))) - (define-vop (,(symbolicate 'data-vector-ref-c/ type)) - (:translate data-vector-ref) + (define-vop (,(symbolicate 'data-vector-ref-c-with-offset/ type)) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:arg-types ,type (:constant low-index)) - (:info index) + (:arg-types ,type (:constant low-index) (:constant (integer 0 0))) + (:info index offset) (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 15 + (aver (zerop offset)) (multiple-value-bind (word extra) (floor index ,elements-per-word) (loadw result object (+ word vector-data-offset) other-pointer-lowtag) @@ -213,20 +216,23 @@ (inst shr result (* extra ,bits))) (unless (= extra ,(1- elements-per-word)) (inst and result ,(1- (ash 1 bits))))))) - (define-vop (,(symbolicate 'data-vector-set/ type)) + (define-vop (,(symbolicate 'data-vector-set-with-offset/ type)) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (unsigned-reg) :target ecx) (value :scs (unsigned-reg immediate) :target result)) - (:arg-types ,type positive-fixnum positive-fixnum) + (:info offset) + (:arg-types ,type positive-fixnum (:constant (integer 0 0)) + positive-fixnum) (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:temporary (:sc unsigned-reg) word-index) (:temporary (:sc unsigned-reg) old) (:temporary (:sc unsigned-reg :offset ecx-offset) ecx) (:generator 25 + (aver (zerop offset)) (move word-index index) (inst shr word-index ,bit-shift) (inst mov old @@ -264,18 +270,20 @@ (inst mov result (tn-value value))) (unsigned-reg (move result value))))) - (define-vop (,(symbolicate 'data-vector-set-c/ type)) - (:translate data-vector-set) + (define-vop (,(symbolicate 'data-vector-set-c-with-offset/ type)) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (value :scs (unsigned-reg immediate) :target result)) - (:arg-types ,type (:constant low-index) positive-fixnum) + (:arg-types ,type (:constant low-index) + (:constant (integer 0 0)) positive-fixnum) (:temporary (:sc unsigned-reg) mask-tn) - (:info index) + (:info index offset) (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:temporary (:sc unsigned-reg :to (:result 0)) old) (:generator 20 + (aver (zerop offset)) (multiple-value-bind (word extra) (floor index ,elements-per-word) (inst mov old (make-ea :qword :base object diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp index 16e9aa0..0b12e75 100644 --- a/src/compiler/x86/array.lisp +++ b/src/compiler/x86/array.lisp @@ -162,17 +162,19 @@ (let* ((elements-per-word (floor n-word-bits bits)) (bit-shift (1- (integer-length elements-per-word)))) `(progn - (define-vop (,(symbolicate 'data-vector-ref/ type)) + (define-vop (,(symbolicate 'data-vector-ref-with-offset/ type)) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (unsigned-reg))) - (:arg-types ,type positive-fixnum) + (:info offset) + (:arg-types ,type positive-fixnum (:constant (integer 0 0))) (:results (result :scs (unsigned-reg) :from (:argument 0))) (:result-types positive-fixnum) (:temporary (:sc unsigned-reg :offset ecx-offset) ecx) (:generator 20 + (aver (zerop offset)) (move ecx index) (inst shr ecx ,bit-shift) (inst mov result (make-ea-for-vector-data object :index ecx)) @@ -187,15 +189,16 @@ (inst shl ecx ,(1- (integer-length bits))))) (inst shr result :cl) (inst and result ,(1- (ash 1 bits))))) - (define-vop (,(symbolicate 'data-vector-ref-c/ type)) - (:translate data-vector-ref) + (define-vop (,(symbolicate 'data-vector-ref-c-with-offset/ type)) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:arg-types ,type (:constant index)) - (:info index) + (:arg-types ,type (:constant index) (:constant (integer 0 0))) + (:info index offset) (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 15 + (aver (zerop offset)) (multiple-value-bind (word extra) (floor index ,elements-per-word) (loadw result object (+ word vector-data-offset) other-pointer-lowtag) @@ -203,20 +206,23 @@ (inst shr result (* extra ,bits))) (unless (= extra ,(1- elements-per-word)) (inst and result ,(1- (ash 1 bits))))))) - (define-vop (,(symbolicate 'data-vector-set/ type)) + (define-vop (,(symbolicate 'data-vector-set-with-offset/ type)) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:argument 2)) (index :scs (unsigned-reg) :target ecx) (value :scs (unsigned-reg immediate) :target result)) - (:arg-types ,type positive-fixnum positive-fixnum) + (:info offset) + (:arg-types ,type positive-fixnum (:constant (integer 0 0)) + positive-fixnum) (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:temporary (:sc unsigned-reg) word-index) (:temporary (:sc unsigned-reg) old) (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx) (:generator 25 + (aver (zerop offset)) (move word-index index) (inst shr word-index ,bit-shift) (inst mov old (make-ea-for-vector-data object :index word-index)) @@ -247,17 +253,19 @@ (inst mov result (tn-value value))) (unsigned-reg (move result value))))) - (define-vop (,(symbolicate 'data-vector-set-c/ type)) - (:translate data-vector-set) + (define-vop (,(symbolicate 'data-vector-set-c-with-offset/ type)) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (value :scs (unsigned-reg immediate) :target result)) - (:arg-types ,type (:constant index) positive-fixnum) - (:info index) + (:arg-types ,type (:constant index) (:constant (integer 0 0)) + positive-fixnum) + (:info index offset) (:results (result :scs (unsigned-reg))) (:result-types positive-fixnum) (:temporary (:sc unsigned-reg :to (:result 0)) old) (:generator 20 + (aver (zerop offset)) (multiple-value-bind (word extra) (floor index ,elements-per-word) (loadw old object (+ word vector-data-offset) other-pointer-lowtag) (sc-case value diff --git a/version.lisp-expr b/version.lisp-expr index 65231a4..549510d 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.6.44" +"1.0.6.45" -- 1.7.10.4