From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 6 Jan 2018 22:45:59 +0000 (-0500)
Subject: Establish an explicit booting? flag that controls boot inits.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~413
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=180da0e348f73a08b9258cf3243fd301ea265825;p=mit-scheme.git

Establish an explicit booting? flag that controls boot inits.
---

diff --git a/src/runtime/boot.scm b/src/runtime/boot.scm
index ad3f251fc..e7fbdf2b8 100644
--- a/src/runtime/boot.scm
+++ b/src/runtime/boot.scm
@@ -122,20 +122,20 @@ USA.
 	     (procedure (cddr objects)))
 	(lose))))
 
-;;;; 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 '())
 
diff --git a/src/runtime/option.scm b/src/runtime/option.scm
index 4d3c3eb4f..d6c5e28b6 100644
--- 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 5e0930e98..59b67a0be 100644
--- 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 a10f3d553..e2deda884 100644
--- 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")