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@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