Selaa lähdekoodia

allow disable parallel (for benchmark purposes)

ncannasse 3 kuukautta sitten
vanhempi
commit
d3182cf469
1 muutettua tiedostoa jossa 32 lisäystä ja 14 poistoa
  1. 32 14
      src/context/parallel.ml

+ 32 - 14
src/context/parallel.ml

@@ -1,21 +1,36 @@
+let enable = ref true
+
 let run_parallel_for num_domains ?(chunk_size=0) length f =
-	let pool = Domainslib.Task.setup_pool ~num_domains:(num_domains - 1) () in
-	Domainslib.Task.run pool (fun _ -> Domainslib.Task.parallel_for pool ~chunk_size ~start:0 ~finish:(length-1) ~body:f);
-	Domainslib.Task.teardown_pool pool
+	if not !enable then begin
+		for i = 0 to length - 1 do
+			f i
+		done
+	end else
+		let pool = Domainslib.Task.setup_pool ~num_domains:(num_domains - 1) () in
+		Domainslib.Task.run pool (fun _ -> Domainslib.Task.parallel_for pool ~chunk_size ~start:0 ~finish:(length-1) ~body:f);
+		Domainslib.Task.teardown_pool pool
 
 module ParallelArray = struct
 	let iter pool f a =
-		let f' idx = f a.(idx) in
-		Domainslib.Task.parallel_for pool ~start:0 ~finish:(Array.length a - 1) ~body:f'
+		match pool with
+		| None ->
+			Array.iter f a
+		| Some pool ->
+			let f' idx = f a.(idx) in
+			Domainslib.Task.parallel_for pool ~start:0 ~finish:(Array.length a - 1) ~body:f'
 
 	let map pool f a x =
-		let length = Array.length a in
-		let a_out = Array.make length x in
-		let f' idx =
-			Array.unsafe_set a_out idx (f (Array.unsafe_get a idx))
-		in
-		Domainslib.Task.parallel_for pool ~start:0 ~finish:(length - 1) ~body:f';
-		a_out
+		match pool with
+		| None ->
+			Array.map f a
+		| Some pool ->
+			let length = Array.length a in
+			let a_out = Array.make length x in
+			let f' idx =
+				Array.unsafe_set a_out idx (f (Array.unsafe_get a idx))
+			in
+			Domainslib.Task.parallel_for pool ~start:0 ~finish:(length - 1) ~body:f';
+			a_out
 end
 
 module ParallelSeq = struct
@@ -24,5 +39,8 @@ module ParallelSeq = struct
 end
 
 let run_in_new_pool timer_ctx f =
-	let pool = Timer.time timer_ctx ["domainslib";"setup"] (Domainslib.Task.setup_pool ~num_domains:(Domain.recommended_domain_count() - 1)) () in
-	Std.finally (fun () -> Timer.time timer_ctx ["domainslib";"teardown"] Domainslib.Task.teardown_pool pool) (Domainslib.Task.run pool) (fun () -> f pool)
+	if not !enable then
+		f None
+	else
+		let pool = Timer.time timer_ctx ["domainslib";"setup"] (Domainslib.Task.setup_pool ~num_domains:(Domain.recommended_domain_count() - 1)) () in
+		Std.finally (fun () -> Timer.time timer_ctx ["domainslib";"teardown"] Domainslib.Task.teardown_pool pool) (Domainslib.Task.run pool) (fun () -> f (Some pool))