From 906ecd4ef2d10aca23e1081f03c13fe2f932ed89 Mon Sep 17 00:00:00 2001 From: Nathan Froyd Date: Mon, 7 May 2007 00:42:37 +0000 Subject: [PATCH] 10.CVS: ---------------------------------------------------------------------- --- NEWS | 4 + src/code/early-extensions.lisp | 4 +- src/compiler/array-tran.lisp | 4 +- src/compiler/fndb.lisp | 4 +- src/compiler/generic/utils.lisp | 2 +- src/compiler/generic/vm-fndb.lisp | 4 +- src/compiler/generic/vm-tran.lisp | 14 +- src/compiler/x86-64/arith.lisp | 4 +- src/compiler/x86-64/array.lisp | 978 +++++++++++-------------------------- src/compiler/x86-64/macros.lisp | 81 +++ src/compiler/x86-64/parms.lisp | 6 + version.lisp-expr | 2 +- 12 files changed, 409 insertions(+), 698 deletions(-) diff --git a/NEWS b/NEWS index 52ecd23..516e250 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,10 @@ changes in sbcl-1.0.6 relative to sbcl-1.0.5: as a contrib module. * optimization: STRING-TO-OCTETS for unibyte encodings and UTF-8 is significantly faster. + * optimization: calls of the form (AREF FOO (+ INDEX )) now + produce more efficient code on x86-64 if the compiler can determine + that (+ INDEX ) does not require a bounds check and FOO + has an element type at least 8 bits wide. * enhancement: a new, experimental synchronous timeout facility is provided. Refer to SB-SYS:WITH-DEADLINE for details. * enhancement: when a symbol name conflict error arises, the diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index c9cdbf7..c3f2474 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -69,7 +69,7 @@ (* max-offset sb!vm:n-word-bytes)) scale))) -#!+x86 +#!+(or x86 x86-64) (defun displacement-bounds (lowtag element-size data-offset) (let* ((adjustment (- (* data-offset sb!vm:n-word-bytes) lowtag)) (bytes-per-element (ceiling element-size sb!vm:n-byte-bits)) @@ -79,7 +79,7 @@ bytes-per-element))) (values min max))) -#!+x86 +#!+(or x86 x86-64) (def!type constant-displacement (lowtag element-size data-offset) (flet ((integerify (x) (etypecase x diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index a3c5ab5..0d47738 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -119,7 +119,7 @@ (define hairy-data-vector-ref/check-bounds) (define data-vector-ref)) -#!+x86 +#!+(or x86 x86-64) (defoptimizer (data-vector-ref-with-offset derive-type) ((array index offset)) (extract-upgraded-element-type array)) @@ -130,7 +130,7 @@ (define hairy-data-vector-set/check-bounds) (define data-vector-set)) -#!+x86 +#!+(or x86 x86-64) (defoptimizer (data-vector-set-with-offset derive-type) ((array index offset new-value)) (assert-new-value-type new-value array)) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index e0bd99d..5d2af7c 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1433,12 +1433,12 @@ (defknown %check-bound (array index fixnum) index (movable foldable flushable)) (defknown data-vector-ref (simple-array index) t (foldable explicit-check always-translatable)) -#!+x86 +#!+(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)) -#!+x86 +#!+(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/utils.lisp b/src/compiler/generic/utils.lisp index 1ebf85d..7b433a2 100644 --- a/src/compiler/generic/utils.lisp +++ b/src/compiler/generic/utils.lisp @@ -19,7 +19,7 @@ (error "~W is too big for a fixnum." num))) ;;; Determining whether a constant offset fits in an addressing mode. -#!+x86 +#!+(or x86 x86-64) (defun foldable-constant-offset-p (element-size lowtag data-offset offset) (if (< element-size n-byte-bits) nil diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 50c203c..356fad7 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -290,14 +290,14 @@ (defknown %bignum-ref (bignum-type bignum-index) bignum-element-type (flushable)) -#!+x86 +#!+(or x86 x86-64) (defknown %bignum-ref-with-offset (bignum-type bignum-index (signed-byte 24)) bignum-element-type (flushable always-translatable)) (defknown %bignum-set (bignum-type bignum-index bignum-element-type) bignum-element-type (unsafe)) -#!+x86 +#!+(or x86 x86-64) (defknown %bignum-set-with-offset (bignum-type bignum-index (signed-byte 24) bignum-element-type) bignum-element-type (unsafe always-translatable)) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index f3791f0..9d1108a 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -33,7 +33,7 @@ '(if (< x 0) (- x) x)) ;;; We don't want to clutter the bignum code. -#!+x86 +#!+(or x86 x86-64) (define-source-transform sb!bignum:%bignum-ref (bignum index) ;; KLUDGE: We use TRULY-THE here because even though the bignum code ;; is (currently) compiled with (SAFETY 0), the compiler insists on @@ -45,7 +45,7 @@ `(sb!bignum:%bignum-ref-with-offset ,bignum (truly-the bignum-index ,index) 0)) -#!+x86 +#!+(or x86 x86-64) (defun fold-index-addressing (fun-name element-size lowtag data-offset index offset &optional setter-p) (multiple-value-bind (func index-args) (extract-fun-args index '(+ -) 2) @@ -65,7 +65,7 @@ (,fun-name thing index (,func off2 off1) ,@(when setter-p '(value)))))))) -#!+x86 +#!+(or x86 x86-64) (deftransform sb!bignum:%bignum-ref-with-offset ((bignum index offset) * * :node node) (fold-index-addressing 'sb!bignum:%bignum-ref-with-offset @@ -173,7 +173,7 @@ ;;; Transform data vector access to a form that opens up optimization ;;; opportunities. -#!+x86 +#!+(or x86 x86-64) (deftransform data-vector-ref ((array index) ((or (simple-unboxed-array (*)) simple-vector) t)) @@ -186,7 +186,7 @@ (give-up-ir1-transform)) `(data-vector-ref-with-offset array index 0)))) -#!+x86 +#!+(or x86 x86-64) (deftransform data-vector-ref-with-offset ((array index offset) ((or (simple-unboxed-array (*)) simple-vector) @@ -262,7 +262,7 @@ ;;; Transform data vector access to a form that opens up optimization ;;; opportunities. -#!+x86 +#!+(or x86 x86-64) (deftransform data-vector-set ((array index new-value) ((or (simple-unboxed-array (*)) simple-vector) t t)) @@ -275,7 +275,7 @@ (give-up-ir1-transform)) `(data-vector-set-with-offset array index 0 new-value)))) -#!+x86 +#!+(or x86 x86-64) (deftransform data-vector-set-with-offset ((array index offset new-value) ((or (simple-unboxed-array (*)) simple-vector) diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp index 7ea7d06..3e55ac2 100644 --- a/src/compiler/x86-64/arith.lisp +++ b/src/compiler/x86-64/arith.lisp @@ -1413,7 +1413,9 @@ (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag (unsigned-reg) unsigned-num sb!bignum:%bignum-ref) - +(define-full-reffer+offset bignum--ref-with-offset * bignum-digits-offset + other-pointer-lowtag (unsigned-reg) unsigned-num + sb!bignum:%bignum-ref-with-offset) (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag (unsigned-reg) unsigned-num sb!bignum:%bignum-set) diff --git a/src/compiler/x86-64/array.lisp b/src/compiler/x86-64/array.lisp index ad8f2a5..2c6530c 100644 --- a/src/compiler/x86-64/array.lisp +++ b/src/compiler/x86-64/array.lisp @@ -137,12 +137,14 @@ ;;; out of 8, 16, or 32 bit elements. (macrolet ((def-full-data-vector-frobs (type element-type &rest scs) `(progn - (define-full-reffer ,(symbolicate "DATA-VECTOR-REF/" type) + (define-full-reffer+offset + ,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" type) ,type vector-data-offset other-pointer-lowtag ,scs - ,element-type data-vector-ref) - (define-full-setter ,(symbolicate "DATA-VECTOR-SET/" type) + ,element-type data-vector-ref-with-offset) + (define-full-setter+offset + ,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" type) ,type vector-data-offset other-pointer-lowtag ,scs - ,element-type data-vector-set))) + ,element-type data-vector-set-with-offset))) ) (def-full-data-vector-frobs simple-vector * descriptor-reg any-reg) (def-full-data-vector-frobs simple-array-unsigned-byte-64 unsigned-num @@ -316,151 +318,158 @@ (def-small-data-vector-frobs simple-array-unsigned-byte-4 4)) ;;; And the float variants. +(defun make-ea-for-float-ref (object index offset element-size + &key (scale 1) (complex-offset 0)) + (let ((ea-size (if (= element-size 4) :dword :qword))) + (etypecase index + (integer + (make-ea ea-size :base object + :disp (- (+ (* vector-data-offset n-word-bytes) + (* (+ index offset) element-size) + complex-offset) + other-pointer-lowtag))) + (tn + (make-ea ea-size :base object :index index :scale scale + :disp (- (+ (* vector-data-offset n-word-bytes) + (* offset element-size) + complex-offset) + other-pointer-lowtag)))))) + (define-vop (data-vector-ref/simple-array-single-float) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg))) - (:arg-types simple-array-single-float positive-fixnum) + (:info offset) + (:arg-types simple-array-single-float positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 4 vector-data-offset))) (:temporary (:sc unsigned-reg) dword-index) (:results (value :scs (single-reg))) (:result-types single-float) (:generator 5 (move dword-index index) (inst shr dword-index 1) - (inst movss value (make-ea :dword :base object :index dword-index - :disp (- (* vector-data-offset - n-word-bytes) - other-pointer-lowtag))))) + (inst movss value (make-ea-for-float-ref object dword-index offset 4)))) (define-vop (data-vector-ref-c/simple-array-single-float) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-single-float (:constant low-index)) + (:info index offset) + (:arg-types simple-array-single-float (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 4 vector-data-offset))) (:results (value :scs (single-reg))) (:result-types single-float) (:generator 4 - (inst movss value (make-ea :dword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 4 index)) - other-pointer-lowtag))))) + (inst movss value (make-ea-for-float-ref object index offset 4)))) (define-vop (data-vector-set/simple-array-single-float) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg)) (value :scs (single-reg) :target result)) - (:arg-types simple-array-single-float positive-fixnum single-float) + (:info offset) + (:arg-types simple-array-single-float positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 4 vector-data-offset)) + single-float) (:temporary (:sc unsigned-reg) dword-index) (:results (result :scs (single-reg))) (:result-types single-float) (:generator 5 (move dword-index index) (inst shr dword-index 1) - (inst movss (make-ea :dword :base object :index dword-index - :disp (- (* vector-data-offset - n-word-bytes) - other-pointer-lowtag)) - value) + (inst movss (make-ea-for-float-ref object index offset 4) value) (unless (location= result value) (inst movss result value)))) (define-vop (data-vector-set-c/simple-array-single-float) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (value :scs (single-reg) :target result)) - (:info index) + (:info index offset) (:arg-types simple-array-single-float (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 4 vector-data-offset)) single-float) (:results (result :scs (single-reg))) (:result-types single-float) (:generator 4 - (inst movss (make-ea :dword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 4 index)) - other-pointer-lowtag)) - value) + (inst movss (make-ea-for-float-ref object index offset 4) value) (unless (location= result value) (inst movss result value)))) (define-vop (data-vector-ref/simple-array-double-float) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg))) - (:arg-types simple-array-double-float positive-fixnum) + (:info offset) + (:arg-types simple-array-double-float positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 8 vector-data-offset))) (:results (value :scs (double-reg))) (:result-types double-float) (:generator 7 - (inst movsd value (make-ea :qword :base object :index index :scale 1 - :disp (- (* vector-data-offset - n-word-bytes) - other-pointer-lowtag))))) + (inst movsd value (make-ea-for-float-ref object index offset 8)))) (define-vop (data-vector-ref-c/simple-array-double-float) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-double-float (:constant low-index)) + (:info index offset) + (:arg-types simple-array-double-float (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 8 vector-data-offset))) (:results (value :scs (double-reg))) (:result-types double-float) (:generator 6 - (inst movsd value (make-ea :qword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 8 index)) - other-pointer-lowtag))))) + (inst movsd value (make-ea-for-float-ref object index offset 8)))) (define-vop (data-vector-set/simple-array-double-float) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg)) (value :scs (double-reg) :target result)) - (:arg-types simple-array-double-float positive-fixnum double-float) + (:info offset) + (:arg-types simple-array-double-float positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 8 vector-data-offset)) + double-float) (:results (result :scs (double-reg))) (:result-types double-float) (:generator 20 - (inst movsd (make-ea :qword :base object :index index :scale 1 - :disp (- (* vector-data-offset - n-word-bytes) - other-pointer-lowtag)) - value) + (inst movsd (make-ea-for-float-ref object index offset 8) value) (unless (location= result value) (inst movsd result value)))) (define-vop (data-vector-set-c/simple-array-double-float) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (value :scs (double-reg) :target result)) - (:info index) + (:info index offset) (:arg-types simple-array-double-float (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 8 vector-data-offset)) double-float) (:results (result :scs (double-reg))) (:result-types double-float) (:generator 19 - (inst movsd (make-ea :qword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 8 index)) - other-pointer-lowtag)) - value) + (inst movsd (make-ea-for-float-ref object index offset 8) value) (unless (location= result value) (inst movsd result value)))) @@ -469,220 +478,186 @@ (define-vop (data-vector-ref/simple-array-complex-single-float) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg))) - (:arg-types simple-array-complex-single-float positive-fixnum) + (:info offset) + (:arg-types simple-array-complex-single-float positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 8 vector-data-offset))) (:results (value :scs (complex-single-reg))) (:result-types complex-single-float) (:generator 5 (let ((real-tn (complex-single-reg-real-tn value))) - (inst movss real-tn (make-ea :dword :base object :index index - :disp (- (* vector-data-offset - n-word-bytes) - other-pointer-lowtag)))) + (inst movss real-tn (make-ea-for-float-ref object index offset 8))) (let ((imag-tn (complex-single-reg-imag-tn value))) - (inst movss imag-tn (make-ea :dword :base object :index index - :disp (- (+ (* vector-data-offset - n-word-bytes) - 4) - other-pointer-lowtag)))))) + (inst movss imag-tn (make-ea-for-float-ref object index offset 8 + :complex-offset 4))))) (define-vop (data-vector-ref-c/simple-array-complex-single-float) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-complex-single-float (:constant low-index)) + (:info index offset) + (:arg-types simple-array-complex-single-float (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 8 vector-data-offset))) (:results (value :scs (complex-single-reg))) (:result-types complex-single-float) (:generator 4 (let ((real-tn (complex-single-reg-real-tn value))) - (inst movss real-tn (make-ea :dword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 8 index)) - other-pointer-lowtag)))) + (inst movss real-tn (make-ea-for-float-ref object index offset 8))) (let ((imag-tn (complex-single-reg-imag-tn value))) - (inst movss imag-tn (make-ea :dword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 8 index) 4) - other-pointer-lowtag)))))) + (inst movss imag-tn (make-ea-for-float-ref object index offset 8 + :complex-offset 4))))) (define-vop (data-vector-set/simple-array-complex-single-float) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg)) (value :scs (complex-single-reg) :target result)) + (:info offset) (:arg-types simple-array-complex-single-float positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 8 vector-data-offset)) complex-single-float) (:results (result :scs (complex-single-reg))) (:result-types complex-single-float) (:generator 5 (let ((value-real (complex-single-reg-real-tn value)) (result-real (complex-single-reg-real-tn result))) - (inst movss (make-ea :dword :base object :index index - :disp (- (* vector-data-offset - n-word-bytes) - other-pointer-lowtag)) - value-real) + (inst movss (make-ea-for-float-ref object index offset 8) value-real) (unless (location= value-real result-real) (inst movss result-real value-real))) (let ((value-imag (complex-single-reg-imag-tn value)) (result-imag (complex-single-reg-imag-tn result))) - (inst movss (make-ea :dword :base object :index index - :disp (- (+ (* vector-data-offset - n-word-bytes) - 4) - other-pointer-lowtag)) + (inst movss (make-ea-for-float-ref object index offset 8 + :complex-offset 4) value-imag) (unless (location= value-imag result-imag) (inst movss result-imag value-imag))))) (define-vop (data-vector-set-c/simple-array-complex-single-float) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (value :scs (complex-single-reg) :target result)) - (:info index) + (:info index offset) (:arg-types simple-array-complex-single-float (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 8 vector-data-offset)) complex-single-float) (:results (result :scs (complex-single-reg))) (:result-types complex-single-float) (:generator 4 (let ((value-real (complex-single-reg-real-tn value)) (result-real (complex-single-reg-real-tn result))) - (inst movss (make-ea :dword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 8 index)) - other-pointer-lowtag)) - value-real) + (inst movss (make-ea-for-float-ref object index offset 8) value-real) (unless (location= value-real result-real) (inst movss result-real value-real))) (let ((value-imag (complex-single-reg-imag-tn value)) (result-imag (complex-single-reg-imag-tn result))) - (inst movss (make-ea :dword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 8 index) 4) - other-pointer-lowtag)) + (inst movss (make-ea-for-float-ref object index offset 8 + :complex-offset 4) value-imag) (unless (location= value-imag result-imag) (inst movss result-imag value-imag))))) (define-vop (data-vector-ref/simple-array-complex-double-float) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg))) - (:arg-types simple-array-complex-double-float positive-fixnum) + (:info offset) + (:arg-types simple-array-complex-double-float positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 16 vector-data-offset))) (:results (value :scs (complex-double-reg))) (:result-types complex-double-float) (:generator 7 (let ((real-tn (complex-double-reg-real-tn value))) - (inst movsd real-tn (make-ea :dword :base object :index index :scale 2 - :disp (- (* vector-data-offset - n-word-bytes) - other-pointer-lowtag)))) + (inst movsd real-tn (make-ea-for-float-ref object index offset 16 :scale 2))) (let ((imag-tn (complex-double-reg-imag-tn value))) - (inst movsd imag-tn (make-ea :dword :base object :index index :scale 2 - :disp (- (+ (* vector-data-offset - n-word-bytes) - 8) - other-pointer-lowtag)))))) + (inst movsd imag-tn (make-ea-for-float-ref object index offset 16 :scale 2 + :complex-offset 8))))) (define-vop (data-vector-ref-c/simple-array-complex-double-float) (:note "inline array access") - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-complex-double-float (:constant low-index)) + (:info index offset) + (:arg-types simple-array-complex-double-float (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 16 vector-data-offset))) (:results (value :scs (complex-double-reg))) (:result-types complex-double-float) (:generator 6 (let ((real-tn (complex-double-reg-real-tn value))) - (inst movsd real-tn (make-ea :qword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 16 index)) - other-pointer-lowtag)))) + (inst movsd real-tn (make-ea-for-float-ref object index offset 16 :scale 2))) (let ((imag-tn (complex-double-reg-imag-tn value))) - (inst movsd imag-tn (make-ea :qword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 16 index) 8) - other-pointer-lowtag)))))) + (inst movsd imag-tn (make-ea-for-float-ref object index offset 16 :scale 2 + :complex-offset 8))))) (define-vop (data-vector-set/simple-array-complex-double-float) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (any-reg)) (value :scs (complex-double-reg) :target result)) + (:info offset) (:arg-types simple-array-complex-double-float positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 16 vector-data-offset)) complex-double-float) (:results (result :scs (complex-double-reg))) (:result-types complex-double-float) (:generator 20 (let ((value-real (complex-double-reg-real-tn value)) (result-real (complex-double-reg-real-tn result))) - (inst movsd (make-ea :qword :base object :index index :scale 2 - :disp (- (* vector-data-offset - n-word-bytes) - other-pointer-lowtag)) + (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2) value-real) (unless (location= value-real result-real) (inst movsd result-real value-real))) (let ((value-imag (complex-double-reg-imag-tn value)) (result-imag (complex-double-reg-imag-tn result))) - (inst movsd (make-ea :qword :base object :index index :scale 2 - :disp (- (+ (* vector-data-offset - n-word-bytes) - 8) - other-pointer-lowtag)) + (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2 + :complex-offset 8) value-imag) (unless (location= value-imag result-imag) (inst movsd result-imag value-imag))))) (define-vop (data-vector-set-c/simple-array-complex-double-float) (:note "inline array store") - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (value :scs (complex-double-reg) :target result)) - (:info index) + (:info index offset) (:arg-types simple-array-complex-double-float (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 16 vector-data-offset)) complex-double-float) (:results (result :scs (complex-double-reg))) (:result-types complex-double-float) (:generator 19 (let ((value-real (complex-double-reg-real-tn value)) (result-real (complex-double-reg-real-tn result))) - (inst movsd (make-ea :qword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 16 index)) - other-pointer-lowtag)) + (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2) value-real) (unless (location= value-real result-real) (inst movsd result-real value-real))) (let ((value-imag (complex-double-reg-imag-tn value)) (result-imag (complex-double-reg-imag-tn result))) - (inst movsd (make-ea :qword :base object - :disp (- (+ (* vector-data-offset - n-word-bytes) - (* 16 index) 8) - other-pointer-lowtag)) + (inst movsd (make-ea-for-float-ref object index offset 16 :scale 2 + :complex-offset 8) value-imag) (unless (location= value-imag result-imag) (inst movsd result-imag value-imag))))) @@ -690,646 +665,289 @@ ;;; unsigned-byte-8 -(macrolet ((define-data-vector-frobs (ptype) +(macrolet ((define-data-vector-frobs (ptype mov-inst type + 8-bit-tns-p &rest scs) `(progn (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype)) - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (unsigned-reg))) - (:arg-types ,ptype positive-fixnum) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:info offset) + (:arg-types ,ptype positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 1 vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,type) (:generator 5 - (inst movzx value + (inst ,mov-inst value (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset n-word-bytes) + :disp (- (+ (* vector-data-offset n-word-bytes) + offset) other-pointer-lowtag))))) (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype)) - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types ,ptype (:constant low-index)) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:info index offset) + (:arg-types ,ptype (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 1 vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,type) (:generator 4 - (inst movzx value + (inst ,mov-inst value (make-ea :byte :base object - :disp (- (+ (* vector-data-offset n-word-bytes) index) + :disp (- (+ (* vector-data-offset n-word-bytes) + index offset) other-pointer-lowtag))))) (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype)) - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target eax)) - (:arg-types ,ptype positive-fixnum positive-fixnum) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 2) :to (:result 0)) - eax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (value :scs ,scs :target rax)) + (:info offset) + (:arg-types ,ptype positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 1 vector-data-offset)) + ,type) + ,@(unless 8-bit-tns-p + '((:temporary (:sc unsigned-reg :offset rax-offset :target result + :from (:argument 2) :to (:result 0)) + rax))) + (:results (result :scs ,scs)) + (:result-types ,type) (:generator 5 - (move eax value) + ,@(unless 8-bit-tns-p '((move rax value))) (inst mov (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset n-word-bytes) + :disp (- (+ (* vector-data-offset n-word-bytes) + offset) other-pointer-lowtag)) - al-tn) - (move result eax))) + ,(if 8-bit-tns-p 'value 'al-tn)) + (move result ,(if 8-bit-tns-p 'value 'rax)))) (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype)) - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target eax)) - (:info index) + (value :scs ,scs :target rax)) + (:info index offset) (:arg-types ,ptype (:constant low-index) - positive-fixnum) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 1) :to (:result 0)) - eax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:constant (constant-displacement other-pointer-lowtag + 1 vector-data-offset)) + ,type) + ,@(unless 8-bit-tns-p + '((:temporary (:sc unsigned-reg :offset rax-offset :target result + :from (:argument 2) :to (:result 0)) + rax))) + (:results (result :scs ,scs)) + (:result-types ,type) (:generator 4 - (move eax value) + ,@(unless 8-bit-tns-p '((move rax value))) (inst mov (make-ea :byte :base object - :disp (- (+ (* vector-data-offset n-word-bytes) index) + :disp (- (+ (* vector-data-offset n-word-bytes) + index offset) other-pointer-lowtag)) - al-tn) - (move result eax)))))) - (define-data-vector-frobs simple-array-unsigned-byte-7) - (define-data-vector-frobs simple-array-unsigned-byte-8)) + ,(if 8-bit-tns-p 'value 'al-tn)) + (move result ,(if 8-bit-tns-p 'value 'rax))))))) + (define-data-vector-frobs simple-array-unsigned-byte-7 movzx positive-fixnum + nil unsigned-reg signed-reg) + (define-data-vector-frobs simple-array-unsigned-byte-8 movzx positive-fixnum + nil unsigned-reg signed-reg) + (define-data-vector-frobs simple-array-signed-byte-8 movsx tagged-num + nil signed-reg) + (define-data-vector-frobs simple-base-string + #!+sb-unicode movzx #!-sb-unicode mov + character + #!+sb-unicode nil #!-sb-unicode t character-reg)) ;;; unsigned-byte-16 -(macrolet ((define-data-vector-frobs (ptype) +(macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs) `(progn (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype)) - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (unsigned-reg))) - (:arg-types ,ptype positive-fixnum) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:info offset) + (:arg-types ,ptype positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 2 vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,type) (:generator 5 - (inst movzx value + (inst ,mov-inst value (make-ea :word :base object :index index :scale 2 - :disp (- (* vector-data-offset n-word-bytes) + :disp (- (+ (* vector-data-offset n-word-bytes) + (* offset 2)) other-pointer-lowtag))))) (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype)) - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types ,ptype (:constant low-index)) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:info index offset) + (:arg-types ,ptype (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 2 vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,type) (:generator 4 - (inst movzx value + (inst ,mov-inst value (make-ea :word :base object - :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 index)) + :disp (- (+ (* vector-data-offset n-word-bytes) + (* 2 index) + (* 2 offset)) other-pointer-lowtag))))) (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype)) - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target eax)) - (:arg-types ,ptype positive-fixnum positive-fixnum) + (value :scs ,scs :target eax)) + (:info offset) + (:arg-types ,ptype positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 2 vector-data-offset)) + ,type) (:temporary (:sc unsigned-reg :offset eax-offset :target result :from (:argument 2) :to (:result 0)) eax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:results (result :scs ,scs)) + (:result-types ,type) (:generator 5 (move eax value) (inst mov (make-ea :word :base object :index index :scale 2 - :disp (- (* vector-data-offset n-word-bytes) + :disp (- (+ (* vector-data-offset n-word-bytes) + (* offset 2)) other-pointer-lowtag)) ax-tn) (move result eax))) (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype)) - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target eax)) - (:info index) + (value :scs ,scs :target eax)) + (:info index offset) (:arg-types ,ptype (:constant low-index) - positive-fixnum) + (:constant (constant-displacement other-pointer-lowtag + 2 vector-data-offset)) + ,type) (:temporary (:sc unsigned-reg :offset eax-offset :target result :from (:argument 1) :to (:result 0)) eax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:results (result :scs ,scs)) + (:result-types ,type) (:generator 4 (move eax value) (inst mov (make-ea :word :base object :disp (- (+ (* vector-data-offset n-word-bytes) - (* 2 index)) + (* 2 index) + (* 2 offset)) other-pointer-lowtag)) ax-tn) (move result eax)))))) - (define-data-vector-frobs simple-array-unsigned-byte-15) - (define-data-vector-frobs simple-array-unsigned-byte-16)) - -(macrolet ((define-data-vector-frobs (ptype) + (define-data-vector-frobs simple-array-unsigned-byte-15 movzx positive-fixnum + unsigned-reg signed-reg) + (define-data-vector-frobs simple-array-unsigned-byte-16 movzx positive-fixnum + unsigned-reg signed-reg) + (define-data-vector-frobs simple-array-signed-byte-16 movsx tagged-num + signed-reg)) + +(macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs) `(progn (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype)) - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) (index :scs (unsigned-reg))) - (:arg-types ,ptype positive-fixnum) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:info offset) + (:arg-types ,ptype positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 4 vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,type) (:generator 5 - (inst movzxd value + (inst ,mov-inst value (make-ea :dword :base object :index index :scale 4 - :disp (- (* vector-data-offset n-word-bytes) + :disp (- (+ (* vector-data-offset n-word-bytes) + (* offset 4)) other-pointer-lowtag))))) (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype)) - (:translate data-vector-ref) + (:translate data-vector-ref-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types ,ptype (:constant low-index)) - (:results (value :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:info index offset) + (:arg-types ,ptype (:constant low-index) + (:constant (constant-displacement other-pointer-lowtag + 4 vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,type) (:generator 4 - (inst movzxd value + (inst ,mov-inst value (make-ea :dword :base object :disp (- (+ (* vector-data-offset n-word-bytes) - (* 4 index)) + (* 4 index) + (* 4 offset)) other-pointer-lowtag))))) (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype)) - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target rax)) - (:arg-types ,ptype positive-fixnum positive-fixnum) + (value :scs ,scs :target rax)) + (:info offset) + (:arg-types ,ptype positive-fixnum + (:constant (constant-displacement other-pointer-lowtag + 4 vector-data-offset)) + ,type) (:temporary (:sc unsigned-reg :offset rax-offset :target result :from (:argument 2) :to (:result 0)) rax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:results (result :scs ,scs)) + (:result-types ,type) (:generator 5 (move rax value) (inst mov (make-ea :dword :base object :index index :scale 4 - :disp (- (* vector-data-offset n-word-bytes) + :disp (- (+ (* vector-data-offset n-word-bytes) + (* offset 4)) other-pointer-lowtag)) eax-tn) (move result rax))) (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype)) - (:translate data-vector-set) + (:translate data-vector-set-with-offset) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (unsigned-reg signed-reg) :target rax)) - (:info index) + (value :scs ,scs :target rax)) + (:info index offset) (:arg-types ,ptype (:constant low-index) - positive-fixnum) + (:constant (constant-displacement other-pointer-lowtag + 4 vector-data-offset)) + ,type) (:temporary (:sc unsigned-reg :offset rax-offset :target result :from (:argument 1) :to (:result 0)) rax) - (:results (result :scs (unsigned-reg signed-reg))) - (:result-types positive-fixnum) + (:results (result :scs ,scs)) + (:result-types ,type) (:generator 4 (move rax value) (inst mov (make-ea :dword :base object :disp (- (+ (* vector-data-offset n-word-bytes) - (* 4 index)) + (* 4 index) + (* 4 offset)) other-pointer-lowtag)) eax-tn) (move result rax)))))) - (define-data-vector-frobs simple-array-unsigned-byte-32) - (define-data-vector-frobs simple-array-unsigned-byte-31)) - -;;; simple-string + (define-data-vector-frobs simple-array-unsigned-byte-32 movzxd positive-fixnum + unsigned-reg signed-reg) + (define-data-vector-frobs simple-array-unsigned-byte-31 movzxd positive-fixnum + unsigned-reg signed-reg) + (define-data-vector-frobs simple-array-signed-byte-32 movsxd tagged-num + signed-reg) + (define-data-vector-frobs simple-character-string movzxd character + character-reg)) -#!+sb-unicode -(progn -(define-vop (data-vector-ref/simple-base-string) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types simple-base-string positive-fixnum) - (:results (value :scs (character-reg))) - (:result-types character) - (:generator 5 - (inst movzx value - (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag))))) - -(define-vop (data-vector-ref-c/simple-base-string) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-base-string (:constant low-index)) - (:results (value :scs (character-reg))) - (:result-types character) - (:generator 4 - (inst movzx value - (make-ea :byte :base object - :disp (- (+ (* vector-data-offset n-word-bytes) index) - other-pointer-lowtag))))) - -(define-vop (data-vector-set/simple-base-string) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (character-reg) :target rax)) - (:arg-types simple-base-string positive-fixnum character) - (:temporary (:sc character-reg :offset rax-offset :target result - :from (:argument 2) :to (:result 0)) - rax) - (:results (result :scs (character-reg))) - (:result-types character) - (:generator 5 - (move rax value) - (inst mov (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) - al-tn) - (move result rax))) - -(define-vop (data-vector-set-c/simple-base-string) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (character-reg))) - (:info index) - (:arg-types simple-base-string (:constant (signed-byte 30)) character) - (:temporary (:sc character-reg :offset eax-offset :target result - :from (:argument 1) :to (:result 0)) - rax) - (:results (result :scs (character-reg))) - (:result-types character) - (:generator 4 - (move rax value) - (inst mov (make-ea :byte :base object - :disp (- (+ (* vector-data-offset n-word-bytes) index) - other-pointer-lowtag)) - al-tn) - (move result rax))) -) ; PROGN - - -#!-sb-unicode -(progn -(define-vop (data-vector-ref/simple-base-string) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types simple-base-string positive-fixnum) - (:results (value :scs (character-reg))) - (:result-types character) - (:generator 5 - (inst mov value - (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag))))) - -(define-vop (data-vector-ref-c/simple-base-string) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-base-string (:constant low-index)) - (:results (value :scs (character-reg))) - (:result-types character) - (:generator 4 - (inst mov value - (make-ea :byte :base object - :disp (- (+ (* vector-data-offset n-word-bytes) index) - other-pointer-lowtag))))) - -(define-vop (data-vector-set/simple-base-string) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (character-reg) :target result)) - (:arg-types simple-base-string positive-fixnum character) - (:results (result :scs (character-reg))) - (:result-types character) - (:generator 5 - (inst mov (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) - value) - (move result value))) - -(define-vop (data-vector-set-c/simple-base-string) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (character-reg))) - (:info index) - (:arg-types simple-base-string (:constant low-index) character) - (:results (result :scs (character-reg))) - (:result-types character) - (:generator 4 - (inst mov (make-ea :byte :base object - :disp (- (+ (* vector-data-offset n-word-bytes) index) - other-pointer-lowtag)) - value) - (move result value))) -) ; PROGN - -#!+sb-unicode -(macrolet ((define-data-vector-frobs (ptype) - `(progn - (define-vop (,(symbolicate "DATA-VECTOR-REF/" ptype)) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types ,ptype positive-fixnum) - (:results (value :scs (character-reg))) - (:result-types character) - (:generator 5 - (inst movzxd value - (make-ea :dword :base object :index index :scale 4 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag))))) - (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" ptype)) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types ,ptype (:constant low-index)) - (:results (value :scs (character-reg))) - (:result-types character) - (:generator 4 - (inst movzxd value - (make-ea :dword :base object - :disp (- (+ (* vector-data-offset n-word-bytes) - (* 4 index)) - other-pointer-lowtag))))) - (define-vop (,(symbolicate "DATA-VECTOR-SET/" ptype)) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (character-reg) :target rax)) - (:arg-types ,ptype positive-fixnum character) - (:temporary (:sc character-reg :offset rax-offset :target result - :from (:argument 2) :to (:result 0)) - rax) - (:results (result :scs (character-reg))) - (:result-types character) - (:generator 5 - (move rax value) - (inst mov (make-ea :dword :base object :index index :scale 4 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) - eax-tn) - (move result rax))) - - (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" ptype)) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (character-reg) :target rax)) - (:info index) - (:arg-types ,ptype (:constant low-index) character) - (:temporary (:sc character-reg :offset rax-offset :target result - :from (:argument 1) :to (:result 0)) - rax) - (:results (result :scs (character-reg))) - (:result-types character) - (:generator 4 - (move rax value) - (inst mov (make-ea :dword :base object - :disp (- (+ (* vector-data-offset n-word-bytes) - (* 4 index)) - other-pointer-lowtag)) - eax-tn) - (move result rax)))))) - (define-data-vector-frobs simple-character-string)) - -;;; signed-byte-8 - -(define-vop (data-vector-ref/simple-array-signed-byte-8) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types simple-array-signed-byte-8 positive-fixnum) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (inst movsx value - (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag))))) - -(define-vop (data-vector-ref-c/simple-array-signed-byte-8) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-signed-byte-8 (:constant low-index)) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (inst movsx value - (make-ea :byte :base object - :disp (- (+ (* vector-data-offset n-word-bytes) index) - other-pointer-lowtag))))) - -(define-vop (data-vector-set/simple-array-signed-byte-8) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 2) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (move eax value) - (inst mov (make-ea :byte :base object :index index :scale 1 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) - al-tn) - (move result eax))) - -(define-vop (data-vector-set-c/simple-array-signed-byte-8) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:info index) - (:arg-types simple-array-signed-byte-8 (:constant low-index) - tagged-num) - (:temporary (:sc unsigned-reg :offset eax-offset :target result - :from (:argument 1) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (move eax value) - (inst mov (make-ea :byte :base object - :disp (- (+ (* vector-data-offset n-word-bytes) index) - other-pointer-lowtag)) - al-tn) - (move result eax))) - -;;; signed-byte-16 - -(define-vop (data-vector-ref/simple-array-signed-byte-16) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types simple-array-signed-byte-16 positive-fixnum) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (inst movsx value - (make-ea :word :base object :index index :scale 2 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag))))) - -(define-vop (data-vector-ref-c/simple-array-signed-byte-16) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-signed-byte-16 (:constant low-index)) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (inst movsx value - (make-ea :word :base object - :disp (- (+ (* vector-data-offset n-word-bytes) - (* 2 index)) - other-pointer-lowtag))))) - -(define-vop (data-vector-set/simple-array-signed-byte-16) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num) - (:temporary (:sc signed-reg :offset eax-offset :target result - :from (:argument 2) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (move eax value) - (inst mov (make-ea :word :base object :index index :scale 2 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) - ax-tn) - (move result eax))) - -(define-vop (data-vector-set-c/simple-array-signed-byte-16) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:info index) - (:arg-types simple-array-signed-byte-16 (:constant low-index) tagged-num) - (:temporary (:sc signed-reg :offset eax-offset :target result - :from (:argument 1) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (move eax value) - (inst mov - (make-ea :word :base object - :disp (- (+ (* vector-data-offset n-word-bytes) - (* 2 index)) - other-pointer-lowtag)) - ax-tn) - (move result eax))) - - -(define-vop (data-vector-ref/simple-array-signed-byte-32) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types simple-array-signed-byte-32 positive-fixnum) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (inst movsxd value - (make-ea :dword :base object :index index :scale 4 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag))))) - -(define-vop (data-vector-ref-c/simple-array-signed-byte-32) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:info index) - (:arg-types simple-array-signed-byte-32 (:constant low-index)) - (:results (value :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (inst movsxd value - (make-ea :dword :base object - :disp (- (+ (* vector-data-offset n-word-bytes) - (* 4 index)) - other-pointer-lowtag))))) - -(define-vop (data-vector-set/simple-array-signed-byte-32) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (index :scs (unsigned-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:arg-types simple-array-signed-byte-32 positive-fixnum tagged-num) - (:temporary (:sc signed-reg :offset eax-offset :target result - :from (:argument 2) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 5 - (move eax value) - (inst mov (make-ea :dword :base object :index index :scale 4 - :disp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) - eax-tn) - (move result eax))) - -(define-vop (data-vector-set-c/simple-array-signed-byte-32) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg) :to (:eval 0)) - (value :scs (signed-reg) :target eax)) - (:info index) - (:arg-types simple-array-signed-byte-32 (:constant low-index) tagged-num) - (:temporary (:sc signed-reg :offset eax-offset :target result - :from (:argument 1) :to (:result 0)) - eax) - (:results (result :scs (signed-reg))) - (:result-types tagged-num) - (:generator 4 - (move eax value) - (inst mov - (make-ea :dword :base object - :disp (- (+ (* vector-data-offset n-word-bytes) - (* 4 index)) - other-pointer-lowtag)) - eax-tn) - (move result eax))) ;;; These vops are useful for accessing the bits of a vector ;;; irrespective of what type of vector it is. diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 6ec4218..be94d71 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -409,6 +409,42 @@ :disp (- (* (+ ,offset index) n-word-bytes) ,lowtag))))))) +(defmacro define-full-reffer+offset (name type offset lowtag scs el-type &optional translate) + `(progn + (define-vop (,name) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:info offset) + (:arg-types ,type tagged-num + (:constant (constant-displacement other-pointer-lowtag + n-word-bytes vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,el-type) + (:generator 3 ; pw was 5 + (inst mov value (make-ea :qword :base object :index index + :disp (- (* (+ ,offset offset) n-word-bytes) + ,lowtag))))) + (define-vop (,(symbolicate name "-C")) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:info index offset) + (:arg-types ,type + (:constant (load/store-index ,n-word-bytes ,(eval lowtag) + ,(eval offset))) + (:constant (constant-displacement other-pointer-lowtag + n-word-bytes vector-data-offset))) + (:results (value :scs ,scs)) + (:result-types ,el-type) + (:generator 2 ; pw was 5 + (inst mov value (make-ea :qword :base object + :disp (- (* (+ ,offset index offset) n-word-bytes) + ,lowtag))))))) + (defmacro define-full-setter (name type offset lowtag scs el-type &optional translate) `(progn (define-vop (,name) @@ -446,6 +482,51 @@ value) (move result value))))) +(defmacro define-full-setter+offset (name type offset lowtag scs el-type &optional translate) + `(progn + (define-vop (,name) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs ,scs :target result)) + (:info offset) + (:arg-types ,type tagged-num + (:constant (constant-displacement other-pointer-lowtag + n-word-bytes + vector-data-offset)) + ,el-type) + (:results (result :scs ,scs)) + (:result-types ,el-type) + (:generator 4 ; was 5 + (inst mov (make-ea :qword :base object :index index + :disp (- (* (+ ,offset offset) n-word-bytes) ,lowtag)) + value) + (move result value))) + (define-vop (,(symbolicate name "-C")) + ,@(when translate + `((:translate ,translate))) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (value :scs ,scs :target result)) + (:info index offset) + (:arg-types ,type + (:constant (load/store-index ,n-word-bytes ,(eval lowtag) + ,(eval offset))) + (:constant (constant-displacement other-pointer-lowtag + n-word-bytes + vector-data-offset)) + ,el-type) + (:results (result :scs ,scs)) + (:result-types ,el-type) + (:generator 3 ; was 5 + (inst mov (make-ea :qword :base object + :disp (- (* (+ ,offset index offset) n-word-bytes) + ,lowtag)) + value) + (move result value))))) + ;;; helper for alien stuff. (def!macro with-pinned-objects ((&rest objects) &body body) "Arrange with the garbage collector that the pages occupied by diff --git a/src/compiler/x86-64/parms.lisp b/src/compiler/x86-64/parms.lisp index a66c780..25d8d12 100644 --- a/src/compiler/x86-64/parms.lisp +++ b/src/compiler/x86-64/parms.lisp @@ -35,6 +35,12 @@ ;;; addressable object (def!constant n-byte-bits 8) +;;; The minimum immediate offset in a memory-referencing instruction. +(def!constant minimum-immediate-offset (- (expt 2 31))) + +;;; The maximum immediate offset in a memory-referencing instruction. +(def!constant maximum-immediate-offset (1- (expt 2 31))) + (def!constant float-sign-shift 31) ;;; comment from CMU CL: diff --git a/version.lisp-expr b/version.lisp-expr index fca68a6..a0c4b30 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.5.40" +"1.0.5.41" -- 1.7.10.4