unikernel/duniverse/eqaf/check/benchmark.ml

@@ -0,0 +1,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) |])
+