Add Rwlock

bench/bench_hashtbl.ml

@@ -21,6 +21,7 @@ let run_one ~budgetf ~n_domains ?(n_ops = 100 * Util.iter_factor)
 
   let t = Hashtbl.create 1000 in
   let lock = Lock.create ~padded:true () in
+  let rwlock = Rwlock.create ~padded:true () in
   let sem = Sem.create ~padded:true 1 in
 
   let n_ops = (100 + percent_mem) * n_ops / 100 in
@@ -41,6 +42,16 @@ let run_one ~budgetf ~n_domains ?(n_ops = 100 * Util.iter_factor)
               Hashtbl.replace t key value
             done
           end
+      | `Rwlock ->
+          Rwlock.holding rwlock @@ fun () ->
+          Hashtbl.clear t;
+          if prepopulate then begin
+            for _ = 1 to n_keys do
+              let value = Random.bits () in
+              let key = value mod n_keys in
+              Hashtbl.replace t key value
+            done
+          end
       | `Sem ->
           Sem.acquire sem;
           Hashtbl.clear t;
@@ -87,6 +98,34 @@ let run_one ~budgetf ~n_domains ?(n_ops = 100 * Util.iter_factor)
           end
         in
         work ()
+    | `Rwlock ->
+        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 begin
+                Rwlock.acquire_shared rwlock;
+                Hashtbl.find_opt t key |> ignore;
+                Rwlock.release_shared rwlock
+              end
+              else if op < limit_add then begin
+                Rwlock.acquire rwlock;
+                Hashtbl.replace t key value;
+                Rwlock.release rwlock
+              end
+              else begin
+                Rwlock.acquire rwlock;
+                Hashtbl.remove t key;
+                Rwlock.release rwlock
+              end
+            done;
+            work ()
+          end
+        in
+        work ()
     | `Sem ->
         let rec work () =
           let n = Countdown.alloc n_ops_todo ~domain_index ~batch:1000 in
@@ -121,14 +160,18 @@ let run_one ~budgetf ~n_domains ?(n_ops = 100 * Util.iter_factor)
     Printf.sprintf "%d worker%s, %d%% reads with %s" n_domains
       (if n_domains = 1 then "" else "s")
       percent_mem
-      (match lock_type with `Lock -> "Lock" | `Sem -> "Sem")
+      (match lock_type with
+      | `Lock -> "Lock"
+      | `Rwlock -> "Rwlock"
+      | `Sem -> "Sem")
   in
   Times.record ~budgetf ~n_domains ~n_warmups:1 ~n_runs_min:1 ~before ~init
     ~wrap ~work ()
   |> Times.to_thruput_metrics ~n:n_ops ~singular:"operation" ~config
 
 let run_suite ~budgetf =
-  Util.cross [ 1; 2; 4; 8 ] (Util.cross [ `Lock; `Sem ] [ 10; 50; 90; 95; 100 ])
+  Util.cross [ 1; 2; 4; 8 ]
+    (Util.cross [ `Lock; `Rwlock; `Sem ] [ 10; 50; 90; 95; 100 ])
   |> List.concat_map @@ fun (n_domains, (lock_type, percent_mem)) ->
      if Picos_domain.recommended_domain_count () < n_domains then []
      else run_one ~budgetf ~n_domains ~percent_mem ~lock_type ()

bench/bench_lock_yield.ml

@@ -20,6 +20,7 @@ let run_one ~budgetf ~n_fibers ~use_domains ~lock_type () =
   let n_ops_todo = Countdown.create ~n_domains () in
 
   let lock = Lock.create ~padded:true () in
