Establish an explicit booting? flag that controls boot inits.

diff --git a/src/runtime/boot.scm b/src/runtime/boot.scm
index ad3f251fce20bf44fa6ab282bf557ee841f4a21e..e7fbdf2b8b90e34beb625087cadb98071cf4cebb 100644 (file)
--- a/src/runtime/boot.scm
+++ b/src/runtime/boot.scm
@@ -122,20 +122,20 @@ USA.
             (procedure (cddr objects)))
        (lose))))
 \f
-;;;; Boot initializers
+;;;; Boot-time initializers
 
 (define (init-boot-inits!)
   (set! boot-inits '())
   unspecific)
 
 (define (add-boot-init! thunk)
-  (if boot-inits
+  (if (and booting? boot-inits)
       (set! boot-inits (cons thunk boot-inits))
       (thunk))
   unspecific)
 
 (define (save-boot-inits! environment)
-  (if boot-inits
+  (if (pair? boot-inits)
       (let ((inits (reverse! boot-inits)))
        (set! boot-inits #f)
        (let ((p (assq environment saved-boot-inits)))
@@ -156,6 +156,14 @@ USA.
             (for-each (lambda (init) (init))
                       inits))))))
 
+(define (finished-booting!)
+  (set! booting? #f)
+  (if (pair? boot-inits)
+      (warn "boot-inits not saved:" boot-inits))
+  (if (pair? saved-boot-inits)
+      (warn "saved-boot-inits not run:" saved-boot-inits)))
+
+(define booting? #t)
 (define boot-inits #f)
 (define saved-boot-inits '())
 \f

diff --git a/src/runtime/option.scm b/src/runtime/option.scm
index 4d3c3eb4ff19e98f86ff44ab7209b7ad6a96f020..d6c5e28b603a267f34d4a208c014eab746842e16 100644 (file)
--- a/src/runtime/option.scm
+++ b/src/runtime/option.scm
@@ -112,7 +112,6 @@ USA.
     (let ((environment (package/environment (find-package package-name)))
          (runtime (pathname-as-directory "runtime"))
          (rundir (system-library-directory-pathname "runtime" #t)))
-      (if (not init-expression) (init-boot-inits!))
       (for-each
        (lambda (file)
         (let ((file (force* file)))
@@ -133,10 +132,7 @@ USA.
                                  #t))))))))))
        files)
       (flush-purification-queue!)
-      (if (not init-expression)
-         (begin
-           (save-boot-inits! environment)
-           ((get-boot-init-runner environment)))
+      (if init-expression
          (eval init-expression environment)))))
 
 (define (force* value)

diff --git a/src/runtime/rep.scm b/src/runtime/rep.scm
index 5e0930e987ffe6c86db6228988297a9e23305a24..59b67a0be6bad94140daddb3e3a7d38479cc3ec4 100644 (file)
--- a/src/runtime/rep.scm
+++ b/src/runtime/rep.scm
@@ -52,7 +52,12 @@ USA.
                            `((SET-DEFAULT-DIRECTORY
                               ,top-level-repl/set-default-directory))
                            user-initial-prompt)
-                (cmdl-message/strings "Cold load finished")))))
+                (cmdl-message/append
+                 (cmdl-message/active
+                  (lambda (port)
+                    (declare (ignore port))
+                    (finished-booting!)))
+                 (cmdl-message/strings "Cold load finished"))))))
 
 (define root-continuation)
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index a10f3d553b553133c0e9f749e3d0d33387928ad4..e2deda884a6974abdc9338674907170fd0d537c9 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -164,11 +164,11 @@ USA.
          with-limited-interrupts
          without-interrupts)
   (export (runtime)
-         add-boot-init!)
-  (export (runtime options)
-         get-boot-init-runner
-         init-boot-inits!
-         save-boot-inits!))
+         add-boot-init!
+         defer-boot-action
+         run-deferred-boot-actions)
+  (export (runtime rep)
+         finished-booting!))
 
 (define-package (runtime equality)
   (files "equals")