[movitz-cvs] CVS update: movitz/losp/muerte/segments.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	segments.lisp 
Log Message:
Added segment-descriptor-xxx accessors.

Date: Wed Apr 13 08:43:14 2005
Author: ffjeld

Index: movitz/losp/muerte/segments.lisp
diff -u movitz/losp/muerte/segments.lisp:1.5 movitz/losp/muerte/segments.lisp:1.6
--- movitz/losp/muerte/segments.lisp:1.5	Fri Apr  8 08:17:28 2005
+++ movitz/losp/muerte/segments.lisp	Wed Apr 13 08:43:12 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Thu May  8 14:25:06 2003
 ;;;;                
-;;;; $Id: segments.lisp,v 1.5 2005/04/08 06:17:28 ffjeld Exp $
+;;;; $Id: segments.lisp,v 1.6 2005/04/13 06:43:12 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -50,7 +50,7 @@
       (:gs (set-sreg :gs))))
   value)
 
-(defun sgdt ()
+(defun %sgdt ()
   "Return the location of the GDT, and the limit.
 Error if the GDT location is not zero modulo 4."
   (eval-when (:compile-toplevel)
@@ -74,7 +74,7 @@
     (:movl 2 :ecx)
     (:stc)))
 
-(defun lgdt (base-location limit)
+(defun %lgdt (base-location limit)
   "Set the GDT according to base-location and limit.
 This is the setter corresponding to the sgdt getter."
   (eval-when (:compile-toplevel)
@@ -162,4 +162,67 @@
       (:cr4 (set-creg :cr4)))
     value))
     
-  
+(defun segment-descriptor-base (table index)
+  (check-type table (and vector (not simple-vector)))
+  (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))))
+    (logior (ash (memref table (+ 7 offset) :type :unsigned-byte8)
+		 24)
+	    (ash (memref table (+ 4 offset) :type :unsigned-byte16)
+		 16)
+	    (ash (memref table (+ 2 offset) :type :unsigned-byte16)
+		 0))))
+
+(defun (setf segment-descriptor-base) (base table index)
+  (check-type table (and vector (not simple-vector)))
+  (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))))
+    (setf (memref table (+ 7 offset) :type :unsigned-byte8)
+      (ldb (byte 8 24) base))
+    (setf (memref table (+ 4 offset) :type :unsigned-byte8)
+      (ldb (byte 8 16) base))
+    (setf (memref table (+ 2 offset) :type :unsigned-byte16)
+      (ldb (byte 16 0) base))
+    base))
+
+(defun segment-descriptor-limit (table index)
+  (check-type table (and vector (not simple-vector)))
+  (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))))
+    (dpb (memref table (+ 6 offset) :type :unsigned-byte8)
+	 (byte 4 16)
+	 (memref table (+ 0 offset) :type :unsigned-byte16))))
+
+(defun (setf segment-descriptor-limit) (limit table index)
+  (check-type table (and vector (not simple-vector)))
+  (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))))
+    (setf (memref table (+ 6 offset) :type :unsigned-byte8)
+      (ldb (byte 4 16) limit))
+    (setf (memref table (+ 0 offset) :type :unsigned-byte8)
+      (ldb (byte 16 0) limit))
+    limit))
+
+(defun segment-descriptor-type-s-dpl-p (table index)
+  "Access bits 40-47 of the segment descriptor."
+  (check-type table (and vector (not simple-vector)))
+  (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))
+	  :type :unsigned-byte8))
+
+(defun (setf segment-descriptor-type-s-dpl-p) (bits table index)
+  "Access bits 40-47 of the segment descriptor."
+  (check-type table (and vector (not simple-vector)))
+  (setf (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))
+		:type :unsigned-byte8)
+    bits))
+		   
+(defun segment-descriptor-avl-x-db-g (table index)
+  "Access bits 52-55 of the segment descriptor."
+  (check-type table (and vector (not simple-vector)))
+  (ldb (byte 4 4)
+       (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))
+	       :type :unsigned-byte8)))
+
+(defun (setf segment-descriptor-avl-x-db-g) (bits table index)
+  "Access bits 52-55 of the segment descriptor."
+  (check-type table (and vector (not simple-vector)))
+  (setf (ldb (byte 4 4)
+	     (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))
+		     :type :unsigned-byte8))
+    bits))