diff --git a/src/unix/lwt_engine.ml b/src/unix/lwt_engine.ml index 568ea44377..7d3394cf67 100644 --- a/src/unix/lwt_engine.ml +++ b/src/unix/lwt_engine.ml @@ -128,7 +128,27 @@ type ev_loop type ev_io type ev_timer -external ev_init : unit -> ev_loop = "lwt_libev_init" +module Ev_backend = +struct + type t = + | EV_DEFAULT + | EV_SELECT + | EV_POLL + | EV_EPOLL + | EV_KQUEUE + | EV_DEVPOLL + | EV_PORT + + let default = EV_DEFAULT + let select = EV_SELECT + let poll = EV_POLL + let epoll = EV_EPOLL + let kqueue = EV_KQUEUE + let devpoll = EV_DEVPOLL + let port = EV_PORT +end + +external ev_init : Ev_backend.t -> ev_loop = "lwt_libev_init" external ev_stop : ev_loop -> unit = "lwt_libev_stop" external ev_loop : ev_loop -> bool -> unit = "lwt_libev_loop" external ev_unloop : ev_loop -> unit = "lwt_libev_unloop" @@ -138,10 +158,10 @@ external ev_io_stop : ev_loop -> ev_io -> unit = "lwt_libev_io_stop" external ev_timer_init : ev_loop -> float -> bool -> (unit -> unit) -> ev_timer = "lwt_libev_timer_init" external ev_timer_stop : ev_loop -> ev_timer -> unit = "lwt_libev_timer_stop" -class libev = object +class libev ?(backend=Ev_backend.default) () = object inherit abstract - val loop = ev_init () + val loop = ev_init backend method loop = loop method private cleanup = ev_stop loop @@ -378,7 +398,7 @@ end let current = if Lwt_config._HAVE_LIBEV && Lwt_config.libev_default then - ref (new libev :> t) + ref (new libev () :> t) else ref (new select :> t) diff --git a/src/unix/lwt_engine.mli b/src/unix/lwt_engine.mli index 86c62e31d3..b2c9cac4c8 100644 --- a/src/unix/lwt_engine.mli +++ b/src/unix/lwt_engine.mli @@ -128,11 +128,24 @@ end (** {2 Predefined engines} *) type ev_loop + +module Ev_backend : +sig + type t + val default : t + val select : t + val poll : t + val epoll : t + val kqueue : t + val devpoll : t + val port : t +end + (** Type of libev loops. *) (** Engine based on libev. If not compiled with libev support, the creation of the class will raise {!Lwt_sys.Not_available}. *) -class libev : object +class libev : ?backend:Ev_backend.t -> unit -> object inherit t val loop : ev_loop diff --git a/src/unix/lwt_libev_stubs.c b/src/unix/lwt_libev_stubs.c index 0733f49291..9b7749a87f 100644 --- a/src/unix/lwt_libev_stubs.c +++ b/src/unix/lwt_libev_stubs.c @@ -29,6 +29,8 @@ #define CAML_NAME_SPACE +#include + #include #include #include @@ -38,6 +40,34 @@ #include #include +/* +-----------------------------------------------------------------+ + | Backend types | + +-----------------------------------------------------------------+ */ +enum { + val_EVBACKEND_DEFAULT, + val_EVBACKEND_SELECT, + val_EVBACKEND_POLL, + val_EVBACKEND_EPOLL, + val_EVBACKEND_KQUEUE, + val_EVBACKEND_DEVPOLL, + val_EVBACKEND_PORT +}; + +static unsigned int backend_val(value v) +{ + switch (Int_val(v)) + { + case val_EVBACKEND_DEFAULT : return 0; + case val_EVBACKEND_SELECT : return EVBACKEND_SELECT; + case val_EVBACKEND_POLL : return EVBACKEND_POLL; + case val_EVBACKEND_EPOLL : return EVBACKEND_EPOLL; + case val_EVBACKEND_KQUEUE : return EVBACKEND_KQUEUE; + case val_EVBACKEND_DEVPOLL : return EVBACKEND_DEVPOLL; + case val_EVBACKEND_PORT : return EVBACKEND_PORT; + default: assert(0); + } +} + /* +-----------------------------------------------------------------+ | Loops | +-----------------------------------------------------------------+ */ @@ -72,9 +102,9 @@ static void nop(struct ev_loop *loop) { } -CAMLprim value lwt_libev_init(value Unit) +CAMLprim value lwt_libev_init(value backend) { - struct ev_loop *loop = ev_loop_new(EVFLAG_FORKCHECK); + struct ev_loop *loop = ev_loop_new(EVFLAG_FORKCHECK | backend_val(backend)); if (!loop) caml_failwith("lwt_libev_init"); /* Remove the invoke_pending callback. */ ev_set_invoke_pending_cb(loop, nop);