From 949746e13adfb7aa48bdfd3eb48f916813e6555b Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 23 May 2010 22:11:11 -0700
Subject: [PATCH] Add LOAD-WITH-BOOT-INITS! for testing.

---
 src/runtime/boot.scm    | 9 +++++++++
 src/runtime/runtime.pkg | 1 +
 2 files changed, 10 insertions(+)

diff --git a/src/runtime/boot.scm b/src/runtime/boot.scm
index 3d90a3395..80ab3ae2d 100644
--- 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 f8957ef26..e2f95aa83 100644
--- 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)
-- 
2.25.1