-I $(OCAML_TOPLEVEL)/libs/xc \
-I $(OCAML_TOPLEVEL)/libs/eventchn
-LIBS = syslog.cma syslog.cmxa
+LIBS = syslog.cma syslog.cmxa select.cma select.cmxa
syslog_OBJS = syslog
syslog_C_OBJS = syslog_stubs
-OCAML_LIBRARY = syslog
+select_OBJS = select
+select_C_OBJS = select_stubs
+OCAML_LIBRARY = syslog select
LIBS += systemd.cma systemd.cmxa
systemd_OBJS = systemd
process \
xenstored
-INTF = symbol.cmi trie.cmi syslog.cmi systemd.cmi
+INTF = symbol.cmi trie.cmi syslog.cmi systemd.cmi select.cmi
XENSTOREDLIBS = \
unix.cmxa \
-ccopt -L -ccopt . syslog.cmxa \
-ccopt -L -ccopt . systemd.cmxa \
+ -ccopt -L -ccopt . select.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/xenmmap.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/xeneventchn.cmxa \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xenctrl.cmxa \
--- /dev/null
+(*
+ * Copyright (C) 2014 Zheng Li <dev@zheng.li>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+
+(* The [read], [write], [except] are fields mapped to the POLLIN/OUT/PRI
+ subscription flags used by poll, which have a correspondence to the
+ readfds, writefds, exceptfds concept as in select. *)
+type event = {
+ mutable read: bool;
+ mutable write: bool;
+ mutable except: bool;
+}
+
+external select_on_poll: (Unix.file_descr * event) array -> int -> int = "stub_select_on_poll"
+
+let init_event () = {read = false; write = false; except = false}
+
+let select in_fds out_fds exc_fds timeout =
+ let h = Hashtbl.create 57 in
+ let add_event event_set fd =
+ let e =
+ try Hashtbl.find h fd
+ with Not_found ->
+ let e = init_event () in
+ Hashtbl.add h fd e; e in
+ event_set e in
+ List.iter (add_event (fun x -> x.read <- true)) in_fds;
+ List.iter (add_event (fun x -> x.write <- true)) out_fds;
+ List.iter (add_event (fun x -> x.except <- true)) exc_fds;
+ (* Unix.stdin and init_event are dummy input as stubs, which will
+ always be overwritten later on. *)
+ let a = Array.make (Hashtbl.length h) (Unix.stdin, init_event ()) in
+ let i = ref (-1) in
+ Hashtbl.iter (fun fd event -> incr i; Array.set a !i (fd, event)) h;
+ let n = select_on_poll a (int_of_float (timeout *. 1000.)) in
+ let r = [], [], [] in
+ if n = 0 then r else
+ Array.fold_right
+ (fun (fd, event) (r, w, x) ->
+ (if event.read then fd :: r else r),
+ (if event.write then fd :: w else w),
+ (if event.except then fd :: x else x))
+ a r
--- /dev/null
+(*
+ * Copyright (C) 2014 Zheng Li <dev@zheng.li>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+
+(** Same interface and semantics as [Unix.select] but with an extra alternative
+ implementation based on poll. *)
+val select:
+ Unix.file_descr list -> Unix.file_descr list -> Unix.file_descr list -> float
+ -> Unix.file_descr list * Unix.file_descr list * Unix.file_descr list
--- /dev/null
+/*
+ * Copyright (C) 2014 Zheng Li <dev@zheng.li>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#include <poll.h>
+#include <errno.h>
+#include <sys/resource.h>
+#include <unistd.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/alloc.h>
+#include <caml/signals.h>
+#include <caml/unixsupport.h>
+
+CAMLprim value stub_select_on_poll(value fd_events, value timeo) {
+
+ CAMLparam2(fd_events, timeo);
+ CAMLlocal1(events);
+ int i, rc, c_len = Wosize_val(fd_events), c_timeo = Int_val(timeo);
+ struct pollfd c_fds[c_len];
+
+
+ for (i = 0; i < c_len; i++) {
+
+ events = Field(Field(fd_events, i), 1);
+
+ c_fds[i].fd = Int_val(Field(Field(fd_events, i), 0));
+ c_fds[i].events = c_fds[i].revents = 0;
+ c_fds[i].events |= Bool_val(Field(events, 0)) ? POLLIN : 0;
+ c_fds[i].events |= Bool_val(Field(events, 1)) ? POLLOUT: 0;
+ c_fds[i].events |= Bool_val(Field(events, 2)) ? POLLPRI: 0;
+
+ };
+
+ caml_enter_blocking_section();
+ rc = poll(c_fds, c_len, c_timeo);
+ caml_leave_blocking_section();
+
+ if (rc < 0) uerror("poll", Nothing);
+
+ if (rc > 0) {
+
+ for (i = 0; i < c_len; i++) {
+
+ events = Field(Field(fd_events, i), 1);
+
+ if (c_fds[i].revents & POLLNVAL) unix_error(EBADF, "select", Nothing);
+ Field(events, 0) = Val_bool(c_fds[i].events | POLLIN && c_fds[i].revents & (POLLIN |POLLHUP|POLLERR));
+ Field(events, 1) = Val_bool(c_fds[i].events | POLLOUT && c_fds[i].revents & (POLLOUT|POLLHUP|POLLERR));
+ Field(events, 2) = Val_bool(c_fds[i].revents & POLLPRI);
+
+ }
+
+ }
+
+ CAMLreturn(Val_int(rc));
+}
let timeout = if List.length mw > 0 then 0. else -1. in
let rset, wset, _ =
try
- Unix.select (spec_fds @ inset) outset [] timeout
+ Select.select (spec_fds @ inset) outset [] timeout
with Unix.Unix_error(Unix.EINTR, _, _) ->
[], [], [] in
let sfds, cfds =
projects / xen.git / commitdiff