Hash table from picos

bench/bench_htbl.ml

@@ -0,0 +1,79 @@
+open Multicore_bench
+
+module Key = struct
+  type t = int
+
+  let equal = Int.equal
+  let hash = Fun.id
+end
+
+let run_one ~budgetf ~n_domains ?(n_ops = 20 * Util.iter_factor)
+    ?(n_keys = 10000) ~percent_mem ?(percent_add = (100 - percent_mem + 1) / 2)
+    ?(prepopulate = true) ~unsafe (module Htbl : Htbl_intf.HTBL) =
+  let limit_mem = percent_mem in
+  let limit_add = percent_mem + percent_add in
+
+  assert (0 <= limit_mem && limit_mem <= 100);
+  assert (limit_mem <= limit_add && limit_add <= 100);
+
+  let t = Htbl.create ~hashed_type:(module Key) () in
+
+  let n_ops = (100 + percent_mem) * n_ops / 100 in
+  let n_ops = n_ops * n_domains in
+
+  let n_ops_todo = Countdown.create ~n_domains () in
+
+  let before () =
+    let _ : _ Seq.t = Htbl.remove_all t in
+    Countdown.non_atomic_set n_ops_todo n_ops
+  in
+  let init i =
+    let state = Random.State.make_self_init () in
+    if prepopulate then begin
+      let n = ((i + 1) * n_keys / n_domains) - (i * n_keys / n_domains) in
+      for _ = 1 to n do
+        let value = Random.State.bits state in
+        let key = value mod n_keys in
+        Htbl.try_add t key value |> ignore
+      done
+    end;
+    state
+  in
+  let work domain_index state =
+    let rec work () =
+      let n = Countdown.alloc n_ops_todo ~domain_index ~batch:1000 in
+      if n <> 0 then begin
+        for _ = 1 to n do
+          let value = Random.State.bits state in
+          let op = (value asr 20) mod 100 in
+          let key = value mod n_keys in
+          if op < percent_mem then
+            match Htbl.find_exn t key with _ -> () | exception Not_found -> ()
+          else if op < limit_add then Htbl.try_add t key value |> ignore
+          else Htbl.try_remove t key |> ignore
+        done;
+        work ()
+      end
+    in
+    work ()
+  in
+  let config =
+    Printf.sprintf "%d worker%s, %d%% reads %s" n_domains
+      (if n_domains = 1 then "" else "s")
+      percent_mem
+      (if unsafe then " (unsafe)" else "")
+  in
+  Times.record ~budgetf ~n_domains ~before ~init ~work ()
+  |> Times.to_thruput_metrics ~n:n_ops ~singular:"operation" ~config
+
+let run_suite ~budgetf =
+  let run ~unsafe (module Htbl : Htbl_intf.HTBL) =
+    Util.cross [ 10; 50; 90 ] [ 1; 2; 4 ]
+    |> List.concat_map @@ fun (percent_mem, n_domains) ->
+       run_one ~budgetf ~n_domains ~percent_mem ~unsafe (module Htbl)
+  in
+  List.fold_right2
+    (fun safe unsafe acc -> safe :: unsafe :: acc)
+    (run ~unsafe:false (module Saturn_lockfree.Htbl))
+    (run ~unsafe:true (module Saturn_lockfree.Htbl_unsafe))
+    []

bench/dune

