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

[Frode Vatvedt Fjeld]

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

Modified Files:
	image.lisp 
Log Message:
Initialize *setf-namespace* at dump-time.
In movitz-read, update old cons-cells also when they are found in the
cache of previously-read cells.

Date: Tue Apr 19 08:44:01 2005
Author: ffjeld

Index: movitz/image.lisp
diff -u movitz/image.lisp:1.88 movitz/image.lisp:1.89
--- movitz/image.lisp:1.88	Mon Jan 10 09:18:56 2005
+++ movitz/image.lisp	Tue Apr 19 08:44:01 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.88 2005/01/10 08:18:56 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.89 2005/04/19 06:44:01 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -882,6 +882,8 @@
   (let ((handler (movitz-env-symbol-function 'muerte::interrupt-default-handler)))
     (setf (movitz-run-time-context-exception-handlers (image-run-time-context *image*))
       (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))
   (let ((load-address (image-start-address *image*)))
     (setf (image-cons-pointer *image*) (- load-address
 					  (image-ds-segment-base *image*))
@@ -969,8 +971,6 @@
 		   (setf (movitz-symbol-value mname) mvalue)))
 	  (setf (movitz-run-time-context-global-properties run-time-context)
 	    (movitz-read (list :packages (make-packages-hash)
-			       :setf-namespace (movitz-environment-setf-function-names
-						*movitz-global-environment*)
 			       :trampoline-funcall%1op (find-primitive-function
 							'muerte::trampoline-funcall%1op)
 			       :trampoline-funcall%2op (find-primitive-function
@@ -1483,7 +1483,10 @@
 					:element-type (array-element-type expr)
 					:initial-contents expr))
 	    (cons
-	     (or (gethash expr (image-cons-constants *image*))
+	     (or (let ((old-cons (gethash expr (image-cons-constants *image*))))
+		   (when old-cons
+		     (update-movitz-object old-cons expr)
+		     old-cons))
 		 (setf (gethash expr (image-cons-constants *image*))
 		   (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#)))
 		       (multiple-value-bind (unfolded-expr cdr-index)