module Rtime:Timelines forsig..end
React.
Rtime manages time stamp events, delayed events and delayed signals along timelines. The client chooses the concrete timeline by providing an absolute notion of time. Running the timeline at the appropriate pace is left to the client.
See examples of use.
Release %%VERSION%% - %%AUTHORS%%
Creating and running timelines
typetime =float
typeduration =float
type t
val create : ?earlier:(t -> unit) -> (unit -> time) -> tcreate earlier now is a timeline whose absolute current time is
defined by calling the function now. earlier is called with
the timeline as an argument whenever a new deadline is scheduled
before all the others on the line; this can be used to unblock a
sleeping thread.
Warning earlier must not perform React update cycles (because
it may very likely be called during an update cycle).
val now : t -> timenow l is the current time on the timeline.val wakeup : t -> duration optionwakeup l is the duration until the next deadline on the timeline
(if any). If duration is negative, the timeline is late.val progress : ?exec:bool -> t -> unitprogress exec l immediatly removes the next deadline from the
timeline and if exec is true (default) executes it.
Warning. Deadline executions usually perform React
update cycles.
On a time stamp event occurence we distinguish :
The schedule and the occurence time may not coincide.
val stamp : ?stop:'a React.event ->
(time -> time -> 'b) -> t -> time -> 'b React.eventstamp stop occ l t is an event such that :
t on l.occ t t' with t' the occurence time.stop occurs
(existing deadlines are removed) or if t is earlier than now l
when stamp gets executed.val stamps : ?stop:'a React.event ->
?start:time ->
(time -> time -> 'b * time) -> t -> 'b React.eventstamps stop start occ l is an event such that :
start (defaults to now l).t, occ start t returns the stamp for the
current occurence and the time of the next schedule. If the latter
is earlier or equal to t no new occurence is scheduled.stop occurs
(existing deadlines are removed) or if start is earlier than
now l when stamps gets exectued.val delay_e : ?stop:'a React.event ->
t -> duration -> 'b React.event -> 'b React.eventdelay_e stop l d e is an event such that :
e delayed by d units of time on l.stop occurs (existing deadlines
are removed).val delay_s : ?eq:('b -> 'b -> bool) ->
?stop:'a React.event ->
t -> duration -> 'b -> 'b React.signal -> 'b React.signaldelay_s eq stop l d i s is :
S.hold ?eq i (S.delay stop l d (S.changes s))
Time stamps on a periodic schedule
The following function returns an event with occurences stamped by their
occurence time and scheduled on l at
start, start + p, start + 2p, ...
start + (max - 1)p. Occurences known to be late at schedule time
are dropped. If max is None the number of occurences is unbounded.
let periodic ?max ?stop ?start l p = match max with
| None ->
let occ start t = t, (start +. ceil ((t -. start) /. p) *. p) in
Rtime.stamps ?stop ?start occ l
| Some max ->
if max <= 0 then React.E.never else
let occ max start t =
let i = ceil ((t -. start) /. p) in
if i >= max then t, t (* stop *) else t, (start +. i *. p)
in
Rtime.stamps ?stop ?start (occ (float max)) l
Normalized linear time interval
The following function returns a signal that will vary linearly
from 0.0 to 1.0 during the time interval from start to
start + d on l. The signal will update at most freq times per
l units. Updates known to be late at schedule time are dropped
and the last update value is guaranteed to be 1.
let ninterval ?stop ?start freq l d =
let max = floor (freq *. d) in
let p = 1. /. freq in
let np = 1. /. max in
let first = p +. match start with None -> Rtime.now l | Some s -> s in
let occ first t =
let i = ceil ((t -. first) /. p) in
if i >= max then 1., t (* stop *) else (i *. np), (first +. i *. p)
in
React.S.hold 0. (Rtime.stamps ?stop ~start:first occ l)
The following examples show different techniques to run a UNIX timeline.
Single threaded program with Unix.select
The call run l executes all expired deadlines on the
timeline l and returns the next deadline or a negative value if
there's no deadline.
let rec run l = match Rtime.wakeup l with
| None -> -1. (* unbounded wait *)
| Some d when d > 0. -> d
| Some _ -> Rtime.progress l; run l
The main function creates a timeline using Unix.gettimeofday
for the absolute time, initializes input and ouput descriptors
and enters an infinite loop that runs the timeline and waits
with Unix.select on descriptor events or timeline deadlines.
let main () =
let unix_timeline = Rtime.create Unix.gettimeofday in
let r, w, e = ... (* init. descriptors *) in
while true do
let delay = run unix_timeline in
let r', w', e' = Unix.select !r !w !e delay in
... (* handle descriptor events *)
done
The call run l executes all expired deadlines
on the timeline l and installs a timer to send the Sys.sigalrm
signal on the next deadline or does nothing if there's no deadline.
let rec run l = match Rtime.wakeup l with
| None -> ()
| Some d when d > 0. ->
let s = { Unix.it_interval = 0.; it_value = d } in
ignore (Unix.setitimer Unix.ITIMER_REAL s)
| Some _ -> Rtime.progress l; run l
The idea is to install a handler for Sys.sigalrm that notifies
the main program that a deadline expired. It is very important
that the handler does not try to progress the timeline itself by calling
Rtime.progress, because doing so may violate the mutual exclusion of
React's update cycles if the handler is invoked during such a
cycle.
In our example below, we assume the main loop waits indefinitely
for messages in a queue with a blocking call to wait_message.
Whenever the timer expires the unblock handler sends a message
to the queue with send_timer_message. If the main loop is
currently blocked on wait_message this will unblock it and run
the timeline. The timeline uses Unix.gettimeofday for the
absolute time and calls unblock if a deadline is inserted before
the others to readjust the timer delay.
let main () =
let unblock _ = send_timer_message () in
let unix_timeline = Rtime.create ~earlier:unblock Unix.gettimeofday in
Sys.set_signal Sys.sigalrm (Sys.Signal_handle unblock);
run unix_timeline;
while true do
let m = wait_message () in
if m = timer_message then run unix_timeline else
... (* handle other message *)
done
In this example, we run the timeline in a dedicated thread.
First, React's update cycles must be executed in a critical
section. The thread dedicated to the timeline will trigger update
cycles upon deadline execution. Hence we need to execute them in
mutual exclusion from update cycles triggered by other
threads. The mutex function applies a function to its argument
in a critical section. The other threads will have to use this
function to perform update cycles; to acheive this automatically
they can use e_create and s_create to create their primitives.
let mutex =
let m = Mutex.create () in
fun f v ->
try Mutex.lock m; let r = f v in Mutex.unlock m; r with
| e -> (Mutex.unlock m; raise e)
let e_create () =
let e, send = React.E.create () in
e, mutex send
let s_create v =
let s, set = React.S.create v in
s, mutex set
Next, we need a mechanism to sleep the thread for a specific
amount of time (sleep) and a mean to unblock the thread
from another thread in case an earlier event occurrence gets created
(earlier). Unix's interval timers and condition variables are used to
achieve this.
let sleep, earlier =
let m = Mutex.create () in
let proceed = Condition.create () in
let sleeping = ref false in
let set_timer d =
let s = { Unix.it_interval = 0.; it_value = d } in
ignore (Unix.setitimer Unix.ITIMER_REAL s)
in
let sleep d = (* if d = 0. unbounded sleep *)
if d < 0. then invalid_arg "negative delay";
Mutex.lock m;
sleeping := true;
set_timer d;
while !sleeping do Condition.wait proceed m done;
Mutex.unlock m
in
let earlier _ =
Mutex.lock m;
sleeping := false;
set_timer 0.;
Condition.signal proceed;
Mutex.unlock m;
in
let timer _ = sleeping := false; Condition.signal proceed;
in
Sys.set_signal Sys.sigalrm (Sys.Signal_handle timer);
sleep, earlier
The call run l is an infinite loop that executes expired
deadlines on the timeline l (note the use of the mutex
function to progress the timeline), sleeps the thread until
the next deadline or forever if there's no deadline.
let run l =
while true do
try match Rtime.wakeup l with
| None -> sleep 0. (* unbounded sleep *)
| Some d when d > 0. -> sleep d
| Some _ -> mutex Rtime.progress l
with e -> ... (* print or ignore exception to avoid termination *)
done;
assert (false)
The main function creates a timeline using Unix.gettimeofday for the
absolute time and earlier to wake up the thread on earlier deadlines
and runs it in a dedicated thread.
let main () =
let unix_timeline = Rtime.create ~earlier Unix.gettimeofday in
let timeline_thread = Thread.create run unix_timeline in
...