From 906cc152f2d96b0bcb10e7ca20e922ab56cadaea Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 2 Jul 2025 23:11:18 -0400 Subject: [PATCH] feat lwt_task: adaptative limit on number of tasks in one go --- src/lwt/task.ml | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/lwt/task.ml b/src/lwt/task.ml index 2902022f..15c29b25 100644 --- a/src/lwt/task.ml +++ b/src/lwt/task.ml @@ -14,12 +14,11 @@ let on_uncaught_exn : (exn -> Printexc.raw_backtrace -> unit) ref = (Printexc.raw_backtrace_to_string bt)) let run_all_tasks () : unit = - (* use local queue to prevent the hook from running forever in case - tasks keep scheduling new tasks. *) - let local = Queue.create () in - Queue.transfer tasks local; - while not (Queue.is_empty local) do - let t = Queue.pop local in + let n_processed = ref 0 in + let max_number_of_steps = min 10_000 (2 * Queue.length tasks) in + while (not (Queue.is_empty tasks)) && !n_processed < max_number_of_steps do + let t = Queue.pop tasks in + incr n_processed; try t () with exn -> let bt = Printexc.get_raw_backtrace () in