[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 array.lisp, 1.10, 1.11 cell.lisp, 1.18, 1.19 macros.lisp, 1.19, 1.20

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv30418/src/compiler/x86-64

Modified Files:
	array.lisp cell.lisp macros.lisp 
Log Message:
1.0.5.6: compare-and-swap / instance-set-conditional refactoring

 * Rename *-COMPARE-AND-EXCHANGE *-COMPARE-AND-SWAP.

 * DEFINE-FULL-COMPARE-AND-SWAP, use it to implement
   %INSTANCE-COMPARE-AND-SWAP (previously %INTANCE-SET-CONDITIONAL) on x86oids.

 * Implement %SIMPLE-VECTOR-COMPARE-AND-SWAP. Not used right now, but required
   by a forthcoming patch.

 * Implement non-x86oid (non-threaded) versions of the above.

 * Check that the slot isn't raw in DEFINE-STRUCURE-SLOT-COMPARE-AND-SWAP.

 * Whitespace.


Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/array.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- array.lisp	16 Jul 2006 06:39:04 -0000	1.10
+++ array.lisp	29 Apr 2007 17:17:27 -0000	1.11
@@ -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)
 
 ;;;; integer vectors whose elements are smaller than a byte, i.e.,
 ;;;; bit, 2-bit, and 4-bit vectors

Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/cell.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- cell.lisp	11 Apr 2007 11:37:44 -0000	1.18
+++ cell.lisp	29 Apr 2007 17:17:27 -0000	1.19
@@ -441,32 +441,9 @@
 (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 rax)
-         (new-value :scs (descriptor-reg any-reg)))
-  (:arg-types instance positive-fixnum * *)
-  (:temporary (:sc descriptor-reg :offset rax-offset
-                   :from (:argument 2) :to :result :target result)  rax)
-  (:results (result :scs (descriptor-reg any-reg)))
-  ;(:guard (backend-featurep :i486))
-  (:policy :fast-safe)
-  (:generator 5
-    (move rax old-value)
-    (inst lock)
-    (inst cmpxchg (make-ea :qword :base object :index slot :scale 1
-                           :disp (- (* instance-slots-offset n-word-bytes)
-                                    instance-pointer-lowtag))
-          new-value)
-    (move result rax)))
-
-
+(define-full-compare-and-swap instance-compare-and-swap instance
+  instance-slots-offset instance-pointer-lowtag (any-reg descriptor-reg)
+  * %instance-compare-and-swap)
 
 ;;;; code object frobbing
 
@@ -475,8 +452,6 @@
 
 (define-full-setter code-header-set * 0 other-pointer-lowtag
   (any-reg descriptor-reg) * code-header-set)
-
-
 
 ;;;; raw instance slot accessors
 

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/macros.lisp,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- macros.lisp	3 Mar 2007 00:42:02 -0000	1.19
+++ macros.lisp	29 Apr 2007 17:17:27 -0000	1.20
@@ -354,6 +354,30 @@
 
 ;;;; indexed references
 
+(defmacro define-full-compare-and-swap
+    (name type offset lowtag scs el-type &optional translate)
+  `(progn
+     (define-vop (,name)
+         ,@(when translate `((:translate ,translate)))
+       (:policy :fast-safe)
+       (:args (object :scs (descriptor-reg) :to :eval)
+              (index :scs (any-reg) :to :result)
+              (old-value :scs ,scs :target rax)
+              (new-value :scs ,scs))
+       (:arg-types ,type tagged-num ,el-type ,el-type)
+       (:temporary (:sc descriptor-reg :offset rax-offset
+                        :from (:argument 2) :to :result :target value)  rax)
+       (:results (value :scs ,scs))
+       (:result-types ,el-type)
+       (:generator 5
+         (move rax old-value)
+         #!+sb-thread
+         (inst lock)
+         (inst cmpxchg (make-ea :qword :base object :index index
+                                :disp (- (* ,offset n-word-bytes) ,lowtag))
+               new-value)
+         (move value rax)))))
+
 (defmacro define-full-reffer (name type offset lowtag scs el-type &optional translate)
   `(progn
      (define-vop (,name)