diff --git a/unix/lib/main.ml b/unix/lib/main.ml index 7857f33..af83463 100644 --- a/unix/lib/main.ml +++ b/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) diff --git a/unix/lib/main.mli b/unix/lib/main.mli index c7cf82a..5ca38a2 100644 --- a/unix/lib/main.mli +++ b/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 diff --git a/xen/lib/main.ml b/xen/lib/main.ml index bfc439c..9478d30 100644 --- a/xen/lib/main.ml +++ b/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) diff --git a/xen/lib/main.mli b/xen/lib/main.mli index c385605..56fe6c2 100644 --- a/xen/lib/main.mli +++ b/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