From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Sat, 8 Feb 2014 17:29:09 +0000 (-0700)
Subject: Fluidize (runtime gc-statistics) internal hook/record-statistic!.
X-Git-Tag: mit-scheme-pucked-9.2.12~401^2~9
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=51a288448dd8906949a88565c75ca9fa7e05f0cd;p=mit-scheme.git

Fluidize (runtime gc-statistics) internal hook/record-statistic!.
---

diff --git a/src/runtime/gcnote.scm b/src/runtime/gcnote.scm
index 25bf81528..6c3357600 100644
--- a/src/runtime/gcnote.scm
+++ b/src/runtime/gcnote.scm
@@ -30,29 +30,29 @@ USA.
 (declare (usual-integrations))
 
 (define (toggle-gc-notification!)
-  (set! hook/record-statistic!
-	(let ((current hook/record-statistic!))
-	  (cond ((eq? current gc-notification) default/record-statistic!)
-		((eq? current default/record-statistic!) gc-notification)
-		(else (error "Can't grab GC statistics hook")))))
+  (set-fluid! hook/record-statistic!
+	      (let ((current (fluid hook/record-statistic!)))
+		(cond ((eq? current gc-notification) default/record-statistic!)
+		      ((eq? current default/record-statistic!) gc-notification)
+		      (else (error "Can't grab GC statistics hook")))))
   unspecific)
 
 (define (set-gc-notification! #!optional on?)
   (let ((on? (if (default-object? on?) #T on?)))
-    (set! hook/record-statistic!
-	  (let ((current hook/record-statistic!))
-	    (if (or (eq? current gc-notification)
-		    (eq? current default/record-statistic!))
-		(if on?
-		    gc-notification
-		    default/record-statistic!)
-		(error "Can't grab GC statistics hook"))))
+    (set-fluid! hook/record-statistic!
+		(let ((current (fluid hook/record-statistic!)))
+		  (if (or (eq? current gc-notification)
+			  (eq? current default/record-statistic!))
+		      (if on?
+			  gc-notification
+			  default/record-statistic!)
+		      (error "Can't grab GC statistics hook"))))
     unspecific))
 
 (define (with-gc-notification! notify? thunk)
-  (fluid-let ((hook/record-statistic!
-	       (if notify? gc-notification default/record-statistic!)))
-    (thunk)))
+  (let-fluid hook/record-statistic!
+	     (if notify? gc-notification default/record-statistic!)
+    thunk))
 
 (define (gc-notification statistic)
   (print-statistic statistic (notification-output-port)))
diff --git a/src/runtime/gcstat.scm b/src/runtime/gcstat.scm
index 9031fdc80..c9c25b300 100644
--- a/src/runtime/gcstat.scm
+++ b/src/runtime/gcstat.scm
@@ -30,7 +30,7 @@ USA.
 (declare (usual-integrations))
 
 (define (initialize-package!)
-  (set! hook/record-statistic! default/record-statistic!)
+  (set! hook/record-statistic! (make-fluid default/record-statistic!))
   (set! history-modes
 	`((NONE . ,none:install-history!)
 	  (BOUNDED . ,bounded:install-history!)
@@ -106,7 +106,7 @@ USA.
     (set! last-gc-start-clock start-clock)
     (set! last-gc-end-clock end-clock)
     (record-statistic! statistic)
-    (hook/record-statistic! statistic)))
+    ((fluid hook/record-statistic!) statistic)))
 
 (define (gc-statistic/meter stat)
   (car (gc-statistic/timestamp stat)))