X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Farray.lisp;h=65f7aeca8fe65935cd94bb7620e6a318f4a88d79;hb=9304704f68a18894fa8eb985b387465e5d25e1d5;hp=37cf6ea16841d7d352af936b3253c7301b6e3781;hpb=5745b5a5b2e3b967bf3876b4306f31b3c78495fa;p=sbcl.git

diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp
index 37cf6ea..65f7aec 100644
--- a/src/compiler/ppc/array.lisp
+++ b/src/compiler/ppc/array.lisp
@@ -133,9 +133,9 @@
   (def-data-vector-frobs simple-array-unsigned-byte-32 word-index
     unsigned-num unsigned-reg)
 
-  (def-data-vector-frobs simple-array-unsigned-byte-29 word-index
+  (def-data-vector-frobs simple-array-unsigned-fixnum word-index
     positive-fixnum any-reg)
-  (def-data-vector-frobs simple-array-signed-byte-30 word-index
+  (def-data-vector-frobs simple-array-fixnum word-index
     tagged-num any-reg)
   (def-data-vector-frobs simple-array-signed-byte-32 word-index
     signed-num signed-reg))
@@ -558,4 +558,31 @@
          (value :scs (signed-reg)))
   (:results (result :scs (signed-reg)))
   (:result-types tagged-num))
+
+;;;; ATOMIC-INCF for arrays
 
+(define-vop (array-atomic-incf/word)
+  (:translate %array-atomic-incf/word)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg))
+         (index :scs (any-reg) :target offset)
+         (diff :scs (unsigned-reg)))
+  (:arg-types * positive-fixnum unsigned-num)
+  (:results (result :scs (unsigned-reg) :from :load))
+  (:result-types unsigned-num)
+  (:temporary (:sc unsigned-reg :from (:argument 1)) offset)
+  (:temporary (:sc non-descriptor-reg) sum)
+  (:generator 4
+    (inst addi offset index
+          (- (* vector-data-offset n-word-bytes)
+             other-pointer-lowtag))
+    ;; load the slot value, add DIFF, write the sum back, and return
+    ;; the original slot value, atomically, and include a memory
+    ;; barrier.
+    (inst sync)
+    LOOP
+    (inst lwarx result offset object)
+    (inst add sum result diff)
+    (inst stwcx. sum offset object)
+    (inst bne LOOP)
+    (inst isync)))