Commit 6169cae5 authored by François Bobot's avatar François Bobot

whybench : Use one main thread for async call

parent cf57997c
......@@ -384,3 +384,44 @@ in
open_std (fun fmt -> Pp.wnl fmt;
print_csv cmp print_tool print_probs fmt l) s
) b.boutputs
(** Create and manage one main working thread *)
module MainWorker =
struct
type 'a t = { queue : 'a Queue.t;
mutex : Mutex.t;
condition : Condition.t;
}
let create f =
let t = { queue = Queue.create ();
mutex = Mutex.create ();
condition = Condition.create ();
} in
let rec main () =
Mutex.lock t.mutex;
while Queue.is_empty t.queue do
Condition.wait t.condition t.mutex
done;
let v = Queue.pop t.queue in
Mutex.unlock t.mutex;
f v;
main () in
let _ = Thread.create main () in
t
let add_work t x =
Mutex.lock t.mutex;
Queue.push x t.queue;
Condition.signal t.condition;
Mutex.unlock t.mutex
let add_works t q =
Mutex.lock t.mutex;
Queue.transfer q t.queue;
Condition.signal t.condition;
Mutex.unlock t.mutex
end
......@@ -137,3 +137,11 @@ val print_output :
(formatter -> 'a -> unit) ->
(formatter -> 'b -> unit) ->
('a,'b) bench * ('a * ('a,'b) result list) list -> unit
module MainWorker :
sig
type 'a t
val create : ('a -> unit) -> 'a t
val add_work : 'a t -> 'a -> unit
val add_works : 'a t -> 'a Queue.t -> unit
end
......@@ -371,7 +371,10 @@ let () =
eprintf "%a@." Exn_printer.exn_printer e;
exit 1
let () = Scheduler.async := (fun f v -> ignore (Thread.create f v))
let () =
let m = B.MainWorker.create (fun (f,v) -> f v) in
let async f v = B.MainWorker.add_work m (f,v) in
Scheduler.async := async
let () =
let m = Mutex.create () in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment