1.0.41.35: ppc: Implement compare-and-swap-vops.

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

diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp
index 2590000..8ba4680 100644 (file)
--- a/src/compiler/x86/cell.lisp
+++ b/src/compiler/x86/cell.lisp
@@ -504,7 +504,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (inst mov value (make-ea-for-raw-slot object index tmp 1))))
 
@@ -522,7 +522,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (inst mov (make-ea-for-raw-slot object index tmp 1) value)
     (move result value)))
@@ -540,8 +540,8 @@
   (:policy :fast-safe)
   (:args (object :scs (descriptor-reg))
          (index :scs (any-reg immediate))
-         (diff :scs (signed-reg) :target result))
-  (:arg-types * tagged-num signed-num)
+         (diff :scs (unsigned-reg) :target result))
+  (:arg-types * tagged-num unsigned-num)
   (:temporary (:sc unsigned-reg) tmp)
   (:results (result :scs (unsigned-reg)))
   (:result-types unsigned-num)
@@ -549,7 +549,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (inst xadd (make-ea-for-raw-slot object index tmp 1) diff :lock)
     (move result diff)))
@@ -566,7 +566,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (with-empty-tn@fp-top(value)
       (inst fld (make-ea-for-raw-slot object index tmp 1)))))
@@ -585,7 +585,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (unless (zerop (tn-offset value))
       (inst fxch value))
@@ -622,7 +622,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (with-empty-tn@fp-top(value)
       (inst fldd (make-ea-for-raw-slot object index tmp 2)))))
@@ -641,7 +641,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (unless (zerop (tn-offset value))
       (inst fxch value))
@@ -679,7 +679,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (let ((real-tn (complex-single-reg-real-tn value)))
       (with-empty-tn@fp-top (real-tn)
@@ -702,7 +702,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (let ((value-real (complex-single-reg-real-tn value))
           (result-real (complex-single-reg-real-tn result)))
@@ -758,7 +758,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (let ((real-tn (complex-double-reg-real-tn value)))
       (with-empty-tn@fp-top (real-tn)
@@ -781,7 +781,7 @@
     (loadw tmp object 0 instance-pointer-lowtag)
     (inst shr tmp n-widetag-bits)
     (when (sc-is index any-reg)
-      (inst shl tmp 2)
+      (inst shl tmp n-fixnum-tag-bits)
       (inst sub tmp index))
     (let ((value-real (complex-double-reg-real-tn value))
           (result-real (complex-double-reg-real-tn result)))