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)
|