X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fcell.lisp;h=9e2712fc89583991ceead284e85af17b079f9e45;hb=debae3c18d31b5222be4d5de8dcb2601336e24a4;hp=491941cbdc3d4cb972de3e4cafee9c245983c3ac;hpb=43a3cc06f2671f6a3e75ae22c17f369e6306b6bb;p=sbcl.git diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp index 491941c..9e2712f 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)) @@ -227,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)) @@ -279,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 @@ -291,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))) @@ -301,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) @@ -317,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) @@ -338,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) @@ -347,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) @@ -375,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. @@ -411,7 +475,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 +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)