Fluidize (runtime gc-statistics) internal hook/record-statistic!.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Sat, 8 Feb 2014 17:29:09 +0000 (10:29 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Tue, 12 Aug 2014 00:30:29 +0000 (17:30 -0700)
src/runtime/gcnote.scm
src/runtime/gcstat.scm

index 25bf815288ec492dd394bdde96cd8ecdfca0a2c4..6c3357600f0bb24b4d1693fea4cf9c7b38ee3dce 100644 (file)
@@ -30,29 +30,29 @@ USA.
 (declare (usual-integrations))
 \f
 (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)))
index 9031fdc80b2035e44d32c64fb7f41656b2e38747..c9c25b3001eb4ff2f561a0a350c940b43d66ef52 100644 (file)
@@ -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)))