X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcell.lisp;h=f844f871b6600e6d16bb44725b4c86a9491a4c22;hb=f1d7728ddfc59f6df04eaf622c6f3e6b07c739bc;hp=74c23e917854311b8bdb499376d4b3ce403c0abd;hpb=862c0325616a991a5bd7b50d79f7176d2115493b;p=sbcl.git diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp index 74c23e9..f844f87 100644 --- a/src/compiler/x86/cell.lisp +++ b/src/compiler/x86/cell.lisp @@ -72,11 +72,10 @@ (inst or tls tls) (inst jmp :z global-val) (inst fs-segment-prefix) - (inst cmp (make-ea :dword :scale 1 :index tls) - no-tls-value-marker-widetag) + (inst cmp (make-ea :dword :base 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) + (inst mov (make-ea :dword :base tls) value) (inst jmp done) (emit-label global-val) (storew value symbol symbol-value-slot other-pointer-lowtag) @@ -113,7 +112,7 @@ (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 mov value (make-ea :dword :base value)) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -135,7 +134,7 @@ (let ((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 mov value (make-ea :dword :base value)) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne ret-lab) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -192,7 +191,7 @@ (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 mov value (make-ea :dword :base value)) (inst cmp value no-tls-value-marker-widetag) (inst jmp :ne check-unbound-label) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -287,29 +286,47 @@ (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)) + (inst mov temp (make-ea :dword :base tls-index)) (storew temp bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls-index) val)))) + (inst mov (make-ea :dword :base tls-index) val)))) #!-sb-thread (define-vop (bind) @@ -331,18 +348,18 @@ ;; 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)) (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls-index) value) + (inst mov (make-ea :dword :base 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) @@ -352,6 +369,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*))) @@ -361,7 +379,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) @@ -375,15 +393,15 @@ #!+sb-thread (loadw 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) + #!+sb-thread (inst mov (make-ea :dword :base 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)) @@ -432,18 +450,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)