wip: debug pool

This commit is contained in:
Simon Cruanes 2023-10-25 09:57:19 -04:00
parent 3d7e272d01
commit fdc188c291
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4

View file

@ -40,8 +40,12 @@ let find_current_worker_ (self : state) : worker_state option =
(** Run [task] as is, on the pool. *) (** Run [task] as is, on the pool. *)
let run_direct_ (self : state) (w : worker_state option) (task : task) : unit = let run_direct_ (self : state) (w : worker_state option) (task : task) : unit =
match w with match w with
| Some w -> WSQ.push w.q task | Some w ->
| None -> Bb_queue.push self.main_q task print_endline "push local";
WSQ.push w.q task
| None ->
print_endline "push blocking";
Bb_queue.push self.main_q task
let run_async_ (self : state) (task : task) : unit = let run_async_ (self : state) (task : task) : unit =
(* stay on current worker if possible *) (* stay on current worker if possible *)
@ -88,6 +92,7 @@ let worker_thread_ (self : state) (runner : t) (w : worker_state) ~on_exn
in in
let run_self_tasks_ () = let run_self_tasks_ () =
print_endline "run self tasks";
let continue = ref true in let continue = ref true in
let pop_retries = ref 0 in let pop_retries = ref 0 in
while !continue do while !continue do
@ -104,6 +109,7 @@ let worker_thread_ (self : state) (runner : t) (w : worker_state) ~on_exn
(* get a task from another worker *) (* get a task from another worker *)
let try_to_steal_work () : task option = let try_to_steal_work () : task option =
print_endline "try to steal work";
try try
for _retry = 1 to 3 do for _retry = 1 to 3 do
Array.iter Array.iter
@ -119,32 +125,46 @@ let worker_thread_ (self : state) (runner : t) (w : worker_state) ~on_exn
with Got_task task -> Some task with Got_task task -> Some task
in in
(* try to steal work multiple times *)
let try_to_steal_work_loop () : bool =
try
let unsuccessful_steal_attempts = ref 0 in
while !unsuccessful_steal_attempts < steal_attempt_max_retry do
match try_to_steal_work () with
| Some task ->
run_task task;
raise_notrace Exit
| None ->
incr unsuccessful_steal_attempts;
Domain_.relax ()
done;
false
with Exit -> true
in
let main_loop () = let main_loop () =
let steal_attempts = ref 0 in (try
while true do while true do
run_self_tasks_ (); run_self_tasks_ ();
match try_to_steal_work () with if not (try_to_steal_work_loop ()) then (
| Some task -> Array.iteri
steal_attempts := 0; (fun i w -> Printf.printf "w[%d].q.size=%d\n" i (WSQ.size w.q))
run_task task self.workers;
| None -> Printf.printf "bq.size=%d\n%!" (Bb_queue.size self.main_q);
incr steal_attempts;
Domain_.relax ();
if !steal_attempts > steal_attempt_max_retry then ( print_endline "wait block";
steal_attempts := 0;
let task = Bb_queue.pop self.main_q in let task = Bb_queue.pop self.main_q in
run_task task run_task task
) )
done done
with Bb_queue.Closed -> ());
run_self_tasks_ ()
in in
try
(* handle domain-local await *) (* handle domain-local await *)
Dla_.using ~prepare_for_await:Suspend_.prepare_for_await Dla_.using ~prepare_for_await:Suspend_.prepare_for_await
~while_running:main_loop ~while_running:main_loop
with Bb_queue.Closed -> ()
let default_thread_init_exit_ ~dom_id:_ ~t_id:_ () = () let default_thread_init_exit_ ~dom_id:_ ~t_id:_ () = ()