63 lines
1.7 KiB
OCaml
63 lines
1.7 KiB
OCaml
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) |])
|
|
|