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
|
type t = V : (unit -> 'a) -> t
let stabilize_garbage_collector () =
let rec go limit last_heap_live_words =
if limit <= 0 then failwith "Unable to stabilize the number of live words in the heap" ;
Gc.compact () ;
let stat = Gc.stat () in
if stat.Gc.live_words <> last_heap_live_words
then go (pred limit) stat.Gc.live_words in
go 10 0
let runnable f i =
for _ = 1 to i do ignore @@ Sys.opaque_identity (f ()) done [@@inline]
let tmp = Bytes.create 40
let reset () = Bytes.fill tmp 0 40 ' '
let print ppf (n, m) =
let l = n * 40 / m in
Bytes.fill tmp 0 l '#' ;
Fmt.pf ppf "[%s] %d%%%!" (Bytes.unsafe_to_string tmp) (n * 100 / m)
let samples = 750
let run t =
let idx = ref 0 in
let run = ref 0 in
let (V fn) = t in
let m = Array.create_float (samples * 2) in
reset () ;
Fmt.pr "%a" print (0, samples) ;
while !idx < samples do
let current_run = !run in
let current_idx = !idx in
(* XXX(dinosaure): GC and prints can put noise on our samples.
- GC is not predictable
- prints can add a latency on I/O *)
(* Fmt.pr "\r%a" print (current_idx, samples) ; *)
(* if current_run = 0 then stabilize_garbage_collector () ; *)
let time_0 = Clock.now () in
runnable fn current_run ;
let time_1 = Clock.now () in
m.((current_idx * 2) + 0) <- float_of_int current_run ;
m.((current_idx * 2) + 1) <- Int64.to_float (Int64.sub time_1 time_0) ;
let next =
(max : int -> int -> int) (int_of_float (float_of_int current_run *. 1.01)) (succ current_run) in
run := next ; incr idx
done ;
Fmt.pr "\r%a\n%!" print (samples, samples) ;
Array.init samples (fun i -> [| m.((i * 2) + 0); m.((i * 2) + 1) |])
|
