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@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))))) +