rename Simple_pool into Fifo_pool, update doc

This commit is contained in:
Simon Cruanes 2023-10-25 21:55:29 -04:00
parent db33bec13f
commit 6452ca89d1
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
12 changed files with 31 additions and 23 deletions

View file

@ -24,7 +24,7 @@ DUNE_OPTS_BENCH?=--profile=release
N?=40 N?=40
NITER?=2 NITER?=2
BENCH_PSIZE?=1,4,8,20 BENCH_PSIZE?=1,4,8,20
BENCH_KIND?=simple,pool BENCH_KIND?=fifo,pool
BENCH_CUTOFF?=20 BENCH_CUTOFF?=20
bench-fib: bench-fib:
@echo running for N=$(N) @echo running for N=$(N)
@ -34,7 +34,7 @@ bench-fib:
PI_NSTEPS?=100_000_000 PI_NSTEPS?=100_000_000
PI_MODES?=seq,par1,forkjoin PI_MODES?=seq,par1,forkjoin
PI_KIND?=simple,pool PI_KIND?=fifo,pool
bench-pi: bench-pi:
@echo running for N=$(PI_NSTEPS) @echo running for N=$(PI_NSTEPS)
dune build $(DUNE_OPTS_BENCH) benchs/pi.exe dune build $(DUNE_OPTS_BENCH) benchs/pi.exe

View file

@ -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 () = let create_pool ~psize ~kind () =
match kind with match kind with
| "simple" -> Simple_pool.create ~min:psize () | "fifo" -> Fifo_pool.create ~min:psize ()
| "pool" -> Pool.create ~min:psize () | "pool" -> Pool.create ~min:psize ()
| _ -> assert false | _ -> assert false
@ -54,7 +54,7 @@ let () =
"-niter", Arg.Set_int niter, " number of iterations"; "-niter", Arg.Set_int niter, " number of iterations";
"-cutoff", Arg.Set_int cutoff, " cutoff for sequential computation"; "-cutoff", Arg.Set_int cutoff, " cutoff for sequential computation";
( "-kind", ( "-kind",
Arg.Symbol ([ "pool"; "simple" ], ( := ) kind), Arg.Symbol ([ "pool"; "fifo" ], ( := ) kind),
" pick pool implementation" ); " pick pool implementation" );
] ]
|> Arg.align |> Arg.align

View file

@ -24,11 +24,11 @@ let with_pool ~kind f =
Pool.with_ ~per_domain:1 f Pool.with_ ~per_domain:1 f
else else
Pool.with_ ~min:!j f Pool.with_ ~min:!j f
| "simple" -> | "fifo" ->
if !j = 0 then if !j = 0 then
Simple_pool.with_ ~per_domain:1 f Fifo_pool.with_ ~per_domain:1 f
else else
Simple_pool.with_ ~min:!j f Fifo_pool.with_ ~min:!j f
| _ -> assert false | _ -> assert false
(** Run in parallel using {!Fut.for_} *) (** Run in parallel using {!Fut.for_} *)
@ -120,7 +120,7 @@ let () =
"-j", Arg.Set_int j, " number of threads"; "-j", Arg.Set_int j, " number of threads";
"-t", Arg.Set time, " printing timing"; "-t", Arg.Set time, " printing timing";
( "-kind", ( "-kind",
Arg.Symbol ([ "pool"; "simple" ], ( := ) kind), Arg.Symbol ([ "pool"; "fifo" ], ( := ) kind),
" pick pool implementation" ); " pick pool implementation" );
] ]
|> Arg.align |> Arg.align

View file

@ -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 FIFO: first-in, first-out. Basically tasks are put into a queue,
simple and reliable. Like {!Pool} it distributes a fixed number and worker threads pull them out of the queue at the other end.
of workers over several domains.
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 *) @since NEXT_RELEASE *)

View file

@ -11,7 +11,7 @@ module Fut = Fut
module Lock = Lock module Lock = Lock
module Pool = Pool module Pool = Pool
module Runner = Runner module Runner = Runner
module Simple_pool = Simple_pool module Fifo_pool = Fifo_pool
module Private = struct module Private = struct
module Ws_deque_ = Ws_deque_ module Ws_deque_ = Ws_deque_

View file

@ -5,7 +5,7 @@
*) *)
module Pool = Pool module Pool = Pool
module Simple_pool = Simple_pool module Fifo_pool = Fifo_pool
module Runner = Runner module Runner = Runner
val start_thread_on_some_domain : ('a -> unit) -> 'a -> Thread.t val start_thread_on_some_domain : ('a -> unit) -> 'a -> Thread.t

View file

@ -4,7 +4,7 @@ let ( let@ ) = ( @@ )
let with_pool ~kind () f = let with_pool ~kind () f =
match kind with 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 | `Pool -> Pool.with_ ~min:4 () f
let rec fib x = let rec fib x =
@ -75,4 +75,4 @@ let run ~kind () =
let () = let () =
run ~kind:`Pool (); run ~kind:`Pool ();
run ~kind:`Simple_pool () run ~kind:`Fifo_pool ()

View file

@ -7,7 +7,7 @@ let add_test t = tests := t :: !tests
let with_pool ~kind () f = let with_pool ~kind () f =
match kind with 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 | `Pool -> Pool.with_ ~min:4 ~per_domain:1 () f
let () = let () =
@ -48,7 +48,7 @@ let () =
let () = let () =
let tests = 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 |> List.flatten
in in
QCheck_base_runner.run_tests_main tests QCheck_base_runner.run_tests_main tests

View file

@ -4,7 +4,7 @@ let ( let@ ) = ( @@ )
let with_pool ~kind () f = let with_pool ~kind () f =
match kind with 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 | `Pool -> Pool.with_ ~min:4 ~per_domain:1 () f
(* test proper resource handling *) (* test proper resource handling *)
@ -24,4 +24,4 @@ let run ~kind () =
let () = let () =
run ~kind:`Pool (); run ~kind:`Pool ();
run ~kind:`Simple_pool () run ~kind:`Fifo_pool ()

View file

@ -4,7 +4,7 @@ let ( let@ ) = ( @@ )
let with_pool ~kind ~j () f = let with_pool ~kind ~j () f =
match kind with 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 | `Pool -> Pool.with_ ~min:j () f
type 'a tree = type 'a tree =
@ -89,4 +89,4 @@ let () =
Tracy_client_trace.setup (); Tracy_client_trace.setup ();
*) *)
run_main ~kind:`Pool (); run_main ~kind:`Pool ();
run_main ~kind:`Simple_pool () run_main ~kind:`Fifo_pool ()

View file

@ -20,7 +20,7 @@ let run ~kind () =
in in
match kind with 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 () | `Pool -> Pool.create ~min:3 ~on_init_thread ~around_task ()
in in