unikernel/duniverse/bstr/bench/blit.ml

@@ -0,0 +1,50 @@
+open Bechamel
+open Toolkit
+
+let src = String.make 256 '\x10'
+let cs = Cstruct.create 512
+let bstr = Bstr.create 512
+let bigstringaf = Bigstringaf.create 512
+let cstruct_blit () = Cstruct.blit_from_string src 0 cs 0 256
+let bstr_blit () = Bstr.blit_from_string src ~src_off:0 bstr ~dst_off:0 ~len:256
+
+let bigstringaf_blit () =
+  Bigstringaf.blit_from_string src ~src_off:0 bigstringaf ~dst_off:0 ~len:256
+
+let cstruct_blit = Staged.stage cstruct_blit
+let bstr_blit = Staged.stage bstr_blit
+let bigstringaf_blit = Staged.stage bigstringaf_blit
+let test0 = Test.make ~name:"Cstruct" cstruct_blit
+let test1 = Test.make ~name:"Bstr" bstr_blit
+let test2 = Test.make ~name:"Bigstringaf" bigstringaf_blit
+
+let benchmark () =
+  let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in
+  let ols = Analyze.ols ~bootstrap ~r_square ~predictors in
+  let instances = Instance.[ monotonic_clock ] in
+  let limit = 2000
+  and stabilize = true
+  and quota = Time.second 1.0
+  and kde = Some 1000 in
+  let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in
+  let tests =
+    Test.make_grouped ~name:"blit" ~fmt:"%s %s" [ test0; test1; test2 ]
+  in
+  let raw = Benchmark.all cfg instances tests in
+  let res = List.map (fun i -> Analyze.all ols i raw) instances in
+  let res = Analyze.merge ols instances res in
+  (res, raw)
+
+let nothing _ = Ok ()
+let compare = String.compare
+
+let () =
+  let res = benchmark () in
+  let res =
+    let open Bechamel_js in
+    let dst = Channel stdout
+    and x_label = Measure.run
+    and y_label = Measure.label Instance.monotonic_clock in
+    emit ~dst nothing ~compare ~x_label ~y_label res
+  in
+  match res with Ok () -> () | Error (`Msg msg) -> failwith msg

unikernel/duniverse/bstr/bench/contains.ml

@@ -0,0 +1,75 @@
+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 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 str = random 4096
+let chr_into_str = str.[Random.int 4096]
+
+open Bechamel
+open Toolkit
+
+let bstr_contains =
+  let bstr = Bstr.of_string str in
+  Test.make ~name:"bstr"
+  @@ Staged.stage
+  @@ fun () -> ignore (Bstr.contains bstr chr_into_str)
+
+let bigstringaf_contains =
+  let bstr = Bigstringaf.of_string str ~off:0 ~len:4096 in
+  Test.make ~name:"bigstringaf"
+  @@ Staged.stage
+  @@ fun () -> ignore (Bigstringaf.memchr bstr 0 chr_into_str 4096)
+
+let cstruct_contains =
+  let cs = Cstruct.of_string str in
+  let fn chr = chr == chr_into_str in
+  Test.make ~name:"cstruct"
+  @@ Staged.stage
+  @@ fun () -> ignore (Cstruct.exists fn cs)
+
+let tests =
+  Test.make_grouped ~name:"contains" ~fmt:"%s %s"
+    [ bstr_contains; bigstringaf_contains; cstruct_contains ]
+
+let benchmark () =
+  let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in
+  let ols = Analyze.ols ~bootstrap ~r_square ~predictors in
+  let instances = Instance.[ monotonic_clock ] in
+  let limit = 2000
+  and stabilize = true
+  and quota = Time.second 1.0
+  and kde = Some 1000 in
+  let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in
+  let raw = Benchmark.all cfg instances tests in
+  let res = List.map (fun i -> Analyze.all ols i raw) instances in
+  let res = Analyze.merge ols instances res in
+  (res, raw)
+
+let nothing _ = Ok ()
+let compare = String.compare
+
+let () =
+  let res = benchmark () in
+  let res =
+    let open Bechamel_js in
+    let dst = Channel stdout
+    and x_label = Measure.run
+    and y_label = Measure.label Instance.monotonic_clock in
+    emit ~dst nothing ~compare ~x_label ~y_label res
+  in
+  match res with Ok () -> () | Error (`Msg msg) -> failwith msg

unikernel/duniverse/bstr/bench/dune

@@ -0,0 +1,87 @@
+(executable
+ (name sub)
+ (enabled_if
+  (= %{profile} benchmark))
+ (libraries slice.bstr bstr cstruct bechamel bechamel-js))
+
+(rule
+ (targets sub.json)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./sub.exe))))
+
+(rule
+ (targets sub.html)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (system "%{bin:bechamel-html} < %{dep:sub.json} > %{targets}")))
+
+(executable
+ (name blit)
+ (enabled_if
+  (= %{profile} benchmark))
+ (libraries bstr cstruct bechamel bechamel-js))
+
+(rule
+ (targets blit.json)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./blit.exe))))
+
+(rule
+ (targets blit.html)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (system "%{bin:bechamel-html} < %{dep:blit.json} > %{targets}")))
+
+(executable
+ (name equal)
+ (enabled_if
+  (= %{profile} benchmark))
+ (libraries base64 slice.bstr bstr cstruct bigstringaf bechamel bechamel-js))
+
+(rule
+ (targets equal.json)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./equal.exe))))
+
+(rule
+ (targets equal.html)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (system "%{bin:bechamel-html} < %{dep:equal.json} > %{targets}")))
+
+(executable
+ (name contains)
+ (enabled_if
+  (= %{profile} benchmark))
+ (libraries slice.bstr base64 bigstringaf bstr cstruct bechamel bechamel-js))
+
+(rule
+ (targets contains.json)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./contains.exe))))
+
+(rule
+ (targets contains.html)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (system "%{bin:bechamel-html} < %{dep:contains.json} > %{targets}")))

