unikernel/duniverse/eqaf/check/README.md

@@ -0,0 +1,127 @@
+# Check tool - a small benchmark tool
+
+`eqaf` comes with a small benchmark tool to record time/tick spend by our functions:
+- `equal`
+- `compare`
+- `find_uint8`
+- `exists_uint8`
+
+This README.md wants to explain into details this tool.
+
+## Some problems
+
+Try to record time spend is hard. Indeed, the operating system or, at least, the
+CPU can disturb this specific sample. Of course, into a virtualized
+operating-system, it's more difficult to rely on this sample. At least,
+`check.exe` should be executed into a bare-metal operating system.
+
+By this fact, when we try to record time/tick, we have some noise. It's easily
+understable by this simple code (assume a `Clock.now ()` function which gives
+you the current time).
+
+```ocaml
+let bench f =
+  let a = Clock.now () in
+  f () ;
+  let b = Clock.now () in
+  Format.printf "%Ld ns.\n%!" (Int64.sub b a)
+```
+
+If you run `bench` two times, results are surely differents. The difference is
+small but enough to not be able to assert an equality. By this fact, try to
+check a predicate such as the _constant-time_ of our function is not so easy
+than that.
+
+**NOTE**: when we talk about _constant-time_, it's not an algorithmic
+_constant-time_ as we can believe. Currently, our equal function respects 2
+predicates (and we will fold them into one term, _constant-time_):
+- for 2 strings where lengths differs, `equal` must spend `B` ns where `B` is a
+  real constant
+- for 2 strings where lengths are equal but contents __can__ differs (or not),
+  `equal` must spend `A * L + B` where `L` is a the length of input strings and
+  `A` and `B` are real constants.
+
+Then, the first predicate should be a subset of the second where `L = 0`.
+
+## Metrics
+
+Currently, `check` relies (when you compile it into a Linux operating-system) on
+ticks with the _Time Stamp Counter_ instead to use `clock_gettime`. For MacOS or
+Windows, we use `clock_gettime` or something equivalent. It's a special ASM
+instruction. So, we possibly not handle your architecture.
+
+In fact, `RDTSC` is more reliable than `clock_gettime`.
+
+## Linear regresssion to infer `A * L + B`
+
+As we said, samples can be disturbed. So we are not able to just compare samples
+and see that they are equal or not. We must infer our equation `A * L + B` (eg.
+our _constant-time_ predicate). Our experience is done as follow:
+1) we infer our equation `A1 * L + B1` when we compare 2 strictly equal strings
+2) we infer our equation `A2 * L + B2` when we compare 2 strictly different
+strings
+
+Even if a computation of `Eqaf.equal` will return expected result (see _fuzzer_
+and basic tests):
+1) The function always returns `true`
+2) The function always returns `false`
+
+We want to check that `A1 = A2` and `B1 = B2`, or, in other words, we infer the
+same equation independently than inputs (different or not) - if we check that
+time spent by `Eqaf.equal` does not depend on inputs. At the end, this check
+means that `Eqaf.equal` does not leak any information by the _time side
+channel_.
+
+To be able to infer our equation, we use a linear regression: 1) we follow a
+sequence to execute our function `R0 = 1`, `Rn = max (R(n-1) * 1.01, R(n-1) +
+1)` when `R` is how many times we execute our function and `n` is our iteration
+Arbitrary, we do 750 iterations 2) For each iteration, we record our time metric
+as follow: `samples.(n).(0) <- tick` `samples.(n).(1) <- R` 3) At the end, from
+these samples, we can infer by a linear regression our equation. The resulted
+coefficient of determination should be higher than 0.95. It tells to us that the
+infered equation is good enough.
+
+## A counter example
+
+However, we should show a counter example of our results and we can do that with
+`String.equal`. So we redo the experience with `String.equal` and we should have
+an inequality betwen our equations.
+
+**NOTE**: If 2 strings are physically equal, `String.equal` does not introspect
+contents and it returns directly `true`. So we ensure that strings can be equal
+(and they are) but they are not physically equal.
+
+## Predictible results
+
+When we generate different strings, we do that randomly. The first diff
+character can be at the beginning of the string or at the end. Because of that,
+time spent by `String.equal` is not very predictable - it depends, as we want to
+solve, from contents. By this way, `check.exe` use a constant seed to generate
+strings to be more predictable about results.
+
+## How to compare our equations
+
+Come back earlier, we want to check that our first equation when inputs are
+equal is the same than our equation when inputs are not equal. However, due to
+our problems (noise on our samples), we can not strictly assert that they are
+equal. However, we can infer the difference between them with 2 techniques:
+1) CCEA technique
+2) SPSS technique
+
+Both are explained into `check.ml` and they are not really formalized as we
+expect. However, they give to us a way to compare our results. From them, it
+comes a _coefficient_ which should be between `30.0` and `30.0`. Of course, this
+segment is arbitrary but it's far from what we can get when we do the same
+process with `String.equal`.
+
+So if we don't have a good _coefficient_ with the CCEA technique, we restart the
+process with the SPSS technique as the final result.
+
+## Tries
+
+At the end, if we have a _good_ final coefficient, we can say that our function
+respects our predicate. If the coefficient of the determination is not good
+enough (`<= 0.95`), we restart the process. If we don't have a good final
+_coefficient_, we restart the process.
+
+At least, we give 20 chances to our process to check our predicate.

