event_stubs.c

   1 /************************************************************************/
   2 /* The OcamlEvent library                                               */
   3 /*                                                                      */
   4 /* Copyright 2002, 2003, 2004 Maas-Maarten Zeeman. All rights reserved. */
   5 /* See LICENCE for details.                                             */
   6 /************************************************************************/
   7
   8 /* $Id: event_stubs.c,v 1.10 2004/12/18 21:58:25 maas Exp $ */
   9
  10 /* Stub code to interface Ocaml with libevent */
  11
  12 #include <sys/time.h>
  13 #include <stdlib.h>
  14 #include <event.h>
  15
  16 #include <caml/mlvalues.h>
  17 #include <caml/custom.h>
  18 #include <caml/alloc.h>
  19 #include <caml/memory.h>
  20 #include <caml/callback.h>
  21 #include <caml/fail.h>
  22
  23 #define struct_event_val(v) ((struct event*) Data_custom_val(v))
  24 #define Is_some(v) (Is_block(v))
  25
  26 static value * event_cb_closure = NULL;
  27
  28 /* use the error function from the Unix library */
  29 extern void uerror (char * cmdname, value arg) Noreturn;
  30
  31 static void
  32 struct_event_finalize(value ve)
  33 {
  34   struct event *ev = struct_event_val(ve);
  35
  36   /* This means that event_set is called. We can assume that there */
  37   if(event_initialized(ev)) {
  38     /* */
  39   }
  40
  41   stat_free(struct_event_val(ve));
  42 }
  43
  44 static int
  45 struct_event_compare(value v1, value v2)
  46 {
  47   struct event *p1 = struct_event_val(v1);
  48   struct event *p2 = struct_event_val(v2);
  49   if(p1 == p2) return 0;
  50   if(p1 < p2) return -1;
  51   return 1;
  52 }
  53
  54 static long
  55 struct_event_hash(value v)
  56 {
  57   return (long) struct_event_val(v);
  58 }
  59
  60 static struct custom_operations struct_event_ops = {
  61   "struct event",
  62   struct_event_finalize,
  63   struct_event_compare,
  64   struct_event_hash,
  65   custom_serialize_default,
  66   custom_deserialize_default
  67 };
  68
  69 /*
  70  * This callback calls the ocaml event callback, which will in turn
  71  * call the real ocaml callback.
  72  */
  73 static void
  74 event_cb(int fd, short type, void *arg)
  75 {
  76   callback3(*event_cb_closure,
  77             Val_long((long) arg), Val_int(fd), Val_int(type));
  78 }
  79
  80 static void
  81 set_struct_timeval(struct timeval *tv, value vfloat)
  82 {
  83   double timeout = Double_val(vfloat);
  84   tv->tv_sec = (int) timeout;
  85   tv->tv_usec = (int) (1e6 * (timeout - tv->tv_sec));
  86 }
  87
  88 CAMLprim value
  89 oc_create_event(value unit)
  90 {
  91   CAMLparam0();
  92   CAMLlocal1(ve);
  93
  94   ve = alloc_custom(&struct_event_ops, sizeof(struct event), 0, 1);
  95
  96   CAMLreturn(ve);
  97 }
  98
  99 CAMLprim value
 100 oc_event_id(value vevent)
 101 {
 102   CAMLparam0();
 103   CAMLreturn(Val_long((long) struct_event_val(vevent)));
 104 }
 105
 106 CAMLprim value
 107 oc_event_fd(value vevent)
 108 {
 109   CAMLparam1(vevent);
 110   CAMLreturn(Val_long(EVENT_FD(struct_event_val(vevent))));
 111 }
 112
 113 CAMLprim value
 114 oc_event_set(value vevent, value fd, value vevent_flag)
 115 {
 116   CAMLparam3(vevent, fd, vevent_flag);
 117
 118   struct event *event = struct_event_val(vevent);
 119
 120   event_set(event, Int_val(fd), Int_val(vevent_flag),
 121             &event_cb, event);
 122
 123   CAMLreturn(Val_unit);
 124 }
 125
 126 CAMLprim value
 127 oc_event_add(value vevent, value vfloat_option)
 128 {
 129   CAMLparam2(vevent, vfloat_option);
 130   struct event *event = struct_event_val(vevent);
 131   struct timeval timeval;
 132   struct timeval *tv = NULL;
 133
 134   if Is_some(vfloat_option) {
 135     set_struct_timeval(&timeval, Field(vfloat_option, 0));
 136     tv = &timeval;
 137   }
 138
 139   if((0 != event_add(event, tv))) {
 140     uerror("event_add", vevent);
 141   }
 142
 143   CAMLreturn(Val_unit);
 144 }
 145
 146 CAMLprim value
 147 oc_event_del(value vevent)
 148 {
 149   CAMLparam0();
 150   struct event *event = struct_event_val(vevent);
 151
 152   event_del(event);
 153
 154   CAMLreturn(Val_unit);
 155 }
 156
 157 CAMLprim value
 158 oc_event_pending(value vevent, value vtype, value vfloat_option)
 159 {
 160   CAMLparam3(vevent, vtype, vfloat_option);
 161   struct event *event = struct_event_val(vevent);
 162   struct timeval timeval;
 163   struct timeval *tv = NULL;
 164
 165   if Is_some(vfloat_option) {
 166     set_struct_timeval(&timeval, Field(vfloat_option, 0));
 167     tv = &timeval;
 168   }
 169
 170   event_pending(event, Int_val(vtype), tv);
 171
 172   CAMLreturn(Val_unit);
 173 }
 174
 175 CAMLprim value
 176 oc_event_loop(value vloop_flag)
 177 {
 178   CAMLparam1(vloop_flag);
 179
 180   if((-1 == event_loop(Int_val(vloop_flag)))) {
 181     uerror("event_dispatch", vloop_flag);
 182   }
 183
 184   CAMLreturn(Val_unit);
 185 }
 186
 187
 188 CAMLprim value
 189 oc_event_dispatch(value unit)
 190 {
 191   CAMLparam1(unit);
 192
 193   if((-1 == event_dispatch())) {
 194     uerror("event_dispatch", unit);
 195   }
 196
 197   CAMLreturn(Val_unit);
 198 }
 199
 200 /*
 201  * Initialize the event library
 202  */
 203 CAMLprim value
 204 oc_event_init(value unit)
 205 {
 206   CAMLparam1(unit);
 207
 208   /* setup the event callback closure if needed */
 209   if(event_cb_closure == NULL) {
 210     event_cb_closure = caml_named_value("event_cb");
 211     if(event_cb_closure == NULL) {
 212       invalid_argument("Callback event_cv not initialized.");
 213     }
 214   }
 215
 216   /* and don't forget to initialize libevent */
 217   event_init();
 218
 219   CAMLreturn(Val_unit);
 220 }