diff --git a/Makefile b/Makefile index 3e63a195..8e08c4b8 100644 --- a/Makefile +++ b/Makefile @@ -24,7 +24,7 @@ DUNE_OPTS_BENCH?=--profile=release N?=40 NITER?=2 BENCH_PSIZE?=1,4,8,20 -BENCH_KIND?=simple,pool +BENCH_KIND?=fifo,pool BENCH_CUTOFF?=20 bench-fib: @echo running for N=$(N) @@ -34,7 +34,7 @@ bench-fib: PI_NSTEPS?=100_000_000 PI_MODES?=seq,par1,forkjoin -PI_KIND?=simple,pool +PI_KIND?=fifo,pool bench-pi: @echo running for N=$(PI_NSTEPS) dune build $(DUNE_OPTS_BENCH) benchs/pi.exe diff --git a/benchs/fib_rec.ml b/benchs/fib_rec.ml index 57a444f0..385bfed4 100644 --- a/benchs/fib_rec.ml +++ b/benchs/fib_rec.ml @@ -20,7 +20,7 @@ let () = assert (List.init 10 fib_direct = [ 1; 1; 2; 3; 5; 8; 13; 21; 34; 55 ]) let create_pool ~psize ~kind () = match kind with - | "simple" -> Simple_pool.create ~min:psize () + | "fifo" -> Fifo_pool.create ~min:psize () | "pool" -> Pool.create ~min:psize () | _ -> assert false @@ -54,7 +54,7 @@ let () = "-niter", Arg.Set_int niter, " number of iterations"; "-cutoff", Arg.Set_int cutoff, " cutoff for sequential computation"; ( "-kind", - Arg.Symbol ([ "pool"; "simple" ], ( := ) kind), + Arg.Symbol ([ "pool"; "fifo" ], ( := ) kind), " pick pool implementation" ); ] |> Arg.align diff --git a/benchs/pi.ml b/benchs/pi.ml index 36b4e92a..01017ae9 100644 --- a/benchs/pi.ml +++ b/benchs/pi.ml @@ -24,11 +24,11 @@ let with_pool ~kind f = Pool.with_ ~per_domain:1 f else Pool.with_ ~min:!j f - | "simple" -> + | "fifo" -> if !j = 0 then - Simple_pool.with_ ~per_domain:1 f + Fifo_pool.with_ ~per_domain:1 f else - Simple_pool.with_ ~min:!j f + Fifo_pool.with_ ~min:!j f | _ -> assert false (** Run in parallel using {!Fut.for_} *) @@ -120,7 +120,7 @@ let () = "-j", Arg.Set_int j, " number of threads"; "-t", Arg.Set time, " printing timing"; ( "-kind", - Arg.Symbol ([ "pool"; "simple" ], ( := ) kind), + Arg.Symbol ([ "pool"; "fifo" ], ( := ) kind), " pick pool implementation" ); ] |> Arg.align diff --git a/src/simple_pool.ml b/src/fifo_pool.ml similarity index 100% rename from src/simple_pool.ml rename to src/fifo_pool.ml diff --git a/src/simple_pool.mli b/src/fifo_pool.mli similarity index 65% rename from src/simple_pool.mli rename to src/fifo_pool.mli index b7f89824..252083c5 100644 --- a/src/simple_pool.mli +++ b/src/fifo_pool.mli @@ -1,8 +1,16 @@ -(** A simple thread pool. +(** A simple thread pool in FIFO order. - This uses a single blocking queue to manage tasks, it's very - simple and reliable. Like {!Pool} it distributes a fixed number - of workers over several domains. + FIFO: first-in, first-out. Basically tasks are put into a queue, + and worker threads pull them out of the queue at the other end. + + Since this uses a single blocking queue to manage tasks, it's very + simple and reliable. The number of worker threads is fixed, but + they are spread over several domains to enable parallelism. + + This can be useful for latency-sensitive applications (e.g. as a + pool of workers for network servers). Work-stealing pools might + have higher throughput but they're very unfair to some tasks; by + contrast, here, older tasks have priority over younger tasks. @since NEXT_RELEASE *) diff --git a/src/moonpool.ml b/src/moonpool.ml index 97da4d2a..fb0a3661 100644 --- a/src/moonpool.ml +++ b/src/moonpool.ml @@ -11,7 +11,7 @@ module Fut = Fut module Lock = Lock module Pool = Pool module Runner = Runner -module Simple_pool = Simple_pool +module Fifo_pool = Fifo_pool module Private = struct module Ws_deque_ = Ws_deque_ diff --git a/src/moonpool.mli b/src/moonpool.mli index 74b48772..66b3164a 100644 --- a/src/moonpool.mli +++ b/src/moonpool.mli @@ -5,7 +5,7 @@ *) module Pool = Pool -module Simple_pool = Simple_pool +module Fifo_pool = Fifo_pool module Runner = Runner val start_thread_on_some_domain : ('a -> unit) -> 'a -> Thread.t diff --git a/test/t_fib.ml b/test/t_fib.ml index 32e264e9..f54d7118 100644 --- a/test/t_fib.ml +++ b/test/t_fib.ml @@ -4,7 +4,7 @@ let ( let@ ) = ( @@ ) let with_pool ~kind () f = match kind with - | `Simple_pool -> Simple_pool.with_ ~min:4 () f + | `Fifo_pool -> Fifo_pool.with_ ~min:4 () f | `Pool -> Pool.with_ ~min:4 () f let rec fib x = @@ -75,4 +75,4 @@ let run ~kind () = let () = run ~kind:`Pool (); - run ~kind:`Simple_pool () + run ~kind:`Fifo_pool () diff --git a/test/t_props.ml b/test/t_props.ml index 403f2534..be586251 100644 --- a/test/t_props.ml +++ b/test/t_props.ml @@ -7,7 +7,7 @@ let add_test t = tests := t :: !tests let with_pool ~kind () f = match kind with - | `Simple_pool -> Simple_pool.with_ ~min:4 ~per_domain:1 () f + | `Fifo_pool -> Fifo_pool.with_ ~min:4 ~per_domain:1 () f | `Pool -> Pool.with_ ~min:4 ~per_domain:1 () f let () = @@ -48,7 +48,7 @@ let () = let () = let tests = - List.map (fun t -> [ t ~kind:`Simple_pool; t ~kind:`Pool ]) !tests + List.map (fun t -> [ t ~kind:`Fifo_pool; t ~kind:`Pool ]) !tests |> List.flatten in QCheck_base_runner.run_tests_main tests diff --git a/test/t_resource.ml b/test/t_resource.ml index 01f8be57..005ed4c3 100644 --- a/test/t_resource.ml +++ b/test/t_resource.ml @@ -4,7 +4,7 @@ let ( let@ ) = ( @@ ) let with_pool ~kind () f = match kind with - | `Simple_pool -> Simple_pool.with_ ~min:4 ~per_domain:1 () f + | `Fifo_pool -> Fifo_pool.with_ ~min:4 ~per_domain:1 () f | `Pool -> Pool.with_ ~min:4 ~per_domain:1 () f (* test proper resource handling *) @@ -24,4 +24,4 @@ let run ~kind () = let () = run ~kind:`Pool (); - run ~kind:`Simple_pool () + run ~kind:`Fifo_pool () diff --git a/test/t_tree_futs.ml b/test/t_tree_futs.ml index 56bde804..83a9d80c 100644 --- a/test/t_tree_futs.ml +++ b/test/t_tree_futs.ml @@ -4,7 +4,7 @@ let ( let@ ) = ( @@ ) let with_pool ~kind ~j () f = match kind with - | `Simple_pool -> Simple_pool.with_ ~min:j () f + | `Fifo_pool -> Fifo_pool.with_ ~min:j () f | `Pool -> Pool.with_ ~min:j () f type 'a tree = @@ -89,4 +89,4 @@ let () = Tracy_client_trace.setup (); *) run_main ~kind:`Pool (); - run_main ~kind:`Simple_pool () + run_main ~kind:`Fifo_pool () diff --git a/test/t_unfair.ml b/test/t_unfair.ml index 5d22a663..b6dc5884 100644 --- a/test/t_unfair.ml +++ b/test/t_unfair.ml @@ -20,7 +20,7 @@ let run ~kind () = in match kind with - | `Simple -> Simple_pool.create ~min:3 ~on_init_thread ~around_task () + | `Simple -> Fifo_pool.create ~min:3 ~on_init_thread ~around_task () | `Pool -> Pool.create ~min:3 ~on_init_thread ~around_task () in