From 641fe4d4aa7cafc39219e93baa0b5fd019f376ee Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 29 May 2008 16:11:09 +0000 Subject: [PATCH] 1.0.17.7: smaller and faster raw slot initialization on x86oids * Since %MAKE-STRUCTURE-INSTANCE knows exactly how long the instance will be, RAW-INSTANCE-INIT/* VOPs don't need to fetch the length at all, but can receive it as a direct argument. * Use (* INDEX N-WORD-BYTES) in MAKE-EA-FOR-RAW-SLOT instead of (FIXNUMIZE INDEX) -- same result, but the intention becomes clear. --- src/compiler/generic/vm-ir2tran.lisp | 10 ++--- src/compiler/x86-64/cell.lisp | 78 +++++++++++++++------------------ src/compiler/x86/cell.lisp | 83 +++++++++++++++++------------------- version.lisp-expr | 2 +- 4 files changed, 79 insertions(+), 94 deletions(-) diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 19527a6f5..5df3845b1 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -53,7 +53,7 @@ res) (move-lvar-result node block locs lvar))) -(defun emit-inits (node block name object lowtag inits args) +(defun emit-inits (node block name object lowtag instance-length inits args) (let ((unbound-marker-tn nil) (funcallable-instance-tramp-tn nil)) (dolist (init inits) @@ -72,7 +72,7 @@ `(,(sb!kernel::raw-slot-data-raw-type rsd) (vop ,(sb!kernel::raw-slot-data-init-vop rsd) node block - object arg-tn slot))) + object arg-tn instance-length slot))) #!+raw-instance-init-vops sb!kernel::*raw-slot-data-list* #!-raw-instance-init-vops @@ -123,7 +123,7 @@ (locs (lvar-result-tns lvar (list *backend-t-primitive-type*))) (result (first locs))) (emit-fixed-alloc node block name words type lowtag result lvar) - (emit-inits node block name result lowtag inits args) + (emit-inits node block name result lowtag words inits args) (move-lvar-result node block locs lvar))) (defoptimizer ir2-convert-variable-allocation @@ -136,7 +136,7 @@ (emit-fixed-alloc node block name words type lowtag result lvar)) (vop var-alloc node block (lvar-tn node block extra) name words type lowtag result)) - (emit-inits node block name result lowtag inits args) + (emit-inits node block name result lowtag nil inits args) (move-lvar-result node block locs lvar))) (defoptimizer ir2-convert-structure-allocation @@ -150,7 +150,7 @@ (c-slot-specs (lvar-value slot-specs)) (words (+ (sb!kernel::dd-instance-length c-dd) words))) (emit-fixed-alloc node block name words type lowtag result lvar) - (emit-inits node block name result lowtag `((:dd . ,c-dd) ,@c-slot-specs) args) + (emit-inits node block name result lowtag words `((:dd . ,c-dd) ,@c-slot-specs) args) (move-lvar-result node block locs lvar)))) ;;; :SET-TRANS (in objdef.lisp DEFINE-PRIMITIVE-OBJECT) doesn't quite diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 213c90074..5a4b846ed 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -19,7 +19,7 @@ (:ignore name) (:results (result :scs (descriptor-reg any-reg))) (:generator 1 - (loadw result object offset lowtag))) + (loadw result object offset lowtag))) (define-vop (set-slot) (:args (object :scs (descriptor-reg)) @@ -525,19 +525,28 @@ (defun make-ea-for-raw-slot (object index instance-length &optional (adjustment 0)) - (etypecase index - (tn - (make-ea :qword :base object :index instance-length - :disp (+ (* (1- instance-slots-offset) n-word-bytes) - (- instance-pointer-lowtag) - adjustment))) - (integer - (make-ea :qword :base object :index instance-length - :scale 8 - :disp (+ (* (1- instance-slots-offset) n-word-bytes) - (- instance-pointer-lowtag) - adjustment - (- (fixnumize index))))))) + (if (integerp instance-length) + ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length + ;; at compile time. + (make-ea :qword + :base object + :disp (+ (* (- instance-length instance-slots-offset index) + n-word-bytes) + (- instance-pointer-lowtag) + adjustment)) + (etypecase index + (tn + (make-ea :qword :base object :index instance-length + :disp (+ (* (1- instance-slots-offset) n-word-bytes) + (- instance-pointer-lowtag) + adjustment))) + (integer + (make-ea :qword :base object :index instance-length + :scale 8 + :disp (+ (* (1- instance-slots-offset) n-word-bytes) + (- instance-pointer-lowtag) + adjustment + (* index (- n-word-bytes)))))))) (define-vop (raw-instance-ref/word) (:translate %raw-instance-ref/word) @@ -611,12 +620,9 @@ (:args (object :scs (descriptor-reg)) (value :scs (unsigned-reg))) (:arg-types * unsigned-num) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 4 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) - (inst mov (make-ea-for-raw-slot object index tmp) value))) + (inst mov (make-ea-for-raw-slot object index instance-length) value))) (define-vop (raw-instance-ref/single) (:translate %raw-instance-ref/single) @@ -690,17 +696,12 @@ (inst movss result value)))) (define-vop (raw-instance-init/single) - (:translate %raw-instance-set/single) - (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (value :scs (single-reg))) (:arg-types * single-float) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 4 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) - (inst movss (make-ea-for-raw-slot object index tmp) value))) + (inst movss (make-ea-for-raw-slot object index instance-length) value))) (define-vop (raw-instance-ref/double) (:translate %raw-instance-ref/double) @@ -777,12 +778,9 @@ (:args (object :scs (descriptor-reg)) (value :scs (double-reg))) (:arg-types * double-float) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 4 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) - (inst movsd (make-ea-for-raw-slot object index tmp) value))) + (inst movsd (make-ea-for-raw-slot object index instance-length) value))) (define-vop (raw-instance-ref/complex-single) (:translate %raw-instance-ref/complex-single) @@ -879,15 +877,12 @@ (:args (object :scs (descriptor-reg)) (value :scs (complex-single-reg))) (:arg-types * complex-single-float) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 4 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) (let ((value-real (complex-single-reg-real-tn value))) - (inst movss (make-ea-for-raw-slot object index tmp) value-real)) + (inst movss (make-ea-for-raw-slot object index instance-length) value-real)) (let ((value-imag (complex-single-reg-imag-tn value))) - (inst movss (make-ea-for-raw-slot object index tmp 4) value-imag)))) + (inst movss (make-ea-for-raw-slot object index instance-length 4) value-imag)))) (define-vop (raw-instance-ref/complex-double) (:translate %raw-instance-ref/complex-double) @@ -984,12 +979,9 @@ (:args (object :scs (descriptor-reg)) (value :scs (complex-double-reg))) (:arg-types * complex-double-float) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 4 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) (let ((value-real (complex-double-reg-real-tn value))) - (inst movsd (make-ea-for-raw-slot object index tmp -8) value-real)) + (inst movsd (make-ea-for-raw-slot object index instance-length -8) value-real)) (let ((value-imag (complex-double-reg-imag-tn value))) - (inst movsd (make-ea-for-raw-slot object index tmp) value-imag)))) + (inst movsd (make-ea-for-raw-slot object index instance-length) value-imag)))) diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 73cfc6f5b..168cad86b 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -503,24 +503,32 @@ ;;;; raw instance slot accessors (defun make-ea-for-raw-slot (object index instance-length n-words) - (flet ((make-ea-using-value (value) - (make-ea :dword :base object - :index instance-length - :scale 4 - :disp (- (* (- instance-slots-offset n-words) - n-word-bytes) - instance-pointer-lowtag - (fixnumize value))))) - (if (typep index 'tn) - (sc-case index - (any-reg (make-ea :dword - :base object - :index instance-length - :disp (- (* (- instance-slots-offset n-words) - n-word-bytes) - instance-pointer-lowtag))) - (immediate (make-ea-using-value (tn-value index)))) - (make-ea-using-value index)))) + (if (integerp instance-length) + ;; For RAW-INSTANCE-INIT/* VOPs, which know the exact instance length + ;; at compile time. + (make-ea :dword + :base object + :disp (- (* (- instance-length instance-slots-offset index (1- n-words)) + n-word-bytes) + instance-pointer-lowtag)) + (flet ((make-ea-using-value (value) + (make-ea :dword :base object + :index instance-length + :scale 4 + :disp (- (* (- instance-slots-offset n-words) + n-word-bytes) + instance-pointer-lowtag + (* value n-word-bytes))))) + (if (typep index 'tn) + (sc-case index + (any-reg (make-ea :dword + :base object + :index instance-length + :disp (- (* (- instance-slots-offset n-words) + n-word-bytes) + instance-pointer-lowtag))) + (immediate (make-ea-using-value (tn-value index)))) + (make-ea-using-value index))))) (define-vop (raw-instance-ref/word) (:translate %raw-instance-ref/word) @@ -561,12 +569,9 @@ (:args (object :scs (descriptor-reg)) (value :scs (unsigned-reg))) (:arg-types * unsigned-num) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 5 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) - (inst mov (make-ea-for-raw-slot object index tmp 1) value))) + (inst mov (make-ea-for-raw-slot object index instance-length 1) value))) (define-vop (raw-instance-ref/single) (:translate %raw-instance-ref/single) @@ -619,13 +624,10 @@ (:args (object :scs (descriptor-reg)) (value :scs (single-reg))) (:arg-types * single-float) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 5 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) (with-tn@fp-top (value) - (inst fst (make-ea-for-raw-slot object index tmp 1))))) + (inst fst (make-ea-for-raw-slot object index instance-length 1))))) (define-vop (raw-instance-ref/double) (:translate %raw-instance-ref/double) @@ -678,13 +680,10 @@ (:args (object :scs (descriptor-reg)) (value :scs (double-reg))) (:arg-types * double-float) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 5 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) (with-tn@fp-top (value) - (inst fstd (make-ea-for-raw-slot object index tmp 2))))) + (inst fstd (make-ea-for-raw-slot object index instance-length 2))))) (define-vop (raw-instance-ref/complex-single) (:translate %raw-instance-ref/complex-single) @@ -756,17 +755,14 @@ (:args (object :scs (descriptor-reg)) (value :scs (complex-single-reg))) (:arg-types * complex-single-float) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 5 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) (let ((value-real (complex-single-reg-real-tn value))) (with-tn@fp-top (value-real) - (inst fst (make-ea-for-raw-slot object index tmp 2)))) + (inst fst (make-ea-for-raw-slot object index instance-length 2)))) (let ((value-imag (complex-single-reg-imag-tn value))) (with-tn@fp-top (value-imag) - (inst fst (make-ea-for-raw-slot object index tmp 1)))))) + (inst fst (make-ea-for-raw-slot object index instance-length 1)))))) (define-vop (raw-instance-ref/complex-double) (:translate %raw-instance-ref/complex-double) @@ -838,14 +834,11 @@ (:args (object :scs (descriptor-reg)) (value :scs (complex-double-reg))) (:arg-types * complex-double-float) - (:info index) - (:temporary (:sc unsigned-reg) tmp) + (:info instance-length index) (:generator 20 - (loadw tmp object 0 instance-pointer-lowtag) - (inst shr tmp n-widetag-bits) (let ((value-real (complex-double-reg-real-tn value))) (with-tn@fp-top (value-real) - (inst fstd (make-ea-for-raw-slot object index tmp 4)))) + (inst fstd (make-ea-for-raw-slot object index instance-length 4)))) (let ((value-imag (complex-double-reg-imag-tn value))) (with-tn@fp-top (value-imag) - (inst fstd (make-ea-for-raw-slot object index tmp 2)))))) + (inst fstd (make-ea-for-raw-slot object index instance-length 2)))))) diff --git a/version.lisp-expr b/version.lisp-expr index 15686abb3..11ae74077 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.17.6" +"1.0.17.7" -- 2.11.4.GIT