Add real time GC statistics gathering and reporting.

diff --git a/v7/src/runtime/gcnote.scm b/v7/src/runtime/gcnote.scm
index c1360cd13c12af313de73f44d4a50d8ac473f15f..cd82dcc9bdeb45df75b50ab5298f450e1cadda04 100644 (file)
--- a/v7/src/runtime/gcnote.scm
+++ b/v7/src/runtime/gcnote.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gcnote.scm,v 14.6 1989/10/26 06:46:11 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gcnote.scm,v 14.7 1991/09/07 05:30:43 jinx Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988-1991 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -94,19 +94,30 @@ MIT in each case. |#
   (write-string (gc-statistic->string statistic)))
 
 (define (gc-statistic->string statistic)
-  (let ((delta-time
-        (- (gc-statistic/this-gc-end statistic)
-           (gc-statistic/this-gc-start statistic))))
+  (let ((intervals->string
+        (lambda (start end last-end)
+          (let ((gc-length (- end start))
+                (period (- end last-end)))
+            (string-append
+             (number->string (internal-time/ticks->seconds gc-length))
+             " ("
+             (if (zero? period)
+                 "100"
+                 (number->string
+                  (round->exact (* (/ gc-length period) 100))))
+             "%)")))))
+            
     (string-append "GC #"
                   (number->string (gc-statistic/meter statistic))
-                  " took: "
-                  (number->string (internal-time/ticks->seconds delta-time))
-                  " ("
-                  (number->string
-                   (round->exact
-                    (* (/ delta-time 
-                          (- (gc-statistic/this-gc-end statistic)
-                             (gc-statistic/last-gc-end statistic)))
-                       100)))
-                  "%) free: "
+                  ": took: "
+                  (intervals->string
+                   (gc-statistic/this-gc-start statistic)
+                   (gc-statistic/this-gc-end statistic)
+                   (gc-statistic/last-gc-end statistic))
+                  " process time, "
+                  (intervals->string
+                   (gc-statistic/this-gc-start-clock statistic)
+                   (gc-statistic/this-gc-end-clock statistic)
+                   (gc-statistic/last-gc-end-clock statistic))
+                  " real time; free: "
                   (number->string (gc-statistic/heap-left statistic)))))
\ No newline at end of file

diff --git a/v7/src/runtime/gcstat.scm b/v7/src/runtime/gcstat.scm
index 2629ad6361773a11b33db41fc24ac1d6dae58a3a..bc4c04a6e6c52470e990f4e6c80b2984fc4dd3de 100644 (file)
--- a/v7/src/runtime/gcstat.scm
+++ b/v7/src/runtime/gcstat.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gcstat.scm,v 14.3 1990/03/26 19:42:44 jinx Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gcstat.scm,v 14.4 1991/09/07 05:30:57 jinx Exp $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988-1991 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -51,17 +51,27 @@ MIT in each case. |#
   (set! hook/gc-finish recorder/gc-finish))
 
 (define (recorder/gc-start)
-  (process-time-clock))
-
-(define (recorder/gc-finish start-time space-remaining)
-  (let ((end-time (process-time-clock)))
-    (increment-non-runtime! (- end-time start-time))
-    (statistics-flip start-time end-time space-remaining)))
+  (set! this-gc-start-clock (real-time-clock))
+  (set! this-gc-start (process-time-clock))
+  unspecific)
+
+(define (recorder/gc-finish ignored space-remaining)
+  ignored
+  (let* ((end-time (process-time-clock))
+        (end-time-clock (real-time-clock)))
+    (increment-non-runtime! (- end-time this-gc-start))
+    (statistics-flip this-gc-start end-time
+                    space-remaining
+                    this-gc-start-clock end-time-clock)))
 \f
 (define timestamp)
 (define total-gc-time)
 (define last-gc-start)
 (define last-gc-end)
+(define this-gc-start)
+(define this-gc-start-clock)
+(define last-gc-start-clock)
+(define last-gc-end-clock)
 
 (define (gc-timestamp)
   timestamp)
