0.8.2.15:
[sbcl.git] / src / compiler / x86 / array.lisp
index 966cb7a..6d9d9a6 100644 (file)
   (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num
     unsigned-reg)
   (def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg)
+  (def-full-data-vector-frobs simple-array-unsigned-byte-29 positive-fixnum any-reg)
   (def-full-data-vector-frobs simple-array-signed-byte-32 signed-num
-    signed-reg))
+    signed-reg)
+  (def-full-data-vector-frobs simple-array-unsigned-byte-31 unsigned-num
+    unsigned-reg))
 \f
 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
 ;;;; bit, 2-bit, and 4-bit vectors
       (inst fxch value-imag))))
 \f
 ;;; unsigned-byte-8
-
-(define-vop (data-vector-ref/simple-array-unsigned-byte-8)
-  (:translate data-vector-ref)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg))
-        (index :scs (unsigned-reg)))
-  (:arg-types simple-array-unsigned-byte-8 positive-fixnum)
-  (:results (value :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (: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-array-unsigned-byte-8)
-  (:translate data-vector-ref)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg)))
-  (:info index)
-  (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30)))
-  (:results (value :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (: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-array-unsigned-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 (unsigned-reg signed-reg) :target eax))
-  (:arg-types simple-array-unsigned-byte-8 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)
-  (:generator 5
-    (move eax value)
-    (inst mov (make-ea :byte :base object :index index :scale 1
+(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 (unsigned-reg signed-reg)))
+      (:result-types positive-fixnum)
+      (:generator 5
+       (inst movzx value
+             (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-unsigned-byte-8)
-  (:translate data-vector-set)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to (:eval 0))
-        (value :scs (unsigned-reg signed-reg) :target eax))
-  (:info index)
-  (:arg-types simple-array-unsigned-byte-8 (:constant (signed-byte 30))
-             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)
-  (:generator 4
-    (move eax value)
-    (inst mov (make-ea :byte :base object
+                               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 (signed-byte 30)))
+      (:results (value :scs (unsigned-reg signed-reg)))
+      (:result-types positive-fixnum)
+      (:generator 4
+       (inst movzx value
+             (make-ea :byte :base object
                       :disp (- (+ (* vector-data-offset n-word-bytes) index)
-                               other-pointer-lowtag))
-         al-tn)
-    (move result eax)))
+                               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 (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)
+      (: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 (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
+      (:translate data-vector-set)
+      (:policy :fast-safe)
+      (:args (object :scs (descriptor-reg) :to (:eval 0))
+            (value :scs (unsigned-reg signed-reg) :target eax))
+      (:info index)
+      (:arg-types ,ptype (:constant (signed-byte 30))
+                 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)
+      (: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))))))
+  (define-data-vector-frobs simple-array-unsigned-byte-7)
+  (define-data-vector-frobs simple-array-unsigned-byte-8))
 
 ;;; unsigned-byte-16
-
-(define-vop (data-vector-ref/simple-array-unsigned-byte-16)
-  (:translate data-vector-ref)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg))
-        (index :scs (unsigned-reg)))
-  (:arg-types simple-array-unsigned-byte-16 positive-fixnum)
-  (:results (value :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 5
-    (inst movzx 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-unsigned-byte-16)
-  (:translate data-vector-ref)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg)))
-  (:info index)
-  (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30)))
-  (:results (value :scs (unsigned-reg signed-reg)))
-  (:result-types positive-fixnum)
-  (:generator 4
-    (inst movzx 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-unsigned-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 (unsigned-reg signed-reg) :target eax))
-  (:arg-types simple-array-unsigned-byte-16 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)
-  (: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-unsigned-byte-16)
-  (:translate data-vector-set)
-  (:policy :fast-safe)
-  (:args (object :scs (descriptor-reg) :to (:eval 0))
-        (value :scs (unsigned-reg signed-reg) :target eax))
-  (:info index)
-  (:arg-types simple-array-unsigned-byte-16 (:constant (signed-byte 30))
-             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)
-  (: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)))
+(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 (unsigned-reg signed-reg)))
+       (:result-types positive-fixnum)
+       (:generator 5
+         (inst movzx value
+               (make-ea :word :base object :index index :scale 2
+                        :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 (signed-byte 30)))
+       (:results (value :scs (unsigned-reg signed-reg)))
+       (:result-types positive-fixnum)
+       (:generator 4
+         (inst movzx value
+               (make-ea :word :base object
+                        :disp (- (+ (* vector-data-offset n-word-bytes) (* 2 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 (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)
+       (: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 (,(symbolicate "DATA-VECTOR-SET-C/" ptype))
+       (:translate data-vector-set)
+       (:policy :fast-safe)
+       (:args (object :scs (descriptor-reg) :to (:eval 0))
+              (value :scs (unsigned-reg signed-reg) :target eax))
+       (:info index)
+       (:arg-types ,ptype (:constant (signed-byte 30))
+                   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)
+       (: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-data-vector-frobs simple-array-unsigned-byte-15)
+  (define-data-vector-frobs simple-array-unsigned-byte-16))
 
 ;;; simple-string