unikernel/duniverse/eqaf/check/bench.ml

@@ -0,0 +1,137 @@
+let seed = "4EygbdYh+v35vvrmD9YYP4byT5E3H7lTeXJiIj+dQnc="
+let seed = Base64.decode_exn seed
+
+let seed =
+  let res = Array.make (String.length seed / 2) 0 in
+  for i = 0 to (String.length seed / 2) - 1 do
+    res.(i) <- (Char.code seed.[i * 2] lsl 8) lor Char.code seed.[(i * 2) + 1]
+  done;
+  res
+
+let () =
+  let random_seed = seed in
+  Random.full_init random_seed
+
+let random length =
+  let get _ =
+    match Random.int (10 + 26 + 26) with
+    | n when n < 10 -> Char.(chr (code '0' + n))
+    | n when n < 10 + 26 -> Char.(chr (code 'a' + n - 10))
+    | n -> Char.(chr (code 'A' + n - 10 - 26))
+  in
+  String.init length get
+
+open Bechamel
+open Toolkit
+
+let hash_eq_0 = random 4096
+let hash_eq_1 = Bytes.to_string (Bytes.of_string hash_eq_0)
+let chr_into_hash_eq_0 = hash_eq_0.[Random.int 4096]
+let hash_neq_0 = random 4096
+
+let hash_neq_1 =
+  let rec go limit =
+    if limit <= 0 then failwith "Impossible to generate different hashes.";
+    let res = random 4096 in
+    if res = hash_neq_0 then go (pred limit) else res
+  in
+  go 10
+
+let random_chr =
+  let rec go limit =
+    if limit <= 0 then
+      failwith
+        "Impossible to generate a byte which does not appear into hash_neq_0.";
+    let res = Char.chr (Random.int 256) in
+    if not (String.contains hash_neq_0 res) then res else go (pred limit)
+  in
+  go 10
+
+let test_equal0 =
+  Test.make ~name:"equal"
+    (Staged.stage @@ fun () -> Eqaf.equal hash_eq_0 hash_eq_1)
+
+let test_equal1 =
+  Test.make ~name:"not equal"
+    (Staged.stage @@ fun () -> Eqaf.equal hash_neq_0 hash_neq_1)
+
+let cfg = Benchmark.cfg ~start:100
+
+let test_compare0 =
+  Test.make ~name:"equal"
+    (Staged.stage @@ fun () -> Eqaf.compare_be hash_eq_0 hash_eq_1)
+let test_compare1 =
+  Test.make ~name:"not equal"
+    (Staged.stage @@ fun () -> Eqaf.compare_be hash_neq_0 hash_neq_1)
+
+let f_eq_0 (v : int) = v = Char.code chr_into_hash_eq_0
+let f_neq_0 (v : int) = v = Char.code random_chr
+
+let test_exists0 =
+  Test.make ~name:"equal"
+    (Staged.stage @@ fun () -> Eqaf.exists_uint8 ~f:f_eq_0 hash_eq_0)
+let test_exists1 =
+  Test.make ~name:"not equal"
+    (Staged.stage @@ fun () -> Eqaf.exists_uint8 ~f:f_neq_0 hash_neq_0)
+
+let f_hash_eq_0 (v : int) = v = Char.code chr_into_hash_eq_0
+let f_random (v : int) = v = Char.code random_chr
+
+let test_find0 =
+  Test.make ~name:"equal"
+    (Staged.stage @@ fun () -> Eqaf.find_uint8 ~f:f_hash_eq_0 hash_eq_0)
+let test_find1 =
+  Test.make ~name:"not equal"
+    (Staged.stage @@ fun () -> Eqaf.find_uint8 ~f:f_random hash_neq_0)
+
+let benchmark () =
+  let ols =
+    Analyze.ols ~bootstrap:0 ~r_square:true ~predictors:Measure.[| run |]
+  in
+  let instances =
+    Instance.[ monotonic_clock ]
+  in
+  let cfg =
+    Benchmark.cfg ~limit:2000 ~stabilize:true ~quota:(Time.second 1.)
+      ~start:1000 ~kde:(Some 1000) ()
+  in
+  let test_equal =
+    Test.make_grouped ~name:"equal" ~fmt:"%s %s"
+      [ test_equal0; test_equal1 ]
+  in
+  let test_compare =
+    Test.make_grouped ~name:"compare" ~fmt:"%s %s"
+      [ test_compare0; test_compare1 ]
+  in
+  let test_exists =
+    Test.make_grouped ~name:"exists" ~fmt:"%s %s"
+      [ test_exists0; test_exists1 ]
+  in
+  let test_find =
+    Test.make_grouped ~name:"find" ~fmt:"%s %s"
+      [ test_find0; test_find1 ]
+  in
+  let raw_results =
+    Benchmark.all cfg instances
+      (Test.make_grouped ~name:"benchmark" ~fmt:"%s %s"
+         [ test_equal; test_compare; test_exists; test_find ])
+  in
+  let results =
+    List.map (fun instance -> Analyze.all ols instance raw_results) instances
+  in
+  let pr_bench name value =
+    Format.printf
+      {|{"results": [{"name": "eqaf", "metrics": [{"name": "%s", "value": %f, "units": "ns"}]}]}@.|}
+      name value
+  in
+  let results = Analyze.merge ols instances results in
+  let timings = Hashtbl.find results "monotonic-clock" in
+  Hashtbl.iter
+    (fun c v ->
+       match Analyze.OLS.estimates v with
+       | None -> ()
+       | Some ts -> List.iter (pr_bench c) ts)
+    timings;
+  ()
+
+let () = benchmark ()

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) |])
+

