exported verbose-timer parameter that allows printing more detailed
information when "time" or "time-it" are used.
This commit is contained in:
parent
1d4db4b9c9
commit
8cd744d4bd
|
@ -15,7 +15,7 @@
|
||||||
|
|
||||||
|
|
||||||
(library (ikarus timers)
|
(library (ikarus timers)
|
||||||
(export time-it)
|
(export time-it verbose-timer)
|
||||||
(import (except (ikarus) time-it))
|
(import (except (ikarus) time-it))
|
||||||
|
|
||||||
(define-struct stats
|
(define-struct stats
|
||||||
|
@ -38,19 +38,21 @@
|
||||||
|
|
||||||
(define (print-stats message bytes t1 t0)
|
(define (print-stats message bytes t1 t0)
|
||||||
(define (print-time msg msecs gc-msecs)
|
(define (print-time msg msecs gc-msecs)
|
||||||
(printf " ~a ms elapsed ~a time, including ~a ms collecting\n" msecs msg
|
(fprintf
|
||||||
|
(console-error-port)
|
||||||
|
" ~a ms elapsed ~a time, including ~a ms collecting\n" msecs msg
|
||||||
gc-msecs))
|
gc-msecs))
|
||||||
(define (msecs s1 s0 u1 u0)
|
(define (msecs s1 s0 u1 u0)
|
||||||
(+ (* (- s1 s0) 1000) (quotient (- u1 u0) 1000)))
|
(+ (* (- s1 s0) 1000) (quotient (- u1 u0) 1000)))
|
||||||
(if message
|
(if message
|
||||||
(printf "running stats for ~a:\n" message)
|
(fprintf (console-error-port) "running stats for ~a:\n" message)
|
||||||
(printf "running stats:\n"))
|
(fprintf (console-error-port) "running stats:\n"))
|
||||||
(let ([collections
|
(let ([collections
|
||||||
(fx- (stats-collection-id t1) (stats-collection-id t0))])
|
(fx- (stats-collection-id t1) (stats-collection-id t0))])
|
||||||
(case collections
|
(case collections
|
||||||
[(0) (display " no collections\n")]
|
[(0) (display " no collections\n" (console-error-port))]
|
||||||
[(1) (display " 1 collection\n")]
|
[(1) (display " 1 collection\n" (console-error-port))]
|
||||||
[else (printf " ~a collections\n" collections)]))
|
[else (fprintf (console-error-port) " ~a collections\n" collections)]))
|
||||||
(print-time "cpu"
|
(print-time "cpu"
|
||||||
(+ (msecs (stats-user-secs t1) (stats-user-secs t0)
|
(+ (msecs (stats-user-secs t1) (stats-user-secs t0)
|
||||||
(stats-user-usecs t1) (stats-user-usecs t0))
|
(stats-user-usecs t1) (stats-user-usecs t0))
|
||||||
|
@ -76,7 +78,7 @@
|
||||||
(stats-sys-usecs t1) (stats-sys-usecs t0))
|
(stats-sys-usecs t1) (stats-sys-usecs t0))
|
||||||
(msecs (stats-gc-sys-secs t1) (stats-gc-sys-secs t0)
|
(msecs (stats-gc-sys-secs t1) (stats-gc-sys-secs t0)
|
||||||
(stats-gc-sys-usecs t1) (stats-gc-sys-usecs t0))))
|
(stats-gc-sys-usecs t1) (stats-gc-sys-usecs t0))))
|
||||||
(printf " ~a bytes allocated\n" bytes))
|
(fprintf (console-error-port) " ~a bytes allocated\n" bytes))
|
||||||
|
|
||||||
(define time-it
|
(define time-it
|
||||||
(case-lambda
|
(case-lambda
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1234
|
1235
|
||||||
|
|
|
@ -369,6 +369,7 @@
|
||||||
[expand i]
|
[expand i]
|
||||||
[environment? i]
|
[environment? i]
|
||||||
[time-it i]
|
[time-it i]
|
||||||
|
[verbose-timer i]
|
||||||
[current-time i]
|
[current-time i]
|
||||||
[time? i]
|
[time? i]
|
||||||
[time-second i]
|
[time-second i]
|
||||||
|
|
Loading…
Reference in New Issue