Guarantee that GC notifications are printed with correct radix.
authorChris Hanson <org/chris-hanson/cph>
Fri, 26 Jun 1987 01:01:16 +0000 (01:01 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 26 Jun 1987 01:01:16 +0000 (01:01 +0000)
v7/src/runtime/gcstat.scm

index ac86593f3fcb45f9c540202acb5ae42cc1d13499..af96bd65477239a5c3ea6c80abd2d71b2939ce0d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gcstat.scm,v 13.43 1987/04/13 18:43:38 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gcstat.scm,v 13.44 1987/06/26 01:01:16 cph Rel $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
       (print-statistic statistic))))
 
 (set! toggle-gc-notification!
-(named-lambda (toggle-gc-notification!)
-  (if (null? normal-recorder)
-      (begin (set! normal-recorder
-                  (access record-statistic! gc-statistics-package))
-            (set! (access record-statistic! gc-statistics-package)
-                  gc-notification))
-      (begin (set! (access record-statistic! gc-statistics-package)
-                  normal-recorder)
-            (set! normal-recorder '())))
-  *the-non-printing-object*))
+  (named-lambda (toggle-gc-notification!)
+    (if (null? normal-recorder)
+       (begin (set! normal-recorder
+                    (access record-statistic! gc-statistics-package))
+              (set! (access record-statistic! gc-statistics-package)
+                    gc-notification))
+       (begin (set! (access record-statistic! gc-statistics-package)
+                    normal-recorder)
+              (set! normal-recorder '())))
+    *the-non-printing-object*))
 
 (set! print-gc-statistics
-(named-lambda (print-gc-statistics)
-  (for-each print-statistic (gc-statistics))))
+  (named-lambda (print-gc-statistics)
+    (for-each print-statistic (gc-statistics))))
 
 (define (print-statistic statistic)
-  (apply (lambda (meter
-                 this-gc-start this-gc-end
-                 last-gc-start last-gc-end
-                 heap-left)
-          (let ((delta-time (- this-gc-end this-gc-start)))
-            (newline) (write-string "GC #") (write meter)
-            (write-string " took: ") (write delta-time)
-            (write-string " (")
-            (write (round (* (/ delta-time (- this-gc-end last-gc-end))
-                             100)))
-            (write-string "%) free: ") (write heap-left)))
-        (vector->list statistic)))
+  (fluid-let ((*unparser-radix* 10))
+    (apply (lambda (meter
+                   this-gc-start this-gc-end
+                   last-gc-start last-gc-end
+                   heap-left)
+            (let ((delta-time (- this-gc-end this-gc-start)))
+              (newline) (write-string "GC #") (write meter)
+              (write-string " took: ") (write delta-time)
+              (write-string " (")
+              (write (round (* (/ delta-time (- this-gc-end last-gc-end))
+                               100)))
+              (write-string "%) free: ") (write heap-left)))
+          (vector->list statistic))))
 
 )
\ No newline at end of file