diff --git a/CHANGES.md b/CHANGES.md index 58a5256..c995656 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,7 @@ +## Unreleased + +* Make ~num_domains argument for Task.setup_pool optional (#87, #91) + ## v0.5.0 This release includes: diff --git a/README.md b/README.md index 78a7319..1bc81aa 100644 --- a/README.md +++ b/README.md @@ -21,8 +21,8 @@ We can parallelise this program using Domainslib: ```ocaml (* fib_par.ml *) -let num_domains = try int_of_string Sys.argv.(1) with _ -> 1 -let n = try int_of_string Sys.argv.(2) with _ -> 1 +let n = try int_of_string Sys.argv.(1) with _ -> 1 +let num_domains = try Some (int_of_string Sys.argv.(2) - 1) with _ -> None (* Sequential Fibonacci *) let rec fib n = @@ -40,7 +40,7 @@ let rec fib_par pool n = fib n let main () = - let pool = T.setup_pool ~num_domains:(num_domains - 1) () in + let pool = T.setup_pool ?num_domains () in let res = T.run pool (fun _ -> fib_par pool n) in T.teardown_pool pool; Printf.printf "fib(%d) = %d\n" n res @@ -51,28 +51,28 @@ let _ = main () The parallel program scales nicely compared to the sequential version. The results presented below were obtained on a 2.3 GHz Quad-Core Intel Core i7 MacBook Pro with 4 cores and 8 hardware threads. ```bash -$ hyperfine './fib.exe 42' './fib_par.exe 2 42' \ - './fib_par.exe 4 42' './fib_par.exe 8 42' +$ hyperfine './fib.exe 42' './fib_par.exe 42 2' \ + './fib_par.exe 42 4' './fib_par.exe 42 8' Benchmark 1: ./fib.exe 42 Time (mean ± sd): 1.217 s ± 0.018 s [User: 1.203 s, System: 0.004 s] Range (min … max): 1.202 s … 1.261 s 10 runs -Benchmark 2: ./fib_par.exe 2 42 +Benchmark 2: ./fib_par.exe 42 2 Time (mean ± sd): 628.2 ms ± 2.9 ms [User: 1243.1 ms, System: 4.9 ms] Range (min … max): 625.7 ms … 634.5 ms 10 runs -Benchmark 3: ./fib_par.exe 4 42 +Benchmark 3: ./fib_par.exe 42 4 Time (mean ± sd): 337.6 ms ± 23.4 ms [User: 1321.8 ms, System: 8.4 ms] Range (min … max): 318.5 ms … 377.6 ms 10 runs -Benchmark 4: ./fib_par.exe 8 42 +Benchmark 4: ./fib_par.exe 42 8 Time (mean ± sd): 250.0 ms ± 9.4 ms [User: 1877.1 ms, System: 12.6 ms] Range (min … max): 242.5 ms … 277.3 ms 11 runs Summary - './fib_par2.exe 8 42' ran - 1.35 ± 0.11 times faster than './fib_par.exe 4 42' - 2.51 ± 0.10 times faster than './fib_par.exe 2 42' + './fib_par.exe 42 8' ran + 1.35 ± 0.11 times faster than './fib_par.exe 42 4' + 2.51 ± 0.10 times faster than './fib_par.exe 42 2' 4.87 ± 0.20 times faster than './fib.exe 42' ``` diff --git a/lib/task.ml b/lib/task.ml index 3599925..b839041 100644 --- a/lib/task.ml +++ b/lib/task.ml @@ -106,7 +106,8 @@ let run (type a) pool (f : unit -> a) : a = let named_pools = Hashtbl.create 8 let named_pools_mutex = Mutex.create () -let setup_pool ?name ~num_domains () = +(* Domain.recommended_domain_count is guaranteed to be at least 1 *) +let setup_pool ?name ?(num_domains = Domain.recommended_domain_count () - 1) () = if num_domains < 0 then invalid_arg "Task.setup_pool: num_domains must be at least 0" else diff --git a/lib/task.mli b/lib/task.mli index 16baeac..08f53b7 100644 --- a/lib/task.mli +++ b/lib/task.mli @@ -7,10 +7,11 @@ type !'a promise type pool (** Type of task pool *) -val setup_pool : ?name:string -> num_domains:int -> unit -> pool +val setup_pool : ?name:string -> ?num_domains:int -> unit -> pool (** Sets up a task execution pool with [num_domains] new domains. If [name] is provided, the pool is mapped to [name] which can be looked up later with - [lookup_pool name]. + [lookup_pool name]. [~num_domains] defaults to + [Domain.recommended_domain_count () - 1]. When [num_domains] is 0, the new pool will be empty, and when an empty pool is in use, every function in this module will run effectively diff --git a/test/LU_decomposition_multicore.ml b/test/LU_decomposition_multicore.ml index ab123ee..519fdd5 100644 --- a/test/LU_decomposition_multicore.ml +++ b/test/LU_decomposition_multicore.ml @@ -1,6 +1,8 @@ module T = Domainslib.Task -let num_domains = try int_of_string Sys.argv.(1) with _ -> 1 -let mat_size = try int_of_string Sys.argv.(2) with _ -> 1200 +let mat_size = try int_of_string Sys.argv.(1) with _ -> 1200 +let num_domains = + try int_of_string Sys.argv.(2) + with _ -> Domain.recommended_domain_count () let k = Domain.DLS.new_key Random.State.make_self_init diff --git a/test/enumerate_par.ml b/test/enumerate_par.ml index da8e65f..f547e45 100644 --- a/test/enumerate_par.ml +++ b/test/enumerate_par.ml @@ -1,10 +1,10 @@ -let num_domains = try int_of_string Sys.argv.(1) with _ -> 1 -let n = try int_of_string Sys.argv.(2) with _ -> 100 +let n = try int_of_string Sys.argv.(1) with _ -> 100 +let num_domains = try Some (int_of_string Sys.argv.(2) - 1) with _ -> None module T = Domainslib.Task let _ = - let p = T.setup_pool ~num_domains:(num_domains - 1) () in + let p = T.setup_pool ?num_domains () in T.run p (fun _ -> T.parallel_for p ~start:0 ~finish:(n-1) ~chunk_size:16 ~body:(fun i -> print_string @@ Printf.sprintf "[%d] %d\n%!" (Domain.self () :> int) i)); diff --git a/test/fib_par.ml b/test/fib_par.ml index 77e944b..63e5bac 100644 --- a/test/fib_par.ml +++ b/test/fib_par.ml @@ -1,5 +1,5 @@ -let num_domains = try int_of_string Sys.argv.(1) with _ -> 1 -let n = try int_of_string Sys.argv.(2) with _ -> 43 +let n = try int_of_string Sys.argv.(1) with _ -> 43 +let num_domains = try Some (int_of_string Sys.argv.(2) - 1) with _ -> None module T = Domainslib.Task @@ -15,7 +15,7 @@ let rec fib_par pool n = T.await pool a + T.await pool b let main = - let pool = T.setup_pool ~num_domains:(num_domains - 1) () in + let pool = T.setup_pool ?num_domains () in let res = T.run pool (fun _ -> fib_par pool n) in T.teardown_pool pool; Printf.printf "fib(%d) = %d\n" n res diff --git a/test/game_of_life_multicore.ml b/test/game_of_life_multicore.ml index 6606ab7..a3956fc 100644 --- a/test/game_of_life_multicore.ml +++ b/test/game_of_life_multicore.ml @@ -1,6 +1,6 @@ -let num_domains = try int_of_string Sys.argv.(1) with _ -> 1 -let n_times = try int_of_string Sys.argv.(2) with _ -> 20 -let board_size = try int_of_string Sys.argv.(3) with _ -> 16 +let n_times = try int_of_string Sys.argv.(1) with _ -> 20 +let board_size = try int_of_string Sys.argv.(2) with _ -> 16 +let num_domains = try Some (int_of_string Sys.argv.(3) - 1) with _ -> None module T = Domainslib.Task @@ -62,7 +62,7 @@ let rec repeat pool n = | _-> next pool; repeat pool (n-1) let ()= - let pool = T.setup_pool ~num_domains:(num_domains - 1) () in + let pool = T.setup_pool ?num_domains () in print !rg; T.run pool (fun _ -> repeat pool n_times); print !rg; diff --git a/test/spectralnorm2_multicore.ml b/test/spectralnorm2_multicore.ml index f8c5830..b0e20c8 100644 --- a/test/spectralnorm2_multicore.ml +++ b/test/spectralnorm2_multicore.ml @@ -6,8 +6,10 @@ * Modified by Mauricio Fernandez *) -let num_domains = try int_of_string Sys.argv.(1) with _ -> 1 -let n = try int_of_string Sys.argv.(2) with _ -> 2000 +let n = try int_of_string Sys.argv.(1) with _ -> 2000 +let num_domains = + try int_of_string Sys.argv.(2) + with _ -> Domain.recommended_domain_count () module T = Domainslib.Task diff --git a/test/sum_par.ml b/test/sum_par.ml index 3e0083a..2347afe 100644 --- a/test/sum_par.ml +++ b/test/sum_par.ml @@ -1,5 +1,7 @@ -let num_domains = try int_of_string Sys.argv.(1) with _ -> 2 let n = try int_of_string Sys.argv.(2) with _ -> 100 +let num_domains = + try int_of_string Sys.argv.(2) + with _ -> Domain.recommended_domain_count () module T = Domainslib.Task diff --git a/test/summed_area_table.ml b/test/summed_area_table.ml index b860995..dbc3898 100644 --- a/test/summed_area_table.ml +++ b/test/summed_area_table.ml @@ -1,6 +1,6 @@ module T = Domainslib.Task -let num_domains = try int_of_string Sys.argv.(1) with _ -> 4 -let size = try int_of_string Sys.argv.(2) with _ -> 100 +let size = try int_of_string Sys.argv.(1) with _ -> 100 +let num_domains = try Some (int_of_string Sys.argv.(2) - 1) with _ -> None let transpose a = let r = Array.length a in @@ -29,7 +29,7 @@ let calc_table pool mat = let _ = let m = Array.make_matrix size size 1 (*Array.init size (fun _ -> Array.init size (fun _ -> Random.int size))*) in - let pool = T.setup_pool ~num_domains:(num_domains - 1) () in + let pool = T.setup_pool ?num_domains () in let _ = T.run pool (fun _ -> calc_table pool m) in (* for i = 0 to size-1 do diff --git a/test/task_throughput.ml b/test/task_throughput.ml index c8bce4c..6c91862 100644 --- a/test/task_throughput.ml +++ b/test/task_throughput.ml @@ -1,7 +1,9 @@ -let n_domains = try int_of_string Sys.argv.(1) with _ -> 1 -let n_iterations = try int_of_string Sys.argv.(2) with _ -> 1024 -let n_tasks = try int_of_string Sys.argv.(3) with _ -> 1024 +let n_iterations = try int_of_string Sys.argv.(1) with _ -> 1024 +let n_tasks = try int_of_string Sys.argv.(2) with _ -> 1024 +let n_domains = + try int_of_string Sys.argv.(3) + with _ -> Domain.recommended_domain_count () module T = Domainslib.Task