[Sbcl-commits] CVS: sbcl/src/compiler/x86 c-call.lisp,1.12.6.1,1.12.6.2 cell.lisp,1.10.4.2,1.10.4.3 macros.lisp,1.10.2.1,1.10.2.2

[Daniel B. <da...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/x86
In directory sc8-pr-cvs1:/tmp/cvs-serv11991/src/compiler/x86

Modified Files:
      Tag: dan_native_threads_branch
	c-call.lisp cell.lisp macros.lisp 
Log Message:
0.7.9.54.thread.6
	This is the #-continued-will-to-live experimental native
	threads branch, which in general is not expected to do anything
	useful.  Current status: runs through a couple of GCs then dies with
	apparently random memory corruption

	Change semantics of the symbol's tls-index slot, so that it does not
	to be treaded specially in garbage collection. It is now a fixnum
	whose value is the number of lispobjs from the start of thread-local
	storage.  (By happy coincidence, on a machine with 30-bit fixnums and
	32 bit lispobjs, interpreting this as a raw machine integer will give
	you a byte offset to the same place.  The per-machine backend puns
	this way to advantage)



Index: c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/c-call.lisp,v
retrieving revision 1.12.6.1
retrieving revision 1.12.6.2
diff -u -d -r1.12.6.1 -r1.12.6.2
--- c-call.lisp	2 Dec 2002 15:57:50 -0000	1.12.6.1
+++ c-call.lisp	2 Dec 2002 20:00:47 -0000	1.12.6.2
@@ -222,7 +222,7 @@
 				(ash symbol-tls-index-slot word-shift)
 				(- other-pointer-lowtag))))
 	(inst gs-segment-prefix)
-	(inst sub (make-ea :dword :scale 4 :index temp) delta)))
+	(inst sub (make-ea :dword :scale 1 :index temp) delta)))
     (load-tl-symbol-value result *alien-stack*)))
 
 (define-vop (dealloc-alien-stack-space)
@@ -238,4 +238,4 @@
 				(ash symbol-tls-index-slot word-shift)
 				(- other-pointer-lowtag))))
 	(inst gs-segment-prefix)
-	(inst add (make-ea :dword :scale 4 :index temp) delta)))))
+	(inst add (make-ea :dword :scale 1 :index temp) delta)))))

Index: cell.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/cell.lisp,v
retrieving revision 1.10.4.2
retrieving revision 1.10.4.3
diff -u -d -r1.10.4.2 -r1.10.4.3
--- cell.lisp	2 Dec 2002 15:57:50 -0000	1.10.4.2
+++ cell.lisp	2 Dec 2002 20:00:50 -0000	1.10.4.3
@@ -72,10 +72,10 @@
       (inst or tls tls)
       (inst jmp :z global-val)
       (inst gs-segment-prefix)
-      (inst cmp (make-ea :dword :scale 4 :index tls) unbound-marker-widetag)
+      (inst cmp (make-ea :dword :scale 1 :index tls) unbound-marker-widetag)
       (inst jmp :z global-val)
       (inst gs-segment-prefix)
-      (inst mov (make-ea :dword :scale 4 :index tls) value)
+      (inst mov (make-ea :dword :scale 1 :index tls) value)
       (inst jmp done)
       (emit-label global-val)
       (storew value symbol symbol-value-slot other-pointer-lowtag)
@@ -105,7 +105,7 @@
 	   (ret-lab (gen-label)))
       (loadw value object symbol-tls-index-slot other-pointer-lowtag)
       (inst gs-segment-prefix)
-      (inst mov value (make-ea :dword :index value :scale 4))
+      (inst mov value (make-ea :dword :index value :scale 1))
       (inst cmp value unbound-marker-widetag)
       (inst jmp :ne ret-lab)
       (loadw value object symbol-value-slot other-pointer-lowtag)
@@ -239,17 +239,17 @@
       (inst jmp :ne tls-index-valid)
       ;; allocate a new tls-index
       (load-symbol-value tls-index *free-tls-index*)
-      (inst add tls-index 1)		;XXX surely we can do this more
+      (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 1)
+      (inst sub tls-index 4)
       (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag)
       (emit-label tls-index-valid)
       (inst gs-segment-prefix) 
-      (inst mov temp (make-ea :dword :scale 4 :index tls-index))
+      (inst mov temp (make-ea :dword :scale 1 :index tls-index))
       (storew temp bsp (- binding-value-slot binding-size))
       (storew symbol bsp (- binding-symbol-slot binding-size))
       (inst gs-segment-prefix)
-      (inst mov (make-ea :dword :scale 4 :index tls-index) val))))
+      (inst mov (make-ea :dword :scale 1 :index tls-index) val))))
   
 (define-vop (unbind)
     ;; four temporaries?   
@@ -261,7 +261,7 @@
 
     (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)    
     (inst gs-segment-prefix)
-    (inst mov (make-ea :dword :scale 4 :index tls-index) value)
+    (inst mov (make-ea :dword :scale 1 :index tls-index) value)
 
     (storew 0 bsp (- binding-symbol-slot binding-size))
     (inst sub bsp (* binding-size n-word-bytes))
@@ -284,7 +284,7 @@
 
     (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag)    
     (inst gs-segment-prefix)
-    (inst mov (make-ea :dword :scale 4 :index tls-index) value)
+    (inst mov (make-ea :dword :scale 1 :index tls-index) value)
     (storew 0 bsp (- binding-symbol-slot binding-size))
 
     SKIP

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/macros.lisp,v
retrieving revision 1.10.2.1
retrieving revision 1.10.2.2
diff -u -d -r1.10.2.1 -r1.10.2.2
--- macros.lisp	2 Dec 2002 15:57:50 -0000	1.10.2.1
+++ macros.lisp	2 Dec 2002 20:00:51 -0000	1.10.2.2
@@ -93,7 +93,7 @@
 	       (ash symbol-tls-index-slot word-shift)
 	       (- other-pointer-lowtag))))
     (inst gs-segment-prefix)
-    (inst mov ,reg (make-ea :dword :scale 4 :index ,reg))))
+    (inst mov ,reg (make-ea :dword :scale 1 :index ,reg))))
 
 (defmacro store-tl-symbol-value (reg symbol temp)
   `(progn
@@ -104,7 +104,7 @@
 	       (ash symbol-tls-index-slot word-shift)
 	       (- other-pointer-lowtag))))
     (inst gs-segment-prefix)
-    (inst mov (make-ea :dword :scale 4 :index ,temp) ,reg)))
+    (inst mov (make-ea :dword :scale 1 :index ,temp) ,reg)))
 
 (defmacro load-type (target source &optional (offset 0))
   #!+sb-doc