- (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)
- (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 push (make-ea :dword :base tls-index) :fs)
- (popw bsp (- binding-value-slot binding-size))
- (storew symbol bsp (- binding-symbol-slot binding-size))
- (inst mov (make-ea :dword :base tls-index) val :fs))))
+ (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 test tls-index tls-index)
+ (inst jmp :ne tls-index-valid)
+ (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))
+ TLS-INDEX-VALID
+ ;; with-tls-ea on win32 causes tls-index to be an absolute address
+ ;; which is problematic when UNBIND uses with-tls-ea too.
+ #!+win32(move temp tls-index)
+ (with-tls-ea (EA :base tls-index :base-already-live-p t)
+ (inst push EA :maybe-fs)
+ (popw bsp (- binding-value-slot binding-size))
+ (storew #!-win32 tls-index
+ #!+win32 temp
+ bsp (- binding-symbol-slot binding-size))
+ (inst mov EA val :maybe-fs))))