provide new sleeper storage in here

mirage · May 18, 2024 · 32c2880 · 32c2880
1 parent d7c1088
commit 32c2880
Show file tree

Hide file tree

Showing 5 changed files with 28 additions and 10 deletions.
diff --git a/mirage-time.opam b/mirage-time.opam
@@ -23,7 +23,6 @@ depends: [
   "lwt" {>= "4.0.0"}
   "duration"
 ]
-depopts: [ "mirage-runtime" ]
 build: [
   ["dune" "subst"] {dev}
   ["dune" "build" "-p" name "-j" jobs]

diff --git a/solo5/dune b/solo5/dune
@@ -2,5 +2,4 @@
  (name mirage_time_solo5)
  (public_name mirage-time.solo5)
  (implements mirage-time)
- (libraries mirage-runtime lwt)
  (optional))
diff --git a/solo5/mirage_time.ml b/solo5/mirage_time.ml
@@ -1,9 +1,18 @@
 external time : unit -> int64 = "caml_get_monotonic_time"
 
+type sleep = { time : int64; mutable canceled : bool; thread : unit Lwt.u }
+
+let sleepers = ref []
+
 let sleep_ns d =
   let res, w = Lwt.task () in
   let time = Int64.add (time ()) d in
-  let sleeper = Mirage_runtime.{ time; canceled = false; thread = w } in
-  Mirage_runtime.add_new_sleeper sleeper;
+  let sleeper = { time; canceled = false; thread = w } in
+  sleepers := sleeper :: !sleepers;
   Lwt.on_cancel res (fun _ -> sleeper.canceled <- true);
   res
+
+let new_sleepers () =
+  let sl = !sleepers in
+  sleepers := [];
+  sl
diff --git a/src/mirage_time.mli b/src/mirage_time.mli
@@ -16,13 +16,20 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-(** {1 Time-related devices}
+(** {1 Time device}
 
-    This module define time-related devices for MirageOS and
-    sleep operations.
-
-    {e Release %%VERSION%% } *)
+    This module defines a target-agnostic MirageOS sleep operation.  *)
 
 val sleep_ns: int64 -> unit Lwt.t
-(** [sleep_ns n] Block the current thread for [n] nanoseconds, treating the [n]
+(** [sleep_ns n] blocks the current task for [n] nanoseconds, treating [n] as
     unsigned.  *)
+
+(** {1 Values used by the schedulers} *)
+
+type sleep = { time : int64; mutable canceled : bool; thread : unit Lwt.u }
+(** The type for a sleeping task. *)
+
+val new_sleepers : unit -> sleep list
+(** [new_sleepers ()] is used by the scheduler to find at their convenience
+    the tasks that need to be enqueued into their task set. This also empties
+    the list of sleepers. *)
diff --git a/unix/mirage_time.ml b/unix/mirage_time.ml
@@ -15,3 +15,7 @@
  *)
 
 let sleep_ns ns = Lwt_unix.sleep (Duration.to_f ns)
+
+type sleep = { time : int64; mutable canceled : bool; thread : unit Lwt.u }
+
+let new_sleepers () = []