@@ -7,6 +7,11 @@ let () =
   Jbuild_plugin.V1.send
   @@ {|
 
+(rule
+ (action
+  (copy ../src_lockfree/htbl/htbl_intf.mli htbl_intf.ml))
+ (package saturn_lockfree))
+
 (test
  (package saturn)
  (name main)

bench/main.ml

@@ -5,6 +5,7 @@ let benchmarks =
     ("Saturn_lockfree Single_prod_single_cons_queue", Bench_spsc_queue.run_suite);
     ("Saturn_lockfree Size", Bench_size.run_suite);
     ("Saturn_lockfree Skiplist", Bench_skiplist.run_suite);
+    ("Saturn_lockfree Htbl", Bench_htbl.run_suite);
     ("Saturn_lockfree Stack", Bench_stack.run_suite);
     ("Saturn_lockfree Work_stealing_deque", Bench_ws_deque.run_suite);
   ]

dune-project

@@ -7,16 +7,19 @@
 (authors "KC Sivaramakrishnan")
 (maintainers "Carine Morel" "KC Sivaramakrishnan" "Sudha Parimala")
 (documentation "https://ocaml-multicore.github.io/saturn/")
+(using mdx 0.4)
+
 
 (package
  (name saturn)
  (synopsis "Collection of parallelism-safe data structures for Multicore OCaml")
  (depends
-  (ocaml (>= 4.13))
+  (ocaml (>= 4.14))
   (domain_shims (and (>= 0.1.0) :with-test))
   (saturn_lockfree (= :version))
+  (mdx (and (>= 0.4) :with-test))
   (multicore-magic (and (>= 2.3.0) :with-test))
-  (multicore-bench (and (>= 0.1.2) :with-test))
+  (multicore-bench (and (>= 0.1.7) :with-test))
   (multicore-magic-dscheck (and (>= 2.3.0) :with-test))
   (backoff (and (>= 0.1.0) :with-test))
   (alcotest (and (>= 1.7.0) :with-test))
@@ -32,11 +35,12 @@
  (name saturn_lockfree)
  (synopsis "Collection of lock-free data structures for Multicore OCaml")
  (depends
-  (ocaml (>= 4.13))
+  (ocaml (>= 4.14))
   (domain_shims (and (>= 0.1.0) :with-test))
   (backoff (>= 0.1.0))
   (multicore-magic (>= 2.3.0))
   (multicore-magic-dscheck (and (>= 2.3.0) :with-test))
+  (mdx (and (>= 0.4) :with-test))
   (alcotest (and (>= 1.7.0) :with-test))
   (qcheck (and (>= 0.21.3) :with-test))
   (qcheck-core (and (>= 0.21.3) :with-test))

saturn.opam

@@ -10,11 +10,12 @@ doc: "https://ocaml-multicore.github.io/saturn/"
 bug-reports: "https://github.com/ocaml-multicore/saturn/issues"
 depends: [
   "dune" {>= "3.14"}
-  "ocaml" {>= "4.13"}
+  "ocaml" {>= "4.14"}
   "domain_shims" {>= "0.1.0" & with-test}
   "saturn_lockfree" {= version}
+  "mdx" {>= "0.4" & with-test}
   "multicore-magic" {>= "2.3.0" & with-test}
-  "multicore-bench" {>= "0.1.2" & with-test}
+  "multicore-bench" {>= "0.1.7" & with-test}
   "multicore-magic-dscheck" {>= "2.3.0" & with-test}
   "backoff" {>= "0.1.0" & with-test}
   "alcotest" {>= "1.7.0" & with-test}

saturn_lockfree.opam

@@ -9,11 +9,12 @@ doc: "https://ocaml-multicore.github.io/saturn/"
 bug-reports: "https://github.com/ocaml-multicore/saturn/issues"
 depends: [
   "dune" {>= "3.14"}
-  "ocaml" {>= "4.13"}
+  "ocaml" {>= "4.14"}
   "domain_shims" {>= "0.1.0" & with-test}
   "backoff" {>= "0.1.0"}
   "multicore-magic" {>= "2.3.0"}
   "multicore-magic-dscheck" {>= "2.3.0" & with-test}
+  "mdx" {>= "0.4" & with-test}
   "alcotest" {>= "1.7.0" & with-test}
   "qcheck" {>= "0.21.3" & with-test}
   "qcheck-core" {>= "0.21.3" & with-test}

src/saturn.ml

@@ -40,3 +40,5 @@ module Single_prod_single_cons_queue_unsafe =
 module Single_consumer_queue = Saturn_lockfree.Single_consumer_queue
 module Relaxed_queue = Mpmc_relaxed_queue
 module Skiplist = Saturn_lockfree.Skiplist
+module Htbl = Saturn_lockfree.Htbl
+module Htbl_unsafe = Saturn_lockfree.Htbl_unsafe

src/saturn.mli

@@ -44,3 +44,5 @@ module Single_prod_single_cons_queue_unsafe =
 module Single_consumer_queue = Saturn_lockfree.Single_consumer_queue
 module Relaxed_queue = Mpmc_relaxed_queue
 module Skiplist = Saturn_lockfree.Skiplist
+module Htbl = Saturn_lockfree.Htbl
+module Htbl_unsafe = Saturn_lockfree.Htbl_unsafe

src_lockfree/dune

@@ -13,6 +13,7 @@ let () =
 (library
  (name saturn_lockfree)
  (public_name saturn_lockfree)
+ (modules_without_implementation htbl_intf)
  (libraries backoff multicore-magic |}
   ^ maybe_threads
   ^ {| ))

src_lockfree/htbl/dune

@@ -0,0 +1,28 @@
+(rule
+ (action
+  (with-stdout-to
+   htbl.ml
+   (progn
+    (echo "# 1 \"htbl.head_safe.ml\"\n")
+    (cat htbl.head_safe.ml)
+    (echo "# 1 \"htbl.body.ml\"\n")
+    (cat htbl.body.ml)))))
+
+(rule
+ (action
+  (with-stdout-to
+   htbl_unsafe.ml
+   (progn
+    (echo "# 1 \"htbl.head_unsafe.ml\"\n")
+    (cat htbl.head_safe.ml)
+    (echo "# 1 \"htbl.body.ml\"\n")
+    (cat htbl.body.ml)))))
+
+(mdx
+ (package saturn_lockfree)
+ (enabled_if
+  (and
+   (<> %{os_type} Win32)
+   (>= %{ocaml_version} 5.1.0)))
+ (libraries saturn_lockfree)
+ (files htbl_intf.mli))