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

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

diff --git a/src/compiler/x86-64/array.lisp b/src/compiler/x86-64/array.lisp
index a144c56..ad8f2a5 100644 (file)
--- a/src/compiler/x86-64/array.lisp
+++ b/src/compiler/x86-64/array.lisp
@@ -154,6 +154,11 @@
       signed-num signed-reg)
   (def-full-data-vector-frobs simple-array-unsigned-byte-63 unsigned-num
     unsigned-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
@@ -180,9 +185,14 @@
                           :disp (- (* vector-data-offset n-word-bytes)
                                    other-pointer-lowtag)))
            (move ecx index)
-           (inst and ecx ,(1- elements-per-word))
+           ;; We used to mask ECX for all values of BITS, but since
+           ;; Intel's documentation says that the chip will mask shift
+           ;; and rotate counts by 63 automatically, we can safely move
+           ;; the masking operation under the protection of this UNLESS
+           ;; in the bit-vector case.  --njf, 2006-07-14
            ,@(unless (= bits 1)
-               `((inst shl ecx ,(1- (integer-length bits)))))
+               `((inst and ecx ,(1- elements-per-word))
+                 (inst shl ecx ,(1- (integer-length bits)))))
            (inst shr result :cl)
            (inst and result ,(1- (ash 1 bits)))))
        (define-vop (,(symbolicate 'data-vector-ref-c/ type))
@@ -205,29 +215,32 @@
          (:note "inline array store")
          (:translate data-vector-set)
          (:policy :fast-safe)
-         (:args (object :scs (descriptor-reg) :target ptr)
+         (:args (object :scs (descriptor-reg))
                 (index :scs (unsigned-reg) :target ecx)
                 (value :scs (unsigned-reg immediate) :target result))
          (:arg-types ,type positive-fixnum positive-fixnum)
          (:results (result :scs (unsigned-reg)))
          (:result-types positive-fixnum)
          (:temporary (:sc unsigned-reg) word-index)
-         (:temporary (:sc unsigned-reg :from (:argument 0)) ptr old)
-         (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1))
-                     ecx)
+         (:temporary (:sc unsigned-reg) old)
+         (:temporary (:sc unsigned-reg :offset ecx-offset) ecx)
          (:generator 25
            (move word-index index)
            (inst shr word-index ,bit-shift)
-           (inst lea ptr
+           (inst mov old
                  (make-ea :qword :base object :index word-index
                           :scale n-word-bytes
                           :disp (- (* vector-data-offset n-word-bytes)
                                    other-pointer-lowtag)))
-           (loadw old ptr)
            (move ecx index)
-           (inst and ecx ,(1- elements-per-word))
+           ;; We used to mask ECX for all values of BITS, but since
+           ;; Intel's documentation says that the chip will mask shift
+           ;; and rotate counts by 63 automatically, we can safely move
+           ;; the masking operation under the protection of this UNLESS
+           ;; in the bit-vector case.  --njf, 2006-07-14
            ,@(unless (= bits 1)
-               `((inst shl ecx ,(1- (integer-length bits)))))
+               `((inst and ecx ,(1- elements-per-word))
+                 (inst shl ecx ,(1- (integer-length bits)))))
            (inst ror old :cl)
            (unless (and (sc-is value immediate)
                         (= (tn-value value) ,(1- (ash 1 bits))))
@@ -239,7 +252,11 @@
              (unsigned-reg
               (inst or old value)))
            (inst rol old :cl)
-           (storew old ptr)
+           (inst mov (make-ea :qword :base object :index word-index
+                              :scale n-word-bytes
+                              :disp (- (* vector-data-offset n-word-bytes)
+                                       other-pointer-lowtag))
+                 old)
            (sc-case value
              (immediate
               (inst mov result (tn-value value)))