[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 array.lisp,1.21,1.22

[Nathan F. <nf...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv5285/src/compiler/x86-64

Modified Files:
	array.lisp 
Log Message:
1.0.32.8: macroize x86-64 {8,16,32}-bit array accessors

One wonders if the profusion of array access VOPs are merely bloat...


Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/array.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- array.lisp	29 Sep 2009 13:35:38 -0000	1.21
+++ array.lisp	30 Oct 2009 18:42:02 -0000	1.22
@@ -610,93 +610,13 @@
 
 
 
-;;; unsigned-byte-8
-(macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
-  `(progn
-    (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
-      (:translate data-vector-ref-with-offset)
-      (:policy :fast-safe)
-      (:args (object :scs (descriptor-reg))
-             (index :scs (unsigned-reg)))
-      (: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 ,mov-inst value
-              (make-ea :byte :base object :index index :scale 1
-                       :disp (- (+ (* vector-data-offset n-word-bytes)
-                                   offset)
-                                other-pointer-lowtag)))))
-    (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
-      (:translate data-vector-ref-with-offset)
-      (:policy :fast-safe)
-      (:args (object :scs (descriptor-reg)))
-      (: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 ,mov-inst value
-              (make-ea :byte :base object
-                       :disp (- (+ (* vector-data-offset n-word-bytes)
-                                   index offset)
-                                other-pointer-lowtag)))))
-    (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
-      (: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 ,scs :target result))
-      (:info offset)
-      (:arg-types ,ptype positive-fixnum
-                  (:constant (constant-displacement other-pointer-lowtag
-                                                    1 vector-data-offset))
-                  ,type)
-      (:results (result :scs ,scs))
-      (:result-types ,type)
-      (:generator 5
-        (inst mov (make-ea :byte :base object :index index :scale 1
-                           :disp (- (+ (* vector-data-offset n-word-bytes)
-                                       offset)
-                                    other-pointer-lowtag))
-              (reg-in-size value :byte))
-        (move result value)))
-    (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
-      (:translate data-vector-set-with-offset)
-      (:policy :fast-safe)
-      (:args (object :scs (descriptor-reg) :to (:eval 0))
-             (value :scs ,scs :target result))
-      (:info index offset)
-      (:arg-types ,ptype (:constant low-index)
-                  (:constant (constant-displacement other-pointer-lowtag
-                                                    1 vector-data-offset))
-                  ,type)
-      (:results (result :scs ,scs))
-      (:result-types ,type)
-      (:generator 4
-        (inst mov (make-ea :byte :base object
-                           :disp (- (+ (* vector-data-offset n-word-bytes)
-                                       index offset)
-                                    other-pointer-lowtag))
-              (reg-in-size value :byte))
-        (move result value))))))
-  (define-data-vector-frobs simple-array-unsigned-byte-7 movzx positive-fixnum
-    unsigned-reg signed-reg)
-  (define-data-vector-frobs simple-array-unsigned-byte-8 movzx positive-fixnum
-    unsigned-reg signed-reg)
-  (define-data-vector-frobs simple-array-signed-byte-8 movsx tagged-num
-    signed-reg)
-  (define-data-vector-frobs simple-base-string
-     #!+sb-unicode movzx #!-sb-unicode mov
-     character character-reg))
-
-;;; unsigned-byte-16
-(macrolet ((define-data-vector-frobs (ptype mov-inst type &rest scs)
+;;; {un,}signed-byte-{8,16,32} and characters
+(macrolet ((define-data-vector-frobs (ptype mov-inst operand-size
+                                            type &rest scs)
+  (let ((n-bytes (ecase operand-size
+                   (:byte 1)
+                   (:word 2)
+                   (:dword 4))))
     `(progn
       (define-vop (,(symbolicate "DATA-VECTOR-REF-WITH-OFFSET/" ptype))
         (:translate data-vector-ref-with-offset)
@@ -706,14 +626,14 @@
         (:info offset)
         (:arg-types ,ptype positive-fixnum
                     (:constant (constant-displacement other-pointer-lowtag
-                                                      2 vector-data-offset)))
+                                                      ,n-bytes vector-data-offset)))
         (:results (value :scs ,scs))
         (:result-types ,type)
         (:generator 5
           (inst ,mov-inst value
-                (make-ea :word :base object :index index :scale 2
+                (make-ea ,operand-size :base object :index index :scale ,n-bytes
                          :disp (- (+ (* vector-data-offset n-word-bytes)
-                                     (* offset 2))
+                                     (* offset ,n-bytes))
                                   other-pointer-lowtag)))))
       (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
         (:translate data-vector-ref-with-offset)
@@ -722,15 +642,15 @@
         (:info index offset)
         (:arg-types ,ptype (:constant low-index)
                     (:constant (constant-displacement other-pointer-lowtag
-                                                      2 vector-data-offset)))
+                                                      ,n-bytes vector-data-offset)))
         (:results (value :scs ,scs))
         (:result-types ,type)
         (:generator 4
           (inst ,mov-inst value
-                (make-ea :word :base object
+                (make-ea ,operand-size :base object
                          :disp (- (+ (* vector-data-offset n-word-bytes)
-                                     (* 2 index)
-                                     (* 2 offset))
+                                     (* ,n-bytes index)
+                                     (* ,n-bytes offset))
                                   other-pointer-lowtag)))))
       (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
         (:translate data-vector-set-with-offset)
@@ -741,100 +661,16 @@
         (:info offset)
         (:arg-types ,ptype positive-fixnum
                     (:constant (constant-displacement other-pointer-lowtag
-                                                      2 vector-data-offset))
+                                                      ,n-bytes vector-data-offset))
                     ,type)
         (:results (result :scs ,scs))
         (:result-types ,type)
         (:generator 5
-          (inst mov (make-ea :word :base object :index index :scale 2
-                             :disp (- (+ (* vector-data-offset n-word-bytes)
-                                         (* offset 2))
-                                      other-pointer-lowtag))
-                (reg-in-size value :word))
-          (move result value)))
-
-      (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
-        (:translate data-vector-set-with-offset)
-        (:policy :fast-safe)
-        (:args (object :scs (descriptor-reg) :to (:eval 0))
-               (value :scs ,scs :target result))
-        (:info index offset)
-        (:arg-types ,ptype (:constant low-index)
-                    (:constant (constant-displacement other-pointer-lowtag
-                                                      2 vector-data-offset))
-                    ,type)
-        (:results (result :scs ,scs))
-        (:result-types ,type)
-        (:generator 4
-          (inst mov (make-ea :word :base object
+          (inst mov (make-ea ,operand-size :base object :index index :scale ,n-bytes
                              :disp (- (+ (* vector-data-offset n-word-bytes)
-                                         (* 2 index)
-                                         (* 2 offset))
+                                         (* offset ,n-bytes))
                                       other-pointer-lowtag))
-                (reg-in-size value :word))
-          (move result value))))))
-  (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-WITH-OFFSET/" ptype))
-        (:translate data-vector-ref-with-offset)
-        (:policy :fast-safe)
-        (:args (object :scs (descriptor-reg))
-               (index :scs (unsigned-reg)))
-        (: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 ,mov-inst value
-                (make-ea :dword :base object :index index :scale 4
-                         :disp (- (+ (* vector-data-offset n-word-bytes)
-                                     (* offset 4))
-                                  other-pointer-lowtag)))))
-      (define-vop (,(symbolicate "DATA-VECTOR-REF-C-WITH-OFFSET/" ptype))
-        (:translate data-vector-ref-with-offset)
-        (:policy :fast-safe)
-        (:args (object :scs (descriptor-reg)))
-        (: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 ,mov-inst value
-                (make-ea :dword :base object
-                         :disp (- (+ (* vector-data-offset n-word-bytes)
-                                     (* 4 index)
-                                     (* 4 offset))
-                                  other-pointer-lowtag)))))
-      (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
-        (: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 ,scs :target result))
-        (:info offset)
-        (:arg-types ,ptype positive-fixnum
-                    (:constant (constant-displacement other-pointer-lowtag
-                                                      4 vector-data-offset))
-                    ,type)
-        (:results (result :scs ,scs))
-        (:result-types ,type)
-        (:generator 5
-          (inst mov (make-ea :dword :base object :index index :scale 4
-                                :disp (- (+ (* vector-data-offset n-word-bytes)
-                                            (* offset 4))
-                                         other-pointer-lowtag))
-                (reg-in-size value :dword))
+                (reg-in-size value ,operand-size))
           (move result value)))
 
       (define-vop (,(symbolicate "DATA-VECTOR-SET-C-WITH-OFFSET/" ptype))
@@ -845,27 +681,42 @@
         (:info index offset)
         (:arg-types ,ptype (:constant low-index)
                     (:constant (constant-displacement other-pointer-lowtag
-                                                      4 vector-data-offset))
+                                                      ,n-bytes vector-data-offset))
                     ,type)
         (:results (result :scs ,scs))
         (:result-types ,type)
         (:generator 4
-          (inst mov (make-ea :dword :base object
+          (inst mov (make-ea ,operand-size :base object
                              :disp (- (+ (* vector-data-offset n-word-bytes)
-                                         (* 4 index)
-                                         (* 4 offset))
+                                         (* ,n-bytes index)
+                                         (* ,n-bytes offset))
                                       other-pointer-lowtag))
-                (reg-in-size value :dword))
-          (move result value))))))
-  (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)
+                (reg-in-size value ,operand-size))
+          (move result value)))))))
+  (define-data-vector-frobs simple-array-unsigned-byte-7 movzx :byte
+    positive-fixnum unsigned-reg signed-reg)
+  (define-data-vector-frobs simple-array-unsigned-byte-8 movzx :byte
+    positive-fixnum unsigned-reg signed-reg)
+  (define-data-vector-frobs simple-array-signed-byte-8 movsx :byte
+    tagged-num signed-reg)
+  (define-data-vector-frobs simple-base-string
+     #!+sb-unicode movzx #!-sb-unicode mov :byte
+     character character-reg)
+  (define-data-vector-frobs simple-array-unsigned-byte-15 movzx :word
+    positive-fixnum unsigned-reg signed-reg)
+  (define-data-vector-frobs simple-array-unsigned-byte-16 movzx :word
+    positive-fixnum unsigned-reg signed-reg)
+  (define-data-vector-frobs simple-array-signed-byte-16 movsx :word
+    tagged-num signed-reg)
+  (define-data-vector-frobs simple-array-unsigned-byte-32 movzxd :dword
+    positive-fixnum unsigned-reg signed-reg)
+  (define-data-vector-frobs simple-array-unsigned-byte-31 movzxd :dword
+    positive-fixnum unsigned-reg signed-reg)
+  (define-data-vector-frobs simple-array-signed-byte-32 movsxd :dword
+    tagged-num signed-reg)
   #!+sb-unicode
-  (define-data-vector-frobs simple-character-string movzxd character
-    character-reg))
+  (define-data-vector-frobs simple-character-string movzxd :dword
+    character character-reg))
 
 
 ;;; These vops are useful for accessing the bits of a vector