unikernel/duniverse/eqaf/check/check.ml

@@ -0,0 +1,490 @@
+let exit_success = 0
+let exit_failure = 1
+
+external random_seed : unit -> int array = "caml_sys_random_seed"
+
+let pp_int_array ppf arr =
+  Fmt.pf ppf "[|" ;
+  for i = 0 to pred (Array.length arr) do Fmt.pf ppf "%d;" arr.(i) done ;
+  Fmt.pf ppf "|]"
+
+ (* XXX(dinosaure): deterministic generation.
+    It appears that some calls of [check/check.exe] does not get same results,
+    mostly about [String.*] functions. As we understand implementation of them,
+    it's an expected behavior but it puts some noises when we try to introspect
+    results on different platforms.
+    
+    So all inputs are generated with this seed to be able to get as much as we
+    can reproducible outputs. *)
+let seed = "4EygbdYh+v35vvrmD9YYP4byT5E3H7lTeXJiIj+dQnc="
+let seed = Base64.decode_exn seed
+let seed =
+   let res = Array.make (String.length seed / 2) 0 in
+   for i = 0 to (String.length seed / 2) - 1
+   do res.(i) <- (Char.code seed.[i * 2] lsl 8) lor (Char.code seed.[i * 2 + 1]) done ;
+   res
+
+let () =
+  let random_seed = seed in
+  Fmt.pr "Random: %a.\n%!" pp_int_array random_seed ;
+  Random.full_init random_seed
+
+let random length =
+  let get _ =
+    match Random.int (10 + 26 + 26) with
+    | n when n < 10 -> Char.(chr (code '0' + n))
+    | n when n < 10 + 26 -> Char.(chr (code 'a' + n - 10))
+    | n -> Char.(chr (code 'A' + n - 10 - 26)) in
+  String.init length get
+
+let hash_eq_0 = random 4096
+let hash_eq_1 = Bytes.to_string (Bytes.of_string hash_eq_0)
+let chr_into_hash_eq_0 = hash_eq_0.[Random.int 4096]
+let int32_into_hash_eq_0 =
+  Unsafe.get_int32_ne (Bytes.of_string hash_eq_0) (Random.int (4096-4))
+let int32_into_hash_eq_1 =
+  Unsafe.get_int32_ne (Bytes.of_string hash_eq_1) (Random.int (4096-4))
+let int14_into_hash_eq_0 =
+  Unsafe.get_int32_ne (Bytes.of_string hash_eq_0) (Random.int (4096-4))
+  |> (Int32.logand 0xfffl)
+let int14_into_hash_eq_1 =
+  Unsafe.get_int32_ne (Bytes.of_string hash_eq_1) (Random.int (4096-4))
+  |> (Int32.logand 0xfffl)
+
+let () = assert (hash_eq_0 != hash_eq_1)
+let () = assert (hash_eq_0 = hash_eq_1)
+let () = assert (String.contains hash_eq_0 chr_into_hash_eq_0)
+
+let hash_neq_0 = random 4096
+let hash_neq_1 =
+  let rec go limit =
+    if limit <= 0 then failwith "Impossible to generate different hashes." ;
+    let res = random 4096 in
+    if res = hash_neq_0 then go (pred limit) else res in
+  go 10
+let random_chr =
+  let rec go limit =
+    if limit <= 0 then failwith "Impossible to generate a byte which does not appear into hash_neq_0." ;
+    let res = Char.chr (Random.int 256) in
+    if not (String.contains hash_neq_0 res) then res else go (pred limit) in
+  go 10
+
+let () = assert (hash_neq_0 <> hash_neq_1)
+let () = assert (not (String.contains hash_neq_0 random_chr))
+
+let error_msgf fmt = Fmt.kstrf (fun err -> Error (`Msg err)) fmt
+
+let merge m0 m1 =
+  let cons_0 r = [| 0.; r.(0); r.(1) |] in
+  let cons_1 r = [| 1.; r.(0); r.(1) |] in
+  Array.(append (map cons_0 m0) (map cons_1 m1))
+
+let test_spss fn_0 fn_1 =
+  Fmt.pr "> Start benchmarks on [fn⁰].\n%!" ;
+  let m0 = Benchmark.run fn_0 in
+  Fmt.pr "> Start benchmarks on [fn¹].\n%!" ;
+  let m1 = Benchmark.run fn_1 in
+  Fmt.pr "> Merge results.\n%!" ;
+  let m = merge m0 m1 in
+  let m = Array.map (fun r -> [| r.(0); r.(1); r.(2); r.(0) *. r.(1) |]) m in
+  Fmt.pr "> Start linear regression.\n%!" ;
+  match Linear_algebra.ols
+          (fun m -> m.(2))
+          [|(fun m -> m.(0)); (fun m -> m.(1)); (fun m -> m.(3))|]
+          m with
+  | Ok (estimates, r_square) ->
+    if r_square >= 0.95 then Ok estimates
+    else error_msgf "r² (%f) is bad" r_square
+  | Error (`Msg _) as err -> err
+
+let test_ccea fn_0 fn_1 =
+  Fmt.pr "> Start benchmarks on [fn⁰].\n%!" ;
+  let m0 = Benchmark.run fn_0 in
+  Fmt.pr "> Start benchmarks on [fn¹].\n%!" ;
+  let m1 = Benchmark.run fn_1 in
+  match Linear_algebra.ols (fun m -> m.(1)) [|(fun m -> m.(0))|] m0,
+        Linear_algebra.ols (fun m -> m.(1)) [|(fun m -> m.(0))|] m1 with
+  | Ok (estimates_0, r_square_0),
+    Ok (estimates_1, r_square_1) ->
+    Fmt.epr "> Calculating Z.\n%!" ;
+    let z = (estimates_0.(0) -. estimates_1.(0)) /. sqrt ((r_square_0 ** 2.) +. (r_square_1 ** 2.)) in
+    Ok z
+  | (Error (`Msg _) as err), Ok _ -> err
+  | Ok _, (Error (`Msg _) as err) -> err
+  | Error (`Msg err0), Error (`Msg err1) ->
+    Fmt.epr "Got errors for while processing both.\n%!" ;
+    Fmt.epr "B¹: %s.\n%!" err0 ;
+    Fmt.epr "B²: %s.\n%!" err1 ;
+    exit exit_failure
+
+let ccea ~reset ~switch ~name_of_fns_0 ~name_of_fns_1 fns_0 fns_1 =
+  Fmt.pr "> Start to test %s (B¹).\n%!" name_of_fns_0 ;
+  reset () ;
+  let eqaf = test_ccea (fst fns_0) (snd fns_0) in
+  switch () ;
+  Fmt.pr "> Start to test %s (B²).\n%!" name_of_fns_1 ;
+  let stdlib = test_ccea (fst fns_1) (snd fns_1) in
+  match eqaf, stdlib with
+  | Ok eqaf, Ok stdlib ->
+    Ok (eqaf, stdlib)
+  | Error (`Msg err), Ok _ ->
+    Fmt.epr "Got an error while processing %s: %s\n%!" name_of_fns_0 err ;
+    Error ()
+  | Ok _, Error (`Msg err) ->
+    Fmt.epr "Got an error while processing %s: %s\n%!" name_of_fns_1 err ;
+    Error ()
+  | Error (`Msg err0), Error (`Msg err1) ->
+    Fmt.epr "Got errors while processing both:\n%!" ;
+    Fmt.epr "B¹> %s.\n%!" err0 ;
+    Fmt.epr "B²> %s.\n%!" err1 ;
+    Error ()
+
+let spss ~reset ~switch ~name_of_fns_0 ~name_of_fns_1 fns_0 fns_1 =
+  Fmt.pr "> Start to test %s (B¹).\n%!" name_of_fns_0 ;
+  reset () ;
+  let eqaf = test_spss (fst fns_0) (snd fns_0) in
+  switch () ;
+  Fmt.pr "> Start to test %s (B²).\n%!" name_of_fns_1 ;
+  let stdlib = test_spss (fst fns_1) (snd fns_1) in
+
+  match eqaf, stdlib with
+  | Ok eqaf, Ok stdlib ->
+    Fmt.pr "%s: %f ns/run.\n%!" name_of_fns_0 eqaf.(1) ;
+    Fmt.pr "%s: %f ns/run.\n%!" name_of_fns_1 stdlib.(1) ;
+    Ok (eqaf.(2), stdlib.(2))
+  | Error (`Msg err), Ok _ ->
+    Fmt.epr "Got an error while processing %s: %s\n%!" name_of_fns_0 err ;
+    Error ()
+  | Ok _, Error (`Msg err) ->
+    Fmt.epr "Got an error while processing %s: %s\n%!" name_of_fns_1 err ;
+    Error ()
+  | Error (`Msg err0), Error (`Msg err1) ->
+    Fmt.epr "Got errors while processing both:\n%!" ;
+    Fmt.epr "B¹> %s.\n%!" err0 ;
+    Fmt.epr "B²> %s.\n%!" err1 ;
+    Error ()
+
+(* XXX(dinosaure): this program try to compute diff between 2 coefficient
+   regressions:
+
+   - 1: time needed to compute equal function on 2 same values ([_eq])
+   - 2: time needed to compute equal function on 2 different values ([_neq])
+
+   ### Samples
+
+   We have 2 ways to compute it. The first is to compute a regression equation
+   which includes group 1 and group 2. A initial regression equation can be done
+   to know how long [equal] lasts:
+
+   regression
+     /dep time // m.(1)
+     /method = enter run // m.(0)
+
+   It's a basic linear regression where we run 1..N times the function with same
+   inputs. Then, we have a matrix such as:
+
+   m.(n).(0) <- time
+   m.(n).(1) <- run
+
+   Obviously, if our function is /constant-time/, you should have something like:
+
+   y = m.(x).(0) = a * m.(x).(1) + b
+
+   To infer the curve, we use the linear regression for each points. Then, we
+   collect same samples but with [_neq] values. Now, the goal is to see that
+   [_eq]: y = a * x + b and [_neq]: y = a * x + b are ~ equals. For that, we have
+   2 ways.
+
+   ### SPSS
+
+   The first way to compare group 1 ([_eq]) and group 2 ([_neq]): we need to
+   insert a dummy variable [kind] where it is equal to [0.0] when it's owned by
+   the group 1 and [1.1] is owned by the group 2 (see [cons_*] function).
+   Finally, we had a new variable which is the product between [kind] ([m.(0)])
+   and [run] ([m.(1)]).
+
+   Finally, we can start to compute a regression equation where [time] will be
+   the responder and [kind], [run] and [kind * run] will be predictors:
+
+   regression
+     /dep time // m.(2)
+     /method = enter kind run (kind * run) // m.(0) m.(1) m.(3)
+
+   Time of [equal] will be available on [estimates.(1)] and diff will be
+   available on [estimates.(2)]. [compare_spss] checks r² ([>= 0.95]) and
+   main program checks if the diff is between [-30.0] and [30.0].
+
+   ### CCEA
+
+   The second way to compare group 1 and group 2: it consists to compute basic
+   regression equation to know how long [equal] lasts. Then, we will compute [Z]
+   which is equal to:
+
+        B¹-B²
+   ---------------
+   sqrt(r¹² + r²²)
+
+   Where B¹ and B² are regression coefficients for [_eq] and [_neq] and r¹ and r²
+   are standard error of B¹ and B². Then, main program, as the first way, checks
+   if [Z] is between [-30.0] and [30.0].
+
+   NOTE about SPSS:
+
+   This is the name of a software which explain how to compare results of linear
+   regression.
+
+   NOTE about CCEA:
+
+   I don't remmember when I got this name but it seems close to Vuong test.
+
+   NOTE about virtualization:
+
+   Virtual context (VirtualBox, VMWare, Xen or qemu) can delayed CPU instructions
+   and tricks on the time spended to execute them. By this fact, time counter lies
+   about time needed to compute [equal] function. So, in a virtual context we can
+   have some noises when we record measures (in [Benchmark]).
+
+   NOTE about bare-metal:
+   
+   In a bare-metal context, results are more determinists (but they are not
+   completely fixed). In fact, it depends on the system-scheduler which can 
+   prioritize an other process while [check/check.exe] is executed. For all of
+   these reasons, [check/check.exe] is really fragile and can not work in
+   your context - however, a CI with [eqaf] is provided is we surely are aware
+   of it and results. *)
+
+module Make (Check : sig 
+    type ret
+
+    val eqaf_name : string
+    val stdlib_name : string
+
+    val reset : unit -> unit
+    val switch : unit -> unit
+
+    val eqaf_true : unit -> ret
+    val eqaf_false : unit -> ret
+
+    val stdlib_true : unit -> ret
+    val stdlib_false : unit -> ret
+  end) = struct
+  open Check
+
+  let last_chance () =
+    let open Benchmark in
+    match ccea
+            ~reset:Check.reset ~switch:Check.switch
+            ~name_of_fns_0:eqaf_name
+            ~name_of_fns_1:stdlib_name
+            (V eqaf_true, V eqaf_false)
+            (V stdlib_true, V stdlib_false) with
+    | Error () -> exit_failure
+    | Ok (eqaf, stdlib) ->
+      if eqaf >= -30. && eqaf <= 30.
+      then ( Fmt.pr "Z¹ = %f, Z² = %f.\n%!" eqaf stdlib ; exit_success )
+      else ( Fmt.pr "Z¹ = %f, Z² = %f.\n%!" eqaf stdlib ; exit_failure )
+  
+  let test () =
+    let open Benchmark in
+    match spss
+            ~reset:Check.reset ~switch:Check.switch
+            ~name_of_fns_0:eqaf_name
+            ~name_of_fns_1:stdlib_name
+            (V eqaf_true, V eqaf_false)
+            (V stdlib_true, V stdlib_false) with
+    | Error () -> last_chance ()
+    | Ok (eqaf, stdlib) ->
+      if eqaf >= -30. && eqaf <= 30.
+      then ( Fmt.pr "B¹ = %f, B² = %f.\n%!" eqaf stdlib ; exit_success )
+      else
+        ( Fmt.pr "Fail with B¹ = %f, B² = %f.\n%!" eqaf stdlib ;
+          Fmt.pr "> Start to compute Z.\n%!" ;
+          last_chance () )
+end
+
+module Equal = Make(struct
+  type ret = bool
+
+  let eqaf_name = "Eqaf.equal"
+  let stdlib_name = "String.equal"
+
+  let reset = ignore and switch = ignore
+
+  let stdlib_true () = String.equal hash_eq_0 hash_eq_1
+  let stdlib_false () =
+    for _ = 1 to 100
+    do let _ = String.equal hash_neq_0 hash_neq_1 in () done ;
+    String.equal hash_neq_0 hash_neq_1
+
+  let eqaf_true () = Eqaf.equal hash_eq_0 hash_eq_1
+  let eqaf_false () = Eqaf.equal hash_neq_0 hash_neq_1
+end)
+
+module Compare = Make(struct
+  type ret = int
+
+  let eqaf_name = "Eqaf.compare"
+  let stdlib_name = "String.compare"
+
+  let reset = ignore and switch = ignore
+
+  let stdlib_true () = String.compare hash_eq_0 hash_eq_1
+  let stdlib_false () =
+    for _ = 1 to 100
+    do let _ = String.compare hash_neq_0 hash_neq_1 in () done ;
+    String.compare hash_neq_0 hash_neq_1
+  
+  let eqaf_true () = Eqaf.compare_be hash_eq_0 hash_eq_1
+  let eqaf_false () = Eqaf.compare_be hash_neq_0 hash_neq_1
+end)
+
+module Exists = Make(struct
+  type ret = bool
+
+  let eqaf_name = "Eqaf.exists_uint8"
+  let stdlib_name = "String.contains"
+
+  let constant = ref (Char.code chr_into_hash_eq_0)
+  let reset () = constant := Char.code chr_into_hash_eq_0
+  let switch () = constant := Char.code random_chr
+
+  let stdlib_true () = String.contains hash_eq_0 chr_into_hash_eq_0
+  let stdlib_false () = String.contains hash_neq_0 random_chr
+
+  let f (v : int) = v = !constant
+  let eqaf_true () = Eqaf.exists_uint8 ~f hash_eq_0
+  let eqaf_false () = Eqaf.exists_uint8 ~f hash_neq_0
+end)
+
+module Find = Make(struct
+  type ret = int
+
+  let eqaf_name = "Eqaf.find_uint8"
+  let stdlib_name = "String.index"
+
+  let switch () = ()
+  let reset () = ()
+
+  let stdlib_true () = String.index hash_eq_0 chr_into_hash_eq_0
+  let stdlib_false () = try String.index hash_neq_0 random_chr with Not_found -> (-1)
+
+  let f_hash_eq_0 (v : int) = v = Char.code chr_into_hash_eq_0
+  let f_random (v : int) = v = Char.code random_chr
+  let eqaf_true () = Eqaf.find_uint8 ~f:f_hash_eq_0 hash_eq_0
+  let eqaf_false () = Eqaf.find_uint8 ~f:f_random hash_neq_0
+end)
+
+module Divmod32 = Make(struct
+  type ret = int32 * int32
+
+  let eqaf_name = "Eqaf.divmod"
+  let stdlib_name = "Int32.unsigned_div,Int32.unsigned_rem"
+
+
+  let switch () = ()
+  let reset () = ()
+
+  (* These are here for compat with OCaml <= 4.09
+     from >= they can be replaced by
+     Int32.unsigned_div
+     Int32.unsigned_rem
+  *)
+  let int32_div_unsigned n d =
+    let sub,min_int = Int32.(sub,min_int)in
+    let int32_unsigned_compare n m =
+        Int32.compare (sub n min_int) (sub m min_int)
+    in
+    if d < 0_l then
+      if int32_unsigned_compare n d < 0 then 0_l else 1_l
+    else
+      let q =
+        let open Int32 in
+        shift_left (Int32.div (Int32.shift_right_logical n 1) d) 1 in
+      let r = sub n (Int32.mul q d) in
+      if int32_unsigned_compare r d >= 0 then Int32.succ q else q
+  let int32_rem_unsigned n d =
+    Int32.sub n (Int32.mul (int32_div_unsigned n d) d)
+
+  (* TODO *)
+  let stdlib_true () =
+    let x, m = int32_into_hash_eq_0, int14_into_hash_eq_0 in
+    int32_div_unsigned x m,
+    int32_rem_unsigned x m
+  let stdlib_false () =
+    let x, m = int32_into_hash_eq_1, int14_into_hash_eq_1 in
+    int32_div_unsigned x m,
+    int32_rem_unsigned x m
+
+  let eqaf_true () =
+    Eqaf.divmod ~x:int32_into_hash_eq_0 ~m:int14_into_hash_eq_0
+  let eqaf_false () =
+    Eqaf.divmod ~x:int32_into_hash_eq_1 ~m:int14_into_hash_eq_1
+end)
+
+module Ascii_int32 = Make(struct
+  type ret = string
+
+  let eqaf_name = "Eqaf.ascii_of_int32"
+  let stdlib_name = "Int32.to_string"
+
+
+  let switch () = ()
+  let reset () = ()
+
+  (* TODO setting 0x8000 bit ensures five digits.
+     We need a constant amount of digits to specify ~digits because
+     we don't have a [Int32.to_string] that left-pads.
+     Maybe we can use [Format.sprintf] ?
+  *)
+  let true_int = Int32.logand 0x8000l int14_into_hash_eq_0
+  let false_int = Int32.logand 0x8000l int14_into_hash_eq_1
+  let stdlib_true () = Int32.to_string true_int
+  let stdlib_false () = Int32.to_string false_int
+
+  let eqaf_true () = Eqaf.ascii_of_int32 ~digits:5 true_int
+  let eqaf_false () = Eqaf.ascii_of_int32 ~digits:5 false_int
+end)
+
+let limit = 20
+
+let () =
+  let rec _0 tried =
+    if tried > 20 then invalid_arg "Too many tried for Eqaf.equal" ;
+    let res = Equal.test () in
+    if res = exit_success then tried else _0 (succ tried) in
+  let rec _1 tried =
+    if tried > 20 then invalid_arg "Too many tried for Eqaf.compare" ;
+    let res = Compare.test () in
+    if res = exit_success then tried else _1 (succ tried) in
+  let rec _2 tried =
+    if tried > 20 then invalid_arg "Too many tried for Eqaf.exists" ;
+    let res = Exists.test () in
+    if res = exit_success then tried else _2 (succ tried) in
+  let rec _3 tried =
+    if tried > 20 then invalid_arg "Too many tried for Eqaf.find_uint8" ;
+    let res = Find.test () in
+    if res = exit_success then tried else _3 (succ tried) in
+  let rec _4 tried =
+    if tried > 20 then invalid_arg "Too many tried for Eqaf.divmod" ;
+    let res = Divmod32.test () in
+    if res = exit_success then tried else _4 (succ tried) in
+  let pr_bench name value = 
+    Fmt.pr {|{"results": [{"name": "check", "metrics": [{"name": "%s", "value": %d}]}]}@.|} name value in
+  
+  let _0 = _0 1 in
+  Fmt.pr "%d trial(s) for Eqaf.equal.\n%!" _0 ;
+  pr_bench "equal" _0 ;
+  let _1 = _1 1 in
+  Fmt.pr "%d trial(s) for Eqaf.compare.\n%!" _1 ;
+  pr_bench "compare" _1 ;
+  let _2 = _2 1 in
+  Fmt.pr "%d trial(s) for Eqaf.exists.\n%!" _2 ;
+  pr_bench "exists" _2 ;
+  let _3 = _3 1 in
+  Fmt.pr "%d trial(s) for Eqaf.find_uint8.\n%!" _3 ;
+  pr_bench "find_uint8" _3 ;
+  let _4 = _4 1 in
+  Fmt.pr "%d trial(s) for Eqaf.divmod.\n%!" _4 ;
+  pr_bench "divmod" _4 ;
+
+  exit exit_success

unikernel/duniverse/eqaf/check/dune

@@ -0,0 +1,20 @@
+(executable
+ (name check)
+ (modules check linear_algebra benchmark fmt unsafe)
+ (libraries eqaf base64 clock))
+
+(executable
+ (name bench)
+ (modules bench)
+ (libraries bechamel eqaf base64))
+
+(rule
+ (copy %{read:../config/which-unsafe-file} unsafe.ml))
+
+(rule
+ (alias runbench)
+ (package eqaf)
+ (deps
+  (:check check.exe))
+ (action
+  (run %{check})))

unikernel/duniverse/eqaf/check/fmt.ml

@@ -0,0 +1,4 @@
+let pr fmt = Format.printf fmt
+let epr fmt = Format.eprintf fmt
+let pf ppf fmt = Format.fprintf ppf fmt
+let kstrf k fmt = Format.kasprintf k fmt

unikernel/duniverse/eqaf/check/linear_algebra.ml

@@ -0,0 +1,129 @@
+(* Code under Apache License 2.0 - Jane Street Group, LLC <opensource@janestreet.com> *)
+
+let col_norm a column =
+  let acc = ref 0. in
+  for i = 0 to Array.length a - 1 do
+    let entry = a.(i).(column) in
+    acc := !acc +. (entry *. entry)
+  done ;
+  sqrt !acc
+
+let col_inner_prod t j1 j2 =
+  let acc = ref 0. in
+  for i = 0 to Array.length t - 1 do
+    acc := !acc +. (t.(i).(j1) *. t.(i).(j2))
+  done ;
+  !acc
+
+let qr_in_place a =
+  let m = Array.length a in
+  if m = 0 then ([||], [||])
+  else
+    let n = Array.length a.(0) in
+    let r = Array.make_matrix n n 0. in
+    for j = 0 to n - 1 do
+      let alpha = col_norm a j in
+      r.(j).(j) <- alpha ;
+      let one_over_alpha = 1. /. alpha in
+      for i = 0 to m - 1 do
+        a.(i).(j) <- a.(i).(j) *. one_over_alpha
+      done ;
+      for j2 = j + 1 to n - 1 do
+        let c = col_inner_prod a j j2 in
+        r.(j).(j2) <- c ;
+        for i = 0 to m - 1 do
+          a.(i).(j2) <- a.(i).(j2) -. (c *. a.(i).(j))
+        done
+      done
+    done ;
+    (a, r)
+
+let qr ?(in_place = false) a =
+  let a = if in_place then a else Array.map Array.copy a in
+  qr_in_place a
+
+let mul_mv ?(trans = false) a x =
+  let rows = Array.length a in
+  if rows = 0 then [||]
+  else
+    let cols = Array.length a.(0) in
+    let m, n, get =
+      if trans then
+        let get i j = a.(j).(i) in
+        (cols, rows, get)
+      else
+        let get i j = a.(i).(j) in
+        (rows, cols, get)
+    in
+    if n <> Array.length x then failwith "Dimension mismatch" ;
+    let result = Array.make m 0. in
+    for i = 0 to m - 1 do
+      let v, _ =
+        Array.fold_left
+          (fun (acc, j) x -> (acc +. (get i j *. x), succ j))
+          (0., 0) x
+      in
+      result.(i) <- v
+    done ;
+    result
+
+let is_nan v = match classify_float v with FP_nan -> true | _ -> false
+  let error_msg msg = Error (`Msg msg)
+
+let triu_solve r b =
+  let m = Array.length b in
+  if m <> Array.length r then
+    error_msg
+      "triu_solve R b requires R to be square with same number of rows as b"
+  else if m = 0 then Ok [||]
+  else if m <> Array.length r.(0) then
+    error_msg "triu_solve R b requires R to be a square"
+  else
+    let sol = Array.copy b in
+    for i = m - 1 downto 0 do
+      sol.(i) <- sol.(i) /. r.(i).(i) ;
+      for j = 0 to i - 1 do
+        sol.(j) <- sol.(j) -. (r.(j).(i) *. sol.(i))
+      done
+    done ;
+    if Array.exists is_nan sol then
+      error_msg "triu_solve detected NaN result"
+    else Ok sol
+
+let ols ?(in_place = false) a b =
+  let q, r = qr ~in_place a in
+  triu_solve r (mul_mv ~trans:true q b)
+
+let make_lr_inputs responder predictors m =
+  Array.init (Array.length m) (fun i -> Array.map (fun a -> a m.(i)) predictors),
+  Array.init (Array.length m) (fun i -> responder m.(i))
+
+let r_square m responder predictors r =
+  let predictors_matrix, responder_vector =
+    make_lr_inputs responder predictors m
+  in
+  let sum_responder = Array.fold_left ( +. ) 0. responder_vector in
+  let mean = sum_responder /. float (Array.length responder_vector) in
+  let tot_ss = ref 0. in
+  let res_ss = ref 0. in
+  let predicted i =
+    let x = ref 0. in
+    for j = 0 to Array.length r - 1 do
+      x := !x +. (predictors_matrix.(i).(j) *. r.(j))
+    done ;
+    !x
+  in
+  for i = 0 to Array.length responder_vector - 1 do
+    tot_ss := !tot_ss +. ((responder_vector.(i) -. mean) ** 2.) ;
+    res_ss := !res_ss +. ((responder_vector.(i) -. predicted i) ** 2.)
+  done ;
+  1. -. (!res_ss /. !tot_ss)
+
+let ols responder predictors m =
+  let matrix, vector = make_lr_inputs responder predictors m in
+  match ols ~in_place:true matrix vector with
+  | Ok estimates ->
+     let r_square = r_square m responder predictors estimates in
+     Ok (estimates, r_square)
+  | Error _ as err -> err
+

unikernel/duniverse/eqaf/check/unsafe_pre407.ml

@@ -0,0 +1 @@
+external get_int32_ne : bytes -> int -> int32 = "%caml_string_get32"

unikernel/duniverse/eqaf/check/unsafe_pre408.ml

@@ -0,0 +1 @@
+external get_int32_ne : bytes -> int -> int32 = "%caml_bytes_get32"

unikernel/duniverse/eqaf/check/unsafe_stable.ml

@@ -0,0 +1 @@
+let get_int32_ne b i = Bytes.get_int32_ne b i