@@ -69,6 +79,8 @@ MIT in each case. |#
 (define (statistics-reset!)
   (set! timestamp (cons 1 (1+ (cdr timestamp))))
   (set! total-gc-time 0)
+  (set! last-gc-start-clock false)
+  (set! last-gc-end-clock (real-time-clock))
   (set! last-gc-start false)
   (set! last-gc-end (process-time-clock))
   (reset-recorder! '()))
@@ -79,17 +91,25 @@ MIT in each case. |#
   (this-gc-start false read-only true)
   (this-gc-end false read-only true)
   (last-gc-start false read-only true)
-  (last-gc-end false read-only true))
+  (last-gc-end false read-only true)
+  (this-gc-start-clock false read-only true)
+  (this-gc-end-clock false read-only true)
+  (last-gc-start-clock false read-only true)
+  (last-gc-end-clock false read-only true))
 
-(define (statistics-flip start-time end-time heap-left)
+(define (statistics-flip start-time end-time heap-left start-clock end-clock)
   (let ((statistic
         (make-gc-statistic timestamp heap-left
                            start-time end-time
-                           last-gc-start last-gc-end)))
+                           last-gc-start last-gc-end
+                           start-clock end-clock
+                           last-gc-start-clock last-gc-end-clock)))
     (set! timestamp (cons (1+ (car timestamp)) (cdr timestamp)))
     (set! total-gc-time (+ (- end-time start-time) total-gc-time))
     (set! last-gc-start start-time)
     (set! last-gc-end end-time)
+    (set! last-gc-start-clock start-clock)
+    (set! last-gc-end-clock end-clock)
     (record-statistic! statistic)
     (hook/record-statistic! statistic)))
 

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index dfeda0166dd02158b31b977d8fe20ee5cd24dea9..bd4278a6b618519da348d9abd551c8876830b107 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.120 1991/09/02 03:57:21 sybok Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.121 1991/09/07 05:31:10 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -737,9 +737,13 @@ MIT in each case. |#
          gc-statistic/heap-left
          gc-statistic/last-gc-end
          gc-statistic/last-gc-start
+         gc-statistic/last-gc-end-clock
+         gc-statistic/last-gc-start-clock
          gc-statistic/meter
          gc-statistic/this-gc-end
          gc-statistic/this-gc-start
+         gc-statistic/this-gc-end-clock
+         gc-statistic/this-gc-start-clock
          gc-statistics
          gc-timestamp
          gctime)

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index 1140d028787e6aa61ddf17c86abd0b6f6c476a60..d078cc7d084034bc62286b8499e7fbd3564667c9 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.137 1991/08/29 14:23:23 bal Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.138 1991/09/07 05:30:30 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -45,10 +45,10 @@ MIT in each case. |#
                     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 137))
+  (add-identification! "Runtime" 14 138))
 
 (define microcode-system)
 
 (define (snarf-microcode-version!)
   (set-system/version! microcode-system microcode-id/version)
-  (set-system/modification! microcode-system microcode-id/modification))
+  (set-system/modification! microcode-system microcode-id/modification))
\ No newline at end of file

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 905ce4895e36e9a8549c271ad529dc3d1d5c12b7..560411cc67b603f02d7295f28ad84ffe5b08d81e 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.120 1991/09/02 03:57:21 sybok Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.121 1991/09/07 05:31:10 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -737,9 +737,13 @@ MIT in each case. |#
          gc-statistic/heap-left
          gc-statistic/last-gc-end
          gc-statistic/last-gc-start
+         gc-statistic/last-gc-end-clock
+         gc-statistic/last-gc-start-clock
          gc-statistic/meter
          gc-statistic/this-gc-end
          gc-statistic/this-gc-start
+         gc-statistic/this-gc-end-clock
+         gc-statistic/this-gc-start-clock
          gc-statistics
          gc-timestamp
          gctime)