0.9.4.5:

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

diff --git a/src/compiler/x86/cell.lisp b/src/compiler/x86/cell.lisp
index f14185c..74c23e9 100644 (file)
--- 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)