10.\7f\7fCVS: ----------------------------------------------------------------------
authorNathan Froyd <froydnj@cs.rice.edu>
Mon, 7 May 2007 00:42:37 +0000 (00:42 +0000)
committerNathan Froyd <froydnj@cs.rice.edu>
Mon, 7 May 2007 00:42:37 +0000 (00:42 +0000)
12 files changed:
NEWS
src/code/early-extensions.lisp
src/compiler/array-tran.lisp
src/compiler/fndb.lisp
src/compiler/generic/utils.lisp
src/compiler/generic/vm-fndb.lisp
src/compiler/generic/vm-tran.lisp
src/compiler/x86-64/arith.lisp
src/compiler/x86-64/array.lisp
src/compiler/x86-64/macros.lisp
src/compiler/x86-64/parms.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 52ecd23..516e250 100644 (file)
--- 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
index c9cdbf7..c3f2474 100644 (file)
@@ -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
index a3c5ab5..0d47738 100644 (file)
   (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))
 
   (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))
 
index e0bd99d..5d2af7c 100644 (file)
 (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
index 1ebf85d..7b433a2 100644 (file)
@@ -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
index 50c203c..356fad7 100644 (file)
 
 (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))
index f3791f0..9d1108a 100644 (file)
@@ -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
 
 ;;; 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))
         (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)
 
 ;;; 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))
         (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)
index 7ea7d06..3e55ac2 100644 (file)
 
 (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)
 
index ad8f2a5..2c6530c 100644 (file)
 ;;; 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
   (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))))
 
 
 (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)))))
 \f
 
 ;;; 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))
-\f
-;;; 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)))
 \f
 ;;; These vops are useful for accessing the bits of a vector
 ;;; irrespective of what type of vector it is.
index 6ec4218..be94d71 100644 (file)
                                   :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)
                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
index a66c780..25d8d12 100644 (file)
 ;;; 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:
index fca68a6..a0c4b30 100644 (file)
@@ -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"