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

Modified Files:
	segments.lisp 
Log Message:
Added accessor segment-descriptor.
Fixed bug in accessor segment-descriptor-avl-x-db-g: use the correct
offset.

Date: Mon Apr 18 09:07:45 2005
Author: ffjeld

Index: movitz/losp/muerte/segments.lisp
diff -u movitz/losp/muerte/segments.lisp:1.10 movitz/losp/muerte/segments.lisp:1.11
--- movitz/losp/muerte/segments.lisp:1.10	Fri Apr 15 09:04:10 2005
+++ movitz/losp/muerte/segments.lisp	Mon Apr 18 09:07:45 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.10 2005/04/15 07:04:10 ffjeld Exp $
+;;;; $Id: segments.lisp,v 1.11 2005/04/18 07:07:45 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -215,13 +215,33 @@
   "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))
+       (memref table (+ 6 (* 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))
+	     (memref table (+ 6 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))
 		     :type :unsigned-byte8))
     bits))
+
+(defun segment-descriptor (table index)
+  "Access entire segment descriptor as a 64-bit integer."
+  (check-type table (and vector (not simple-vector)))
+  (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))))
+    (logior (ash (memref table offset :index 1 :type :unsigned-byte32)
+		 32)
+	    (ash (memref table offset :index 0 :type :unsigned-byte32)
+		 0))))
+
+(defun (setf segment-descriptor) (value table index)
+  "Access entire segment descriptor as a 64-bit integer."
+  (check-type table (and vector (not simple-vector)))
+  (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data))))
+    (setf (memref table offset :index 1 :type :unsigned-byte32)
+      (ldb (byte 32 32) value))
+    (setf (memref table offset :index 0 :type :unsigned-byte32)
+      (ldb (byte 32 0) value))
+    value))
+