From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Fri, 7 Feb 2014 18:20:07 +0000 (-0700)
Subject: Fluidize (runtime options) internal variables *options*, *parent*.
X-Git-Tag: mit-scheme-pucked-9.2.12~401^2~11
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=dd639c1070e77f5b139f8c089355f48330ed36a8;p=mit-scheme.git

Fluidize (runtime options) internal variables *options*, *parent*.
---

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index 328ffde9e..e6e35e8f1 100644
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -502,6 +502,7 @@ USA.
    ;; Syntax
    (RUNTIME KEYWORD)
    (RUNTIME NUMBER-PARSER)
+   (RUNTIME OPTIONS)
    (RUNTIME PARSER)
    (RUNTIME PARSER FILE-ATTRIBUTES)
    ((RUNTIME PATHNAME) INITIALIZE-PARSER-METHOD!)
diff --git a/src/runtime/option.scm b/src/runtime/option.scm
index fd7905ef7..2a10a47eb 100644
--- a/src/runtime/option.scm
+++ b/src/runtime/option.scm
@@ -46,12 +46,12 @@ USA.
     (define (search-parent pathname)
       (call-with-values
 	  (lambda ()
-	    (fluid-let ((*options* '())
-			(*parent* #f))
-	      (let-fluid load/suppress-loading-message? #t
-		(lambda ()
-		  (load pathname (make-load-environment))))
-	      (values *options* *parent*)))
+	    (let-fluids *options* '()
+			*parent* #f
+			load/suppress-loading-message? #t
+	      (lambda ()
+		(load pathname (make-load-environment))
+		(values (fluid *options*) (fluid *parent*)))))
 	find-option))
 
     (define (make-load-environment)
@@ -61,14 +61,14 @@ USA.
 
     (if (memq name loaded-options)
 	name
-	(find-option *options* *parent*))))
+	(find-option (fluid *options*) (fluid *parent*)))))
 
 (define (define-load-option name . loaders)
-  (set! *options* (cons (cons name loaders) *options*))
+  (set-fluid! *options* (cons (cons name loaders) (fluid *options*)))
   unspecific)
 
 (define (further-load-options place)
-  (set! *parent* place)
+  (set-fluid! *parent* place)
   unspecific)
 
 (define (initial-load-options)
@@ -94,9 +94,13 @@ USA.
        pathname))
 
 (define loaded-options '())
-(define *options* '())			; Current options.
-(define *parent* initial-load-options)	; A thunk or a pathname/string or #f.
+(define *options*)		 ; Current options.
+(define *parent*)		 ; A thunk or a pathname/string or #f.
 (define *initial-options-file* #f)
+
+(define (initialize-package!)
+  (set! *options* (make-fluid '()))
+  (set! *parent* (make-fluid initial-load-options)))
 
 (define (dummy-option-loader)
   unspecific)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index e3a02903c..6e6a40109 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3015,7 +3015,8 @@ USA.
 	  local-load-options
 	  standard-load-options
 	  standard-option-loader
-	  standard-system-loader))
+	  standard-system-loader)
+  (initialization (initialize-package!)))
 
 (define-package (runtime parser)
   (files "parse")