summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNathan Froyd <froydnj@cs.rice.edu>2007-05-07 00:42:37 +0000
committerNathan Froyd <froydnj@cs.rice.edu>2007-05-07 00:42:37 +0000
commit906ecd4ef2d10aca23e1081f03c13fe2f932ed89 (patch)
tree0838aef8f883607ee08f3bbc12b48fb8590893ec
parent8cb20ebfcf46c5b1dfb037676fe199ec25d59faf (diff)
10.CVS: ----------------------------------------------------------------------
-rw-r--r--NEWS4
-rw-r--r--src/code/early-extensions.lisp4
-rw-r--r--src/compiler/array-tran.lisp4
-rw-r--r--src/compiler/fndb.lisp4
-rw-r--r--src/compiler/generic/utils.lisp2
-rw-r--r--src/compiler/generic/vm-fndb.lisp4
-rw-r--r--src/compiler/generic/vm-tran.lisp14
-rw-r--r--src/compiler/x86-64/arith.lisp4
-rw-r--r--src/compiler/x86-64/array.lisp978
-rw-r--r--src/compiler/x86-64/macros.lisp81
-rw-r--r--src/compiler/x86-64/parms.lisp6
-rw-r--r--version.lisp-expr2
12 files changed, 409 insertions, 698 deletions
diff --git a/NEWS b/NEWS
index 52ecd23c8..516e2509c 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 <constant>)) now
+ produce more efficient code on x86-64 if the compiler can determine
+ that (+ INDEX <constant>) 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 c9cdbf718..c3f247435 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 a3c5ab5c7..0d47738a4 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 e0bd99d27..5d2af7c17 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 1ebf85d47..7b433a21b 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 50c203c58..356fad794 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 f3791f00f..9d1108a5d 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 7ea7d0686..3e55ac2d3 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 ad8f2a57e..2c6530c16 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 6ec421875..be94d71a3 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 a66c780af..25d8d122d 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 fca68a6c1..a0c4b3058 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"