1.0.5.6: compare-and-swap / instance-set-conditional refactoring

[sbcl.git] / src / compiler / x86 / array.lisp

diff --git a/src/compiler/x86/array.lisp b/src/compiler/x86/array.lisp
index 3926463..16e9aa0 100644 (file)
--- a/src/compiler/x86/array.lisp
+++ b/src/compiler/x86/array.lisp
@@ -150,6 +150,10 @@
   #!+sb-unicode
   (def-full-data-vector-frobs simple-character-string character character-reg))
 
+(define-full-compare-and-swap simple-vector-compare-and-swap
+    simple-vector vector-data-offset other-pointer-lowtag
+    (descriptor-reg any-reg) *
+    %simple-vector-compare-and-swap)
 \f
 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
 ;;;; bit, 2-bit, and 4-bit vectors
@@ -171,10 +175,7 @@
          (:generator 20
            (move ecx index)
            (inst shr ecx ,bit-shift)
-           (inst mov result
-                 (make-ea :dword :base object :index ecx :scale 4
-                          :disp (- (* vector-data-offset n-word-bytes)
-                                   other-pointer-lowtag)))
+           (inst mov result (make-ea-for-vector-data object :index ecx))
            (move ecx index)
            ;; We used to mask ECX for all values of ELEMENT-PER-WORD,
            ;; but since Intel's documentation says that the chip will
@@ -218,10 +219,7 @@
          (:generator 25
            (move word-index index)
            (inst shr word-index ,bit-shift)
-           (inst mov old
-                 (make-ea :dword :base object :index word-index :scale 4
-                          :disp (- (* vector-data-offset n-word-bytes)
-                                   other-pointer-lowtag)))
+           (inst mov old (make-ea-for-vector-data object :index word-index))
            (move ecx index)
            ;; We used to mask ECX for all values of ELEMENT-PER-WORD,
            ;; but since Intel's documentation says that the chip will
@@ -242,9 +240,7 @@
              (unsigned-reg
               (inst or old value)))
            (inst rol old :cl)
-           (inst mov (make-ea :dword :base object :index word-index :scale 4
-                              :disp (- (* vector-data-offset n-word-bytes)
-                                       other-pointer-lowtag))
+           (inst mov (make-ea-for-vector-data object :index word-index)
                  old)
            (sc-case value
              (immediate
@@ -263,11 +259,7 @@
          (:temporary (:sc unsigned-reg :to (:result 0)) old)
          (:generator 20
            (multiple-value-bind (word extra) (floor index ,elements-per-word)
-             (inst mov old
-                   (make-ea :dword :base object
-                            :disp (- (* (+ word vector-data-offset)
-                                        n-word-bytes)
-                                     other-pointer-lowtag)))
+             (loadw old object (+ word vector-data-offset) other-pointer-lowtag)
              (sc-case value
                (immediate
                 (let* ((value (tn-value value))
@@ -286,11 +278,7 @@
                   (inst or old value)
                   (unless (zerop shift)
                     (inst rol old shift)))))
-             (inst mov (make-ea :dword :base object
-                                :disp (- (* (+ word vector-data-offset)
-                                            n-word-bytes)
-                                         other-pointer-lowtag))
-                   old)
+             (storew old object (+ word vector-data-offset) other-pointer-lowtag)
              (sc-case value
                (immediate
                 (inst mov result (tn-value value)))
@@ -574,18 +562,13 @@
       (:generator 5
         (sc-case index
           (immediate
-           (inst ,ref-inst value
-                 (make-ea :byte :base object
-                          :disp (- (+ (* vector-data-offset n-word-bytes)
-                                      (tn-value index)
-                                      offset)
-                                   other-pointer-lowtag))))
+           (inst ,ref-inst value (make-ea-for-vector-data
+                                  object :size :byte
+                                  :offset (+ (tn-value index) offset))))
           (t
            (inst ,ref-inst value
-                 (make-ea :byte :base object :index index :scale 1
-                          :disp (- (+ (* vector-data-offset n-word-bytes)
-                                      offset)
-                                   other-pointer-lowtag)))))))
+                 (make-ea-for-vector-data object :size :byte
+                                          :index index :offset offset))))))
     (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
       (:translate data-vector-set-with-offset)
       (:policy :fast-safe)
@@ -609,19 +592,14 @@
            '((move eax value)))
         (sc-case index
           (immediate
-           (inst mov (make-ea :byte :base object
-                              :disp (- (+ (* vector-data-offset n-word-bytes)
-                                          (tn-value index)
-                                          offset)
-                                       other-pointer-lowtag))
+           (inst mov (make-ea-for-vector-data
+                      object :size :byte :offset (+ (tn-value index) offset))
                  ,(if 8-bit-tns-p
                       'value
                       'al-tn)))
           (t
-           (inst mov (make-ea :byte :base object :index index :scale 1
-                              :disp (- (+ (* vector-data-offset n-word-bytes)
-                                          offset)
-                                       other-pointer-lowtag))
+           (inst mov (make-ea-for-vector-data object :size :byte
+                                              :index index :offset offset)
                  ,(if 8-bit-tns-p
                       'value
                       'al-tn))))
@@ -656,16 +634,12 @@
           (sc-case index
             (immediate
              (inst ,ref-inst value
-                   (make-ea :word :base object
-                            :disp (- (+ (* vector-data-offset n-word-bytes)
-                                        (* 2 (+ offset (tn-value index))))
-                                     other-pointer-lowtag))))
+                   (make-ea-for-vector-data object :size :word
+                                            :offset (+ (tn-value index) offset))))
             (t
              (inst ,ref-inst value
-                   (make-ea :word :base object :index index :scale 2
-                            :disp (- (+ (* vector-data-offset n-word-bytes)
-                                        (* 2 offset))
-                                     other-pointer-lowtag)))))))
+                   (make-ea-for-vector-data object :size :word
+                                            :index index :offset offset))))))
       (define-vop (,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/" ptype))
         (:translate data-vector-set-with-offset)
         (:policy :fast-safe)
@@ -686,16 +660,12 @@
           (move eax value)
           (sc-case index
             (immediate
-             (inst mov (make-ea :word :base object
-                                :disp (- (+ (* vector-data-offset n-word-bytes)
-                                            (* 2 (+ offset (tn-value index))))
-                                         other-pointer-lowtag))
+             (inst mov (make-ea-for-vector-data
+                        object :size :word :offset (+ (tn-value index) offset))
                    ax-tn))
             (t
-             (inst mov (make-ea :word :base object :index index :scale 2
-                                :disp (- (+ (* vector-data-offset n-word-bytes)
-                                            (* 2 offset))
-                                         other-pointer-lowtag))
+             (inst mov (make-ea-for-vector-data object :size :word
+                                                :index index :offset offset)
                    ax-tn)))
           (move result eax))))))
   (define-data-vector-frobs simple-array-unsigned-byte-15 positive-fixnum