[movitz-cvs] CVS update: movitz/image.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	image.lisp 
Log Message:
Cleaned up the unbound-value protocol a bit.

Date: Sat Apr 30 23:15:36 2005
Author: ffjeld

Index: movitz/image.lisp
diff -u movitz/image.lisp:1.91 movitz/image.lisp:1.92
--- movitz/image.lisp:1.91	Sat Apr 30 00:36:01 2005
+++ movitz/image.lisp	Sat Apr 30 23:15:35 2005
@@ -9,7 +9,7 @@
 ;;;; Created at:    Sun Oct 22 00:22:43 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: image.lisp,v 1.91 2005/04/29 22:36:01 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.92 2005/04/30 21:15:35 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -27,6 +27,19 @@
     :initform :bootup
     :map-binary-write 'movitz-read-and-intern
     :map-binary-read-delayed 'movitz-word)
+   (class
+    :binary-type word
+    :map-binary-write 'movitz-intern
+    :map-binary-read-delayed 'movitz-word
+    :initarg :class
+    :accessor run-time-context-class)
+   (slots
+    :binary-type word
+    :map-binary-write 'movitz-read-and-intern
+    :map-binary-read-delayed 'movitz-word
+    :initarg :slots
+    :initform #()
+    :accessor run-time-context-slots)
    (fast-car
     :binary-type code-vector-word
     :initform nil
@@ -150,10 +163,10 @@
     :reader movitz-run-time-context-null-symbol
     :initarg :null-symbol)
    (new-unbound-value
-    :binary-type lu32
-;;;    :map-binary-read-delayed 'movitz-word
-;;;    :map-binary-write 'movitz-read-and-intern
-    :initform #x7fffffff)
+    :binary-type word
+    :map-binary-read-delayed 'movitz-word
+    :map-binary-write 'movitz-read-and-intern
+    :initform 'unbound)
    ;; primitive functions global constants
    (pop-current-values
     :binary-type code-vector-word
@@ -598,8 +611,8 @@
 
 (defun unbound-value ()
   (declare (special *image*))
-  (slot-value (image-run-time-context *image*)
-	      'new-unbound-value))
+  (movitz-read (slot-value (image-run-time-context *image*)
+			   'new-unbound-value)))
 
 (defun edi-offset ()
   (declare (special *image*))
@@ -861,6 +874,9 @@
       (movitz-read (make-array 256 :initial-element handler))))
   (setf (movitz-symbol-value (movitz-read 'muerte::*setf-namespace*))
     (movitz-read (movitz-environment-setf-function-names *movitz-global-environment*) t))
+  (setf (run-time-context-class (image-run-time-context *image*))
+    (muerte::movitz-find-class 'muerte::run-time-context))
+  (setf (run-time-context-slots (image-run-time-context *image*)) #(1 2 3))
   (let ((load-address (image-start-address *image*)))
     (setf (image-cons-pointer *image*) (- load-address
 					  (image-ds-segment-base *image*))
@@ -1450,6 +1466,7 @@
 	  (etypecase expr
 	    (null *movitz-nil*)
 	    ((member t) (movitz-read 'muerte.cl:t))
+	    ((eql unbound) (make-instance 'movitz-unbound-value))
 	    (symbol (intern-movitz-symbol expr))
 	    (integer (make-movitz-integer expr))
 	    (character (make-movitz-character expr))