[Sbcl-commits] CVS: sbcl/src/code debug-int.lisp,1.67.2.2,1.67.2.3 target-thread.lisp,1.1.2.1,1.1.2.2

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

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs1:/tmp/cvs-serv3399/src/code

Modified Files:
      Tag: dan_native_threads_branch
	debug-int.lisp target-thread.lisp 
Log Message:
0.7.9.54.thread.8
	(step :forward 1 :back 2) 
	This is the experimental native threads branch, which in general is
	not expected to do anything useful, and in this version does even less
	than last time (dies with gc invariant violated)

	Move the per-thread stuff around so that the %gs register now points
	to the base of the struct thread: now by choosing appropriate tls
	indices for certain symbols we can make them point at bits of the
	thread structure (e.g. stack pointers) that the debugger internals
	want to see

	New nth-interrupt-context vop, written in extraordinarily brittle manner

	Make each thread have its own allocation region so that (some) consing
	can happen without serialising around a global lock

	Remove all references to current_region_{free_pointer,end_addr}

	Disable inline allocation in the (allocation) macro, to avoid having
	to get at thread->alloc-region.start_addr from lisp and without a
	spare register to index off

	GC is blowing up, so turned on lots of useful checks to make it blow
	up sooner

	Changes to gencgc alloc_region creation so that it will not attempt to
	allocate space to regions if an alread-open region has reserved that
	space

	last_used_page didn't appear to be used for anything, so out it goes
	


Index: debug-int.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/debug-int.lisp,v
retrieving revision 1.67.2.2
retrieving revision 1.67.2.3
diff -u -d -r1.67.2.2 -r1.67.2.3
--- debug-int.lisp	2 Dec 2002 15:57:49 -0000	1.67.2.2
+++ debug-int.lisp	5 Dec 2002 01:38:54 -0000	1.67.2.3
@@ -527,8 +527,8 @@
 #!-sb-fluid (declaim (inline control-stack-pointer-valid-p))
 (defun control-stack-pointer-valid-p (x)
   (declare (type system-area-pointer x))
-  (let* ((control-stack-start (sb!vm::current-thread-control-stack-start))
-	 (control-stack-end (sb!vm::current-thread-control-stack-end)))
+  (let* ((control-stack-start (sb!di::current-thread-control-stack-start))
+	 (control-stack-end (sb!di::current-thread-control-stack-end)))
     #!-stack-grows-downward-not-upward
     (and (sap< x (current-sp))
 	 (sap<= control-stack-start
@@ -889,9 +889,9 @@
   (declare (type system-area-pointer frame-pointer))
   (/noshow0 "entering FIND-ESCAPED-FRAME")
   (dotimes (index *free-interrupt-context-index* (values nil 0 nil))
-    (let ((lisp-interrupt-contexts (sb!vm::current-thread-interrupt-contexts)))
+    (let ()
       (/noshow0 "at head of WITH-ALIEN")
-      (let ((context (sb!alien:deref lisp-interrupt-contexts index)))
+      (let ((context (nth-interrupt-context index)))
 	(/noshow0 "got CONTEXT")
 	(when (= (sap-int frame-pointer)
 		 (sb!vm:context-register context sb!vm::cfp-offset))

Index: target-thread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/Attic/target-thread.lisp,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -d -r1.1.2.1 -r1.1.2.2
--- target-thread.lisp	2 Dec 2002 15:57:49 -0000	1.1.2.1
+++ target-thread.lisp	5 Dec 2002 01:38:54 -0000	1.1.2.2
@@ -1,29 +1,10 @@
-(in-package "SB!VM")
-
-;;; XXX this depends on the layout of struct thread in rather brittle
-;;; ways.
-#|
-struct thread {
-    lispobj *control_stack_start;
-    lispobj *binding_stack_start;
-    lispobj *alien_stack_start;
-    lispobj *dynamic_values_start;
-    pid_t pid;
-    int tls_cookie;		/* on x86, the LDT index */
-    os_context_t *interrupt_contexts[MAX_INTERRUPTS];
-    struct thread *next;
-};
-|#
+(in-package "SB!DI")
 
-(defun current-thread-control-stack-start ()
-  (let ((thread (int-sap *current-thread-struct*)))
-    (sap-ref-sap thread 0)))
+(defun current-thread-control-stack-start () 
+  (int-sap *control-stack-start*))
 
 (defun current-thread-control-stack-end ()
-  (let ((thread (int-sap *current-thread-struct*)))
-    (sap+ (sap-ref-sap thread 4) -4)))
+  (sap+ (int-sap *binding-stack-start*) -4))
 
-(defun current-thread-interrupt-contexts ()
-  (let ((thread (int-sap *current-thread-struct*)))
-    (sb!alien:sap-alien (sap-ref-sap thread (* 6 4))
-			(array (* os-context-t) nil))))
+(defun nth-interrupt-context (n)
+  (sb!alien:sap-alien (nth-interrupt-context-sap n) (* os-context-t)))