diff --git a/OMakefile b/OMakefile index 78be146..87fd0f1 100644 --- a/OMakefile +++ b/OMakefile @@ -10,7 +10,7 @@ OCamlProgram(ircd, ircd irc command iobuf client channel) section OCAML_CLIBS = ocamlpoll - StaticCLibrary(ocamlpoll, inspect poll_stubs) + StaticCLibrary(ocamlpoll, poll_wrapper) OCamlProgram(polltest, polltest) section diff --git a/poll.mli b/poll.mli index ef5adc5..31b382e 100644 --- a/poll.mli +++ b/poll.mli @@ -1,5 +1,37 @@ -type pollfd = {fd: int; - events: int; - revents: int} +(* + * OCaml poll() / epoll() interface + * Author: Neale Pickett + * Time-stamp: <2008-03-10 16:38:38 neale> + *) -external in : int = "poll_in" +(** + * This module provides an interface to epoll() on Linux, or poll() on + * everything else. The provided interface is pretty raw, and if you're + * not careful you can really booger things up. + *) + +type t + +type event = In | Out | Pri | Err | Hup | Nval + (** Event types, mirroring poll() and epoll() event constants. + * Apparently Linux has some way to deal with Nval so that you never + * see it. + *) + +type op = Add | Modify | Delete + (** Operations for ctl *) + +type data + (** User data type *) + +external create : int -> t = "ocaml_poll_create" + (* Create a new poll structure *) + +external destroy : t -> unit = "ocaml_poll_destroy" + (* Destroy a poll structure *) + +external ctl : t -> op -> (Unix.file_descr * event list) -> unit = "ocaml_poll_ctl" + (* Add, Modify, or Delete an event list and associated user data *) + +external wait : t -> int -> (Unix.file_descr * event list) list = "ocaml_poll_wait" + (* Block on events *) diff --git a/poll_stubs.c b/poll_stubs.c deleted file mode 100644 index b1fad9e..0000000 --- a/poll_stubs.c +++ /dev/null @@ -1,150 +0,0 @@ -#include -#include -#include -#include -#include - -#include -#include -#include -#include - -#define puke(str) \ - { \ - char errstr[512]; \ - snprintf(errstr, sizeof(errstr), str ": %s", strerror(errno)); \ - caml_failwith(errstr); \ - } - -value inspect_block(value v); - -enum { - caml_POLLIN, - caml_POLLPRI, - caml_POLLOUT, - caml_POLLERR, - caml_POLLHUP, - caml_POLLNVAL -} - -static int -list_length(value list) -{ - int len; - value l; - - for (l = list; l != Val_int(0); l = Field(l, 1)) { - len += 1; - } - return len; -} - -static int -int_of_event_list(value list) -{ - int acc = 0; - value l; - - for (l = list; l != Val_int(0); l = Field(l, 1)) { - switch (Field(l, 0)) { - case caml_POLLIN: - acc |= POLLIN; - break; - case caml_POLLPRI: - acc |= POLLPRI; - break; - case caml_POLLOUT: - acc |= POLLOUT; - break; - case caml_POLLERR: - acc |= POLLERR; - break; - case caml_POLLHUP: - acc |= POLLHUP; - break; - case caml_POLLNVAL: - acc |= POLLNVAL; - break; - } - } - return acc; -} - -static value -append(value list, value item) -{ - value new = alloc_small(2, 0); - Field(new, 0) = item; - Field(new, 1) = list; - return new; -} - -static value -event_list_of_int(int events) -{ - value result = Val_int(0); - - if (events & POLLIN) { - result = append(result, Val_int(caml_POLLIN)); - } else if (events & POLLPRI) { - result = append(result, Val_int(caml_POLLPRI)); - } else if (events & POLLOUT) { - result = append(result, Val_int(caml_POLLOUT)); - } else if (events & POLLERR) { - result = append(result, Val_int(caml_POLLERR)); - } else if (events & POLLHUP) { - result = append(result, Val_int(caml_POLLHUP)); - } else if (events & POLLNVAL) { - result = append(result, Val_int(caml_POLLNVAL)); - } - return result; -} - -CAMLprim value -ocaml_poll(value caml_fds, value caml_timeout) -{ - CAMLparam2(caml_fds, caml_timeout); - CAMLlocal1(result); - - value l; - int nfds; - int timeout = Int_val(caml_timeout); - struct pollfd fds[nfds]; - int i; - int ret; - - result = Val_int(0); - inspect_block(caml_fds); - - /* Count entries */ - nfds = list_length(caml_fds); - - /* Build fds */ - for (i=0, l = caml_fds; l != Val_int(0); i += 1, l = Field(l, 1)) { - value f = Field(l, 0); - struct pollfd *p = &(fds[i]); - - p->fd = Int_val(Field(f, 0)); - p->events = int_of_event_list(Field(f, 1)); - } - - /* Call poll */ - ret = poll(*fds, nfds, timeout); - if (-1 == ret) { - puke("poll"); - } - - for (i=0; i < nfds; i += 1) { - struct pollfd *p = &(fds[i]); - if (p->revents) { - value v = alloc_small(2,0); - - Field(v, 0) = Val_int(p->fd); - Field(v, 1) = event_list_of_int(p->revents); - result = append(result, v); - } - } - - CAMLreturn(result); -} - diff --git a/poll_wrapper.c b/poll_wrapper.c new file mode 100644 index 0000000..67cd2fa --- /dev/null +++ b/poll_wrapper.c @@ -0,0 +1,300 @@ +/** OCaml poll() interface + * + * Time-stamp: <2008-03-10 17:19:26 neale> + * + * Copyright (C) 2008 Neale Pickett + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or (at + * your option) any later version. + * + * 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 + * General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + */ + + +#include +#include +#include +#include +#include + +#ifdef __linux +# include +# define EPOLL +# define POLL_IN EPOLLIN +# define POLL_PRI EPOLLPRI +# define POLL_OUT EPOLLOUT +# define POLL_ERR EPOLLERR +# define POLL_HUP EPOLLHUP +# define POLL_NVAL 0 +#else +# include +# undef EPOLL +# define POLL_IN POLLIN +# define POLL_PRI POLLPRI +# define POLL_OUT POLLOUT +# define POLL_ERR POLLERR +# define POLL_HUP POLLHUP +# define POLL_NVAL POLLNVAL +#endif + +#include +#include +#include + +#define puke() \ + { \ + char errstr[512]; \ + snprintf(errstr, sizeof(errstr), __FUNCTION__ ": %s", strerror(errno)); \ + caml_failwith(errstr); \ + } + +enum { + caml_POLLIN, + caml_POLLPRI, + caml_POLLOUT, + caml_POLLERR, + caml_POLLHUP, + caml_POLLNVAL +}; + +enum { + caml_POLL_ADD, + caml_POLL_MOD, + caml_POLL_DEL +}; + + +static int +list_length(value list) +{ + int len = 0; + value l; + + for (l = list; l != caml_Val_int(0); l = caml_Field(l, 1)) { + len += 1; + } + return len; +} + +static int +int_of_event_list(value list) +{ + int acc = 0; + value l; + + for (l = list; l != caml_Val_int(0); l = caml_Field(l, 1)) { + switch (caml_Int_val(caml_Field(l, 0))) { + case caml_POLLIN: + acc |= POLL_IN; + break; + case caml_POLLPRI: + acc |= POLL_PRI; + break; + case caml_POLLOUT: + acc |= POLL_OUT; + break; + case caml_POLLERR: + acc |= POLL_ERR; + break; + case caml_POLLHUP: + acc |= POLL_HUP; + break; + case caml_POLLNVAL: + acc |= POLL_NVAL; + break; + } + } + return acc; +} + +static value +append(value list, value item) +{ + value new = alloc_small(2, 0); + caml_Field(new, 0) = item; + caml_Field(new, 1) = list; + return new; +} + +static value +event_list_of_int(int events) +{ + value result = caml_Val_int(0); + + if (events & POLL_IN) { + result = append(result, caml_Val_int(caml_POLLIN)); + } else if (events & POLL_PRI) { + result = append(result, caml_Val_int(caml_POLLPRI)); + } else if (events & POLL_OUT) { + result = append(result, caml_Val_int(caml_POLLOUT)); + } else if (events & POLL_ERR) { + result = append(result, caml_Val_int(caml_POLLERR)); + } else if (events & POLL_HUP) { + result = append(result, caml_Val_int(caml_POLLHUP)); + } else if (events & POLL_NVAL) { + result = append(result, caml_Val_int(caml_POLLNVAL)); + } + inspect_block(result); + return result; +} + +#ifdef EPOLL +/******************************************************************************** + * + * epoll() + * + ********************************************************************************/ +CAMLprim value +ocaml_poll_create(value size) +{ + CAMLparam1(size); + CAMLlocal1(result); + + int ret; + + ret = epoll_create(caml_Int_val(size)); + if (-1 == ret) { + puke(); + } + result = caml_Val_int(ret); + CAMLreturn(result); +} + +CAMLprim value +ocaml_poll_destroy(value caml_t) +{ + CAMLparam1(caml_t); + + int ret; + + ret = close(caml_Int_val(caml_t)); + if (-1 == ret) { + puke(); + } + CAMLreturn(caml_Val_unit); +} + +/* I'm sad that I can't do anything more interesting with evt.data than + * put the file descriptor in it. Like, say, storing a continuation. + * Unfortunately doing so would require caml_register_global_root for + * each one to prevent the GC from blowing them away or heap compaction + * from moving them, and I don't want to do that for so many objects + * (plus I'd (maybe) have to keep track of them). Anyway this isn't so + * bad, you can make a record type with the fd in it and search through + * that pretty quickly with the balanced binary tree provided by Set, or + * use a hash table if you like those better. */ +CAMLprim value +ocaml_poll_ctl(value caml_t, value caml_op, value caml_what) +{ + CAMLparam3(caml_t, caml_op, caml_what); + + int op; + int fd; + int ret; + struct epoll_event evt; + + switch (caml_Int_val(caml_op)) { + case caml_POLL_ADD: + op = EPOLL_CTL_ADD; + break; + case caml_POLL_MOD: + op = EPOLL_CTL_MOD; + break; + case caml_POLL_DEL: + op = EPOLL_CTL_DEL; + break; + } + fd = caml_Int_val(Field(caml_what, 0)); + evt.events = int_of_event_list(caml_Field(f, 1)); + evt.data.fd = fd; + + ret = epoll_ctl(caml_Int_val(caml_t), op, fd, *evt); + if (-1 == ret) { + puke(); + } + CAMLreturn(caml_Val_unit); +} + +CAMLprim value +ocaml_poll_wait(value caml_t, value caml_timeout) +{ + CAMLparam2(caml_t, caml_timeout); + CAMLlocal1(result); + + /* XXX: complete me */ + caml_enter_blocking_section(); + /* XXX: fix me */ + ret = epoll_wait(caml_Int_val(caml_t), fds, nfds, timeout); + caml_leave_blocking_section(); + + CAMLreturn(result); +} + +#else +/******************************************************************************** + * + * epoll() + * + ********************************************************************************/ + +CAMLprim value +ocaml_poll(value caml_fds, value caml_timeout) +{ + CAMLparam2(caml_fds, caml_timeout); + CAMLlocal2(result, l); + + int nfds; + int timeout = caml_Int_val(caml_timeout); + int i; + int ret; + + result = caml_Val_int(0); + + /* Count entries */ + nfds = list_length(caml_fds); + + { + struct pollfd fds[nfds]; + + /* Build fds */ + for (i=0, l = caml_fds; l != caml_Val_int(0); i += 1, l = caml_Field(l, 1)) { + value f = caml_Field(l, 0); + struct pollfd *p = &(fds[i]); + + p->fd = caml_Int_val(caml_Field(f, 0)); + p->events = int_of_event_list(caml_Field(f, 1)); + } + + /* Call poll */ + caml_enter_blocking_section(); + ret = poll(fds, nfds, timeout); + caml_leave_blocking_section(); + if (-1 == ret) { + puke(); + } + + for (i=0; i < nfds; i += 1) { + struct pollfd *p = &(fds[i]); + + if (p->revents) { + value v = alloc_small(2,0); + + caml_Field(v, 0) = caml_Val_int(p->fd); + caml_Field(v, 1) = event_list_of_int(p->revents); + result = append(result, v); + } + } + + CAMLreturn(result); + } +} + +#endif