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

Frode Vatvedt Fjeld ffjeld at common-lisp.net
Thu May 5 20:52:25 UTC 2005


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

Modified Files:
	threading.lisp 
Log Message:
Changed order of arguments for %run-time-context-slot, new signature
is (context slot-name), where nil may be used as a designator for
(current-run-time-context).

Date: Thu May  5 22:52:21 2005
Author: ffjeld

Index: movitz/losp/lib/threading.lisp
diff -u movitz/losp/lib/threading.lisp:1.2 movitz/losp/lib/threading.lisp:1.3
--- movitz/losp/lib/threading.lisp:1.2	Thu May  5 17:21:59 2005
+++ movitz/losp/lib/threading.lisp	Thu May  5 22:52:21 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.2 2005/05/05 15:21:59 ffjeld Exp $
+;;;; $Id: threading.lisp,v 1.3 2005/05/05 20:52:21 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -26,7 +26,8 @@
 (in-package muerte)
 
 (defclass thread (run-time-context)
-  ()
+  ((segment-selector
+    :initform :segment-selector))
   (:metaclass run-time-context-class))
 
 (defmacro control-stack-ebp (stack)
@@ -109,11 +110,11 @@
 	(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)
+      (setf (%run-time-context-slot thread 'dynamic-env) 0
+	    (%run-time-context-slot thread 'stack-vector) stack
+	    (%run-time-context-slot thread 'stack-top) (+ 2 (object-location stack)
 							  (length stack))
-	    (%run-time-context-slot 'stack-bottom thread) (+ (object-location stack) 2
+	    (%run-time-context-slot thread 'stack-bottom) (+ (object-location stack) 2
 							     (or cushion
 								 (if (>= (length stack) 200)
 								     100
@@ -123,8 +124,8 @@
 (defun yield (target-rtc &optional value)
   (declare (dynamic-extent values))
   (assert (not (eq target-rtc (current-run-time-context))))
-  (let ((my-stack (%run-time-context-slot 'stack-vector))
-	(target-stack (%run-time-context-slot 'stack-vector target-rtc)))
+  (let ((my-stack (%run-time-context-slot nil 'stack-vector))
+	(target-stack (%run-time-context-slot target-rtc 'stack-vector)))
     (assert (not (eq my-stack target-stack)))
     (let ((fs (control-stack-fs target-stack))
 	  (esp (control-stack-esp target-stack))
@@ -137,8 +138,8 @@
       ;; Push eflags for later..
       (setf (memref (decf esp) 0) (eflags))
       ;; Store EBP and ESP so we can get to them after the switch
-      (setf (%run-time-context-slot 'scratch1 target-rtc) ebp
-	    (%run-time-context-slot 'scratch2 target-rtc) esp)
+      (setf (%run-time-context-slot target-rtc 'scratch1) ebp
+	    (%run-time-context-slot target-rtc '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)




More information about the Movitz-cvs mailing list