From 17a859d937c3838c7882b98622cbe1db90ffae45 Mon Sep 17 00:00:00 2001
From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Wed, 9 Dec 2015 15:53:45 -0700
Subject: [PATCH] Add clock time (HH:MM) to GC notifications.

This makes it easier to see if a long running program is GCing more than
infrequently.
---
 src/runtime/gcnote.scm  | 16 ++++++++++++++--
 src/runtime/gcstat.scm  |  9 +++++++--
 src/runtime/runtime.pkg |  1 +
 3 files changed, 22 insertions(+), 4 deletions(-)

diff --git a/src/runtime/gcnote.scm b/src/runtime/gcnote.scm
index e612ae658..30c1dd44a 100644
--- a/src/runtime/gcnote.scm
+++ b/src/runtime/gcnote.scm
@@ -205,10 +205,22 @@ USA.
 		     (round->exact (* (/ gc-length period) 100))
 		     #d10))
 		"%)")
-	       7))))))
-
+	       7)))))
+	 (uctime-string	    ;; E.g. "13:15" for 1:15pm local time
+	  (lambda (uctime)
+	    (let* ((decoded-time
+		    (universal-time->local-decoded-time uctime))
+		   (hour (decoded-time/hour decoded-time))
+		   (minute (decoded-time/minute decoded-time))
+		   (second (decoded-time/second decoded-time)))
+	      (string-append
+	       (if (< hour 10) "0" "") (number->string hour)
+	       (if (< minute 10) ":0" ":") (number->string minute)
+	       (if (< second 10) ":0" ":") (number->string second))))))
     (string-append ";GC #"
 		   (number->string (gc-statistic/meter statistic))
+		   " "
+		   (uctime-string (gc-statistic/this-gc-start-uctime statistic))
 		   ": took: "
 		   (intervals->string
 		    (gc-statistic/this-gc-start statistic)
diff --git a/src/runtime/gcstat.scm b/src/runtime/gcstat.scm
index 532d1113e..46400439c 100644
--- a/src/runtime/gcstat.scm
+++ b/src/runtime/gcstat.scm
@@ -44,6 +44,7 @@ USA.
 
 (define (recorder/gc-start)
   (port/gc-start console-i/o-port)
+  (set! this-gc-start-uctime (get-universal-time))
   (set! this-gc-start-clock (real-time-clock))
   (set! this-gc-start (process-time-clock))
   unspecific)
@@ -55,6 +56,7 @@ USA.
     (increment-non-runtime! (- end-time this-gc-start))
     (statistics-flip this-gc-start end-time
 		     space-remaining
+		     this-gc-start-uctime
 		     this-gc-start-clock end-time-clock))
   (port/gc-finish console-i/o-port))
 
@@ -63,6 +65,7 @@ USA.
 (define last-gc-start)
 (define last-gc-end)
 (define this-gc-start)
+(define this-gc-start-uctime)
 (define this-gc-start-clock)
 (define last-gc-start-clock)
 (define last-gc-end-clock)
@@ -86,17 +89,19 @@ USA.
   (this-gc-end false read-only true)
   (last-gc-start false read-only true)
   (last-gc-end false read-only true)
+  (this-gc-start-uctime 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 start-clock end-clock)
+(define (statistics-flip start-time end-time heap-left
+			 start-uctime start-clock end-clock)
   (let ((statistic
 	 (make-gc-statistic timestamp heap-left
 			    start-time end-time
 			    last-gc-start last-gc-end
-			    start-clock end-clock
+			    start-uctime 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))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 0a1dc5718..87ca7625b 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2053,6 +2053,7 @@ USA.
 	  gc-statistic/this-gc-start
 	  gc-statistic/this-gc-end-clock
 	  gc-statistic/this-gc-start-clock
+	  gc-statistic/this-gc-start-uctime
 	  gc-statistics
 	  gc-timestamp
 	  gctime)
-- 
2.25.1