diff --git a/Makefile b/Makefile index 8e08c4b8..3a6c7bf1 100644 --- a/Makefile +++ b/Makefile @@ -30,6 +30,8 @@ bench-fib: @echo running for N=$(N) dune build $(DUNE_OPTS_BENCH) benchs/fib_rec.exe hyperfine -L psize $(BENCH_PSIZE) -L kind $(BENCH_KIND) --warmup=1 \ + './_build/default/benchs/fib_rec.exe -seq -cutoff $(BENCH_CUTOFF) -niter $(NITER) -n $(N)' \ + './_build/default/benchs/fib_rec.exe -dl -cutoff $(BENCH_CUTOFF) -niter $(NITER) -n $(N)' \ './_build/default/benchs/fib_rec.exe -cutoff $(BENCH_CUTOFF) -niter $(NITER) -psize={psize} -kind={kind} -n $(N)' PI_NSTEPS?=100_000_000 diff --git a/bench_fib.sh b/bench_fib.sh new file mode 100755 index 00000000..e9996d53 --- /dev/null +++ b/bench_fib.sh @@ -0,0 +1,3 @@ +#!/bin/sh +OPTS="--profile=release --display=quiet" +exec dune exec $OPTS -- benchs/fib_rec.exe $@ diff --git a/benchs/dune b/benchs/dune index 0ae20bf3..ff0f878b 100644 --- a/benchs/dune +++ b/benchs/dune @@ -3,4 +3,4 @@ (names fib_rec pi) (preprocess (action (run %{project_root}/src/cpp/cpp.exe %{input-file}))) - (libraries moonpool unix trace trace-tef)) + (libraries moonpool unix trace trace-tef domainslib)) diff --git a/benchs/fib_rec.ml b/benchs/fib_rec.ml index 06341ce1..d3df44df 100644 --- a/benchs/fib_rec.ml +++ b/benchs/fib_rec.ml @@ -16,6 +16,43 @@ let rec fib ~on x : int Fut.t = let+ t1 = fib ~on (x - 1) and+ t2 = fib ~on (x - 2) in t1 + t2 +let fib_fj ~on x : int Fut.t = + let rec fib_rec x : int = + if x <= !cutoff then + fib_direct x + else ( + let n1, n2 = + Fork_join.both (fun () -> fib_rec (x - 1)) (fun () -> fib_rec (x - 2)) + in + n1 + n2 + ) + in + Fut.spawn ~on (fun () -> fib_rec x) + +let fib_await ~on x : int Fut.t = + let rec fib_rec x : int Fut.t = + if x <= !cutoff then + Fut.spawn ~on (fun () -> fib_direct x) + else + Fut.spawn ~on (fun () -> + let n1 = fib_rec (x - 1) in + let n2 = fib_rec (x - 2) in + let n1 = Fut.await n1 in + let n2 = Fut.await n2 in + n1 + n2) + in + fib_rec x + +let rec fib_dl ~pool x : int Domainslib.Task.promise = + if x <= !cutoff then + Domainslib.Task.async pool (fun () -> fib_direct x) + else + Domainslib.Task.async pool (fun () -> + let t1 = fib_dl ~pool (x - 1) and t2 = fib_dl ~pool (x - 2) in + let t1 = Domainslib.Task.await pool t1 in + let t2 = Domainslib.Task.await pool t2 in + t1 + t2) + let () = assert (List.init 10 fib_direct = [ 1; 1; 2; 3; 5; 8; 13; 21; 34; 55 ]) let create_pool ~psize ~kind () = @@ -24,13 +61,31 @@ let create_pool ~psize ~kind () = | "pool" -> Ws_pool.create ~min:psize () | _ -> assert false -let run ~psize ~n ~seq ~niter ~kind () : unit = +let run ~psize ~n ~seq ~dl ~fj ~await ~niter ~kind () : unit = let pool = lazy (create_pool ~kind ~psize ()) in + let dl_pool = + lazy + (let n = Domain.recommended_domain_count () in + Printf.printf "use %d domains\n%!" n; + Domainslib.Task.setup_pool ~num_domains:n ()) + in for _i = 1 to niter do let res = if seq then ( Printf.printf "compute fib %d sequentially\n%!" n; fib_direct n + ) else if dl then ( + Printf.printf "compute fib %d with domainslib\n%!" n; + let (lazy pool) = dl_pool in + Domainslib.Task.run pool (fun () -> + Domainslib.Task.await pool @@ fib_dl ~pool n) + ) else if fj then ( + Printf.printf "compute fib %d using fork-join with pool size=%d\n%!" n + psize; + fib_fj ~on:(Lazy.force pool) n |> Fut.wait_block_exn + ) else if await then ( + Printf.printf "compute fib %d using await with pool size=%d\n%!" n psize; + fib_await ~on:(Lazy.force pool) n |> Fut.wait_block_exn ) else ( Printf.printf "compute fib %d with pool size=%d\n%!" n psize; fib ~on:(Lazy.force pool) n |> Fut.wait_block_exn @@ -38,7 +93,13 @@ let run ~psize ~n ~seq ~niter ~kind () : unit = in Printf.printf "fib %d = %d\n%!" n res done; - if not seq then Ws_pool.shutdown (Lazy.force pool) + + if seq then + () + else if dl then + Domainslib.Task.teardown_pool (Lazy.force dl_pool) + else + Ws_pool.shutdown (Lazy.force pool) let () = let n = ref 40 in @@ -46,12 +107,18 @@ let () = let seq = ref false in let niter = ref 3 in let kind = ref "pool" in + let dl = ref false in + let await = ref false in + let fj = ref false in let opts = [ "-psize", Arg.Set_int psize, " pool size"; "-n", Arg.Set_int n, " fib "; "-seq", Arg.Set seq, " sequential"; + "-dl", Arg.Set dl, " domainslib"; + "-fj", Arg.Set fj, " fork join"; "-niter", Arg.Set_int niter, " number of iterations"; + "-await", Arg.Set await, " use await"; "-cutoff", Arg.Set_int cutoff, " cutoff for sequential computation"; ( "-kind", Arg.Symbol ([ "pool"; "fifo" ], ( := ) kind), @@ -61,4 +128,5 @@ let () = in Arg.parse opts ignore ""; - run ~psize:!psize ~n:!n ~seq:!seq ~niter:!niter ~kind:!kind () + run ~psize:!psize ~n:!n ~fj:!fj ~seq:!seq ~await:!await ~dl:!dl ~niter:!niter + ~kind:!kind ()