- (symbols (cdr cold-package-symbols-entry))
- (shadows (package-shadowing-symbols cold-package))
- (documentation (string-to-core (documentation cold-package t)))
- (internal *nil-descriptor*)
- (external *nil-descriptor*)
- (imported-internal *nil-descriptor*)
- (imported-external *nil-descriptor*)
- (shadowing *nil-descriptor*))
- (declare (type package cold-package)) ; i.e. not a target descriptor
- (/show "dumping" cold-package symbols)
-
- ;; FIXME: Add assertions here to make sure that inappropriate stuff
- ;; isn't being dumped:
- ;; * the CL-USER package
- ;; * the SB-COLD package
- ;; * any internal symbols in the CL package
- ;; * basically any package other than CL, KEYWORD, or the packages
- ;; in package-data-list.lisp-expr
- ;; and that the structure of the KEYWORD package (e.g. whether
- ;; any symbols are internal to it) matches what we want in the
- ;; target SBCL.
-
- ;; FIXME: It seems possible that by looking at the contents of
- ;; packages in the target SBCL we could find which symbols in
- ;; package-data-lisp.lisp-expr are now obsolete. (If I
- ;; understand correctly, only symbols which actually have
- ;; definitions or which are otherwise referred to actually end
- ;; up in the target packages.)
-
- (dolist (symbol symbols)
- (let ((handle (car (get symbol 'cold-intern-info)))
- (imported-p (not (eq (symbol-package-for-target-symbol symbol)
- cold-package))))
- (multiple-value-bind (found where)
- (find-symbol (symbol-name symbol) cold-package)
- (unless (and where (eq found symbol))
- (error "The symbol ~S is not available in ~S."
- symbol
- cold-package))
- (when (memq symbol shadows)
- (cold-push handle shadowing))
- (case where
- (:internal (if imported-p
- (cold-push handle imported-internal)
- (cold-push handle internal)))
- (:external (if imported-p
- (cold-push handle imported-external)
- (cold-push handle external)))))))
- (let ((r *nil-descriptor*))
- (cold-push documentation r)
- (cold-push shadowing r)
- (cold-push imported-external r)
- (cold-push imported-internal r)
- (cold-push external r)
- (cold-push internal r)
- (cold-push (make-make-package-args cold-package) r)
- ;; FIXME: It would be more space-efficient to use vectors
- ;; instead of lists here, and space-efficiency here would be
- ;; nice, since it would reduce the peak memory usage in
- ;; genesis and cold init.
- (cold-push r initial-symbols))))
+ (symbols (cdr cold-package-symbols-entry))
+ (shadows (package-shadowing-symbols cold-package))
+ (documentation (base-string-to-core (documentation cold-package t)))
+ (internal-count 0)
+ (external-count 0)
+ (internal *nil-descriptor*)
+ (external *nil-descriptor*)
+ (imported-internal *nil-descriptor*)
+ (imported-external *nil-descriptor*)
+ (shadowing *nil-descriptor*))
+ (declare (type package cold-package)) ; i.e. not a target descriptor
+ (/show "dumping" cold-package symbols)
+
+ ;; FIXME: Add assertions here to make sure that inappropriate stuff
+ ;; isn't being dumped:
+ ;; * the CL-USER package
+ ;; * the SB-COLD package
+ ;; * any internal symbols in the CL package
+ ;; * basically any package other than CL, KEYWORD, or the packages
+ ;; in package-data-list.lisp-expr
+ ;; and that the structure of the KEYWORD package (e.g. whether
+ ;; any symbols are internal to it) matches what we want in the
+ ;; target SBCL.
+
+ ;; FIXME: It seems possible that by looking at the contents of
+ ;; packages in the target SBCL we could find which symbols in
+ ;; package-data-lisp.lisp-expr are now obsolete. (If I
+ ;; understand correctly, only symbols which actually have
+ ;; definitions or which are otherwise referred to actually end
+ ;; up in the target packages.)
+
+ (dolist (symbol symbols)
+ (let ((handle (car (get symbol 'cold-intern-info)))
+ (imported-p (not (eq (symbol-package-for-target-symbol symbol)
+ cold-package))))
+ (multiple-value-bind (found where)
+ (find-symbol (symbol-name symbol) cold-package)
+ (unless (and where (eq found symbol))
+ (error "The symbol ~S is not available in ~S."
+ symbol
+ cold-package))
+ (when (memq symbol shadows)
+ (cold-push handle shadowing))
+ (case where
+ (:internal (if imported-p
+ (cold-push handle imported-internal)
+ (progn
+ (cold-push handle internal)
+ (incf internal-count))))
+ (:external (if imported-p
+ (cold-push handle imported-external)
+ (progn
+ (cold-push handle external)
+ (incf external-count))))))))
+ (let ((r *nil-descriptor*))
+ (cold-push documentation r)
+ (cold-push shadowing r)
+ (cold-push imported-external r)
+ (cold-push imported-internal r)
+ (cold-push external r)
+ (cold-push internal r)
+ (cold-push (make-make-package-args cold-package
+ internal-count
+ external-count)
+ r)
+ ;; FIXME: It would be more space-efficient to use vectors
+ ;; instead of lists here, and space-efficiency here would be
+ ;; nice, since it would reduce the peak memory usage in
+ ;; genesis and cold init.
+ (cold-push r initial-symbols))))