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 MLtonRusage: MLTON_RUSAGE = | |
10 | struct | |
11 | structure Prim = PrimitiveFFI.MLton.Rusage | |
12 | ||
13 | type t = {utime: Time.time, stime: Time.time} | |
14 | ||
15 | fun collect (utimeSec, utimeUsec, stimeSec, stimeUsec) = | |
16 | let | |
17 | fun toTime (sec, usec) = | |
18 | let | |
19 | val time_sec = | |
20 | Time.fromSeconds (C_Time.toLargeInt (sec ())) | |
21 | val time_usec = | |
22 | Time.fromMicroseconds (C_SUSeconds.toLargeInt (usec ())) | |
23 | in | |
24 | Time.+ (time_sec, time_usec) | |
25 | end | |
26 | in | |
27 | {stime = toTime (stimeSec, stimeUsec), | |
28 | utime = toTime (utimeSec, utimeUsec)} | |
29 | end | |
30 | ||
31 | val measureGC = MLtonGC.setRusageMeasureGC | |
32 | ||
33 | val rusage = | |
34 | let | |
35 | val () = measureGC true | |
36 | in | |
37 | fn () => | |
38 | let | |
39 | val () = Prim.getrusage () | |
40 | open Prim | |
41 | in | |
42 | {children = collect (children_utime_sec, children_utime_usec, | |
43 | children_stime_sec, children_stime_usec), | |
44 | gc = collect (gc_utime_sec, gc_utime_usec, | |
45 | gc_stime_sec, gc_stime_usec), | |
46 | self = collect (self_utime_sec, self_utime_usec, | |
47 | self_stime_sec, self_stime_usec)} | |
48 | end | |
49 | end | |
50 | end |