From d9b83175a2d362a5a12e9a15676481e2a14ece15 Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Fri, 7 Mar 2008 18:19:58 -0700 Subject: [PATCH] Experimental work on an OCaml poll() wrapper --- OMakefile | 12 +++-- OMakeroot | 38 ++----------- inspect.c | 53 ++++++++++++++++++ poll.mli | 5 ++ poll_stubs.c | 150 +++++++++++++++++++++++++++++++++++++++++++++++++++ polltest.ml | 9 ++++ 6 files changed, 231 insertions(+), 36 deletions(-) create mode 100644 inspect.c create mode 100644 poll.mli create mode 100644 poll_stubs.c create mode 100644 polltest.ml diff --git a/OMakefile b/OMakefile index ba953a9..78be146 100644 --- a/OMakefile +++ b/OMakefile @@ -1,16 +1,18 @@ -USE_OCAMLFIND = true OCAMLPACKS[] = equeue pcre str -NATIVE_ENABLED = true -BYTE_ENABLED = true OCAMLCFLAGS += -g .DEFAULT: ircd OCamlProgram(ircd, ircd irc command iobuf client channel) +section + OCAML_CLIBS = ocamlpoll + StaticCLibrary(ocamlpoll, inspect poll_stubs) + OCamlProgram(polltest, polltest) + section OCAMLPACKS[] += oUnit @@ -23,6 +25,10 @@ section OCamlProgram(tests, tests chat irc command iobuf client channel) +.PHONY: test +test: tests + ./tests + .PHONY: clean clean: rm $(filter-proper-targets $(ls R, .)) diff --git a/OMakeroot b/OMakeroot index 20a8fe6..8044cb8 100644 --- a/OMakeroot +++ b/OMakeroot @@ -1,37 +1,9 @@ -######################################################################## -# Permission is hereby granted, free of charge, to any person -# obtaining a copy of this file, to deal in the File without -# restriction, including without limitation the rights to use, -# copy, modify, merge, publish, distribute, sublicense, and/or -# sell copies of the File, and to permit persons to whom the -# File is furnished to do so, subject to the following condition: -# -# THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES -# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -# OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR -# THE USE OR OTHER DEALINGS IN THE FILE. - -######################################################################## -# The standard OMakeroot file. -# You will not normally need to modify this file. -# By default, your changes should be placed in the -# OMakefile in this directory. -# -# If you decide to modify this file, note that it uses exactly -# the same syntax as the OMakefile. -# - -# -# Include the standard installed configuration files. -# Any of these can be deleted if you are not using them, -# but you probably want to keep the Common file. -# -#open build/C +open build/C open build/OCaml -#open build/LaTeX + +USE_OCAMLFIND = true +NATIVE_ENABLED = true +BYTE_ENABLED = true # # The command-line variables are defined *after* the diff --git a/inspect.c b/inspect.c new file mode 100644 index 0000000..5d57a9e --- /dev/null +++ b/inspect.c @@ -0,0 +1,53 @@ +#include +#include + +void +margin (int n) +{ + while (n-- > 0) + printf("."); + return; +} + +void +print_block(value v,int m) +{ + int size, i; + margin(m); + if (Is_long(v)) + { printf("immediate value (%d)\n", Long_val(v)); return; }; + printf ("memory block: size=%d - ", size=Wosize_val(v)); + switch (Tag_val(v)) + { + case Closure_tag : + printf("closure with %d free variables\n", size-1); + margin(m+4); printf("code pointer: %p\n",Code_val(v)) ; + for (i=1;i=No_scan_tag) { printf("unknown tag"); break; }; + printf("structured block (tag=%d):\n",Tag_val(v)); + for (i=0;i +#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/polltest.ml b/polltest.ml new file mode 100644 index 0000000..758f3e8 --- /dev/null +++ b/polltest.ml @@ -0,0 +1,9 @@ +external poll : 'a -> 'b -> 'c = "ocaml_poll" + +type event = POLLIN | POLLPRI | POLLOUT | POLLERR | POLLHUP | POLLNVAL + +let _ = + poll [ + (10, [POLLIN; POLLOUT]); + (20, [POLLOUT]) + ] ()