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

[Frode Vatvedt Fjeld]

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

Modified Files:
	image.lisp 
Log Message:
Dump images according to the new approach to compile-time
variables. I.e don't any more insert a property into global-properties
for each and every compile-time-variable.

Date: Wed Apr 14 18:51:24 2004
Author: ffjeld

Index: movitz/image.lisp
diff -u movitz/image.lisp:1.21 movitz/image.lisp:1.22
--- movitz/image.lisp:1.21	Wed Apr 14 08:40:26 2004
+++ movitz/image.lisp	Wed Apr 14 18:51:24 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Sun Oct 22 00:22:43 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: image.lisp,v 1.21 2004/04/14 12:40:26 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.22 2004/04/14 22:51:24 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -804,17 +804,18 @@
 		     (movitz-nil)
 		     (t (warn "not a symbol for plist: ~S has ~S" symbol plist)))))
 	  ;; pull in global properties
+	  (loop for var in (image-compile-time-variables *image*)
+	      do (let ((mname (movitz-read var))
+		       (mvalue (movitz-read (symbol-value var))))
+		   (setf (movitz-symbol-value mname) mvalue)))
 	  (setf (movitz-constant-block-global-properties constant-block)
-	    (movitz-read (nconc (mapcan #'(lambda (var)
-					 (list (movitz-read var) (movitz-read (symbol-value var))))
-				     (image-compile-time-variables *image*))
-			     (list :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
-							    'muerte::trampoline-funcall%2op)
-				   :packages (make-packages-hash))))))
+	    (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
+							'muerte::trampoline-funcall%2op)))))
 	(with-binary-file (stream path
 				  :check-stream t
 				  :direction :output