From: Jean-Sebastien Legare <jean-sebastien.legare@citrix.com>
Date: Sat, 13 Jun 2009 02:15:47 +0000 (-0700)
Subject: [eventloop] Added support for periodic timers
X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=76693b93cdbbcd31ae67da8a62479e86168aef2a;p=xenclient%2Ftoolstack.git

[eventloop] Added support for periodic timers
[eventloop] Removed superfluous Map (keyed by handle).
---

diff --git a/libs/stdext/eventloop.ml b/libs/stdext/eventloop.ml
index 47944ec..a7be1d7 100644
--- a/libs/stdext/eventloop.ml
+++ b/libs/stdext/eventloop.ml
@@ -23,47 +23,46 @@ module ConnMap = Map.Make (struct type t = Unix.file_descr let compare = compare
 
 (* A module that supports finding a timer by handle as well as by expiry time. *)
 module Timers = struct
-	type handle = int
 
 	type 'a entry =
 	{
-		handle: handle;
-		expires_at: float;
+		handle : int;
+		mutable expires_at: float; 
 		value: 'a;
 	}
 
-	module Timers_by_handle = Map.Make (struct type t = handle let compare = compare end)
 	module Timers_by_expiry = Map.Make (struct type t = float let compare = compare end)
 
 	type 'a t =
 	{
-		mutable by_handle: ('a entry) Timers_by_handle.t;
 		mutable by_expiry: (('a entry) list) Timers_by_expiry.t;
 	}
 
-	let create () = { by_handle = Timers_by_handle.empty;
-			  by_expiry = Timers_by_expiry.empty }
+	let create () = { by_expiry = Timers_by_expiry.empty }
 
-	let is_empty t = Timers_by_handle.is_empty t.by_handle
+	let is_empty t = Timers_by_expiry.is_empty t.by_expiry
 
 	let next_handle = ref 0
 
+	(** inserts an existing (but not inserted) entry in the map *)
+	let submit_timer t at e = 
+		e.expires_at <- at;
+		let es = try Timers_by_expiry.find e.expires_at t.by_expiry with Not_found -> [] in
+		t.by_expiry <- Timers_by_expiry.add e.expires_at (e :: es) t.by_expiry
+		
 	let add_timer t at v =
 		incr next_handle;
 		let e = { handle = !next_handle; expires_at = at; value = v } in
-		t.by_handle <- Timers_by_handle.add e.handle e t.by_handle;
-		let es = try Timers_by_expiry.find e.expires_at t.by_expiry with Not_found -> [] in
-		t.by_expiry <- Timers_by_expiry.add e.expires_at (e :: es) t.by_expiry;
-		e.handle
+		submit_timer t at e;
+		e
 
-	let remove_timer t handle =
-		let e = Timers_by_handle.find handle t.by_handle in
-		let es = Timers_by_expiry.find e.expires_at t.by_expiry in
+	let remove_timer t entry =
+		let handle = entry.handle in
+		let es = Timers_by_expiry.find entry.expires_at t.by_expiry in
 		let es = List.filter (fun e' -> e'.handle <> handle) es in
-		t.by_handle <- Timers_by_handle.remove handle t.by_handle;
 		t.by_expiry <- (match es with
-				| [] -> Timers_by_expiry.remove e.expires_at t.by_expiry
-				| _  -> Timers_by_expiry.add e.expires_at es t.by_expiry
+				| [] -> Timers_by_expiry.remove entry.expires_at t.by_expiry
+				| _  -> Timers_by_expiry.add entry.expires_at es t.by_expiry
 			       )
 
 	exception Found of float
@@ -78,27 +77,16 @@ module Timers = struct
 			raise Not_found
 		with Found tim -> tim
 
+	(* Extracts the timers for time t, and return a list of values for those timers *)
 	let extract_timers_at t tim =
 		try
 			let es = Timers_by_expiry.find tim t.by_expiry in
 			t.by_expiry <- Timers_by_expiry.remove tim t.by_expiry;
-			t.by_handle <- List.fold_left (fun byh e ->
-							Timers_by_handle.remove e.handle byh
-						      ) t.by_handle es;
 			List.map (fun e -> e.value) es
 		with Not_found -> []
 
-	let num_timers t =
-		let cnt = ref 0 in
-		Timers_by_handle.iter (fun _ _ -> incr cnt) t.by_handle;
-		!cnt
 end
 
-type timer_callbacks =
-{
-	expiry_callback : unit -> unit
-}
-
 type error = Unix.error * string * string
 
 type handle = Unix.file_descr
@@ -133,7 +121,7 @@ and conn_state =
 and t =
 {
 	mutable conns: conn_state ConnMap.t;
-	mutable timers: timer_callbacks Timers.t;
+	mutable timers: (unit -> unit) Timers.t;
 	(* select state *)
 	readers: Unixext.Fdset.t;
 	writers: Unixext.Fdset.t;
@@ -141,6 +129,8 @@ and t =
 	(* dispatch state *)
 	mutable d_readers: Unixext.Fdset.t;
 	mutable d_writers: Unixext.Fdset.t;
+	(** Unix.gettimeofday() at the time the loop iteration started *)
+	mutable current_time: float;
 }
 
 let create () =
@@ -151,15 +141,9 @@ let create () =
 	excepts = Unixext.Fdset.create ();
 	d_readers = Unixext.Fdset.create ();
 	d_writers = Unixext.Fdset.create ();
+	current_time = 0.0;
 }
 
-let num_connections t =
-	let cnt = ref 0 in
-	ConnMap.iter (fun _ _ -> incr cnt) t.conns;
-	!cnt
-
-let num_timers t = Timers.num_timers t.timers
-
 (* connections *)
 
 let register_conn t fd ?(enable_send_done=false) ?(enable_recv=true) callbacks =
@@ -241,17 +225,32 @@ let set_callbacks t handle callbacks =
 	let conn_state = ConnMap.find handle t.conns in
 	conn_state.callbacks <- callbacks
 
+let has_connections t = not (ConnMap.is_empty t.conns)
+
 (* timers *)
 
-type timer = Timers.handle
+type timer = (unit -> unit) Timers.entry
 
-let start_timer t interval callback =
-	let at = Unix.gettimeofday () +. interval in
-	Timers.add_timer t.timers at callback
+let start_timer t time_offset_sec cb =
+	let at = Unix.gettimeofday () +. time_offset_sec in
+	Timers.add_timer t.timers at cb
 
+let start_periodic_timer t time_offset_sec period cb =
+	let orig_timer = ref (None: timer option) in
+	let resubmit_timer_closure () = 
+		let orig_timer = match !orig_timer with None -> raise Not_found | Some x -> x in
+		Timers.submit_timer t.timers (t.current_time +. period) orig_timer;
+		cb (); (* invoke the user's callback *)
+	in
+	let new_timer = start_timer t time_offset_sec resubmit_timer_closure in
+	orig_timer := Some (new_timer);
+	new_timer
+	
 let cancel_timer t timer =
 	Timers.remove_timer t.timers timer
 
+let has_timers t = not (Timers.is_empty t.timers)
+
 (* event dispatch *)
 
 let buf = String.create 512
@@ -347,20 +346,22 @@ let dispatch_write t fd cs =
 				cs.callbacks.send_done_callback t fd
 		end
 
-let dispatch_timers t current_time =
+let dispatch_timers t =
 	let break = ref false in
-	while (not (Timers.is_empty t.timers) && not !break) do
+	while ((not (Timers.is_empty t.timers)) && (not !break)) do
 		let first_expired = Timers.get_first_expiry_time t.timers in
-		if first_expired > current_time then
+		if first_expired > t.current_time then
 			break := true
 		else begin
 			let cbs = Timers.extract_timers_at t.timers first_expired in
-			List.iter (fun cb -> cb.expiry_callback ()) cbs
+			List.iter (fun cb -> cb ()) cbs
 		end
 	done
 
+let timers_empty t = Timers.is_empty t.timers
+
 let dispatch t interval =
-	let ctime = Unix.gettimeofday () in
+	t.current_time <- Unix.gettimeofday ();
 	let interval =
 		if Timers.is_empty t.timers then interval
 		else
@@ -369,10 +370,10 @@ let dispatch t interval =
 			   interval before which the earliest timer
 			   expires.
 			*)
-			let block_until = if interval > 0.0 then ctime +. interval else ctime in
+			let block_until = if interval > 0.0 then t.current_time +. interval else t.current_time in
 			let first_expiry = Timers.get_first_expiry_time t.timers in
 			let block_until = (if first_expiry < block_until then first_expiry else block_until) in
-			let interval = block_until -. ctime in
+			let interval = block_until -. t.current_time in
 			if interval < 0.0 then 0.0 else interval
 	in
 	let events =
@@ -392,5 +393,4 @@ let dispatch t interval =
 			     ) t.conns
 	 | None -> ()
 	);
-
-	dispatch_timers t ctime
+	dispatch_timers t
diff --git a/libs/stdext/eventloop.mli b/libs/stdext/eventloop.mli
index fbd238e..c8d7467 100644
--- a/libs/stdext/eventloop.mli
+++ b/libs/stdext/eventloop.mli
@@ -62,13 +62,21 @@ val set_callbacks : t -> handle -> conn_callbacks -> unit
 
 type timer
 
-type timer_callbacks =
-{
-	expiry_callback : unit -> unit
-}
+(** Starts a timer that will fire once only, and return a handle to
+    this timer, so that it can be cancelled before it fires. The timer
+    is automatically cancelled once it has fired.
+*)
+val start_timer : t -> float (* offset, secs *) -> (unit -> unit) -> timer
+
+(** Starts a timer that will fire periodically. The timer needs
+    explicit cancellation. 	
+*)
+val start_periodic_timer: t -> float (* offset from current time, secs *) -> float (* period, secs *) -> (unit -> unit) -> timer
 
-(* currently, periodic timers are not supported. *)
-val start_timer : t -> float (* in seconds *) -> timer_callbacks -> timer
+(** Allows cancelling a timer before it fires.  Non-periodic timers
+    are implicitly cancelled when their timer fires.  Periodic timers
+    however need explicit cancellation.
+*)
 val cancel_timer : t -> timer -> unit
 
 
@@ -82,7 +90,9 @@ val dispatch : t -> float -> unit
 
 (* Event loop management *)
 
-val num_connections : t -> int
-val num_timers : t -> int
+val has_timers : t -> bool
+
+val has_connections : t -> bool
+