Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * Copyright (C) 1997-2000 NEC Research Institute. | |
4 | * | |
5 | * MLton is released under a BSD-style license. | |
6 | * See the file MLton-LICENSE for details. | |
7 | *) | |
8 | ||
9 | structure Timer: TIMER = | |
10 | struct | |
11 | structure SysUsr = | |
12 | struct | |
13 | datatype t = T of {sys: Time.time, usr: Time.time} | |
14 | ||
15 | fun export (T r) = r | |
16 | ||
17 | fun (T {sys, usr}) - (T {sys = s', usr = u'}) = | |
18 | T {sys = Time.- (sys, s'), | |
19 | usr = Time.- (usr, u')} | |
20 | end | |
21 | ||
22 | type cpu_timer = {gc: SysUsr.t, self: SysUsr.t} | |
23 | ||
24 | fun startCPUTimer (): cpu_timer = | |
25 | let | |
26 | val {gc = {utime = gcu, stime = gcs, ...}, | |
27 | self = {utime = selfu, stime = selfs}, ...} = | |
28 | MLtonRusage.rusage () | |
29 | in | |
30 | {gc = SysUsr.T {sys = gcs, usr = gcu}, | |
31 | self = SysUsr.T {sys = selfs, usr = selfu}} | |
32 | end | |
33 | ||
34 | fun checkCPUTimes {gc, self} = | |
35 | let | |
36 | val {gc = g', self = s'} = startCPUTimer () | |
37 | val gc = SysUsr.- (g', gc) | |
38 | val self = SysUsr.- (s', self) | |
39 | in | |
40 | {gc = SysUsr.export gc, | |
41 | nongc = SysUsr.export (SysUsr.- (self, gc))} | |
42 | end | |
43 | ||
44 | fun checkCPUTimer timer = | |
45 | let | |
46 | val {nongc, gc} = checkCPUTimes timer | |
47 | in | |
48 | {sys = Time.+ (#sys gc, #sys nongc), | |
49 | usr = Time.+ (#usr gc, #usr nongc)} | |
50 | end | |
51 | ||
52 | val totalCPUTimer = | |
53 | let | |
54 | val t = startCPUTimer () | |
55 | in | |
56 | fn () => t | |
57 | end | |
58 | ||
59 | val checkGCTime = #usr o #gc o checkCPUTimes | |
60 | ||
61 | type real_timer = Time.time | |
62 | ||
63 | fun startRealTimer (): real_timer = Time.now () | |
64 | ||
65 | fun checkRealTimer (t: real_timer): Time.time = | |
66 | Time.- (startRealTimer (), t) | |
67 | ||
68 | val totalRealTimer = | |
69 | let | |
70 | val t = startRealTimer () | |
71 | in | |
72 | fn () => t | |
73 | end | |
74 | end |