X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcell.lisp;h=9a6950d432626714fb979fbcd1dc15467512ada8;hb=b9915e9a838059473beb4fa03a6410eb8d6b68e3;hp=f14185c0b89456de3ef437ded43bc64b67a121f7;hpb=0d871fd7a98fc4af92a8b942a1154761466ad8c9;p=sbcl.git diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index f14185c..9a6950d 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -72,7 +72,8 @@ (inst or tls tls) (inst jmp :z global-val) (inst fs-segment-prefix) - (inst cmp (make-ea :dword :scale 1 :index tls) unbound-marker-widetag) + (inst cmp (make-ea :dword :scale 1 :index tls) + no-tls-value-marker-widetag) (inst jmp :z global-val) (inst fs-segment-prefix) (inst mov (make-ea :dword :scale 1 :index tls) value) @@ -107,14 +108,16 @@ (:vop-var vop) (:save-p :compute-only) (:generator 9 - (let* ((err-lab (generate-error-code vop unbound-symbol-error object)) + (let* ((check-unbound-label (gen-label)) + (err-lab (generate-error-code vop unbound-symbol-error object)) (ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) (inst mov value (make-ea :dword :index value :scale 1)) - (inst cmp value unbound-marker-widetag) - (inst jmp :ne ret-lab) + (inst cmp value no-tls-value-marker-widetag) + (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) + (emit-label check-unbound-label) (inst cmp value unbound-marker-widetag) (inst jmp :e err-lab) (emit-label ret-lab)))) @@ -133,7 +136,7 @@ (loadw value object symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) (inst mov value (make-ea :dword :index value :scale 1)) - (inst cmp value unbound-marker-widetag) + (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne ret-lab) (loadw value object symbol-value-slot other-pointer-lowtag) (emit-label ret-lab)))) @@ -186,24 +189,16 @@ (:info target not-p) (:temporary (:sc descriptor-reg #+nil(:from (:argument 0))) value) (:generator 9 - (if not-p - (let ((not-target (gen-label))) - (loadw value object symbol-value-slot other-pointer-lowtag) - (inst cmp value unbound-marker-widetag) - (inst jmp :ne not-target) - (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst cmp (make-ea :dword :index value :scale 1) unbound-marker-widetag) - (inst jmp :e target) - (emit-label not-target)) - (progn - (loadw value object symbol-value-slot other-pointer-lowtag) - (inst cmp value unbound-marker-widetag) - (inst jmp :ne target) - (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst cmp (make-ea :dword :index value :scale 1) unbound-marker-widetag) - (inst jmp :ne target))))) + (let ((check-unbound-label (gen-label))) + (loadw value object symbol-tls-index-slot other-pointer-lowtag) + (inst fs-segment-prefix) + (inst mov value (make-ea :dword :index value :scale 1)) + (inst cmp value no-tls-value-marker-widetag) + (inst jmp :ne check-unbound-label) + (loadw value object symbol-value-slot other-pointer-lowtag) + (emit-label check-unbound-label) + (inst cmp value unbound-marker-widetag) + (inst jmp (if not-p :e :ne) target)))) #!-sb-thread (define-vop (boundp) @@ -292,22 +287,40 @@ (define-vop (bind) (:args (val :scs (any-reg descriptor-reg)) (symbol :scs (descriptor-reg))) + (:temporary (:sc descriptor-reg :offset eax-offset) eax) (: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 4) ;XXX surely we can do this more - (store-symbol-value tls-index *free-tls-index*) ;succintly - (inst sub tls-index 4) - (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + + (pseudo-atomic + (emit-label get-tls-index-lock) + (inst mov temp 1) + (inst xor eax eax) + (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 4) ;XXX surely we can do this more + (store-symbol-value tls-index *free-tls-index*) ;succintly + (inst sub tls-index 4) + (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 fs-segment-prefix) (inst mov temp (make-ea :dword :scale 1 :index tls-index)) @@ -336,7 +349,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)) @@ -344,10 +357,10 @@ (inst fs-segment-prefix) (inst mov (make-ea :dword :scale 1 :index tls-index) value) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-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) @@ -357,6 +370,7 @@ (loadw symbol bsp (- binding-symbol-slot binding-size)) (loadw value bsp (- binding-value-slot binding-size)) (storew value symbol symbol-value-slot other-pointer-lowtag) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) (store-symbol-value bsp *binding-stack-pointer*))) @@ -366,7 +380,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) @@ -381,14 +395,14 @@ tls-index symbol symbol-tls-index-slot other-pointer-lowtag) #!+sb-thread (inst fs-segment-prefix) #!+sb-thread (inst mov (make-ea :dword :scale 1 :index tls-index) value) + (storew 0 bsp (- binding-value-slot binding-size)) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP (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))