Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv30535
Modified Files: image.lisp Log Message: Fixed the dumping of package objects so as to not rely on the ability to access defstruct objects with slot-value. This to accommodate CMUCL.
Date: Mon Feb 9 18:41:13 2004 Author: ffjeld
Index: movitz/image.lisp diff -u movitz/image.lisp:1.9 movitz/image.lisp:1.10 --- movitz/image.lisp:1.9 Thu Feb 5 09:46:13 2004 +++ movitz/image.lisp Mon Feb 9 18:41:13 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.9 2004/02/05 14:46:13 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.10 2004/02/09 23:41:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -1005,16 +1005,15 @@ :name package-name :shadowing-symbols-list (package-shadowing-symbols lisp-package) :external-symbols (make-hash-table :test #'equal) - :internal-symbols (make-hash-table :test #'equal)))) + :internal-symbols (make-hash-table :test #'equal) + :use-list (mapcar #'(lambda (up) + (ensure-package (movitz-package-name (package-name up)) up)) + (package-use-list lisp-package))))) (setf (gethash package-name packages-hash) p) - (setf (slot-value p 'muerte::use-list) - (mapcar #'(lambda (up) - (ensure-package (movitz-package-name (package-name up)) up)) - (package-use-list lisp-package))) p))))) - (let ((cl-package (ensure-package (symbol-name :common-lisp) - (find-package :muerte.common-lisp)))) - (setf (gethash "NIL" (slot-value cl-package 'muerte::external-symbols)) + (let ((movitz-cl-package (ensure-package (symbol-name :common-lisp) + (find-package :muerte.common-lisp)))) + (setf (gethash "NIL" (funcall 'muerte:package-object-external-symbols movitz-cl-package)) nil)) (loop for symbol being the hash-key of (image-oblist *image*) as lisp-package = (symbol-package symbol) @@ -1027,12 +1026,12 @@ (ecase status (:internal (setf (gethash (symbol-name symbol) - (slot-value movitz-package 'muerte::internal-symbols)) + (funcall 'muerte:package-object-internal-symbols movitz-package)) symbol)) (:external ;; (warn "putting external ~S in ~S" symbol package-name) (setf (gethash (symbol-name symbol) - (slot-value movitz-package 'muerte::external-symbols)) + (funcall 'muerte:package-object-external-symbols movitz-package)) symbol)) (:inherited (warn "inherited symbol: ~S" symbol))))))