[movitz-cvs] CVS update: movitz/storage-types.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	storage-types.lisp 
Log Message:
Changed the way the interrupt-descriptor-table is generated. Now, the
host/build-time value is a vector whose elements are names of
primitive-functions that act as interrupt trampolines. Each such
trampoline (ie. at present only muerte:default-interrupt-trampoline)
at position x in the table must define an (integer) assembly-level
label x, which will become the entry-point of that interrupt-gate.

Date: Tue Aug 10 06:25:21 2004
Author: ffjeld

Index: movitz/storage-types.lisp
diff -u movitz/storage-types.lisp:1.37 movitz/storage-types.lisp:1.38
--- movitz/storage-types.lisp:1.37	Sat Jul 31 16:34:57 2004
+++ movitz/storage-types.lisp	Tue Aug 10 06:25:21 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Sun Oct 22 00:22:43 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: storage-types.lisp,v 1.37 2004/07/31 23:34:57 ffjeld Exp $
+;;;; $Id: storage-types.lisp,v 1.38 2004/08/10 13:25:21 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -1112,33 +1112,25 @@
 		  type
 		  'segment-present)))
 
-(defconstant +idt-size+ 127)
-(defconstant +idt-irq-start+ 32)
-
-(defun make-initial-interrupt-descriptors ()
-  (make-array
-   +idt-size+
-   :initial-element nil))
-
-(defun map-idt-to-array (idt type)
-  (check-type idt movitz-basic-vector)
+(defun map-interrupt-trampolines-to-idt (trampolines type)
+  (check-type trampolines vector)
   (assert (eq type 'word))
-  (let ((byte-list
-	 (with-binary-output-to-list (bytes)
-	   (loop for descriptor across (movitz-vector-symbolic-data idt)
-	       as i upfrom 0
-	       if (not (eq *movitz-nil* descriptor))
-	       do (write-binary-record descriptor bytes)
-	       else
-	       do (write-binary-record
-		   (make-gate-descriptor ':interrupt
-					 (+ (slot-offset 'movitz-basic-vector 'data)
-					    (movitz-intern
-					     (find-primitive-function
-					      'muerte::default-interrupt-trampoline))
-					    (* 10 i))
-					 :segment-selector (* 3 8))
-		   bytes)))))
+  (let* ((byte-list
+	  (with-binary-output-to-list (bytes)
+	    (loop for trampoline across trampolines
+		as exception-vector upfrom 0
+		do (let* ((trampoline-address (movitz-intern (find-primitive-function trampoline)))
+			  (symtab (movitz-env-get trampoline :symtab))
+			  (trampoline-offset (cdr (assoc exception-vector symtab))))
+		     (assert symtab ()
+		       "No symtab for exception trampoline ~S." trampoline)
+		     (write-binary-record
+		      (make-gate-descriptor ':interrupt
+					    (+ (slot-offset 'movitz-basic-vector 'data)
+					       trampoline-address
+					       trampoline-offset)
+					    :segment-selector (* 3 8))
+		      bytes))))))
     (let ((l32 (merge-bytes byte-list 8 32)))
       (movitz-intern (make-movitz-vector (length l32)
 					 :element-type '(unsigned-byte 32)