Add support for selecting libev backends.

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)
 

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

src/unix/lwt_libev_stubs.c

@@ -29,6 +29,8 @@
 
 #define CAML_NAME_SPACE
 
+#include <assert.h>
+
 #include <caml/alloc.h>
 #include <caml/fail.h>
 #include <caml/mlvalues.h>
@@ -38,6 +40,34 @@
 #include <caml/callback.h>
 #include <ev.h>
 
+/* +-----------------------------------------------------------------+
+   | 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);