From 5be934d70ac6190367fd5e3fd1493bd40c41770e Mon Sep 17 00:00:00 2001
From: Burke Fetscher <bfetscher@racket-lang.org>
Date: Fri, 11 Apr 2014 16:25:03 -0500
Subject: [PATCH] log major gcs in benchmark

---
 .../redex/examples/benchmark/logging.rkt      | 60 +++++++++++--------
 1 file changed, 35 insertions(+), 25 deletions(-)

diff --git a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt
index 73f010f7ff..0e0f02a58d 100644
--- a/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt
+++ b/pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt
@@ -13,35 +13,39 @@
 
 (struct bmark-log-data (data))
 (struct bmark-log-end ())
+(struct gc-info (major? pre-amount pre-admin-amount code-amount
+                        post-amount post-admin-amount
+                        start-process-time end-process-time
+                        start-time end-time)
+  #:prefab)
 
 (define (with-logging-to filename thunk)
-  (define benchmark-logger
-    (make-logger #f (current-logger)))
   (define bmark-log-recv
-    (make-log-receiver benchmark-logger 'info))
-  (define handler (log-handler bmark-log-recv filename))
-  (parameterize ([current-logger benchmark-logger])
-    (define body-thd
-      (thread thunk))
-    (let loop ()
-      (sync
-       (handle-evt body-thd
-                   (λ (_)
-                     (log-message (current-logger) 'info "STOP" (bmark-log-end))
-                     (loop)))
-       (handle-evt bmark-log-recv 
-                   (λ (log-evt) 
-                     (match (vector-ref log-evt 2)
-                       [(bmark-log-end)
-                        (void)]
-                       [else
-                        (handler log-evt)
-                        (loop)])))))))
+    (make-log-receiver (current-logger) 'debug))
+  (define handler (log-handler filename))
+  (define body-thd
+    (thread thunk))
+  (let loop ()
+    (sync
+     (handle-evt body-thd
+                 (λ (_)
+                   (log-message (current-logger) 'info "STOP" (bmark-log-end))
+                   (loop)))
+     (handle-evt bmark-log-recv 
+                 (λ (log-evt)
+                   (define data (vector-ref log-evt 2))
+                   (match data
+                     [(? gc-info? d)
+                      (handle-gc-log-evt d)
+                      (loop)]
+                     [(bmark-log-end)
+                      (void)]
+                     [else
+                      (handler data)
+                      (loop)]))))))
 
-(define (log-handler recv filename)
-  (λ (log-evt)
-    (define msg (vector-ref log-evt 1))
-    (define data (vector-ref log-evt 2))
+(define (log-handler filename)
+  (λ (data)
     (match data
       [(bmark-log-data data)
        (call-with-output-file filename
@@ -51,6 +55,12 @@
          #:exists 'append)]
       [_ (void)])))
 
+(define (handle-gc-log-evt gci)
+  (when (gc-info-major? gci)
+    (bmark-log 'gc-major
+               `(#:amount ,(- (gc-info-pre-amount gci) (gc-info-post-amount gci))
+                 #:time ,(- (gc-info-end-process-time gci) (gc-info-start-process-time gci))))))
+
 (define (log-counterexample model gen cexp tries time)
   (bmark-log 'counterexample
              `(#:model ,(path-format model)