X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcell.lisp;h=241d434d012eddabd09ab28302e296c4dfdf71d4;hb=a6b91f356da1b5ae2987f79db9bd137970512959;hp=d8e5a3461f07dc8fc2d7656b05900ea6dcdb4996;hpb=bfb19d306581ac86feb4371846c4b9953d692dd8;p=sbcl.git diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index d8e5a34..241d434 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -66,13 +66,13 @@ ;; This code has to pathological cases: NO-TLS-VALUE-MARKER ;; or UNBOUND-MARKER as NEW: in either case we would end up ;; doing possible damage with CMPXCHG -- so don't do that! - (let ((unbound (generate-error-code vop unbound-symbol-error symbol)) + (let ((unbound (generate-error-code vop 'unbound-symbol-error symbol)) (check (gen-label))) (move eax old) #!+sb-thread (progn (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) - ;; Thread-local area, not LOCK needed. + ;; Thread-local area, no LOCK needed. (inst fs-segment-prefix) (inst cmpxchg (make-ea :dword :base tls) new) (inst cmp eax no-tls-value-marker-widetag) @@ -103,8 +103,6 @@ (let ((global-val (gen-label)) (done (gen-label))) (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) - (inst or tls tls) - (inst jmp :z global-val) (inst fs-segment-prefix) (inst cmp (make-ea :dword :base tls) no-tls-value-marker-widetag) (inst jmp :z global-val) @@ -132,7 +130,7 @@ (:save-p :compute-only) (:generator 9 (let* ((check-unbound-label (gen-label)) - (err-lab (generate-error-code vop unbound-symbol-error object)) + (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) @@ -173,7 +171,7 @@ (:vop-var vop) (:save-p :compute-only) (:generator 9 - (let ((err-lab (generate-error-code vop unbound-symbol-error object))) + (let ((err-lab (generate-error-code vop 'unbound-symbol-error object))) (loadw value object symbol-value-slot other-pointer-lowtag) (inst cmp value unbound-marker-widetag) (inst jmp :e err-lab)))) @@ -263,7 +261,7 @@ (:generator 10 (loadw value object fdefn-fun-slot other-pointer-lowtag) (inst cmp value nil-value) - (let ((err-lab (generate-error-code vop undefined-fun-error object))) + (let ((err-lab (generate-error-code vop 'undefined-fun-error object))) (inst jmp :e err-lab)))) (define-vop (set-fdefn-fun) @@ -304,48 +302,38 @@ ;;; the symbol on the binding stack and stuff the new value into the ;;; symbol. +;;; FIXME: Split into DYNBIND and BIND: DYNBIND needs to ensure +;;; TLS-INDEX, whereas BIND should assume it is already in place. Make +;;; LET &co compile into BIND, and PROGV into DYNBIND, plus ensure +;;; TLS-INDEX at compile-time, and make loader and dumper preserve +;;; the existence of a TLS-INDEX. #!+sb-thread (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) + (:temporary (:sc unsigned-reg) tls-index bsp) (:generator 10 - (let ((tls-index-valid (gen-label)) - (get-tls-index-lock (gen-label)) - (release-tls-index-lock (gen-label))) + (let ((tls-index-valid (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-binding-stack-pointer bsp) (inst or tls-index tls-index) (inst jmp :ne tls-index-valid) - - (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*)) - + (inst mov tls-index symbol) + (inst call (make-fixup + (ecase (tn-offset tls-index) + (#.eax-offset 'alloc-tls-index-in-eax) + (#.ebx-offset 'alloc-tls-index-in-ebx) + (#.ecx-offset 'alloc-tls-index-in-ecx) + (#.edx-offset 'alloc-tls-index-in-edx) + (#.edi-offset 'alloc-tls-index-in-edi) + (#.esi-offset 'alloc-tls-index-in-esi)) + :assembly-routine)) (emit-label tls-index-valid) (inst fs-segment-prefix) - (inst mov temp (make-ea :dword :base tls-index)) - (storew temp bsp (- binding-value-slot binding-size)) + (inst push (make-ea :dword :base tls-index)) + (popw bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) (inst fs-segment-prefix) (inst mov (make-ea :dword :base tls-index) val)))) @@ -364,20 +352,19 @@ (storew symbol bsp (- binding-symbol-slot binding-size)) (storew val symbol symbol-value-slot other-pointer-lowtag))) - #!+sb-thread (define-vop (unbind) - ;; four temporaries? - (:temporary (:sc unsigned-reg) symbol value bsp tls-index) + (:temporary (:sc unsigned-reg) temp bsp tls-index) (:generator 0 (load-binding-stack-pointer bsp) - (loadw symbol bsp (- binding-symbol-slot binding-size)) - (loadw value bsp (- binding-value-slot binding-size)) - - (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + ;; Load SYMBOL from stack, and get the TLS-INDEX. + (loadw temp bsp (- binding-symbol-slot binding-size)) + (loadw tls-index temp symbol-tls-index-slot other-pointer-lowtag) + ;; Load VALUE from stack, then restore it to the TLS area. + (loadw temp bsp (- binding-value-slot binding-size)) (inst fs-segment-prefix) - (inst mov (make-ea :dword :base tls-index) value) - + (inst mov (make-ea :dword :base tls-index) temp) + ;; Zero out the stack. (storew 0 bsp (- binding-symbol-slot binding-size)) (storew 0 bsp (- binding-value-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes))