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

cs: fix time-apply process timing

Browse Source 
The `time-apply` function was measuring thread time instead of proecss
time. While thread time would be more useful in many cases, it's meant
to report process time.
This commit is contained in:
Matthew Flatt 2019-10-05 20:26:10 -06:00
parent 4fb8e4a38d
commit 88e7e0a5e4
1 changed files with 9 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
racket/src/cs/rumble/time.ss
View File

@ -78,21 +78,19 @@
(/ (time-nanosecond t) 1000000.)))
(define (time-apply f extra)
(let ([stats (statistics)])
(let ([pre-cpu (current-time 'time-process)]
[pre-real (current-time 'time-monotonic)]
[pre-gc (#%$gc-cpu-time)])
(call-with-values (lambda () (apply f extra))
(lambda args
(let ([new-stats (statistics)])
(let ([post-cpu (current-time 'time-process)]
[post-real (current-time 'time-monotonic)]
[post-gc (#%$gc-cpu-time)])
(values
args
(inexact->exact (floor (time->ms
(time-difference (sstats-cpu new-stats)
(sstats-cpu stats)))))
(inexact->exact (floor (time->ms
(time-difference (sstats-real new-stats)
(sstats-real stats)))))
(inexact->exact (floor (time->ms
(time-difference (sstats-gc-cpu new-stats)
(sstats-gc-cpu stats)))))))))))
(inexact->exact (floor (time->ms (time-difference post-cpu pre-cpu))))
(inexact->exact (floor (time->ms (time-difference post-real pre-real))))
(inexact->exact (floor (time->ms (time-difference post-gc pre-gc))))))))))
(define (current-gc-milliseconds)
(inexact->exact (floor (time->ms (#%$gc-cpu-time)))))