[movitz-cvs] CVS update: movitz/losp/ll-testing.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp
In directory common-lisp.net:/tmp/cvs-serv28126

Modified Files:
	ll-testing.lisp 
Log Message:
Make thread isn't really supposed to be here.

Date: Thu May  5 12:28:53 2005
Author: ffjeld

Index: movitz/losp/ll-testing.lisp
diff -u movitz/losp/ll-testing.lisp:1.6 movitz/losp/ll-testing.lisp:1.7
--- movitz/losp/ll-testing.lisp:1.6	Sat Apr 30 00:36:49 2005
+++ movitz/losp/ll-testing.lisp	Thu May  5 12:28:52 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Thu Apr 14 08:18:43 2005
 ;;;;                
-;;;; $Id: ll-testing.lisp,v 1.6 2005/04/29 22:36:49 ffjeld Exp $
+;;;; $Id: ll-testing.lisp,v 1.7 2005/05/05 10:28:52 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -139,34 +139,34 @@
 		   :esi function)))
   stack)
 
-(defun make-thread (&key (name (gensym "thread-")) (function #'invoke-debugger) (args '(nil)))
-  "Make a thread and initialize its stack to apply function to args."
-  (let* ((fs-index 8)			; a vacant spot in the global segment descriptor table..
-	 (fs (* 8 fs-index))
-	 (thread (muerte::clone-run-time-context :name name))
-	 (segment-descriptor-table (symbol-value 'muerte.init::*segment-descriptor-table*)))
-    (setf (segment-descriptor segment-descriptor-table fs-index)
-      (segment-descriptor segment-descriptor-table (truncate (segment-register :fs) 8)))
-    (setf (segment-descriptor-base-location segment-descriptor-table fs-index)
-      (+ (object-location thread) (muerte::location-physical-offset)))
-    (let ((cushion nil)
-	  (stack (control-stack-init-for-yield (make-array 4094 :element-type '(unsigned-byte 32))
-					       function args)))
-      (multiple-value-bind (ebp esp)
-	  (control-stack-fixate stack)
-	(setf (control-stack-fs stack) fs
-	      (control-stack-ebp stack) ebp
-	      (control-stack-esp stack) esp))
-      (setf (%run-time-context-slot 'dynamic-env thread) 0
-	    (%run-time-context-slot 'stack-vector thread) stack
-	    (%run-time-context-slot 'stack-top thread) (+ 2 (object-location stack)
-							  (length stack))
-	    (%run-time-context-slot 'stack-bottom thread) (+ (object-location stack) 2
-							     (or cushion
-								 (if (>= (length stack) 200)
-								     100
-								   0))))
-      (values thread))))
+;;;(defun make-thread (&key (name (gensym "thread-")) (function #'invoke-debugger) (args '(nil)))
+;;;  "Make a thread and initialize its stack to apply function to args."
+;;;  (let* ((fs-index 8)			; a vacant spot in the global segment descriptor table..
+;;;	 (fs (* 8 fs-index))
+;;;	 (thread (muerte::clone-run-time-context :name name))
+;;;	 (segment-descriptor-table (symbol-value 'muerte.init::*segment-descriptor-table*)))
+;;;    (setf (segment-descriptor segment-descriptor-table fs-index)
+;;;      (segment-descriptor segment-descriptor-table (truncate (segment-register :fs) 8)))
+;;;    (setf (segment-descriptor-base-location segment-descriptor-table fs-index)
+;;;      (+ (object-location thread) (muerte::location-physical-offset)))
+;;;    (let ((cushion nil)
+;;;	  (stack (control-stack-init-for-yield (make-array 4094 :element-type '(unsigned-byte 32))
+;;;					       function args)))
+;;;      (multiple-value-bind (ebp esp)
+;;;	  (control-stack-fixate stack)
+;;;	(setf (control-stack-fs stack) fs
+;;;	      (control-stack-ebp stack) ebp
+;;;	      (control-stack-esp stack) esp))
+;;;      (setf (%run-time-context-slot 'dynamic-env thread) 0
+;;;	    (%run-time-context-slot 'stack-vector thread) stack
+;;;	    (%run-time-context-slot 'stack-top thread) (+ 2 (object-location stack)
+;;;							  (length stack))
+;;;	    (%run-time-context-slot 'stack-bottom thread) (+ (object-location stack) 2
+;;;							     (or cushion
+;;;								 (if (>= (length stack) 200)
+;;;								     100
+;;;								   0))))
+;;;      (values thread))))
 
 (defun stack-bootstrapper (&rest ignore)
   (declare (ignore ignore))