[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-serv30718

Modified Files:
	threading.lisp 
Log Message:
I was a bit too quick about using the segment-selector accessor rather
than the control-stack-fs operator, since the basic RTC object doesn't
have a segment-selector slot. I'll have to come up with a better
protocol for this stuff, in general.

Date: Mon May  9 00:05:13 2005
Author: ffjeld

Index: movitz/losp/lib/threading.lisp
diff -u movitz/losp/lib/threading.lisp:1.6 movitz/losp/lib/threading.lisp:1.7
--- movitz/losp/lib/threading.lisp:1.6	Sun May  8 15:41:32 2005
+++ movitz/losp/lib/threading.lisp	Mon May  9 00:05:13 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.6 2005/05/08 13:41:32 ffjeld Exp $
+;;;; $Id: threading.lisp,v 1.7 2005/05/08 22:05:13 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -66,6 +66,9 @@
 (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))
@@ -88,7 +91,8 @@
 					       function args)))
       (multiple-value-bind (ebp esp)
 	  (control-stack-fixate stack)
-	(setf (control-stack-ebp stack) ebp
+	(setf (control-stack-fs stack) segment-selector
+	      (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)
@@ -163,7 +167,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 (segment-selector target-rtc))
+    (let ((fs (control-stack-fs target-stack))
 	  (esp (control-stack-esp target-stack))
 	  (ebp (control-stack-ebp target-stack)))
       (assert (location-in-object-p target-stack esp))
@@ -177,7 +181,8 @@
       (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-ebp my-stack) (muerte::asm-register :ebp)
+      (setf (control-stack-fs my-stack) (segment-register :fs)
+	    (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)
@@ -187,3 +192,4 @@
 	(:locally (:movl (:edi (:edi-offset scratch1)) :ebp))
 	(:locally (:movl (:edi (:edi-offset scratch2)) :esp))
 	(:popfl)))))
+