From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 26 Jun 1987 01:01:16 +0000 (+0000)
Subject: Guarantee that GC notifications are printed with correct radix.
X-Git-Tag: 20090517-FFI~13322
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=665dc5b9cd41d5b05632194b6615897e15c2959e;p=mit-scheme.git

Guarantee that GC notifications are printed with correct radix.
---

diff --git a/v7/src/runtime/gcstat.scm b/v7/src/runtime/gcstat.scm
index ac86593f3..af96bd654 100644
--- a/v7/src/runtime/gcstat.scm
+++ b/v7/src/runtime/gcstat.scm
@@ -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
 ;;;
@@ -240,33 +240,34 @@
       (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