feat lwt_task: adaptative limit on number of tasks in one go

This commit is contained in:
Simon Cruanes 2025-07-02 23:11:18 -04:00
parent 57bc8e434c
commit 906cc152f2
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4

View file

@ -14,12 +14,11 @@ let on_uncaught_exn : (exn -> Printexc.raw_backtrace -> unit) ref =
(Printexc.raw_backtrace_to_string bt)) (Printexc.raw_backtrace_to_string bt))
let run_all_tasks () : unit = let run_all_tasks () : unit =
(* use local queue to prevent the hook from running forever in case let n_processed = ref 0 in
tasks keep scheduling new tasks. *) let max_number_of_steps = min 10_000 (2 * Queue.length tasks) in
let local = Queue.create () in while (not (Queue.is_empty tasks)) && !n_processed < max_number_of_steps do
Queue.transfer tasks local; let t = Queue.pop tasks in
while not (Queue.is_empty local) do incr n_processed;
let t = Queue.pop local in
try t () try t ()
with exn -> with exn ->
let bt = Printexc.get_raw_backtrace () in let bt = Printexc.get_raw_backtrace () in