[movitz-cvs] CVS update: movitz/losp/lib/threading.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	threading.lisp 
Log Message:
Use the thread's segment-selector rather than storing FS on the stack.

Date: Sun May  8 15:41:32 2005
Author: ffjeld

Index: movitz/losp/lib/threading.lisp
diff -u movitz/losp/lib/threading.lisp:1.5 movitz/losp/lib/threading.lisp:1.6
--- movitz/losp/lib/threading.lisp:1.5	Sun May  8 03:20:48 2005
+++ movitz/losp/lib/threading.lisp	Sun May  8 15:41:32 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Thu Apr 28 08:30:01 2005
 ;;;;                
-;;;; $Id: threading.lisp,v 1.5 2005/05/08 01:20:48 ffjeld Exp $
+;;;; $Id: threading.lisp,v 1.6 2005/05/08 13:41:32 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -56,6 +56,7 @@
 
 (defclass thread (run-time-context)
   ((segment-selector
+    :reader segment-selector
     :initarg :segment-selector))
   (:metaclass run-time-context-class))
 
@@ -65,9 +66,6 @@
 (defmacro control-stack-esp (stack)
   `(stack-frame-ref ,stack 0 1))
 
-(defmacro control-stack-fs (stack)
-  `(stack-frame-ref ,stack 0 2))
-
 (defmethod initialize-instance :after ((thread thread)
 				       &key (stack-size 2048) segment-selector stack-cushion
 					    (function #'invoke-debugger) (args '(nil))
@@ -90,8 +88,7 @@
 					       function args)))
       (multiple-value-bind (ebp esp)
 	  (control-stack-fixate stack)
-	(setf (control-stack-fs stack) segment-selector
-	      (control-stack-ebp stack) ebp
+	(setf (control-stack-ebp stack) ebp
 	      (control-stack-esp stack) esp))
       (setf (%run-time-context-slot thread 'muerte::dynamic-env) 0)
       (setf (%run-time-context-slot thread 'muerte::stack-vector) stack)
@@ -166,7 +163,7 @@
   (let ((my-stack (%run-time-context-slot nil 'muerte::stack-vector))
 	(target-stack (%run-time-context-slot target-rtc 'muerte::stack-vector)))
     (assert (not (eq my-stack target-stack)))
-    (let ((fs (control-stack-fs target-stack))
+    (let ((fs (segment-selector target-rtc))
 	  (esp (control-stack-esp target-stack))
 	  (ebp (control-stack-ebp target-stack)))
       (assert (location-in-object-p target-stack esp))
@@ -180,8 +177,7 @@
       (setf (%run-time-context-slot target-rtc 'muerte::scratch1) ebp
 	    (%run-time-context-slot target-rtc 'muerte::scratch2) esp)
       ;; Enable someone to yield back here..
-      (setf (control-stack-fs my-stack) (segment-register :fs)
-	    (control-stack-ebp my-stack) (muerte::asm-register :ebp)
+      (setf (control-stack-ebp my-stack) (muerte::asm-register :ebp)
 	    (control-stack-esp my-stack) (muerte::asm-register :esp))
       (with-inline-assembly (:returns :eax)
 	(:load-lexical (:lexical-binding fs) :untagged-fixnum-ecx)