Add generic hooks to mainloop

unix/lib/main.ml

@@ -31,3 +31,5 @@ let run t =
 let () = at_exit (fun () -> run (call_hooks exit_hooks))
 let at_exit f = ignore (Lwt_sequence.add_l f exit_hooks)
 let at_enter f = ignore (Lwt_sequence.add_l f enter_hooks)
+let at_exit_iter f = ignore (Lwt_sequence.add_r f Lwt_main.leave_iter_hooks)
+let at_enter_iter f = ignore (Lwt_sequence.add_r f Lwt_main.enter_iter_hooks)

unix/lib/main.mli

@@ -16,3 +16,5 @@
 
 val run : unit Lwt.t -> unit
 val at_enter : (unit -> unit Lwt.t) -> unit
+val at_exit_iter  : (unit -> unit) -> unit
+val at_enter_iter : (unit -> unit) -> unit

xen/lib/main.ml

@@ -29,6 +29,8 @@ let evtchn = Eventchn.init ()
 
 let exit_hooks = Lwt_sequence.create ()
 let enter_hooks = Lwt_sequence.create ()
+let exit_iter_hooks = Lwt_sequence.create ()
+let enter_iter_hooks = Lwt_sequence.create ()
 
 let rec call_hooks hooks  =
   match Lwt_sequence.take_opt_l hooks with
@@ -60,7 +62,11 @@ let run t =
         if look_for_work () then begin
           (* Some event channels have triggered, wake up threads
            * and continue without blocking. *)
+          (* Call enter hooks. *)
+          Lwt_sequence.iter_l (fun f -> f ()) enter_iter_hooks;
           Activations.run evtchn;
+          (* Call leave hooks. *)
+          Lwt_sequence.iter_l (fun f -> f ()) exit_iter_hooks;
           aux ()
         end else begin
           let timeout =
@@ -78,3 +84,5 @@ let run t =
 let () = at_exit (fun () -> run (call_hooks exit_hooks))
 let at_exit f = ignore (Lwt_sequence.add_l f exit_hooks)
 let at_enter f = ignore (Lwt_sequence.add_l f enter_hooks)
+let at_exit_iter f = ignore (Lwt_sequence.add_l f exit_iter_hooks)
+let at_enter_iter f = ignore (Lwt_sequence.add_l f enter_iter_hooks)

xen/lib/main.mli

@@ -16,3 +16,5 @@
 
 val run : unit Lwt.t -> unit
 val at_enter : (unit -> unit Lwt.t) -> unit
+val at_enter_iter : (unit -> unit) -> unit
+val at_exit_iter  : (unit -> unit) -> unit