suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

log major gcs in benchmark

Browse Source
This commit is contained in:
Burke Fetscher 2014-04-11 16:25:03 -05:00
parent a4acf18828
commit 5be934d70a
1 changed files with 35 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
pkgs/redex-pkgs/redex-examples/redex/examples/benchmark/logging.rkt
View File

@ -13,14 +13,16 @@
(struct bmark-log-data (data)) (struct bmark-log-data (data))
(struct bmark-log-end ()) (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 (with-logging-to filename thunk)
(define benchmark-logger
(make-logger #f (current-logger)))
(define bmark-log-recv (define bmark-log-recv
(make-log-receiver benchmark-logger 'info)) (make-log-receiver (current-logger) 'debug))
(define handler (log-handler bmark-log-recv filename)) (define handler (log-handler filename))
(parameterize ([current-logger benchmark-logger])
(define body-thd (define body-thd
(thread thunk)) (thread thunk))
(let loop () (let loop ()
@ -31,17 +33,19 @@
(loop))) (loop)))
(handle-evt bmark-log-recv (handle-evt bmark-log-recv
(λ (log-evt) (λ (log-evt)
(match (vector-ref log-evt 2) (define data (vector-ref log-evt 2))
(match data
[(? gc-info? d)
(handle-gc-log-evt d)
(loop)]
[(bmark-log-end) [(bmark-log-end)
(void)] (void)]
[else [else
(handler log-evt) (handler data)
(loop)]))))))) (loop)]))))))
(define (log-handler recv filename) (define (log-handler filename)
(λ (log-evt) (λ (data)
(define msg (vector-ref log-evt 1))
(define data (vector-ref log-evt 2))
(match data (match data
[(bmark-log-data data) [(bmark-log-data data)
(call-with-output-file filename (call-with-output-file filename
@ -51,6 +55,12 @@
#:exists 'append)] #:exists 'append)]
[_ (void)]))) [_ (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) (define (log-counterexample model gen cexp tries time)
(bmark-log 'counterexample (bmark-log 'counterexample
`(#:model ,(path-format model) `(#:model ,(path-format model)