X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fcell.lisp;h=2da18ed568221a969f3607ade8d9a7e1d7162752;hb=9304704f68a18894fa8eb985b387465e5d25e1d5;hp=491941cbdc3d4cb972de3e4cafee9c245983c3ac;hpb=43a3cc06f2671f6a3e75ae22c17f369e6306b6bb;p=sbcl.git

diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp
index 491941c..2da18ed 100644
--- a/src/compiler/ppc/cell.lisp
+++ b/src/compiler/ppc/cell.lisp
@@ -31,9 +31,71 @@
   (:generator 1
     (storew value object offset lowtag)))
 
+(define-vop (init-slot set-slot))
+
+#!+compare-and-swap-vops
+(define-vop (compare-and-swap-slot)
+  (:args (object :scs (descriptor-reg))
+         (old :scs (descriptor-reg any-reg))
+         (new :scs (descriptor-reg any-reg)))
+  (:temporary (:sc non-descriptor-reg) temp)
+  (:info name offset lowtag)
+  (:ignore name)
+  (:results (result :scs (descriptor-reg) :from :load))
+  (:generator 5
+    (inst sync)
+    (inst li temp (- (* offset n-word-bytes) lowtag))
+    LOOP
+    (inst lwarx result temp object)
+    (inst cmpw result old)
+    (inst bne EXIT)
+    (inst stwcx. new temp object)
+    (inst bne LOOP)
+    EXIT
+    (inst isync)))
+
 
 ;;;; Symbol hacking VOPs:
 
+#!+compare-and-swap-vops
+(define-vop (%compare-and-swap-symbol-value)
+  (:translate %compare-and-swap-symbol-value)
+  (:args (symbol :scs (descriptor-reg))
+         (old :scs (descriptor-reg any-reg))
+         (new :scs (descriptor-reg any-reg)))
+  (:temporary (:sc non-descriptor-reg) temp)
+  (:results (result :scs (descriptor-reg any-reg) :from :load))
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 15
+    (inst sync)
+    #!+sb-thread
+    (assemble ()
+      (loadw temp symbol symbol-tls-index-slot other-pointer-lowtag)
+      ;; Thread-local area, no synchronization needed.
+      (inst lwzx result thread-base-tn temp)
+      (inst cmpw result old)
+      (inst bne DONT-STORE-TLS)
+      (inst stwx new thread-base-tn temp)
+      DONT-STORE-TLS
+
+      (inst cmpwi result no-tls-value-marker-widetag)
+      (inst bne CHECK-UNBOUND))
+
+    (inst li temp (- (* symbol-value-slot n-word-bytes)
+                     other-pointer-lowtag))
+    LOOP
+    (inst lwarx result symbol temp)
+    (inst cmpw result old)
+    (inst bne CHECK-UNBOUND)
+    (inst stwcx. new symbol temp)
+    (inst bne LOOP)
+
+    CHECK-UNBOUND
+    (inst isync)
+    (inst cmpwi result unbound-marker-widetag)
+    (inst beq (generate-error-code vop 'unbound-symbol-error symbol))))
+
 ;;; The compiler likes to be able to directly SET symbols.
 (define-vop (%set-symbol-global-value cell-set)
   (:variant symbol-value-slot other-pointer-lowtag))
@@ -375,6 +437,11 @@
 (define-vop (closure-init slot-set)
   (:variant closure-info-offset fun-pointer-lowtag))
 
+(define-vop (closure-init-from-fp)
+  (:args (object :scs (descriptor-reg)))
+  (:info offset)
+  (:generator 4
+    (storew cfp-tn object (+ closure-info-offset offset) fun-pointer-lowtag)))
 
 ;;;; Value Cell hackery.
 
@@ -411,7 +478,12 @@
   (:variant instance-slots-offset instance-pointer-lowtag)
   (:arg-types instance positive-fixnum *))
 
-
+#!+compare-and-swap-vops
+(define-vop (%compare-and-swap-instance-ref word-index-cas)
+  (:policy :fast-safe)
+  (:translate %compare-and-swap-instance-ref)
+  (:variant instance-slots-offset instance-pointer-lowtag)
+  (:arg-types instance tagged-num * *))
 
 
 ;;;; Code object frobbing.
@@ -443,6 +515,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)