1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
let resident_set_memory () =
let size = Ctypes.(allocate size_t Unsigned.Size_t.zero) in
C.Functions.Resource.resident_set_memory size
|> Error.to_result (Ctypes.(!@) size)
let uptime () =
let time = Ctypes.(allocate double) 0. in
C.Functions.Resource.uptime time
|> Error.to_result (Ctypes.(!@) time)
let loadavg () =
let averages = Ctypes.(allocate_n double) ~count:3 in
C.Functions.Resource.loadavg averages;
let open Ctypes in
(!@ averages, !@ (averages +@ 1), !@ (averages +@ 2))
let free_memory =
C.Functions.Resource.free_memory
let total_memory =
C.Functions.Resource.total_memory
let constrained_memory () =
let result = C.Functions.Resource.constrained_memory () in
if result = Unsigned.UInt64.zero then
None
else
Some result
let getpriority pid =
let priority = Ctypes.(allocate int) 0 in
C.Functions.Resource.getpriority pid priority
|> Error.to_result (Ctypes.(!@) priority)
let setpriority pid priority =
C.Functions.Resource.setpriority pid priority
|> Error.to_result ()
type timeval = {
sec : Signed.Long.t;
usec : Signed.Long.t;
}
type rusage = {
utime : timeval;
stime : timeval;
maxrss : Unsigned.uint64;
ixrss : Unsigned.uint64;
idrss : Unsigned.uint64;
isrss : Unsigned.uint64;
minflt : Unsigned.uint64;
majflt : Unsigned.uint64;
nswap : Unsigned.uint64;
inblock : Unsigned.uint64;
oublock : Unsigned.uint64;
msgsnd : Unsigned.uint64;
msgrcv : Unsigned.uint64;
nsignals : Unsigned.uint64;
nvcsw : Unsigned.uint64;
nivcsw : Unsigned.uint64;
}
let load_timeval c_timeval =
{
sec = Ctypes.getf c_timeval C.Types.Resource.Timeval.sec;
usec = Ctypes.getf c_timeval C.Types.Resource.Timeval.usec;
}
let getrusage () =
let c_rusage = Ctypes.make C.Types.Resource.Rusage.t in
C.Functions.Resource.getrusage (Ctypes.addr c_rusage)
|> Error.to_result_lazy begin fun () ->
let module RU = C.Types.Resource.Rusage in
let field name = Ctypes.getf c_rusage name in
{
utime = field RU.utime |> load_timeval;
stime = field RU.stime |> load_timeval;
maxrss = field RU.maxrss;
ixrss = field RU.ixrss;
idrss = field RU.idrss;
isrss = field RU.isrss;
minflt = field RU.minflt;
majflt = field RU.majflt;
nswap = field RU.nswap;
inblock = field RU.inblock;
oublock = field RU.oublock;
msgsnd = field RU.msgsnd;
msgrcv = field RU.msgrcv;
nsignals = field RU.nsignals;
nvcsw = field RU.nvcsw;
nivcsw = field RU.nivcsw;
}
end