event_stubs.c

   1 /************************************************************************/
   2 /* The ocaml-event library                                              */
   3 /*                                                                      */
   4 /* Copyright 2002, 2003, 2004 Maas-Maarten Zeeman. All rights reserved. */
   5 /* Copyright 2010 ygrek                                                 */
   6 /* See LICENCE for details.                                             */
   7 /************************************************************************/
   8
   9 /* Stub code to interface Ocaml with libevent */
  10
  11 #include <sys/time.h>
  12 #include <stdlib.h>
  13 #include <event.h>
  14 #include <string.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 #include <caml/unixsupport.h>
  23 #include <caml/signals.h>
  24
  25 #define struct_event_val(v) (*(struct event**) Data_custom_val(v))
  26 #define Is_some(v) (Is_block(v))
  27
  28 #define struct_event_base_val(v) (*(struct event_base**) Data_custom_val(v))
  29
  30 static value * event_cb_closure = NULL;
  31
  32 /* FIXME use dedicated exception */
  33 static void raise_error(char const* str, char const* arg)
  34 {
  35   uerror((char*)str, NULL == arg ? Nothing : caml_copy_string(arg));
  36 }
  37
  38 static void
  39 struct_event_finalize(value ve)
  40 {
  41   struct event *ev = struct_event_val(ve);
  42
  43   if (event_pending(ev,EV_TIMEOUT|EV_READ|EV_WRITE|EV_SIGNAL,NULL)) {
  44     event_del(ev);
  45   }
  46
  47   caml_stat_free(struct_event_val(ve));
  48 }
  49
  50 static int
  51 struct_event_compare(value v1, value v2)
  52 {
  53   struct event *p1 = struct_event_val(v1);
  54   struct event *p2 = struct_event_val(v2);
  55   if(p1 == p2) return 0;
  56   if(p1 < p2) return -1;
  57   return 1;
  58 }
  59
  60 static long
  61 struct_event_hash(value v)
  62 {
  63   return (long) struct_event_val(v);
  64 }
  65
  66 static struct custom_operations struct_event_ops = {
  67   "struct event",
  68   struct_event_finalize,
  69   struct_event_compare,
  70   struct_event_hash,
  71   custom_serialize_default,
  72   custom_deserialize_default,
  73 #if defined(custom_compare_ext_default)
  74   custom_compare_ext_default,
  75 #endif
  76 };
  77
  78 static void
  79 struct_event_base_finalize(value vbase)
  80 {
  81   struct event_base* base = struct_event_base_val(vbase);
  82   if (NULL != base)
  83   {
  84     event_base_free(base);
  85     struct_event_base_val(vbase) = NULL;
  86   }
  87 }
  88
  89 static int
  90 struct_event_base_compare(value v1, value v2)
  91 {
  92   struct event_base *p1 = struct_event_base_val(v1);
  93   struct event_base *p2 = struct_event_base_val(v2);
  94   if(p1 == p2) return 0;
  95   if(p1 < p2) return -1;
  96   return 1;
  97 }
  98
  99 static long
 100 struct_event_base_hash(value v)
 101 {
 102   return (long) struct_event_base_val(v);
 103 }
 104
 105 static struct custom_operations struct_event_base_ops = {
 106   "struct event_base",
 107   struct_event_base_finalize,
 108   struct_event_base_compare,
 109   struct_event_base_hash,
 110   custom_serialize_default,
 111   custom_deserialize_default,
 112 #if defined(custom_compare_ext_default)
 113   custom_compare_ext_default,
 114 #endif
 115 };
 116
 117 static struct event_base*
 118 get_struct_event_base_val(value v)
 119 {
 120   struct event_base* base = struct_event_base_val(v);
 121   if (NULL == base)
 122   {
 123     raise_error("event_base","NULL");
 124   }
 125   return base;
 126 }
 127
 128 /*
 129  * This callback calls the ocaml event callback, which will in turn
 130  * call the real ocaml callback.
 131  */
 132 static void
 133 event_cb(int fd, short type, void *arg)
 134 {
 135   caml_leave_blocking_section();
 136   callback3(*event_cb_closure,
 137             Val_long((long) arg), Val_int(fd), Val_int(type));
 138   caml_enter_blocking_section();
 139 }
 140
 141 static void
 142 set_struct_timeval(struct timeval *tv, value vfloat)
 143 {
 144   double timeout = Double_val(vfloat);
 145   tv->tv_sec = (int) timeout;
 146   tv->tv_usec = (int) (1e6 * (timeout - tv->tv_sec));
 147 }
 148
 149 CAMLprim value
 150 oc_create_event(value u)
 151 {
 152   CAMLparam1(u);
 153   CAMLlocal1(ve);
 154   struct event* ev = caml_stat_alloc(sizeof(struct event));
 155   memset(ev, 0, sizeof(*ev));
 156
 157   ve = caml_alloc_custom(&struct_event_ops, sizeof(struct event*), 0, 1);
 158   struct_event_val(ve) = ev;
 159
 160   CAMLreturn(ve);
 161 }
 162
 163 CAMLprim value
 164 oc_event_id(value vevent)
 165 {
 166   CAMLparam0();
 167   CAMLreturn(Val_long((long) struct_event_val(vevent)));
 168 }
 169
 170 CAMLprim value
 171 oc_event_fd(value vevent)
 172 {
 173   CAMLparam1(vevent);
 174   CAMLreturn(Val_long(EVENT_FD(struct_event_val(vevent))));
 175 }
 176
 177 CAMLprim value
 178 oc_event_set(value vbase, value vevent, value fd, value vevent_flag)
 179 {
 180   CAMLparam4(vbase, vevent, fd, vevent_flag);
 181
 182   struct event *event = struct_event_val(vevent);
 183   struct event_base* base = get_struct_event_base_val(vbase);
 184
 185   event_set(event, Int_val(fd), Int_val(vevent_flag),
 186             &event_cb, event);
 187
 188   if (0 != event_base_set(base, event))
 189   {
 190     raise_error("event_set", "event_base_set");
 191   }
 192
 193   CAMLreturn(Val_unit);
 194 }
 195
 196 CAMLprim value
 197 oc_event_add(value vevent, value vfloat_option)
 198 {
 199   CAMLparam2(vevent, vfloat_option);
 200   struct event *event = struct_event_val(vevent);
 201   struct timeval timeval;
 202   struct timeval *tv = NULL;
 203
 204   if (Is_some(vfloat_option)) {
 205     set_struct_timeval(&timeval, Field(vfloat_option, 0));
 206     tv = &timeval;
 207   }
 208
 209   if (0 != event_add(event, tv)) {
 210     raise_error("event_add", "event_add");
 211   }
 212
 213   CAMLreturn(Val_unit);
 214 }
 215
 216 CAMLprim value
 217 oc_event_del(value vevent)
 218 {
 219   CAMLparam0();
 220   struct event *event = struct_event_val(vevent);
 221
 222   event_del(event);
 223
 224   CAMLreturn(Val_unit);
 225 }
 226
 227 CAMLprim value
 228 oc_event_pending(value vevent, value vtype)
 229 {
 230   CAMLparam2(vevent, vtype);
 231   struct event *event = struct_event_val(vevent);
 232   int r = 0;
 233
 234   r = event_pending(event, Int_val(vtype), NULL);
 235
 236   CAMLreturn(Val_bool(r));
 237 }
 238
 239 CAMLprim value
 240 oc_event_active(value vevent, value vtype)
 241 {
 242   CAMLparam2(vevent, vtype);
 243   struct event *event = struct_event_val(vevent);
 244
 245   event_active(event, Int_val(vtype), 0);
 246
 247   CAMLreturn(Val_unit);
 248 }
 249
 250 CAMLprim value
 251 oc_event_base_loop(value vbase, value vloop_flag)
 252 {
 253   CAMLparam2(vbase,vloop_flag);
 254   struct event_base* base = get_struct_event_base_val(vbase);
 255   int flag = 0;
 256   if (0 == Int_val(vloop_flag)) flag = EVLOOP_ONCE;
 257   else if (1 == Int_val(vloop_flag)) flag = EVLOOP_NONBLOCK;
 258   else caml_invalid_argument("loop");
 259
 260   caml_enter_blocking_section();
 261   if((-1 == event_base_loop(base,flag))) {
 262     caml_leave_blocking_section();
 263     raise_error("event_loop", NULL);
 264   }
 265   caml_leave_blocking_section();
 266
 267   CAMLreturn(Val_unit);
 268 }
 269
 270
 271 CAMLprim value
 272 oc_event_base_dispatch(value vbase)
 273 {
 274   CAMLparam1(vbase);
 275   struct event_base* base = get_struct_event_base_val(vbase);
 276
 277   caml_enter_blocking_section();
 278   if((-1 == event_base_dispatch(base))) {
 279     caml_leave_blocking_section();
 280     raise_error("event_dispatch", NULL);
 281   }
 282   caml_leave_blocking_section();
 283
 284   CAMLreturn(Val_unit);
 285 }
 286
 287 /*
 288  * Initialize event base
 289  */
 290 CAMLprim value
 291 oc_event_base_init(value unit)
 292 {
 293   CAMLparam1(unit);
 294   CAMLlocal1(v);
 295   struct event_base* base = NULL;
 296
 297   /* setup the event callback closure if needed */
 298   if(event_cb_closure == NULL) {
 299     event_cb_closure = caml_named_value("event_cb");
 300     if(event_cb_closure == NULL) {
 301       invalid_argument("Callback event_cb not initialized.");
 302     }
 303   }
 304
 305   base = event_base_new();
 306   if (!base) {
 307     raise_error("event_base_init", NULL);
 308   }
 309
 310   v = caml_alloc_custom(&struct_event_base_ops, sizeof(struct event_base*), 0, 1);
 311   struct_event_base_val(v) = base;
 312
 313   CAMLreturn(v);
 314 }
 315
 316 CAMLprim value
 317 oc_event_base_reinit(value vbase)
 318 {
 319   CAMLparam1(vbase);
 320   struct event_base* base = get_struct_event_base_val(vbase);
 321
 322   if (0 != event_reinit(base)) {
 323     raise_error("event_base_reinit", NULL);
 324   }
 325
 326   CAMLreturn(Val_unit);
 327 }
 328
 329 CAMLprim value
 330 oc_event_base_free(value vbase)
 331 {
 332   CAMLparam1(vbase);
 333
 334   struct event_base* base = get_struct_event_base_val(vbase);
 335   event_base_free(base);
 336   struct_event_base_val(vbase) = NULL;
 337
 338   CAMLreturn(Val_unit);
 339 }