mirror of https://github.com/nealey/irc-bot
epoll() interface works great
This commit is contained in:
parent
cd6a35240a
commit
b032eef23a
|
@ -2,16 +2,14 @@ OCAMLPACKS[] =
|
|||
equeue
|
||||
pcre
|
||||
str
|
||||
OCAML_CLIBS = ocamlepoll
|
||||
OCAMLCFLAGS += -g
|
||||
|
||||
.DEFAULT: ircd
|
||||
|
||||
OCamlProgram(ircd, ircd irc command iobuf client channel)
|
||||
StaticCLibrary(ocamlepoll, epoll_wrapper)
|
||||
|
||||
section
|
||||
OCAML_CLIBS = ocamlpoll
|
||||
StaticCLibrary(ocamlpoll, poll_wrapper)
|
||||
OCamlProgram(polltest, polltest)
|
||||
OCamlProgram(ircd, ircd irc command iobuf client channel)
|
||||
|
||||
section
|
||||
OCAMLPACKS[] +=
|
||||
|
|
|
@ -0,0 +1,33 @@
|
|||
(*
|
||||
* OCaml epoll() interface
|
||||
* Author: Neale Pickett <neale@woozle.org>
|
||||
* Time-stamp: <2008-03-10 23:19:20 neale>
|
||||
*)
|
||||
|
||||
(**
|
||||
* This module provides an interface to epoll() on Linux, or poll() on
|
||||
* everything else.
|
||||
*)
|
||||
|
||||
type t
|
||||
|
||||
type event = In | Priority | Out | Error | Hangup
|
||||
(** Event types, mirroring poll() and epoll() event constants. *)
|
||||
|
||||
type op = Add | Modify | Delete
|
||||
(** Operations for ctl *)
|
||||
|
||||
external create : int -> t = "ocaml_epoll_create"
|
||||
(** Create a new poll structure *)
|
||||
|
||||
external destroy : t -> unit = "ocaml_epoll_destroy"
|
||||
(** Destroy a poll structure *)
|
||||
|
||||
external ctl : t -> op -> (Unix.file_descr * event list) -> unit = "ocaml_epoll_ctl"
|
||||
(** Add, Modify, or Delete an event list *)
|
||||
|
||||
external wait : t -> int -> int -> (Unix.file_descr * event list) list = "ocaml_epoll_wait"
|
||||
(** Block on events
|
||||
*
|
||||
* Returns a list of file descriptors and a list of the events that happened.
|
||||
*)
|
|
@ -0,0 +1,410 @@
|
|||
/** OCaml poll() interface
|
||||
*
|
||||
* Time-stamp: <2008-03-10 23:56:36 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 <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/fail.h>
|
||||
#include <caml/custom.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/alloc.h>
|
||||
|
||||
#ifdef __linux
|
||||
# include <sys/epoll.h>
|
||||
# define EPOLL
|
||||
#else
|
||||
# include <poll.h>
|
||||
# undef EPOLL
|
||||
# define EPOLLIN POLLIN
|
||||
# define EPOLLPRI POLLPRI
|
||||
# define EPOLLOUT POLLOUT
|
||||
# define EPOLLERR POLLERR
|
||||
# define EPOLLHUP POLLHUP
|
||||
#endif
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#define puke() \
|
||||
{ \
|
||||
char errstr[512]; \
|
||||
snprintf(errstr, sizeof(errstr), "%s: %s", __FUNCTION__, strerror(errno)); \
|
||||
caml_failwith(errstr); \
|
||||
}
|
||||
|
||||
enum {
|
||||
caml_POLLIN,
|
||||
caml_POLLPRI,
|
||||
caml_POLLOUT,
|
||||
caml_POLLERR,
|
||||
caml_POLLHUP
|
||||
};
|
||||
|
||||
enum {
|
||||
caml_POLL_ADD,
|
||||
caml_POLL_MOD,
|
||||
caml_POLL_DEL
|
||||
};
|
||||
|
||||
|
||||
static int
|
||||
list_length(value list)
|
||||
{
|
||||
CAMLparam1(list);
|
||||
CAMLlocal1(l);
|
||||
|
||||
int len = 0;
|
||||
|
||||
for (l = list; l != Val_int(0); l = Field(l, 1)) {
|
||||
len += 1;
|
||||
}
|
||||
CAMLreturn(len);
|
||||
}
|
||||
|
||||
static int
|
||||
int_of_event_list(value list)
|
||||
{
|
||||
CAMLparam1(list);
|
||||
CAMLlocal1(l);
|
||||
|
||||
int acc = 0;
|
||||
|
||||
for (l = list; l != Val_int(0); l = Field(l, 1)) {
|
||||
switch (Int_val(Field(l, 0))) {
|
||||
case caml_POLLIN:
|
||||
acc |= EPOLLIN;
|
||||
break;
|
||||
case caml_POLLPRI:
|
||||
acc |= EPOLLPRI;
|
||||
break;
|
||||
case caml_POLLOUT:
|
||||
acc |= EPOLLOUT;
|
||||
break;
|
||||
case caml_POLLERR:
|
||||
acc |= EPOLLERR;
|
||||
break;
|
||||
case caml_POLLHUP:
|
||||
acc |= EPOLLHUP;
|
||||
break;
|
||||
}
|
||||
}
|
||||
CAMLreturn(acc);
|
||||
}
|
||||
|
||||
static value
|
||||
cons(value item, value list)
|
||||
{
|
||||
CAMLparam2(item, list);
|
||||
CAMLlocal1(new);
|
||||
|
||||
new = alloc_small(2, 0);
|
||||
|
||||
Field(new, 0) = item;
|
||||
Field(new, 1) = list;
|
||||
CAMLreturn(new);
|
||||
}
|
||||
|
||||
static value
|
||||
event_list_of_int(int events)
|
||||
{
|
||||
CAMLparam0();
|
||||
CAMLlocal1(result);
|
||||
|
||||
result = Val_int(0);
|
||||
|
||||
if (events & EPOLLIN) {
|
||||
result = cons(Val_int(caml_POLLIN), result);
|
||||
} else if (events & EPOLLPRI) {
|
||||
result = cons(Val_int(caml_POLLPRI), result);
|
||||
} else if (events & EPOLLOUT) {
|
||||
result = cons(Val_int(caml_POLLOUT), result);
|
||||
} else if (events & EPOLLERR) {
|
||||
result = cons(Val_int(caml_POLLERR), result);
|
||||
} else if (events & EPOLLHUP) {
|
||||
result = cons(Val_int(caml_POLLHUP), result);
|
||||
}
|
||||
CAMLreturn(result);
|
||||
}
|
||||
|
||||
#ifdef EPOLL
|
||||
/********************************************************************************
|
||||
*
|
||||
* epoll()
|
||||
*
|
||||
********************************************************************************/
|
||||
|
||||
CAMLprim value
|
||||
ocaml_epoll_create(value size)
|
||||
{
|
||||
CAMLparam1(size);
|
||||
CAMLlocal1(result);
|
||||
|
||||
int ret;
|
||||
|
||||
ret = epoll_create(Int_val(size));
|
||||
if (-1 == ret) {
|
||||
puke();
|
||||
}
|
||||
|
||||
result = Val_int(ret);
|
||||
CAMLreturn(result);
|
||||
}
|
||||
|
||||
CAMLprim value
|
||||
ocaml_epoll_destroy(value t)
|
||||
{
|
||||
CAMLparam1(t);
|
||||
|
||||
int ret;
|
||||
|
||||
ret = close(Int_val(t));
|
||||
if (-1 == ret) {
|
||||
puke();
|
||||
}
|
||||
CAMLreturn(Val_unit);
|
||||
}
|
||||
|
||||
/* There are three reasons why I can't store a continuation or any other
|
||||
* complex type in evt.data:
|
||||
*
|
||||
* 1. GC might blow them away
|
||||
* 2. Heap compaction might move them
|
||||
* 3. The kernel can remove events from its internal table without
|
||||
* telling us (this is why there's no EPOLLNVAL)
|
||||
*
|
||||
* 1 and 2 can be solved by calling caml_register_global_root for each
|
||||
* continuation, but this does not solve 3. So you get file
|
||||
* descriptors. You can make a nice record type and wrap a Set around
|
||||
* it. */
|
||||
CAMLprim value
|
||||
ocaml_epoll_ctl(value t, value op, value what)
|
||||
{
|
||||
CAMLparam3(t, op, what);
|
||||
|
||||
int op_;
|
||||
int fd;
|
||||
struct epoll_event evt;
|
||||
int ret;
|
||||
|
||||
switch (Int_val(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 = Int_val(Field(what, 0));
|
||||
evt.events = int_of_event_list(Field(what, 1));
|
||||
evt.data.fd = fd;
|
||||
|
||||
ret = epoll_ctl(Int_val(t), op_, fd, &evt);
|
||||
if (-1 == ret) {
|
||||
puke();
|
||||
}
|
||||
|
||||
CAMLreturn(Val_unit);
|
||||
}
|
||||
|
||||
CAMLprim value
|
||||
ocaml_epoll_wait(value t, value maxevents, value timeout)
|
||||
{
|
||||
CAMLparam2(t, timeout);
|
||||
CAMLlocal2(result, item);
|
||||
|
||||
int maxevents_ = Int_val(maxevents);
|
||||
struct epoll_event events[maxevents_];
|
||||
int i;
|
||||
int ret;
|
||||
|
||||
caml_enter_blocking_section();
|
||||
ret = epoll_wait(Int_val(t), events, maxevents_, Int_val(timeout));
|
||||
caml_leave_blocking_section();
|
||||
if (-1 == ret) {
|
||||
puke();
|
||||
}
|
||||
|
||||
result = Val_int(0);
|
||||
for (i = 0; i < ret; i += 1) {
|
||||
item = alloc_small(2,0);
|
||||
Field(item, 0) = Val_int(events[i].data.fd);
|
||||
Field(item, 1) = event_list_of_int(events[i].events);
|
||||
result = cons(item, result);
|
||||
}
|
||||
|
||||
CAMLreturn(result);
|
||||
}
|
||||
|
||||
#else
|
||||
/********************************************************************************
|
||||
*
|
||||
* poll() compatibility
|
||||
*
|
||||
********************************************************************************/
|
||||
|
||||
#warn "The poll() compatibility routines have not been tested, nay compiled."
|
||||
/* I just coded up how it more or less ought to go. I haven't debugged
|
||||
* it at all. I haven't even tried to compile it. */
|
||||
|
||||
struct t {
|
||||
int nfds;
|
||||
int size;
|
||||
struct pollfd *fds;
|
||||
}
|
||||
|
||||
CAMLprim value
|
||||
ocaml_epoll_create(value size)
|
||||
{
|
||||
CAMLparam1(size);
|
||||
CAMLlocal1(result);
|
||||
|
||||
struct t *t_;
|
||||
|
||||
t_ = (struct t *)malloc(sizeof(struct t));
|
||||
t_->nfds = 0;
|
||||
t_->size = size;
|
||||
t_->fds = (struct pollfd *)calloc(size, sizeof(struct pollfd));
|
||||
|
||||
result = caml_alloc(1, Abstract_tag);
|
||||
Field(result, 0) = (value)t_;
|
||||
|
||||
CAMLreturn(result);
|
||||
}
|
||||
|
||||
CAMLprim value
|
||||
ocaml_epoll_destroy(value t)
|
||||
{
|
||||
CAMLparam1(t);
|
||||
|
||||
struct t *t_ = Field(t, 0);
|
||||
|
||||
free(t_->fds);
|
||||
free(t_);
|
||||
CAMLreturn(Val_unit);
|
||||
}
|
||||
|
||||
|
||||
CAMLprim value
|
||||
ocaml_epoll_ctl(value t, value op, value what)
|
||||
{
|
||||
CAMLparam3(t, op, what);
|
||||
|
||||
struct t *t_ = Field(t, 0);
|
||||
int op_ = Int_val(op);
|
||||
struct pollfd pfd;
|
||||
int i;
|
||||
|
||||
pfd.fd = Int_val(Field(what, 0));
|
||||
pfd.events = int_of_event_list(Field(what, 1));
|
||||
|
||||
/* Find this fd in our list */
|
||||
for (i == 0; i < t_->nfds; i += 1) {
|
||||
struct pollfd *p = &(t_->fds[i]);
|
||||
|
||||
if (p->fd == pfd.fd) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
switch (op_) {
|
||||
case caml_POLL_ADD:
|
||||
if (i < t_->nfds) {
|
||||
caml_failwith("file descriptor already present");
|
||||
}
|
||||
if (i >= t->size) {
|
||||
struct pollfd *newfds;
|
||||
int newsize;
|
||||
|
||||
newsize = t_->size + 20;
|
||||
new = (struct pollfd *)realloc(t_, (sizeof struct pollfd) * newsize);
|
||||
if (! new) {
|
||||
caml_failwith("out of memory");
|
||||
}
|
||||
t_->size = newsize;
|
||||
t_->fds = newfds;
|
||||
}
|
||||
t_->nfds += 1;
|
||||
t_->fds[i] = pfd;
|
||||
break;
|
||||
|
||||
case caml_POLL_MOD:
|
||||
t_->fds[i] = pdf;
|
||||
break;
|
||||
|
||||
case caml_POLL_DEL:
|
||||
if (i == t_->nfds) {
|
||||
caml_failwith("file descriptor not present");
|
||||
}
|
||||
t_->nfds -= 1;
|
||||
for(; i < t_->nfds; i += 1) {
|
||||
t_->fds[i] = t_->fds[i+1];
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
CAMLprim value
|
||||
ocaml_epoll_wait(value t, value maxevents, value timeout)
|
||||
{
|
||||
CAMLparam3(t, maxevents, caml_timeout);
|
||||
CAMLlocal2(result, l, v);
|
||||
|
||||
struct t *t_ = Field(t, 0);
|
||||
int maxevents_ = Int_val(maxevents);
|
||||
int i;
|
||||
int j;
|
||||
int ret;
|
||||
|
||||
/* Call poll */
|
||||
caml_enter_blocking_section();
|
||||
ret = poll(t_->fds, t_->nfds, Int_val(timeout));
|
||||
caml_leave_blocking_section();
|
||||
if (-1 == ret) {
|
||||
puke();
|
||||
}
|
||||
|
||||
result = Val_int(0);
|
||||
j = 0;
|
||||
for (i=0; ((i < t_->nfds) && (i < maxevents_)); i += 1) {
|
||||
struct pollfd *p = &(t_->fds[i]);
|
||||
|
||||
if (p->revents & POLLNVAL) {
|
||||
/* Don't let j increment: remove this item */
|
||||
continue;
|
||||
} else if (p->revents) {
|
||||
v = alloc_small(2, 0);
|
||||
Field(v, 0) = Val_int(p->fd);
|
||||
Field(v, 1) = event_list_of_int(p->revents);
|
||||
result = cons(v, result);
|
||||
}
|
||||
if (i != j) {
|
||||
t_->fds[i] = t_->fds[j];
|
||||
}
|
||||
j += i;
|
||||
}
|
||||
t_->nfds = j;
|
||||
|
||||
CAMLreturn(result);
|
||||
}
|
||||
|
||||
#endif
|
37
poll.mli
37
poll.mli
|
@ -1,37 +0,0 @@
|
|||
(*
|
||||
* OCaml poll() / epoll() interface
|
||||
* Author: Neale Pickett <neale@woozle.org>
|
||||
* Time-stamp: <2008-03-10 16:38:38 neale>
|
||||
*)
|
||||
|
||||
(**
|
||||
* 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 *)
|
300
poll_wrapper.c
300
poll_wrapper.c
|
@ -1,300 +0,0 @@
|
|||
/** 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 <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/fail.h>
|
||||
#include <caml/custom.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/alloc.h>
|
||||
|
||||
#ifdef __linux
|
||||
# include <sys/epoll.h>
|
||||
# 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 <poll.h>
|
||||
# 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 <string.h>
|
||||
#include <errno.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#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
|
|
@ -1,9 +0,0 @@
|
|||
external poll : 'a -> 'b -> 'c = "ocaml_poll"
|
||||
|
||||
type event = POLLIN | POLLPRI | POLLOUT | POLLERR | POLLHUP | POLLNVAL
|
||||
|
||||
let _ =
|
||||
poll [
|
||||
(10, [POLLIN; POLLOUT]);
|
||||
(20, [POLLOUT])
|
||||
] ()
|
96
tests.ml
96
tests.ml
|
@ -5,9 +5,105 @@ open Irc
|
|||
|
||||
let ues = Unixqueue.create_unix_event_system ()
|
||||
|
||||
let int_of_file_descr fd = (Obj.magic fd) + 0
|
||||
|
||||
let rec epollevents_as_list events =
|
||||
match events with
|
||||
| [] ->
|
||||
[]
|
||||
| Epoll.In :: tl ->
|
||||
"POLLIN" :: (epollevents_as_list tl)
|
||||
| Epoll.Priority :: tl ->
|
||||
"POLLPRI" :: (epollevents_as_list tl)
|
||||
| Epoll.Out :: tl ->
|
||||
"POLLOUT" :: (epollevents_as_list tl)
|
||||
| Epoll.Error :: tl ->
|
||||
"POLLERR" :: (epollevents_as_list tl)
|
||||
| Epoll.Hangup :: tl ->
|
||||
"POLLHUP" :: (epollevents_as_list tl)
|
||||
|
||||
let rec epollfds_as_list pfds =
|
||||
match pfds with
|
||||
| [] ->
|
||||
[]
|
||||
| (fd, events) :: tl ->
|
||||
(Printf.sprintf "{fd=%d; events=%s}"
|
||||
(int_of_file_descr fd)
|
||||
(String.concat "|" (epollevents_as_list events))) ::
|
||||
epollfds_as_list tl
|
||||
|
||||
let epollfds_as_string pfds =
|
||||
"[" ^ (String.concat ", " (epollfds_as_list pfds)) ^ "]"
|
||||
|
||||
let unit_tests =
|
||||
"Unit tests" >:::
|
||||
[
|
||||
"epoll" >::
|
||||
(fun () ->
|
||||
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
|
||||
let e = Epoll.create 1 in
|
||||
Epoll.ctl e Epoll.Add (a, [Epoll.Out; Epoll.In]);
|
||||
assert_equal
|
||||
~printer:epollfds_as_string
|
||||
[(a, [Epoll.Out])]
|
||||
(Epoll.wait e 1 0);
|
||||
|
||||
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]);
|
||||
assert_equal
|
||||
~printer:epollfds_as_string
|
||||
[]
|
||||
(Epoll.wait e 1 0);
|
||||
|
||||
Epoll.ctl e Epoll.Add (b, [Epoll.Out; Epoll.In]);
|
||||
assert_equal
|
||||
~printer:epollfds_as_string
|
||||
[(b, [Epoll.Out])]
|
||||
(Epoll.wait e 2 0);
|
||||
|
||||
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
|
||||
assert_equal
|
||||
~printer:epollfds_as_string
|
||||
[(a, [Epoll.Out]); (b, [Epoll.Out])]
|
||||
(Epoll.wait e 2 0);
|
||||
|
||||
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
|
||||
assert_equal
|
||||
~printer:epollfds_as_string
|
||||
[(b, [Epoll.Out])]
|
||||
(Epoll.wait e 1 0);
|
||||
|
||||
Epoll.ctl e Epoll.Delete (a, []);
|
||||
assert_equal
|
||||
~printer:epollfds_as_string
|
||||
[(b, [Epoll.Out])]
|
||||
(Epoll.wait e 2 0);
|
||||
assert_raises
|
||||
(Failure "ocaml_epoll_ctl: No such file or directory")
|
||||
(fun () ->
|
||||
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]));
|
||||
assert_raises
|
||||
(Failure "ocaml_epoll_ctl: File exists")
|
||||
(fun () ->
|
||||
Epoll.ctl e Epoll.Add (b, [Epoll.In; Epoll.Priority]));
|
||||
assert_equal
|
||||
~printer:epollfds_as_string
|
||||
[(b, [Epoll.Out])]
|
||||
(Epoll.wait e 2 0);
|
||||
|
||||
Unix.close b;
|
||||
assert_equal
|
||||
~printer:epollfds_as_string
|
||||
[]
|
||||
(Epoll.wait e 2 0);
|
||||
assert_raises
|
||||
(Failure "ocaml_epoll_ctl: Bad file descriptor")
|
||||
(fun () ->
|
||||
Epoll.ctl e Epoll.Modify (b, [Epoll.In; Epoll.Priority]));
|
||||
|
||||
Epoll.destroy e;
|
||||
Unix.close a
|
||||
);
|
||||
|
||||
"command_of_string" >::
|
||||
(fun () ->
|
||||
assert_equal
|
||||
|
|
Loading…
Reference in New Issue