+  let rwlock = Rwlock.create ~padded:true () in
   let sem =
     Sem.create ~padded:true (match lock_type with `Sem_n n -> n | _ -> 1)
   in
@@ -53,6 +54,22 @@ let run_one ~budgetf ~n_fibers ~use_domains ~lock_type () =
               else work ()
             in
             loop n
+      | `Rwlock ->
+          if n <> 0 then
+            let rec loop n =
+              if 0 < n then begin
+                Rwlock.acquire rwlock;
+                let x = !v in
+                v := x + 1;
+                Control.yield ();
+                assert (!v = x + 1);
+                v := x;
+                Rwlock.release rwlock;
+                loop (n - 1)
+              end
+              else work ()
+            in
+            loop n
       | `Sem ->
           if n <> 0 then
             let rec loop n =
@@ -102,6 +119,7 @@ let run_one ~budgetf ~n_fibers ~use_domains ~lock_type () =
       (if n_fibers = 1 then "" else "s")
       (match lock_type with
       | `Lock -> "Lock"
+      | `Rwlock -> "Rwlock"
       | `Sem -> "Sem"
       | `Sem_n n -> Printf.sprintf "Sem %d" n)
   in
@@ -112,7 +130,7 @@ let run_one ~budgetf ~n_fibers ~use_domains ~lock_type () =
 let run_suite ~budgetf =
   Util.cross [ false; true ]
     (Util.cross
-       [ `Lock; `Sem; `Sem_n 2; `Sem_n 3; `Sem_n 4 ]
+       [ `Lock; `Rwlock; `Sem; `Sem_n 2; `Sem_n 3; `Sem_n 4 ]
        [ 1; 2; 3; 4; 8; 256; 512; 1024 ])
   |> List.concat_map @@ fun (use_domains, (lock_type, n_fibers)) ->
      if

bench/bench_ref.ml

@@ -26,6 +26,7 @@ let run_one ~budgetf ?(n_iter = 250 * Util.iter_factor) ~lock_type
     (Op (name, value, op1, op2, op_kind)) =
   let lock = Lock.create () in
   let sem = Sem.create 1 in
+  let rwlock = Rwlock.create () in
 
   let loc = Ref.make value in
 
@@ -46,6 +47,32 @@ let run_one ~budgetf ?(n_iter = 250 * Util.iter_factor) ~lock_type
           end
         in
         loop n_iter
+    | `Rwlock, `RW ->
+        let rec loop i =
+          if i > 0 then begin
+            Rwlock.acquire rwlock;
+            op1 loc |> ignore;
+            Rwlock.release rwlock;
+            Rwlock.acquire rwlock;
+            op2 loc |> ignore;
+            Rwlock.release rwlock;
+            loop (i - 2)
+          end
+        in
+        loop n_iter
+    | `Rwlock, `RO ->
+        let rec loop i =
+          if i > 0 then begin
+            Rwlock.acquire_shared rwlock;
+            op1 loc |> ignore;
+            Rwlock.release_shared rwlock;
+            Rwlock.acquire_shared rwlock;
+            op2 loc |> ignore;
+            Rwlock.release_shared rwlock;
+            loop (i - 2)
+          end
+        in
+        loop n_iter
     | `Sem, _ ->
         let rec loop i =
           if i > 0 then begin
@@ -63,13 +90,16 @@ let run_one ~budgetf ?(n_iter = 250 * Util.iter_factor) ~lock_type
 
   let config =
     Printf.sprintf "%s with %s" name
-      (match lock_type with `Lock -> "Lock" | `Sem -> "Sem")
+      (match lock_type with
+      | `Lock -> "Lock"
+      | `Rwlock -> "Rwlock"
+      | `Sem -> "Sem")
   in
   Times.record ~budgetf ~n_domains:1 ~init ~wrap ~work ()
   |> Times.to_thruput_metrics ~n:n_iter ~singular:"op" ~config
 
 let run_suite ~budgetf =
-  Util.cross [ `Lock; `Sem ]
+  Util.cross [ `Lock; `Rwlock; `Sem ]
     [
       (let get x = !x in
        Op ("get", 42, get, get, `RO));

lib/picos_std.sync/picos_std_sync.ml

@@ -2,6 +2,7 @@ module Mutex = Mutex
 module Condition = Condition
 module Semaphore = Semaphore
 module Lock = Lock
+module Rwlock = Rwlock
 module Sem = Sem
 module Lazy = Lazy
 module Latch = Latch