From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sat, 8 Feb 2014 17:25:07 +0000 (-0700)
Subject: Fluidize (runtime save/restore) internal *within-restore-window?*.
X-Git-Tag: mit-scheme-pucked-9.2.12~401^2~10
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2f099a8fa8e7cbde95765ae67b4f3b5af055322a;p=mit-scheme.git

Fluidize (runtime save/restore) internal *within-restore-window?*.
---

diff --git a/src/runtime/gcdemn.scm b/src/runtime/gcdemn.scm
index 36506e55a..12e0e95d5 100644
--- a/src/runtime/gcdemn.scm
+++ b/src/runtime/gcdemn.scm
@@ -61,7 +61,7 @@ USA.
 (define (add-gc-daemon!/no-restore daemon)
   (add-gc-daemon!
    (lambda ()
-     (if (not *within-restore-window?*)
+     (if (not (fluid *within-restore-window?*))
 	 (daemon)))))
 
 ;;; SECONDARY-GC-DAEMONS are executed rarely.  Their purpose is to
diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index e6e35e8f1..89da4b8dc 100644
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -544,6 +544,7 @@ USA.
    (RUNTIME HTML-FORM-CODEC)
    (OPTIONAL (RUNTIME WIN32-REGISTRY))
    (OPTIONAL (RUNTIME FFI))
+   (RUNTIME SAVE/RESTORE)
    (RUNTIME SWANK)
    (RUNTIME STACK-SAMPLER)))
 
diff --git a/src/runtime/savres.scm b/src/runtime/savres.scm
index f82dd3bbb..3e5688cc8 100644
--- a/src/runtime/savres.scm
+++ b/src/runtime/savres.scm
@@ -41,7 +41,10 @@ USA.
 
 (define world-id "Image")
 (define time-world-saved #f)
-(define *within-restore-window?* #f)
+(define *within-restore-window?*)
+
+(define (initialize-package!)
+  (set! *within-restore-window?* (make-fluid #f)))
 
 (define (disk-save filename #!optional id)
   (let ((filename (->namestring (merge-pathnames filename)))
@@ -76,8 +79,9 @@ USA.
 	   (read-microcode-tables!)
 	   (lambda ()
 	     (set! time-world-saved time)
-	     (fluid-let ((*within-restore-window?* #t))
-	       (event-distributor/invoke! event:after-restore))
+	     (let-fluid *within-restore-window?* #t
+	       (lambda ()
+		 (event-distributor/invoke! event:after-restore)))
 	     (start-thread-timer)
 	     (cond ((string? id)
 		    (set! world-id id)
diff --git a/src/runtime/usrint.scm b/src/runtime/usrint.scm
index e81b5ad0c..920e05678 100644
--- a/src/runtime/usrint.scm
+++ b/src/runtime/usrint.scm
@@ -382,12 +382,12 @@ USA.
 
 (define (port/gc-start port)
   (let ((operation (port/operation port 'GC-START)))
-    (if (and operation (not *within-restore-window?*))
+    (if (and operation (not (fluid *within-restore-window?*)))
 	(operation port))))
 
 (define (port/gc-finish port)
   (let ((operation (port/operation port 'GC-FINISH)))
-    (if (and operation (not *within-restore-window?*))
+    (if (and operation (not (fluid *within-restore-window?*)))
 	(operation port))))
 
 (define (port/read-start port)