From 988c0c0982e8ebb891da9241c71b5f8350448350 Mon Sep 17 00:00:00 2001
From: Alastair Bridgewater <lisphacker@users.sourceforge.net>
Date: Sun, 8 Aug 2010 01:13:06 +0000
Subject: [PATCH] 1.0.41.36: ppc: Implement atomic-{incf,decf} as atomic
 operations.

  * ATOMIC-INCF and ATOMIC-DECF require a VOP in order to serve as
actual atomic operations.  This VOP is also required to serve as a
memory barrier.  Implemented.
---
 package-data-list.lisp-expr       |    2 +-
 src/code/late-extensions.lisp     |    4 ++--
 src/compiler/generic/vm-fndb.lisp |    2 +-
 src/compiler/ppc/cell.lisp        |   32 ++++++++++++++++++++++++++++++++
 version.lisp-expr                 |    2 +-
 5 files changed, 37 insertions(+), 5 deletions(-)

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index fe2b4c4..7782f15 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1304,7 +1304,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries."
                "%RAW-SET-COMPLEX-DOUBLE" "%RAW-SET-COMPLEX-LONG"
                "%RAW-SET-COMPLEX-SINGLE" "%RAW-SET-DOUBLE"
                "%RAW-SET-LONG" "%RAW-SET-SINGLE" "%SCALB" "%SCALBN"
-               #!+(or x86 x86-64)
+               #!+(or x86 x86-64 ppc)
                "%RAW-INSTANCE-ATOMIC-INCF/WORD"
                "%RAW-INSTANCE-REF/WORD" "%RAW-INSTANCE-SET/WORD"
                "%RAW-INSTANCE-REF/SINGLE" "%RAW-INSTANCE-SET/SINGLE"
diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp
index 3c992d0..c4d59f4 100644
--- a/src/code/late-extensions.lisp
+++ b/src/code/late-extensions.lisp
@@ -189,7 +189,7 @@ EXPERIMENTAL: Interface subject to change."
               (when (dsd-read-only slotd)
                 (error "Cannot use ~S with structure accessor for a read-only slot: ~S"
                        name place))
-              #!+(or x86 x86-64)
+              #!+(or x86 x86-64 ppc)
               `(truly-the sb!vm:word
                           (%raw-instance-atomic-incf/word
                            (the ,structure ,@args) ,index
@@ -200,7 +200,7 @@ EXPERIMENTAL: Interface subject to change."
                                            (atomic-decf
                                             `(- (the sb!vm:signed-word ,diff)))))))
               ;; No threads outside x86 and x86-64 for now, so this is easy...
-              #!-(or x86 x86-64)
+              #!-(or x86 x86-64 ppc)
               (with-unique-names (structure old)
                 `(sb!sys:without-interrupts
                    (let* ((,structure ,@args)
diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp
index a759e56..8976ed2 100644
--- a/src/compiler/generic/vm-fndb.lisp
+++ b/src/compiler/generic/vm-fndb.lisp
@@ -165,7 +165,7 @@
   (complex double-float)
   (unsafe always-translatable))
 
-#!+(or x86 x86-64)
+#!+(or x86 x86-64 ppc)
 (defknown %raw-instance-atomic-incf/word (instance index sb!vm:word) sb!vm:word
     (unsafe always-translatable))
 
diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp
index 5cbe4a5..fda746e 100644
--- a/src/compiler/ppc/cell.lisp
+++ b/src/compiler/ppc/cell.lisp
@@ -508,6 +508,38 @@
   (:generator 4
     (inst stw value object (offset-for-raw-slot instance-length index 1))))
 
+(define-vop (raw-instance-atomic-incf/word)
+  (:translate %raw-instance-atomic-incf/word)
+  (:policy :fast-safe)
+  (:args (object :scs (descriptor-reg))
+         (index :scs (any-reg))
+         (diff :scs (unsigned-reg)))
+  (:arg-types * positive-fixnum unsigned-num)
+  (:temporary (:sc unsigned-reg) offset)
+  (:temporary (:sc non-descriptor-reg) sum)
+  (:results (result :scs (unsigned-reg) :from :load))
+  (:result-types unsigned-num)
+  (:generator 4
+    (loadw offset object 0 instance-pointer-lowtag)
+    ;; offset = (offset >> n-widetag-bits) << 2
+    (inst rlwinm offset offset (- 32 (- n-widetag-bits 2)) (- n-widetag-bits 2) 29)
+    (inst subf offset index offset)
+    (inst addi
+          offset
+          offset
+          (- (* (1- instance-slots-offset) n-word-bytes)
+             instance-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)))
+
 (define-vop (raw-instance-ref/word)
   (:translate %raw-instance-ref/word)
   (:policy :fast-safe)
diff --git a/version.lisp-expr b/version.lisp-expr
index 9db64af..21900b7 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.41.35"
+"1.0.41.36"
-- 
1.7.10.4