From: Chris Hanson Date: Sun, 30 Apr 2017 03:51:02 +0000 (-0700) Subject: Allow option files to use boot-inits. X-Git-Tag: mit-scheme-pucked-9.2.12~14^2~108 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8c0981a6a6ccfad7c442d9d971dd22d23067b397;p=mit-scheme.git Allow option files to use boot-inits. --- diff --git a/src/runtime/boot.scm b/src/runtime/boot.scm index 774e12c4a..4dab58ee6 100644 --- a/src/runtime/boot.scm +++ b/src/runtime/boot.scm @@ -157,7 +157,7 @@ USA. unspecific) (define (save-boot-inits! environment) - (if (pair? boot-inits) + (if boot-inits (let ((inits (reverse! boot-inits))) (set! boot-inits #f) (let ((p (assq environment saved-boot-inits))) diff --git a/src/runtime/option.scm b/src/runtime/option.scm index 18ae8f767..4d3c3eb4f 100644 --- a/src/runtime/option.scm +++ b/src/runtime/option.scm @@ -112,6 +112,7 @@ 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))) @@ -132,7 +133,11 @@ USA. #t)))))))))) files) (flush-purification-queue!) - (eval init-expression environment)))) + (if (not init-expression) + (begin + (save-boot-inits! environment) + ((get-boot-init-runner environment))) + (eval init-expression environment))))) (define (force* value) (cond ((procedure? value) (force* (value))) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index f313c27bb..b44bb16fc 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -164,7 +164,11 @@ USA. with-limited-interrupts without-interrupts) (export (runtime) - add-boot-init!)) + add-boot-init!) + (export (runtime options) + get-boot-init-runner + init-boot-inits! + save-boot-inits!)) (define-package (runtime equality) (files "equals")