Benchmark queues and stacks with heap allocated blocks

polytypic · polytypic · commit 2a653b676afa · 2025-05-23T10:51:27.000+03:00
Queues and stacks were previously benchmarked with immediate values only, which
unfortunately partially hides the potential cost of write barriers related to
setting and clearing elements.

Partially hiding the cost of write barriers makes the queue benchmarks
unrealistic.  Queues and stack are very rarely used with only immediate values.
diff --git a/bench/bench_bounded_queue.ml b/bench/bench_bounded_queue.ml
@@ -9,7 +9,7 @@ module Make (Bounded_queue : Bounded_queue_intf.BOUNDED_QUEUE) : BENCH = struct
     let t = Bounded_queue.create () in
 
     let op push =
-      if push then Bounded_queue.try_push t 101 |> ignore
+      if push then Bounded_queue.try_push t (ref push) |> ignore
       else Bounded_queue.pop_opt t |> ignore
     in
 
@@ -43,7 +43,7 @@ module Make (Bounded_queue : Bounded_queue_intf.BOUNDED_QUEUE) : BENCH = struct
           let n = Util.alloc n_msgs_to_add in
           if 0 < n then begin
             for i = 1 to n do
-              Bounded_queue.try_push t i |> ignore
+              Bounded_queue.try_push t (ref i) |> ignore
             done;
             work ()
           end
diff --git a/bench/bench_bounded_stack.ml b/bench/bench_bounded_stack.ml
@@ -5,7 +5,8 @@ let run_one_domain ~budgetf ?(n_msgs = 50 * Util.iter_factor) () =
   let t = Stack.create () in
 
   let op push =
-    if push then Stack.try_push t 101 |> ignore else Stack.pop_opt t |> ignore
+    if push then Stack.try_push t (ref push) |> ignore
+    else Stack.pop_opt t |> ignore
   in
 
   let init _ =
@@ -37,7 +38,7 @@ let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2)
         let n = Util.alloc n_msgs_to_add in
         if 0 < n then begin
           for i = 1 to n do
-            Stack.try_push t i |> ignore
+            Stack.try_push t (ref i) |> ignore
           done;
           work ()
         end
diff --git a/bench/bench_mpsc.ml b/bench/bench_mpsc.ml
@@ -4,7 +4,9 @@ module Queue = Saturn.Single_consumer_queue
 let run_one_domain ~budgetf ?(n_msgs = 50 * Util.iter_factor) () =
   let t = Queue.create () in
 
-  let op push = if push then Queue.push t 101 else Queue.pop_opt t |> ignore in
+  let op push =
+    if push then Queue.push t (ref push) else Queue.pop_opt t |> ignore
+  in
 
   let init _ =
     assert (Queue.is_empty t);
@@ -35,7 +37,7 @@ let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2)
         let n = Util.alloc n_msgs_to_add in
         if 0 < n then begin
           for i = 1 to n do
-            Queue.push t i
+            Queue.push t (ref i)
           done;
           work ()
         end
diff --git a/bench/bench_queue.ml b/bench/bench_queue.ml
@@ -9,7 +9,7 @@ module Make (Queue : Michael_scott_queue_intf.MS_QUEUE) : BENCH = struct
     let t = Queue.create () in
 
     let op push =
-      if push then Queue.push t 101 else Queue.pop_opt t |> ignore
+      if push then Queue.push t (ref push) else Queue.pop_opt t |> ignore
     in
 
     let init _ =
@@ -42,7 +42,7 @@ module Make (Queue : Michael_scott_queue_intf.MS_QUEUE) : BENCH = struct
           let n = Util.alloc n_msgs_to_add in
           if 0 < n then begin
             for i = 1 to n do
-              Queue.push t i
+              Queue.push t (ref i)
             done;
             work ()
           end
diff --git a/bench/bench_spsc_queue.ml b/bench/bench_spsc_queue.ml
@@ -17,14 +17,14 @@ module Make (Queue : Spsc_queue_intf.SPSC_queue) : BENCH = struct
         done;
         let n = Random.int ((1 lsl size_exponent) + 1) in
         for i = 1 to n do
-          Queue.push_exn t i
+          Queue.push_exn t (ref i)
         done
       in
       let work i () =
         if i = 0 then
           let rec loop n =
             if 0 < n then
-              if Queue.try_push t n then loop (n - 1)
+              if Queue.try_push t (ref n) then loop (n - 1)
               else begin
                 Domain.cpu_relax ();
                 loop n
diff --git a/bench/bench_stack.ml b/bench/bench_stack.ml
@@ -4,7 +4,9 @@ module Stack = Saturn.Stack
 let run_one_domain ~budgetf ?(n_msgs = 50 * Util.iter_factor) () =
   let t = Stack.create () in
 
-  let op push = if push then Stack.push t 101 else Stack.pop_opt t |> ignore in
+  let op push =
+    if push then Stack.push t (ref push) else Stack.pop_opt t |> ignore
+  in
 
   let init _ =
     assert (Stack.is_empty t);
@@ -35,7 +37,7 @@ let run_one ~budgetf ?(n_adders = 2) ?(n_takers = 2)
         let n = Util.alloc n_msgs_to_add in
         if 0 < n then begin
           for i = 1 to n do
-            Stack.push t i
+            Stack.push t (ref i)
           done;
           work ()
         end
diff --git a/bench/bench_ws_deque.ml b/bench/bench_ws_deque.ml
@@ -89,11 +89,11 @@ let run_as_one_domain ~budgetf ?(n_msgs = 150 * Util.iter_factor) order =
   let t = Ws_deque.create () in
 
   let op_lifo push =
-    if push then Ws_deque.push t 101
+    if push then Ws_deque.push t (ref push)
     else
       match Ws_deque.pop_exn t with _ -> () | exception Ws_deque.Empty -> ()
   and op_fifo push =
-    if push then Ws_deque.push t 101
+    if push then Ws_deque.push t (ref push)
     else
       match Ws_deque.steal_exn t with _ -> () | exception Ws_deque.Empty -> ()
   in
@@ -151,7 +151,7 @@ let run_as_spmc ~budgetf ~n_thiefs () =
       work ()
     else
       for i = 1 to n_msgs do
-        Ws_deque.push t i
+        Ws_deque.push t (ref i)
       done
   in
 
