1.0.7.21: threaded SET & BIND VOP touchups

[sbcl.git] / src / compiler / x86 / cell.lisp

diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp
index d8e5a34..de45ddf 100644 (file)
--- a/src/compiler/x86/cell.lisp
+++ b/src/compiler/x86/cell.lisp
@@ -72,7 +72,7 @@
       #!+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)
@@ -309,7 +307,7 @@
   (: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))
@@ -321,12 +319,17 @@
       (inst or tls-index tls-index)
       (inst jmp :ne tls-index-valid)
 
+      ;; FIXME:
+      ;; * We should ensure the existence of TLS index for LET-bound specials
+      ;;   at compile/load time, and use write a FAST-BIND for use with those.
+      ;; * PROGV will need to do this, but even there this should not be inline.
+      ;;   This is probably best moved to C, since dynbind.c also needs to do this.
       (pseudo-atomic
        (emit-label get-tls-index-lock)
-       (inst mov temp 1)
+       (inst mov tls-index 1)
        (inst xor eax eax)
        (inst lock)
-       (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) temp)
+       (inst cmpxchg (make-ea-for-symbol-value *tls-index-lock*) tls-index)
        (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
@@ -335,17 +338,15 @@
        (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)
+       (inst add (make-ea-for-symbol-value *free-tls-index*) 4) ; fixnum + 1
        (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 :base tls-index))
-      (storew temp bsp (- binding-value-slot binding-size))
+      (inst mov eax (make-ea :dword :base tls-index))
+      (storew eax 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))))