Merge pull request #49 from mirage/lwt-pause-dont-sleep

event loop: yield but don't sleep if there are paused tasks
mirage · Oct 19, 2022 · ec38df8 · ec38df8
2 parents bdc9d95 + 256c143
commit ec38df8
Showing 1 changed file with 5 additions and 3 deletions.
diff --git a/lib/main.ml b/lib/main.ml
@@ -48,9 +48,11 @@ let run t =
           aux ())
         else
           let timeout =
-            match Time.select_next () with
-            | None -> Int64.add (Time.time ()) (Duration.of_day 1)
-            | Some tm -> tm
+            if Lwt.paused_count () > 0 then 0L
+            else
+              match Time.select_next () with
+              | None -> Int64.add (Time.time ()) (Duration.of_day 1)
+              | Some tm -> tm
           in
           MProf.Trace.(note_hiatus Wait_for_work);
           evtchn_block_domain timeout;