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

Modified Files:
	threading.lisp 
Log Message:
Started work on segment-descriptor-manager that will hand out segment
selectors to interested parties.

Date: Fri May  6 09:04:43 2005
Author: ffjeld

Index: movitz/losp/lib/threading.lisp
diff -u movitz/losp/lib/threading.lisp:1.3 movitz/losp/lib/threading.lisp:1.4
--- movitz/losp/lib/threading.lisp:1.3	Thu May  5 22:52:21 2005
+++ movitz/losp/lib/threading.lisp	Fri May  6 08:59:03 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.3 2005/05/05 20:52:21 ffjeld Exp $
+;;;; $Id: threading.lisp,v 1.4 2005/05/06 06:59:03 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -24,6 +24,27 @@
 	   ))
 
 (in-package muerte)
+
+(defclass segment-descriptor-manager ()
+  ((table
+    :accessor segment-descriptor-table
+    :initarg :table
+    :initform (dump-global-segment-table :entries 32))
+   (range-start
+    :initarg :range-start
+    :accessor range-start
+    :initform (1+ (ceiling (reduce #'max '(:cs :ds :es :ss :fs)
+				   :key #'segment-register)
+			   8)))))
+
+(defmethod allocate-segment-selector ((manager segment-descriptor-manager) &optional errorp)
+  (loop with table = (segment-descriptor-table manager)
+      for s from (range-start manager) below (/ (length table) 2)
+      do (when (zerop (ldb (byte 1 0) (segment-descriptor-avl-x-db-g table s)))
+	   (setf (ldb (byte 1 0) (segment-descriptor-avl-x-db-g table s)) 1)
+	   (return (* 8 s)))
+      finally (when errorp
+		(error "Unable to allocate a segment selector."))))
 
 (defclass thread (run-time-context)
   ((segment-selector