[Sbcl-commits] CVS: sbcl/src/compiler/x86-64 cell.lisp,1.7,1.8

[<me...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/x86-64
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv10596/src/compiler/x86-64

Modified Files:
	cell.lisp 
Log Message:
0.9.4.5:
  * in tls use the new widetag no-tls-value-market instead of
    unbound-marker when a symbol has no thread local value


Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/cell.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- cell.lisp	14 Jul 2005 19:13:49 -0000	1.7
+++ cell.lisp	26 Aug 2005 20:30:04 -0000	1.8
@@ -69,7 +69,7 @@
       (inst or tls tls)
       (inst jmp :z global-val)
       (inst cmp (make-ea :qword :base thread-base-tn :scale 1 :index tls)
-            unbound-marker-widetag)
+            no-tls-value-marker-widetag)
       (inst jmp :z global-val)
       (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls)
             value)
@@ -104,14 +104,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 mov value (make-ea :qword :base thread-base-tn
                                :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))))
@@ -130,7 +132,7 @@
       (loadw value object symbol-tls-index-slot other-pointer-lowtag)
       (inst mov value
             (make-ea :qword :base thread-base-tn :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))))
@@ -183,24 +185,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 cmp (make-ea :qword  :base thread-base-tn
-                             :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 cmp (make-ea :qword :base thread-base-tn :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 mov value
+            (make-ea :qword :base thread-base-tn :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)