From 1b853cca44f693f28fccef3f94a38e9b5b5d17fe Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Thu, 17 Jun 2021 13:38:08 +0100 Subject: [PATCH] Add `Time.now` and `Time.sleep_until` Providers now provide `sleep_until`. `sleep` is implemented using that. This makes things a little more precise. --- README.md | 19 +++++++++++++++++ doc/prelude.ml | 28 +++++++++++++++++++++++++- lib_eio/eio.ml | 9 +++++++-- lib_eio/eio.mli | 10 ++++++++- lib_eio_linux/eio_linux.ml | 12 +++++------ lib_eio_linux/eio_linux.mli | 4 ++-- lib_eio_linux/tests/basic_eio_linux.ml | 2 +- 7 files changed, 71 insertions(+), 13 deletions(-) diff --git a/README.md b/README.md index 815f71a..8041ed0 100644 --- a/README.md +++ b/README.md @@ -22,6 +22,7 @@ unreleased repository. * [Networking](#networking) * [Design note: object capabilities](#design-note-object-capabilities) * [Filesystem access](#filesystem-access) +* [Time](#time) * [Multicore support](#multicore-support) * [Design note: thread-safety](#design-note-thread-safety) * [Design note: determinism](#design-note-determinism) @@ -507,6 +508,24 @@ A program that operates on the current directory will probably want to use `cwd` whereas a program that accepts a path from the user will probably want to use `fs`, perhaps with `open_dir` to constrain all access to be within that directory. +## Time + +The standard environment provides a clock with the usual POSIX time: + +```ocaml +# Eio_main.run @@ fun env -> + let clock = Eio.Stdenv.clock env in + traceln "The time is now %f" (Eio.Time.now clock); + Eio.Time.sleep clock 1.0; + traceln "The time is now %f" (Eio.Time.now clock) +The time is now 1623940778.270336 +The time is now 1623940779.270336 +- : unit = () +``` + +You might like to replace this clock with a mock for tests. +In fact, this README does just that - see [doc/prelude.ml](doc/prelude.ml) for the fake clock used in the example above! + ## Multicore support Fibres are scheduled cooperatively within a single domain, but you can also create new domains that run in parallel. diff --git a/doc/prelude.ml b/doc/prelude.ml index 8e91c4f..3591972 100644 --- a/doc/prelude.ml +++ b/doc/prelude.ml @@ -3,8 +3,34 @@ module Eio_main = struct open Eio.Std + let now = ref 1623940778.27033591 + + let fake_clock real_clock = object (_ : #Eio.Time.clock) + method now = !now + method sleep_until ?sw time = + (* The fake times are all in the past, so we just ask to wait until the + fake time is due and it will happen immediately. If we wait for + multiple times, they'll get woken in the right order. At the moment, + the scheduler only checks for expired timers when the run-queue is + empty, so this is a convenient way to wait for the system to be idle. + Will need revising if we make the scheduler fair at some point. *) + Eio.Time.sleep_until ?sw real_clock time; + now := max !now time + end + + (* https://github.com/ocaml/ocaml/issues/10324 *) + let dontcrash = Sys.opaque_identity + let run fn = Eio_main.run @@ fun env -> - try fn env + try + fn @@ object + method net = dontcrash env#net + method stdin = dontcrash env#stdin + method stdout = dontcrash env#stdout + method cwd = dontcrash env#cwd + method domain_mgr = dontcrash env#domain_mgr + method clock = fake_clock env#clock + end with Failure msg -> traceln "Error: %s" msg end diff --git a/lib_eio/eio.ml b/lib_eio/eio.ml index 9c36f47..b4bbabb 100644 --- a/lib_eio/eio.ml +++ b/lib_eio/eio.ml @@ -169,10 +169,15 @@ end module Time = struct class virtual clock = object - method virtual sleep : ?sw:Switch.t -> float -> unit + method virtual now : float + method virtual sleep_until : ?sw:Switch.t -> float -> unit end - let sleep ?sw (t : #clock) d = t#sleep ?sw d + let now (t : #clock) = t#now + + let sleep_until ?sw (t : #clock) time = t#sleep_until ?sw time + + let sleep ?sw t d = sleep_until ?sw t (now t +. d) end module Dir = struct diff --git a/lib_eio/eio.mli b/lib_eio/eio.mli index 9dc37ff..84f24b0 100644 --- a/lib_eio/eio.mli +++ b/lib_eio/eio.mli @@ -363,9 +363,17 @@ end module Time : sig class virtual clock : object - method virtual sleep : ?sw:Switch.t -> float -> unit + method virtual now : float + method virtual sleep_until : ?sw:Switch.t -> float -> unit end + val now : #clock -> float + (** [now t] is the current time according to [t]. *) + + val sleep_until : ?sw:Switch.t -> #clock -> float -> unit + (** [sleep_until t time] waits until the given time is reached. + @param sw The sleep is aborted if the switch is turned off. *) + val sleep : ?sw:Switch.t -> #clock -> float -> unit (** [sleep t d] waits for [d] seconds. @param sw The sleep is aborted if the switch is turned off. *) diff --git a/lib_eio_linux/eio_linux.ml b/lib_eio_linux/eio_linux.ml index 2e0c149..6ea1c02 100644 --- a/lib_eio_linux/eio_linux.ml +++ b/lib_eio_linux/eio_linux.ml @@ -404,9 +404,9 @@ let free_buf st buf = | None -> Uring.Region.free buf | Some k -> enqueue_thread st k buf -effect Sleep : Switch.t option * float -> unit -let sleep ?sw d = - perform (Sleep (sw, d)) +effect Sleep_until : Switch.t option * float -> unit +let sleep_until ?sw d = + perform (Sleep_until (sw, d)) effect ERead : (Switch.t option * Optint.Int63.t option * FD.t * Uring.Region.chunk * amount) -> int @@ -722,7 +722,8 @@ module Objects = struct let clock = object inherit Eio.Time.clock - method sleep ?sw d = sleep ?sw d + method now = Unix.gettimeofday () + method sleep_until = sleep_until end class dir fd = object @@ -856,9 +857,8 @@ let run ?(queue_depth=64) ?(block_size=4096) main = let k = { Suspended.k; tid } in enqueue_accept ~sw st k fd client_addr; schedule st - | effect (Sleep (sw, d)) k -> + | effect (Sleep_until (sw, time)) k -> let k = { Suspended.k; tid } in - let time = Unix.gettimeofday () +. d in let cancel_hook = ref Switch.null_hook in begin match sw with | None -> diff --git a/lib_eio_linux/eio_linux.mli b/lib_eio_linux/eio_linux.mli index 414f034..d906baf 100644 --- a/lib_eio_linux/eio_linux.mli +++ b/lib_eio_linux/eio_linux.mli @@ -44,8 +44,8 @@ end (** {1 Time functions} *) -val sleep : ?sw:Switch.t -> float -> unit -(** [sleep s] blocks until (at least) [s] seconds have passed. +val sleep_until : ?sw:Switch.t -> float -> unit +(** [sleep_until time] blocks until the current time is [time]. @param sw Cancel the sleep if [sw] is turned off. *) (** {1 Memory allocation functions} *) diff --git a/lib_eio_linux/tests/basic_eio_linux.ml b/lib_eio_linux/tests/basic_eio_linux.ml index 1ca5f1d..7ccf4cb 100644 --- a/lib_eio_linux/tests/basic_eio_linux.ml +++ b/lib_eio_linux/tests/basic_eio_linux.ml @@ -24,7 +24,7 @@ let () = let buf = alloc () in let _ = read_exactly fd buf 5 in Logs.debug (fun l -> l "sleeping at %f" (Unix.gettimeofday ())); - sleep 1.0; + sleep_until (Unix.gettimeofday () +. 1.0); print_endline (Uring.Region.to_string ~len:5 buf); let _ = read_exactly fd ~file_offset:(Int63.of_int 3) buf 3 in print_endline (Uring.Region.to_string ~len:3 buf);