From 2f099a8fa8e7cbde95765ae67b4f3b5af055322a Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Sat, 8 Feb 2014 10:25:07 -0700 Subject: [PATCH] Fluidize (runtime save/restore) internal *within-restore-window?*. --- src/runtime/gcdemn.scm | 2 +- src/runtime/make.scm | 1 + src/runtime/savres.scm | 10 +++++++--- src/runtime/usrint.scm | 4 ++-- 4 files changed, 11 insertions(+), 6 deletions(-) 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) -- 2.25.1