X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fppc%2Fcell.lisp;h=9e2712fc89583991ceead284e85af17b079f9e45;hb=7f1e94ae961a198e00daf281eb1dc858e5b2dcc7;hp=5cbe4a52cb46f045f82f972796a5dd848be1034e;hpb=5745b5a5b2e3b967bf3876b4306f31b3c78495fa;p=sbcl.git

diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp
index 5cbe4a5..9e2712f 100644
--- a/src/compiler/ppc/cell.lisp
+++ b/src/compiler/ppc/cell.lisp
@@ -31,6 +31,8 @@
   (: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))
@@ -287,7 +289,7 @@
 ;;; BIND -- Establish VAL as a binding for SYMBOL.  Save the old value and
 ;;; the symbol on the binding stack and stuff the new value into the
 ;;; symbol.
-
+;;; See the "Chapter 9: Specials" of the SBCL Internals Manual.
 #!+sb-thread
 (define-vop (bind)
   (:args (val :scs (any-reg descriptor-reg))
@@ -339,9 +341,9 @@
 
      TLS-VALID
      (inst lwzx temp thread-base-tn tls-index)
-     (inst addi bsp-tn bsp-tn (* 2 n-word-bytes))
+     (inst addi bsp-tn bsp-tn (* binding-size n-word-bytes))
      (storew temp bsp-tn (- binding-value-slot binding-size))
-     (storew symbol bsp-tn (- binding-symbol-slot binding-size))
+     (storew tls-index bsp-tn (- binding-symbol-slot binding-size))
      (inst stwx val thread-base-tn tls-index)))
 
 #!-sb-thread
@@ -351,7 +353,7 @@
   (:temporary (:scs (descriptor-reg)) temp)
   (:generator 5
     (loadw temp symbol symbol-value-slot other-pointer-lowtag)
-    (inst addi bsp-tn bsp-tn (* 2 n-word-bytes))
+    (inst addi bsp-tn bsp-tn (* binding-size n-word-bytes))
     (storew temp bsp-tn (- binding-value-slot binding-size))
     (storew symbol bsp-tn (- binding-symbol-slot binding-size))
     (storew val symbol symbol-value-slot other-pointer-lowtag)))
@@ -361,12 +363,11 @@
   (:temporary (:scs (descriptor-reg)) tls-index value)
   (:generator 0
     (loadw tls-index bsp-tn (- binding-symbol-slot binding-size))
-    (loadw tls-index tls-index symbol-tls-index-slot other-pointer-lowtag)
     (loadw value bsp-tn (- binding-value-slot binding-size))
     (inst stwx value thread-base-tn tls-index)
     (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
     (storew zero-tn bsp-tn (- binding-value-slot binding-size))
-    (inst subi bsp-tn bsp-tn (* 2 n-word-bytes))))
+    (inst subi bsp-tn bsp-tn (* binding-size n-word-bytes))))
 
 #!-sb-thread
 (define-vop (unbind)
@@ -377,7 +378,7 @@
     (storew value symbol symbol-value-slot other-pointer-lowtag)
     (storew zero-tn bsp-tn (- binding-symbol-slot binding-size))
     (storew zero-tn bsp-tn (- binding-value-slot binding-size))
-    (inst subi bsp-tn bsp-tn (* 2 n-word-bytes))))
+    (inst subi bsp-tn bsp-tn (* binding-size n-word-bytes))))
 
 
 (define-vop (unbind-to-here)
@@ -398,8 +399,6 @@
       (inst beq skip)
       (loadw value bsp-tn (- binding-value-slot binding-size))
       #!+sb-thread
-      (loadw symbol symbol symbol-tls-index-slot other-pointer-lowtag)
-      #!+sb-thread
       (inst stwx value thread-base-tn symbol)
       #!-sb-thread
       (storew value symbol symbol-value-slot other-pointer-lowtag)
@@ -407,7 +406,7 @@
 
       (emit-label skip)
       (storew zero-tn bsp-tn (- binding-value-slot binding-size))
-      (inst subi bsp-tn bsp-tn (* 2 n-word-bytes))
+      (inst subi bsp-tn bsp-tn (* binding-size n-word-bytes))
       (inst cmpw where bsp-tn)
       (inst bne loop)
 
@@ -435,6 +434,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.
 
@@ -508,6 +512,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)