X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fcell.lisp;h=929e74f002e36930ee03a35c5d2e325b19aef656;hb=085501b44cc1cbdd9e260139d30b383372ddd1b8;hp=6a3a89c5af440209e1461a018022c0c4a0f07661;hpb=862c0325616a991a5bd7b50d79f7176d2115493b;p=sbcl.git diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 6a3a89c..929e74f 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -83,16 +83,6 @@ (define-vop (set cell-set) (:variant symbol-value-slot other-pointer-lowtag)) -;;; Do a cell ref with an error check for being unbound. -;;; XXX stil used? I can't see where -dan -(define-vop (checked-cell-ref) - (:args (object :scs (descriptor-reg) :target obj-temp)) - (:results (value :scs (descriptor-reg any-reg))) - (:policy :fast-safe) - (:vop-var vop) - (:save-p :compute-only) - (:temporary (:sc descriptor-reg :from (:argument 0)) obj-temp)) - ;;; With Symbol-Value, we check that the value isn't the trap object. So ;;; Symbol-Value of NIL is NIL. #!+sb-thread @@ -203,10 +193,10 @@ (:args (object :scs (descriptor-reg))) (:conditional) (:info target not-p) - (:temporary (:sc descriptor-reg :from (:argument 0)) value) (:generator 9 - (loadw value object symbol-value-slot other-pointer-lowtag) - (inst cmp value unbound-marker-widetag) + (inst cmp (make-ea-for-object-slot object symbol-value-slot + other-pointer-lowtag) + unbound-marker-widetag) (inst jmp (if not-p :e :ne) target))) @@ -283,22 +273,40 @@ (define-vop (bind) (:args (val :scs (any-reg descriptor-reg)) (symbol :scs (descriptor-reg))) + (:temporary (:sc descriptor-reg :offset rax-offset) rax) (:temporary (:sc unsigned-reg) tls-index temp bsp) - (:generator 5 - (let ((tls-index-valid (gen-label))) - (load-tl-symbol-value bsp *binding-stack-pointer*) + (:generator 10 + (let ((tls-index-valid (gen-label)) + (get-tls-index-lock (gen-label)) + (release-tls-index-lock (gen-label))) + (load-binding-stack-pointer bsp) (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) (inst add bsp (* binding-size n-word-bytes)) - (store-tl-symbol-value bsp *binding-stack-pointer* temp) - + (store-binding-stack-pointer bsp) (inst or tls-index tls-index) (inst jmp :ne tls-index-valid) - ;; allocate a new tls-index - (load-symbol-value tls-index *free-tls-index*) - (inst add tls-index 8) ;XXX surely we can do this more - (store-symbol-value tls-index *free-tls-index*) ;succintly - (inst sub tls-index 8) - (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + + (pseudo-atomic + (emit-label get-tls-index-lock) + (inst mov temp 1) + (zeroize rax) + (inst lock) + (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) temp) + (inst jmp :ne get-tls-index-lock) + ;; now with the lock held, see if the symbol's tls index has + ;; been set in the meantime + (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + (inst or tls-index tls-index) + (inst jmp :ne release-tls-index-lock) + ;; allocate a new tls-index + (load-symbol-value tls-index *free-tls-index*) + (inst add tls-index 8) ;XXX surely we can do this more + (store-symbol-value tls-index *free-tls-index*) ;succintly + (inst sub tls-index 8) + (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + (emit-label release-tls-index-lock) + (store-symbol-value 0 *tls-index-lock*)) + (emit-label tls-index-valid) (inst mov temp (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)) @@ -327,7 +335,7 @@ ;; four temporaries? (:temporary (:sc unsigned-reg) symbol value bsp tls-index) (:generator 0 - (load-tl-symbol-value bsp *binding-stack-pointer*) + (load-binding-stack-pointer bsp) (loadw symbol bsp (- binding-symbol-slot binding-size)) (loadw value bsp (- binding-value-slot binding-size)) @@ -336,9 +344,9 @@ value) (storew 0 bsp (- binding-symbol-slot binding-size)) + (storew 0 bsp (- binding-value-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) - ;; we're done with value, so we can use it as a temp here - (store-tl-symbol-value bsp *binding-stack-pointer* value))) + (store-binding-stack-pointer bsp))) #!-sb-thread (define-vop (unbind) @@ -349,6 +357,7 @@ (loadw value bsp (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) (storew 0 bsp (- binding-symbol-slot binding-size)) + (storew 0 bsp (- binding-value-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-symbol-value bsp *binding-stack-pointer*))) @@ -357,7 +366,7 @@ (:args (where :scs (descriptor-reg any-reg))) (:temporary (:sc unsigned-reg) symbol value bsp #!+sb-thread tls-index) (:generator 0 - (load-tl-symbol-value bsp *binding-stack-pointer*) + (load-binding-stack-pointer bsp) (inst cmp where bsp) (inst jmp :e DONE) @@ -376,11 +385,11 @@ (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP + (storew 0 bsp (- binding-value-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (inst cmp where bsp) (inst jmp :ne LOOP) - ;; we're done with value, so can use it as a temporary - (store-tl-symbol-value bsp *binding-stack-pointer* value) + (store-binding-stack-pointer bsp) DONE)) @@ -400,9 +409,6 @@ funcallable-instance-info-offset fun-pointer-lowtag (descriptor-reg any-reg) * %funcallable-instance-info) -(define-vop (funcallable-instance-lexenv cell-ref) - (:variant funcallable-instance-lexenv-slot fun-pointer-lowtag)) - (define-vop (closure-ref slot-ref) (:variant closure-info-offset fun-pointer-lowtag)) @@ -429,18 +435,6 @@ (loadw res struct 0 instance-pointer-lowtag) (inst shr res n-widetag-bits))) -(define-vop (instance-ref slot-ref) - (:variant instance-slots-offset instance-pointer-lowtag) - (:policy :fast-safe) - (:translate %instance-ref) - (:arg-types instance (:constant index))) - -(define-vop (instance-set slot-set) - (:policy :fast-safe) - (:translate %instance-set) - (:variant instance-slots-offset instance-pointer-lowtag) - (:arg-types instance (:constant index) *)) - (define-full-reffer instance-index-ref * instance-slots-offset instance-pointer-lowtag (any-reg descriptor-reg) * %instance-ref)