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
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

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 () =
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

View file

@ -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

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
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 *)

View file

@ -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_

View file

@ -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

View file

@ -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 ()

View file

@ -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

View file

@ -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 ()

View file

@ -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 ()

View file

@ -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