conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

exported verbose-timer parameter that allows printing more detailed 

information when "time" or "time-it" are used.
This commit is contained in:
Abdulaziz Ghuloum 2007-12-12 23:58:10 -05:00
parent 1d4db4b9c9
commit 8cd744d4bd
3 changed files with 12 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
scheme/ikarus.timer.ss
View File

@ -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

2
scheme/last-revision
View File

@ -1 +1 @@
1234 1235

1
scheme/makefile.ss
View File

@ -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]