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

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

diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp
index 5a549f5..811b480 100644 (file)
--- a/src/compiler/x86/cell.lisp
+++ b/src/compiler/x86/cell.lisp
@@ -28,27 +28,7 @@
   (:ignore name)
   (:results)
   (:generator 1
-     (if (sc-is value immediate)
-        (let ((val (tn-value value)))
-           (etypecase val
-              (integer
-               (inst mov
-                     (make-ea :dword :base object
-                              :disp (- (* offset n-word-bytes) lowtag))
-                     (fixnumize val)))
-              (symbol
-               (inst mov
-                     (make-ea :dword :base object
-                              :disp (- (* offset n-word-bytes) lowtag))
-                     (+ nil-value (static-symbol-offset val))))
-              (character
-               (inst mov
-                     (make-ea :dword :base object
-                              :disp (- (* offset n-word-bytes) lowtag))
-                     (logior (ash (char-code val) n-widetag-bits)
-                             character-widetag)))))
-       ;; Else, value not immediate.
-       (storew value object offset lowtag))))
+     (storew (encode-value-if-immediate value) object offset lowtag)))
 \f
 
 
@@ -164,9 +144,8 @@
   (:generator 4
     (move result value)
     (inst lock)
-    (inst add (make-ea :dword :base object
-                       :disp (- (* symbol-value-slot n-word-bytes)
-                                other-pointer-lowtag))
+    (inst add (make-ea-for-object-slot object symbol-value-slot
+                                       other-pointer-lowtag)
           value)))
 
 #!+sb-thread
@@ -244,9 +223,8 @@
   (:generator 38
     (load-type type function (- fun-pointer-lowtag))
     (inst lea raw
-          (make-ea :byte :base function
-                   :disp (- (* simple-fun-code-offset n-word-bytes)
-                            fun-pointer-lowtag)))
+          (make-ea-for-object-slot function simple-fun-code-offset
+                                   fun-pointer-lowtag))
     (inst cmp type simple-fun-header-widetag)
     (inst jmp :e normal-fn)
     (inst lea raw (make-fixup "closure_tramp" :foreign))
@@ -437,38 +415,20 @@
     (loadw res struct 0 instance-pointer-lowtag)
     (inst shr res n-widetag-bits)))
 
-(define-full-reffer instance-index-ref * instance-slots-offset
-  instance-pointer-lowtag (any-reg descriptor-reg) * %instance-ref)
-
-(define-full-setter instance-index-set * instance-slots-offset
-  instance-pointer-lowtag (any-reg descriptor-reg) * %instance-set)
-
-
-(defknown %instance-set-conditional (instance index t t) t
-          (unsafe))
-
-(define-vop (instance-set-conditional)
-  (:translate %instance-set-conditional)
-  (:args (object :scs (descriptor-reg) :to :eval)
-         (slot :scs (any-reg) :to :result)
-         (old-value :scs (descriptor-reg any-reg) :target eax)
-         (new-value :scs (descriptor-reg any-reg)))
-  (:arg-types instance positive-fixnum * *)
-  (:temporary (:sc descriptor-reg :offset eax-offset
-                   :from (:argument 2) :to :result :target result)  eax)
-  (:results (result :scs (descriptor-reg any-reg)))
-  ;(:guard (backend-featurep :i486))
-  (:policy :fast-safe)
-  (:generator 5
-    (move eax old-value)
-    (inst lock)
-    (inst cmpxchg (make-ea :dword :base object :index slot :scale 1
-                           :disp (- (* instance-slots-offset n-word-bytes)
-                                    instance-pointer-lowtag))
-          new-value)
-    (move result eax)))
+(define-full-reffer instance-index-ref *
+  instance-slots-offset instance-pointer-lowtag
+  (any-reg descriptor-reg) *
+  %instance-ref)
 
+(define-full-setter instance-index-set *
+  instance-slots-offset instance-pointer-lowtag
+  (any-reg descriptor-reg) *
+  %instance-set)
 
+(define-full-compare-and-swap instance-compare-and-swap instance
+  instance-slots-offset instance-pointer-lowtag
+  (any-reg descriptor-reg) *
+  %instance-compare-and-swap)
 \f
 ;;;; code object frobbing
 
@@ -477,8 +437,6 @@
 
 (define-full-setter code-header-set * 0 other-pointer-lowtag
   (any-reg descriptor-reg) * code-header-set)
-
-
 \f
 ;;;; raw instance slot accessors