unikernel/duniverse/bstr/bench/equal.ml

@@ -0,0 +1,77 @@
+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 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)
+
+open Bechamel
+open Toolkit
+
+let bstr_equal =
+  let hash_eq_0 = Bstr.of_string hash_eq_0 in
+  let hash_eq_1 = Bstr.of_string hash_eq_1 in
+  Test.make ~name:"bstr"
+  @@ Staged.stage
+  @@ fun () -> Bstr.equal hash_eq_0 hash_eq_1
+
+let bigstringaf_equal =
+  let hash_eq_0 = Bigstringaf.of_string hash_eq_0 ~off:0 ~len:4096 in
+  let hash_eq_1 = Bigstringaf.of_string hash_eq_1 ~off:0 ~len:4096 in
+  Test.make ~name:"bigstringaf"
+  @@ Staged.stage
+  @@ fun () -> Bigstringaf.memcmp hash_eq_0 0 hash_eq_1 0 4096
+
+let cstruct_equal =
+  let hash_eq_0 = Cstruct.of_string hash_eq_0 in
+  let hash_eq_1 = Cstruct.of_string hash_eq_1 in
+  Test.make ~name:"cstruct"
+  @@ Staged.stage
+  @@ fun () -> Cstruct.equal hash_eq_0 hash_eq_1
+
+let tests =
+  Test.make_grouped ~name:"equal" ~fmt:"%s %s"
+    [ bstr_equal; bigstringaf_equal; cstruct_equal ]
+
+let benchmark () =
+  let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in
+  let ols = Analyze.ols ~bootstrap ~r_square ~predictors in
+  let instances = Instance.[ monotonic_clock ] in
+  let limit = 2000
+  and stabilize = true
+  and quota = Time.second 1.0
+  and kde = Some 1000 in
+  let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in
+  let raw = Benchmark.all cfg instances tests in
+  let res = List.map (fun i -> Analyze.all ols i raw) instances in
+  let res = Analyze.merge ols instances res in
+  (res, raw)
+
+let nothing _ = Ok ()
+let compare = String.compare
+
+let () =
+  let res = benchmark () in
+  let res =
+    let open Bechamel_js in
+    let dst = Channel stdout
+    and x_label = Measure.run
+    and y_label = Measure.label Instance.monotonic_clock in
+    emit ~dst nothing ~compare ~x_label ~y_label res
+  in
+  match res with Ok () -> () | Error (`Msg msg) -> failwith msg

unikernel/duniverse/bstr/bench/sub.ml

@@ -0,0 +1,49 @@
+open Bechamel
+open Toolkit
+
+let cs = Cstruct.create 32
+let bstr = Bstr.create 32
+let slice : Slice_bstr.t = Slice_bstr.make bstr
+let cstruct_sub () = Cstruct.sub cs 8 8
+let bstr_sub () = Bstr.sub bstr ~off:8 ~len:8
+let bigstringaf_sub () = Bigstringaf.sub bstr ~off:8 ~len:8
+let slice_sub () = Slice.sub slice ~off:8 ~len:8
+let cstruct_sub = Staged.stage cstruct_sub
+let bstr_sub = Staged.stage bstr_sub
+let bigstringaf_sub = Staged.stage bigstringaf_sub
+let slice_sub = Staged.stage slice_sub
+let test0 = Test.make ~name:"Cstruct" cstruct_sub
+let test1 = Test.make ~name:"Bstr" bstr_sub
+let test2 = Test.make ~name:"Bigstringaf" bigstringaf_sub
+let test3 = Test.make ~name:"Slice" slice_sub
+
+let benchmark () =
+  let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in
+  let ols = Analyze.ols ~bootstrap ~r_square ~predictors in
+  let instances = Instance.[ monotonic_clock ] in
+  let limit = 2000
+  and stabilize = true
+  and quota = Time.second 1.0
+  and kde = Some 1000 in
+  let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in
+  let tests =
+    Test.make_grouped ~name:"sub" ~fmt:"%s %s" [ test0; test1; test2; test3 ]
+  in
+  let raw = Benchmark.all cfg instances tests in
+  let res = List.map (fun i -> Analyze.all ols i raw) instances in
+  let res = Analyze.merge ols instances res in
+  (res, raw)
+
+let nothing _ = Ok ()
+let compare = String.compare
+
+let () =
+  let res = benchmark () in
+  let res =
+    let open Bechamel_js in
+    let dst = Channel stdout
+    and x_label = Measure.run
+    and y_label = Measure.label Instance.monotonic_clock in
+    emit ~dst nothing ~compare ~x_label ~y_label res
+  in
+  match res with Ok () -> () | Error (`Msg msg) -> failwith msg