Add LOAD-WITH-BOOT-INITS! for testing.

diff --git a/src/runtime/boot.scm b/src/runtime/boot.scm
index 3d90a3395789b50bec736f2854a224fa35fdaec8..80ab3ae2dd1aba808eab7be3e2629ae83b64b497 100644 (file)
--- a/src/runtime/boot.scm
+++ b/src/runtime/boot.scm
@@ -142,6 +142,15 @@ USA.
 (define-integrable (default-object)
   ((ucode-primitive object-set-type) (ucode-type constant) 7))
 
+(define (load-with-boot-inits! . arguments)
+  (receive (value inits)
+      (fluid-let ((boot-inits '()))
+       (let ((value (apply load arguments)))
+         (values value (reverse! boot-inits))))
+    (for-each (lambda (init) (init))
+             inits)
+    value))
+
 (define (init-boot-inits!)
   (set! boot-inits '())
   unspecific)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index f8957ef260858d25b538d368e3e7fd7add52fdfd..e2f95aa832dea76d22cd93dacd77204d202a243f 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -166,6 +166,7 @@ USA.
          without-interrupts)
   (export (runtime)
          add-boot-init!
+         load-with-boot-inits!
          run-boot-inits!))
 
 (define-package (runtime equality)