[movitz-cvs] CVS update: movitz/losp/ll-testing.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	ll-testing.lisp 
Log Message:
Added install-global-segment-table.

Date: Mon Apr 18 09:08:58 2005
Author: ffjeld

Index: movitz/losp/ll-testing.lisp
diff -u movitz/losp/ll-testing.lisp:1.2 movitz/losp/ll-testing.lisp:1.3
--- movitz/losp/ll-testing.lisp:1.2	Sat Apr 16 18:20:38 2005
+++ movitz/losp/ll-testing.lisp	Mon Apr 18 09:08:58 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Thu Apr 14 08:18:43 2005
 ;;;;                
-;;;; $Id: ll-testing.lisp,v 1.2 2005/04/16 16:20:38 ffjeld Exp $
+;;;; $Id: ll-testing.lisp,v 1.3 2005/04/18 07:08:58 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -18,7 +18,7 @@
 (in-package muerte)
 
 (defun dump-global-segment-table (&key table entries nofill)
-  "Dump contents of the global (segment) descriptor table into a vector."
+  "Dump contents of the current global (segment) descriptor table into a vector."
   (multiple-value-bind (gdt-base gdt-limit)
       (%sgdt)
     (let* ((gdt-entries (/ (1+ gdt-limit) 8))
@@ -34,6 +34,21 @@
 	      do (setf (aref table i)
 		   (memref gdt-base 0 :index i :type :unsigned-byte32 :physicalp t))))
 	table))))
+
+(defun install-global-segment-table (table &optional entries)
+  "Install <table> as the GDT.
+NB! ensure that the table object isn't garbage-collected."
+  (check-type table (vector (unsigned-byte 32)))
+  (let ((entries (or entries (truncate (length table) 2))))
+    (check-type entries (integer 0 *))
+    (let ((limit (1- (* 8 entries)))
+	  (base (+ 2 (+ (object-location table)
+			(memref nil (movitz-type-slot-offset 'movitz-run-time-context
+							     'physical-address-offset)
+				:type :lisp)))))
+      (%lgdt base limit)
+      (values table limit))))
+
 
 (defun format-segment-table (table &key (start 0) (end (truncate (length table) 2)))
   (loop for i from start below end