Menu
▾
▴
[Sbcl-commits] master: Move package initialization earlier in cold-init.
|
From: Douglas K. <sn...@us...> - 2014-09-03 13:56:34
|
The branch "master" has been updated in SBCL:
via 901bb888d4977d2f9701a26abed07a3b2f54c024 (commit)
from 3446e1a9daeb95b1861b85eacdc74bdb67dec57e (commit)
- Log -----------------------------------------------------------------
commit 901bb888d4977d2f9701a26abed07a3b2f54c024
Author: Douglas Katzman <do...@go...>
Date: Wed Sep 3 09:46:19 2014 -0400
Move package initialization earlier in cold-init.
This enables a debugging enhancement (pending).
---
src/code/cold-init.lisp | 5 +++--
src/code/target-package.lisp | 24 ------------------------
src/cold/set-up-cold-packages.lisp | 1 +
src/compiler/generic/genesis.lisp | 32 +++++++++++++++++++++++++-------
4 files changed, 29 insertions(+), 33 deletions(-)
diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index bdf93ae..4715f89 100644
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -81,7 +81,10 @@
(/show0 "entering !COLD-INIT")
+ ;; Putting data in a synchronized hashtable (*PACKAGE-NAMES*)
+ ;; requires that the main thread be properly initialized.
(show-and-call thread-init-or-reinit)
+ (show-and-call !package-cold-init)
;; Anyone might call RANDOM to initialize a hash value or something;
;; and there's nothing which needs to be initialized in order for
@@ -94,8 +97,6 @@
(show-and-call !character-database-cold-init)
(show-and-call !character-name-database-cold-init)
- (show-and-call !package-cold-init)
-
;; All sorts of things need INFO and/or (SETF INFO).
(/show0 "about to SHOW-AND-CALL !GLOBALDB-COLD-INIT")
(show-and-call !globaldb-cold-init)
diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index b15b331..2ee04d4 100644
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -1626,33 +1626,9 @@ PACKAGE."
(setf (package-tables pkg)
(map 'vector #'package-external-symbols (package-%use-list pkg)))))
- ;; FIXME: These assignments are also done at toplevel in
- ;; boot-extensions.lisp. They should probably only be done once.
- (/show0 "setting up *CL-PACKAGE* and *KEYWORD-PACKAGE*")
- (setq *cl-package* (find-package "COMMON-LISP"))
- (setq *keyword-package* (find-package "KEYWORD"))
-
(/show0 "about to MAKUNBOUND *!INITIAL-SYMBOLS*")
(%makunbound '*!initial-symbols*) ; (so that it gets GCed)
- ;; Make some other packages that should be around in the cold load.
- ;; The COMMON-LISP-USER package is required by the ANSI standard,
- ;; but not completely specified by it, so in the cross-compilation
- ;; host Lisp it could contain various symbols, USE-PACKAGEs, or
- ;; nicknames that we don't want in our target SBCL. For that reason,
- ;; we handle it specially, not dumping the host Lisp version at
- ;; genesis time..
- (aver (not (find-package "COMMON-LISP-USER")))
- ;; ..but instead making our own from scratch here.
- (/show0 "about to MAKE-PACKAGE COMMON-LISP-USER")
- (make-package "COMMON-LISP-USER"
- :nicknames '("CL-USER")
- :use '("COMMON-LISP"
- ;; ANSI encourages us to put extension packages
- ;; in the USE list of COMMON-LISP-USER.
- "SB!ALIEN" "SB!ALIEN" "SB!DEBUG"
- "SB!EXT" "SB!GRAY" "SB!PROFILE"))
-
;; For the kernel core image wizards, set the package to *CL-PACKAGE*.
;;
;; FIXME: We should just set this to (FIND-PACKAGE
diff --git a/src/cold/set-up-cold-packages.lisp b/src/cold/set-up-cold-packages.lisp
index 4ee2acc..3837f7f 100644
--- a/src/cold/set-up-cold-packages.lisp
+++ b/src/cold/set-up-cold-packages.lisp
@@ -15,6 +15,7 @@
;;; We make no attempt to be fully general; our table doesn't need to be
;;; able to express features which we don't happen to use.
(export '(package-data
+ make-package-data
package-data-name
package-data-export
package-data-reexport
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index 826adbe..070fbf6 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -1111,10 +1111,14 @@ core and return a descriptor to it."
;; propagate the current state into the target.
(dolist (nickname
(cond ((string= pkg-name "COMMON-LISP") '("CL"))
+ ((string= pkg-name "COMMON-LISP-USER")
+ '("CL-USER"))
((string= pkg-name "KEYWORD") '())
(t (package-nicknames (find-package pkg-name))))
result)
(cold-push (base-string-to-core nickname) result))))
+ (find-cold-package (name)
+ (cadr (find-package-cell name)))
(find-package-cell (name)
(or (assoc (if (string= name "CL") "COMMON-LISP" name)
target-pkg-list :test #'string=)
@@ -1123,14 +1127,18 @@ core and return a descriptor to it."
(let ((res *nil-descriptor*))
(dolist (x list res) (cold-push x res)))))
;; pass 1: make all proto-packages
- (init-cold-package "COMMON-LISP")
- (init-cold-package "KEYWORD")
(dolist (pd package-data-list)
(init-cold-package (sb-cold:package-data-name pd)
#!+sb-doc(sb-cold::package-data-doc pd)))
+ ;; MISMATCH needs !HAIRY-DATA-VECTOR-REFFER-INIT to have been done,
+ ;; and FIND-PACKAGE calls MISMATCH - which it shouldn't - but until
+ ;; that is fixed, doing this in genesis allows packages to be
+ ;; completely sane, modulo the naming, extremely early in cold-init.
+ (cold-set '*keyword-package* (find-cold-package "KEYWORD"))
+ (cold-set '*cl-package* (find-cold-package "COMMON-LISP"))
;; pass 2: set the 'use' lists and collect the 'used-by' lists
(dolist (pd package-data-list)
- (let ((this (cadr (find-package-cell (sb-cold:package-data-name pd))))
+ (let ((this (find-cold-package (sb-cold:package-data-name pd)))
(use nil))
(dolist (that (sb-cold:package-data-use pd))
(let ((cell (find-package-cell that)))
@@ -1234,6 +1242,8 @@ core and return a descriptor to it."
(or (get symbol 'cold-intern-info)
(let ((pkg-info (gethash (package-name package) *cold-package-symbols*))
(handle (allocate-symbol (symbol-name symbol) :gspace gspace)))
+ ;; maintain reverse map from target descriptor to host symbol
+ (setf (gethash (descriptor-bits handle) *cold-symbols*) symbol)
(unless pkg-info
(error "No target package descriptor for ~S" package))
(record-accessibility
@@ -1246,8 +1256,6 @@ core and return a descriptor to it."
(cold-set handle handle))
((assoc symbol sb-cold:*symbol-values-for-genesis*)
(cold-set-symbol-global-value handle (cdr it))))
- ;; maintain reverse map from target descriptor to host symbol
- (setf (gethash (descriptor-bits handle) *cold-symbols*) symbol)
(setf (get symbol 'cold-intern-info) handle))))
(defun record-accessibility (accessibility symbol-descriptor target-pkg-info
@@ -3380,7 +3388,7 @@ initially undefined function references:~2%")
;; This avoids having to track any symbols created prior to
;; creation of packages, since packages are primordial.
(target-cl-pkg-info
- (dolist (name (list* "COMMON-LISP" "KEYWORD"
+ (dolist (name (list* "COMMON-LISP" "COMMON-LISP-USER" "KEYWORD"
(mapcar #'sb-cold:package-data-name
pkg-metadata))
(gethash "COMMON-LISP" *cold-package-symbols*))
@@ -3402,7 +3410,17 @@ initially undefined function references:~2%")
;; Prepare for cold load.
(initialize-non-nil-symbols)
(initialize-layouts)
- (initialize-packages pkg-metadata)
+ (initialize-packages
+ ;; docstrings are set in src/cold/warm. It would work to do it here,
+ ;; but seems preferable not to saddle Genesis with such responsibility.
+ (list* (sb-cold:make-package-data :name "COMMON-LISP" :doc nil)
+ (sb-cold:make-package-data :name "KEYWORD" :doc nil)
+ (sb-cold:make-package-data :name "COMMON-LISP-USER" :doc nil
+ :use '("COMMON-LISP"
+ ;; ANSI encourages us to put extension packages
+ ;; in the USE list of COMMON-LISP-USER.
+ "SB!ALIEN" "SB!DEBUG" "SB!EXT" "SB!GRAY" "SB!PROFILE"))
+ pkg-metadata))
(initialize-static-fns)
;; Initialize the *COLD-SYMBOLS* system with the information
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|