#include <caml/callback.h>
#include <caml/memory.h>           
#include <caml/alloc.h>
#include <caml/custom.h>
#include <caml/signals.h>
#include <ev.h>
#include <assert.h>
#include <string.h>

#include <stdio.h>

#define IO_CB_IDX 0
#define IO_IO_IDX 1
#define IO_LOOP_IDX 2
#define IO_RESCHEDULE_CB_IDX 3

/* precalculated list for the case of revents == same as in init */
#define IO_DEFAULT_REVENTS_MASK_IDX 4
#define IO_DEFAULT_REVENTS_LIST_IDX 5

#define IO_START_IDX 6          /* offset for storing a pointer to the start function (c-function) */
#define IO_STOP_IDX 7           /* ..stop function */

#define IO_AUX_IDX 8            /* a place to store event-specific data, such as the file path by ev_stat */

#define IO_KEEPALIVE_IDX 9      /* should this object keep the event loop alive */

#define IO_SIZE 10              /* number of words to allocate for the ev object */

#define LOOP_LOOP_IDX 0         /* the ev_loop object */
#define LOOP_RUNNING_IDX 1      /* is the loop running? */
#define LOOP_EXN_IDX 2          /* exception handler */
#define LOOP_EXN_STORE 3        /* store exception, if any */
#define LOOP_SIZE 4

static value gs_default_loop = Val_int(0);

#ifndef CAMLreturnT
// bring this in from a more recent ocaml
#define CAMLreturnT(type, result) do{ \
  type caml__temp_result = (result); \
  caml_local_roots = caml__frame; \
  return (caml__temp_result); \
}while(0)
#endif


// macro for generating accessor functions for event watcher fields
#define ACCESSOR(base, field, access)                           \
  CAMLprim value                                                \
  evo_##base##_get_##field(value ml_io)                         \
  {                                                             \
    CAMLparam1(ml_io);                                          \
    struct ev_##base* io = (void*) Field(ml_io, IO_IO_IDX);   \
    CAMLreturn (access);                                        \
  }

////////////////////////////////////////////////////////////////////////
static
void
string_finalizer(value a_wrap)
{
  free(*(char**) a_wrap);
  *(char**) a_wrap = 0;
}

struct custom_operations string_ops =
  { identifier : "ev",
    finalize   : string_finalizer,
    compare    : custom_compare_default,
    hash       : custom_hash_default,
    serialize  : custom_serialize_default,
    deserialize: custom_deserialize_default };

static
CAMLprim value
dup_string(const char* a_str)
{
  CAMLparam0();
  CAMLlocal1(val);
  char** ptr;
  val = alloc_custom(&string_ops, sizeof(char*), 0, 1);
  ptr = (char**) val;
  *ptr = strdup(a_str);
  CAMLreturn(val);
}

static
struct ev_loop*
unwrap_loop(value a_wrapped)
{
  CAMLparam1(a_wrapped);
  void* ptr = (void*) Field(a_wrapped, LOOP_LOOP_IDX);
  if (!ptr) {
    caml_raise_constant(*caml_named_value("stale_object_exception"));
  }
  CAMLreturnT (struct ev_loop*, ptr);
}

static
value*
get_named_value(const char* a_str)
{
  value* v = caml_named_value(a_str);
  assert(v);
  return v;
}

static
CAMLprim value
wrap_loop(struct ev_loop* a_ptr)
{
  CAMLparam0();
  CAMLlocal1(val);
  val = caml_alloc_tuple(LOOP_SIZE);
  Store_field(val, LOOP_LOOP_IDX, (value) a_ptr);
  Store_field(val, LOOP_RUNNING_IDX, Val_false);
  Store_field(val, LOOP_EXN_IDX, *get_named_value("handle_watcher_exception"));
  Store_field(val, LOOP_EXN_STORE, Val_int(0));
  CAMLreturn (val);
}

////////////////////////////////////////////////////////////////////////
// functions for converting masks to ocaml lists and back
int
mask_of_loop_flags(value a_flags)
{
  static value* closure = NULL;
  if (closure == NULL) {
    closure = get_named_value("mask_of_loop_flags");
  }
  return Int_val(caml_callback(*closure, a_flags));
}

value
loop_flags_of_mask(int a_flags)
{
  static value* closure = NULL;
  if (closure == NULL) {
    closure = get_named_value("loop_flags_of_mask");
  }
  return caml_callback(*closure, Val_int(a_flags));
}

int
mask_of_run_loop_flags(value a_flags)
{
  static value* closure = NULL;
  if (closure == NULL) {
    closure = get_named_value("mask_of_run_loop_flags");
  }
  return Int_val(caml_callback(*closure, a_flags));
}

int
mask_of_revents(value a_flags)
{
  static value* closure = NULL;
  if (closure == NULL) {
    closure = get_named_value("mask_of_revents");
  }
  return Int32_val(caml_callback(*closure, a_flags));
}

value
revents_of_mask(int a_flags)
{
  CAMLparam0();
  CAMLlocal1(flags);
  static value* closure = NULL;
  flags = caml_copy_int32(a_flags);
  if (closure == NULL) {
    closure = get_named_value("revents_of_mask");
  }
  CAMLreturn(caml_callback(*closure, flags));
}

////////////////////////////////////////////////////////////////////////
// function for converting a struct stat into Unix.stats
CAMLprim value
ml_of_unix_file_kind(int a_mode)
{
  return Val_int(S_ISREG(a_mode) ? 0 :
                 S_ISDIR(a_mode) ? 1 :
                 S_ISCHR(a_mode) ? 2 :
                 S_ISBLK(a_mode) ? 3 :
                 S_ISLNK(a_mode) ? 4 :
                 S_ISSOCK(a_mode) ? 5 : 0);
}

CAMLprim value
ml_of_unix_file_perm(int a_mode)
{
  return Val_int(a_mode & 07777);
}

CAMLprim value
ml_of_unix_stats(struct stat* a_stat)
{
  CAMLparam0();
  CAMLlocal1(ml_st);
  ml_st = caml_alloc_tuple(12);
  Store_field(ml_st, 0, Val_int(a_stat->st_dev));
  Store_field(ml_st, 1, Val_int(a_stat->st_ino));
  Store_field(ml_st, 2, ml_of_unix_file_kind(a_stat->st_mode));
  Store_field(ml_st, 3, ml_of_unix_file_perm(a_stat->st_mode));
  Store_field(ml_st, 4, Val_int(a_stat->st_nlink));
  Store_field(ml_st, 5, Val_int(a_stat->st_uid));
  Store_field(ml_st, 6, Val_int(a_stat->st_gid));
  Store_field(ml_st, 7, Val_int(a_stat->st_rdev));
  Store_field(ml_st, 8, Val_int(a_stat->st_size));
  Store_field(ml_st, 9, caml_copy_double(a_stat->st_atime));
  Store_field(ml_st, 10, caml_copy_double(a_stat->st_mtime));
  Store_field(ml_st, 11, caml_copy_double(a_stat->st_ctime));
  CAMLreturn(ml_st);
}

////////////////////////////////////////////////////////////////////////
// callback used by all event type
void
evo_watcher_cb(struct ev_loop* a_loop, struct ev_watcher* a_watcher, int a_revents)
{
  CAMLparam0();
  CAMLlocal3(ml_io, loop, rv);
  leave_blocking_section();
  ml_io = (value) a_watcher->data;
  loop = Field(ml_io, IO_LOOP_IDX);
  //printf("reading loop value %p\n", loop);
  //printf("  with real value %p\n", unwrap_loop(loop));
  assert(unwrap_loop(loop) == a_loop);
  assert((void*) Field(ml_io, IO_IO_IDX) == a_watcher);
  rv = caml_callback2_exn(Field(ml_io, IO_CB_IDX), ml_io,
                          Int32_val(Field(ml_io, IO_DEFAULT_REVENTS_MASK_IDX)) == a_revents
                          ? Field(ml_io, IO_DEFAULT_REVENTS_LIST_IDX)
                          : revents_of_mask(a_revents));
  if (Is_exception_result(rv)) {
    rv = Extract_exception(rv);
    // ignore exceptions
    rv = caml_callback2_exn(Field(loop, LOOP_EXN_IDX), loop, rv);
    if (Is_exception_result(rv)) {
      rv = Extract_exception(rv);
      Store_field(loop, LOOP_EXN_STORE, rv);
      ev_unloop(a_loop, EVUNLOOP_ONE);
    }
  }
  enter_blocking_section();
  CAMLreturn0;
}

////////////////////////////////////////////////////////////////////////
// Common functions used by other event initializers etc
CAMLprim value
evo_setup(value a_cb, void* ptr, value a_revents_list,
          void (*a_start)(struct ev_loop* a_loop, struct ev_watcher* a_watcher),
          void (*a_stop)(struct ev_loop* a_loop, struct ev_watcher* a_watcher)
          )
{
  CAMLparam1 (a_cb);
  CAMLlocal1 (ml_io);
  ml_io = caml_alloc(IO_SIZE, 0);
  Store_field(ml_io, IO_CB_IDX, a_cb);
  Store_field(ml_io, IO_IO_IDX, (value) ptr);
  Store_field(ml_io, IO_LOOP_IDX, Val_int(0));
  ((struct ev_watcher*) ptr)->data = NULL;
  Store_field(ml_io, IO_DEFAULT_REVENTS_MASK_IDX, copy_int32(mask_of_revents(a_revents_list)));
  Store_field(ml_io, IO_DEFAULT_REVENTS_LIST_IDX, a_revents_list);
  Store_field(ml_io, IO_START_IDX, (value) a_start);
  Store_field(ml_io, IO_STOP_IDX, (value) a_stop);
  CAMLreturn (ml_io);
}

CAMLprim value
evo_start(value a_loop, value ml_io)
{
  CAMLparam2(a_loop, ml_io);
  struct ev_loop* loop = unwrap_loop(a_loop);
  if (Field(ml_io, IO_LOOP_IDX) == Val_int(0)) {
    struct ev_watcher* io = (void*) Field(ml_io, IO_IO_IDX);
    assert(!ev_is_active((struct ev_watcher*) Field(ml_io, IO_IO_IDX)));
    void (*start)(struct ev_loop* a_loop, struct ev_watcher* a_watcher) =
      (void*) Field(ml_io, IO_START_IDX);
    assert(io->data == NULL);
    assert(Field(ml_io, IO_LOOP_IDX) == Val_int(0));
    Store_field(ml_io, IO_LOOP_IDX, a_loop);
    Store_field(ml_io, IO_KEEPALIVE_IDX, Val_int(1));
    io->data = (void*) ml_io;
    caml_register_global_root((value*) &io->data);
    start(loop, io);
    if (!Bool_val(Field(ml_io, IO_KEEPALIVE_IDX))) {
      ev_unref(loop);
    }
  } else {
    assert(ev_is_active((struct ev_watcher*) Field(ml_io, IO_IO_IDX)));
    if (Field(ml_io, IO_LOOP_IDX) != a_loop) {
      caml_invalid_argument("Ev.ev_start: the event watcher is already started on another loop");
    }
  }
  CAMLreturn (Val_unit);
}

//external io_stop : io -> unit = "evo_io_stop"
CAMLprim value
evo_stop(value ml_io)
{
  CAMLparam1(ml_io);
  {
    if (Field(ml_io, IO_LOOP_IDX) != Val_int(0)) {
      // this may not hold true, if the associated even has been destroyed! I wonder what happens then..
      //assert(ev_is_active((struct ev_watcher*) Field(ml_io, IO_IO_IDX)));
      void (*stop)(struct ev_loop* a_loop, struct ev_watcher* a_watcher) =
        (void*) Field(ml_io, IO_STOP_IDX);
      struct ev_loop* loop = unwrap_loop(Field(ml_io, IO_LOOP_IDX));
      struct ev_watcher* io = (void*) Field(ml_io, IO_IO_IDX);

      assert(io->data != NULL);
      assert(loop != NULL);
      if (!Bool_val(Field(ml_io, IO_KEEPALIVE_IDX))) {
        ev_ref(loop);
      }
      stop(loop, io);
      caml_remove_global_root((value*) &io->data);
      io->data = NULL;
      Store_field(ml_io, IO_LOOP_IDX, Val_int(0));
    } else {
      assert(!ev_is_active((struct ev_watcher*) Field(ml_io, IO_IO_IDX)));
    }
  }
  CAMLreturn (Val_unit);
}

//external set_keepalive : 'a ev -> bool -> unit = "evo_keepalive"
CAMLprim value
evo_set_keepalive(value ml_io, value a_state)
{
  CAMLparam2(ml_io, a_state);
  if (Field(ml_io, IO_LOOP_IDX) != Val_int(0)) {
    struct ev_loop* loop = unwrap_loop(Field(ml_io, IO_LOOP_IDX));
    assert(ev_is_active((struct ev_watcher*) Field(ml_io, IO_IO_IDX)));
    if (Field(ml_io, IO_KEEPALIVE_IDX) != a_state) {
      if (a_state == Val_false) {
        ev_unref(loop);
      } else {
        ev_ref(loop);
      }
    }
  }
  Store_field(ml_io, IO_KEEPALIVE_IDX, a_state);
  CAMLreturn (Val_unit);
}

////////////////////////////////////////////////////////////////////////
// io
//external io_init : Unix.file_descr -> revents -> io cb -> io ev = "evo_io_init"
CAMLprim value
evo_io_init(value a_fd, value a_flags, value a_cb)
{
  CAMLparam3 (a_cb, a_fd, a_flags);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_io)), a_flags, (void*) ev_io_start, (void*) ev_io_stop);
  ev_io_init((struct ev_io*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb, Int_val(a_fd), mask_of_revents(a_flags));
  CAMLreturn (ml_io);
}

////////////////////////////////////////////////////////////////////////
// timer
//external timer_init : float -> float -> timer cb -> timer ev = "evo_io_init"
CAMLprim value
evo_timer_init(value a_timeout, value a_recurrence, value a_cb)
{
  CAMLparam3 (a_cb, a_timeout, a_recurrence);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_timer)), revents_of_mask(EV_TIMEOUT), (void*) ev_timer_start, (void*) ev_timer_stop);
  ev_timer_init((struct ev_timer*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb, Double_val(a_timeout), Double_val(a_recurrence));
  CAMLreturn (ml_io);
}

CAMLprim value
evo_timer_again(value ml_io)
{
  CAMLparam1(ml_io);
  if (Field(ml_io, IO_LOOP_IDX) == Val_int(0)) {
    caml_raise_constant(*get_named_value("no_loop_exception"));
  }
  struct ev_loop* loop = unwrap_loop(Field(ml_io, IO_LOOP_IDX));
  struct ev_timer* io = (void*) Field(ml_io, IO_IO_IDX);
    
  ev_timer_again(loop, io);
  CAMLreturn (Val_unit);
}

////////////////////////////////////////////////////////////////////////
// signal
//external signal_init : int -> signal cb -> signal ev = "evo_signal_init"
CAMLprim value
evo_signal_init(value a_signal, value a_cb)
{
  CAMLparam2 (a_cb, a_signal);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_signal)), revents_of_mask(EV_SIGNAL), (void*) ev_signal_start, (void*) ev_signal_stop);
  ev_signal_init((struct ev_signal*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb,
                 convert_signal_number(Int_val(a_signal)));
  CAMLreturn (ml_io);
}

////////////////////////////////////////////////////////////////////////
// child
//external child_init : int -> bool -> child cb -> child ev = "evo_child_init"
CAMLprim value
evo_child_init(value a_pid, value a_trace, value a_cb)
{
  CAMLparam3 (a_cb, a_pid, a_trace);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_child)), revents_of_mask(EV_CHILD), (void*) ev_child_start, (void*) ev_child_stop);
  ev_child_init((struct ev_child*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb,
                Int_val(a_pid), Bool_val(a_trace));
  CAMLreturn (ml_io);
}

//external child_set : child ev -> int -> bool -> unit = "evo_child_set"
CAMLprim value
evo_child_set(value ml_io, value a_pid, value a_trace)
{
  CAMLparam3 (ml_io, a_pid, a_trace);
  struct ev_child* io = (void*) Field(ml_io, IO_IO_IDX);
  ev_child_set(io, Int_val(a_pid), Bool_val(a_trace));
  CAMLreturn (ml_io);
}

//external child_get_pid : child ev -> int = "evo_child_get_pid"
ACCESSOR(child, pid, Val_int(io->pid));

//external child_get_rpid : child ev -> int = "evo_child_get_rpid"
ACCESSOR(child, rpid, Val_int(io->rpid));

//external child_get_rstatus : child ev -> int = "evo_child_get_rstatus"
ACCESSOR(child, rstatus, Val_int(io->rstatus));

////////////////////////////////////////////////////////////////////////
// idle
//external idle_init : idle cb -> idle ev = "evo_idle_init"
CAMLprim value
evo_idle_init(value a_cb)
{
  CAMLparam1 (a_cb);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_idle)), revents_of_mask(EV_IDLE), (void*) ev_idle_start, (void*) ev_idle_stop);
  ev_idle_init((struct ev_idle*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb);
  CAMLreturn (ml_io);
}

////////////////////////////////////////////////////////////////////////
// stat
//external stat_init : string -> float -> stat cb -> stat ev = "evo_stat_init"
CAMLprim value
evo_stat_init(value a_file, value a_interval, value a_cb)
{
  CAMLparam3 (a_cb, a_file, a_interval);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_stat)), revents_of_mask(EV_STAT), (void*) ev_stat_start, (void*) ev_stat_stop);
  Store_field(ml_io, IO_AUX_IDX, dup_string(String_val(a_file)));
  ev_stat_init((struct ev_stat*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb,
               *(char**) Field(ml_io, IO_AUX_IDX), Double_val(a_interval));
  CAMLreturn (ml_io);
}

CAMLprim value
evo_stat_set(value ml_io, value a_file, value a_interval)
{
  CAMLparam3 (ml_io, a_file, a_interval);
  Store_field(ml_io, IO_AUX_IDX, dup_string(String_val(a_file)));
  ev_stat_set((struct ev_stat*) Field(ml_io, IO_IO_IDX),
              *(char**) Field(ml_io, IO_AUX_IDX), Double_val(a_interval));
  CAMLreturn (ml_io);
}

//external stat_get_attr : stat ev -> Unix.stats = "evo_stat_get_attr"
ACCESSOR(stat, attr, ml_of_unix_stats(&io->attr));

//external stat_get_prev : stat ev -> Unix.stats = "evo_stat_get_attr"
ACCESSOR(stat, prev, ml_of_unix_stats(&io->prev));

////////////////////////////////////////////////////////////////////////
// fork
//external fork_init : fork cb -> fork ev = "evo_fork_init"
CAMLprim value
evo_fork_init(value a_cb)
{
  CAMLparam1 (a_cb);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_fork)), revents_of_mask(EV_FORK), (void*) ev_fork_start, (void*) ev_fork_stop);
  ev_fork_init((struct ev_fork*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb);
  CAMLreturn (ml_io);
}

////////////////////////////////////////////////////////////////////////
// async
//external async_init : async cb -> async ev = "evo_async_init"
CAMLprim value
evo_async_init(value a_cb)
{
  CAMLparam1 (a_cb);
  CAMLlocal1 (ml_async);
  ml_async = evo_setup(a_cb, malloc(sizeof(struct ev_async)), revents_of_mask(EV_ASYNC), (void*) ev_async_start, (void*) ev_async_stop);
  ev_async_init((struct ev_async*) Field(ml_async, IO_IO_IDX), (void*) evo_watcher_cb);
  CAMLreturn (ml_async);
}

//external async_send : async ev -> unit = "evo_async_send"
CAMLprim value 
evo_async_send(value ml_io)
{ 
  CAMLparam1 (ml_io);
  ev_async_send(unwrap_loop(Field(ml_io, IO_LOOP_IDX)), (struct ev_async*) Field(ml_io, IO_IO_IDX));
  CAMLreturn (Val_unit);
}

////////////////////////////////////////////////////////////////////////
// prepare
//external prepare_init : prepare cb -> prepare ev = "evo_prepare_init"
CAMLprim value
evo_prepare_init(value a_cb)
{
  CAMLparam1 (a_cb);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_prepare)), revents_of_mask(EV_PREPARE), (void*) ev_prepare_start, (void*) ev_prepare_stop);
  ev_prepare_init((struct ev_prepare*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb);
  CAMLreturn (ml_io);
}

////////////////////////////////////////////////////////////////////////
// check
//external check_init : check cb -> check ev = "evo_check_init"
CAMLprim value
evo_check_init(value a_cb)
{
  CAMLparam1 (a_cb);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_check)), revents_of_mask(EV_CHECK), (void*) ev_check_start, (void*) ev_check_stop);
  ev_check_init((struct ev_check*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb);
  CAMLreturn (ml_io);
}

////////////////////////////////////////////////////////////////////////
// periodic
static
ev_tstamp
evo_reschedule_cb(struct ev_periodic* a_periodic, ev_tstamp a_now)
{
  CAMLparam0();
  CAMLlocal3(ml_io, loop, rv);
  double val = 0.0;
  leave_blocking_section();
  ml_io = (value) a_periodic->data;
  rv = caml_callback2_exn(Field(ml_io, IO_RESCHEDULE_CB_IDX),
                          ml_io, caml_copy_double(a_now));
  if (Is_exception_result(rv)) {
    struct ev_loop* evloop;
    rv = Extract_exception(rv);
    loop = Field(IO_LOOP_IDX, ml_io);
    // don't call unwrap_loop, because it may throw an exception if the event loop is destroyed
    evloop = loop != Val_int(0) ? (void*) Field(loop, LOOP_LOOP_IDX) : NULL;
    if (evloop) {
      rv = caml_callback2_exn(Field(loop, LOOP_EXN_IDX), loop, rv);
      if (Is_exception_result(rv)) {
        rv = Extract_exception(rv);
        Store_field(loop, LOOP_EXN_STORE, rv);
        ev_unloop(evloop, EVUNLOOP_ONE);
      }
    } else {
      rv = caml_callback2_exn(*get_named_value("handle_watcher_exception"), Val_int(0), rv);
    }
  } else {
    val = Double_val(rv);
  }
  enter_blocking_section();
  CAMLreturnT(double, val);
}

//external periodic_init : periodic_time -> periodic cb -> periodic ev = "evo_periodic_init"
CAMLprim value
evo_periodic_init(value a_periodic, value a_cb)
{
  CAMLparam2 (a_cb, a_periodic);
  CAMLlocal1 (ml_io);
  ml_io = evo_setup(a_cb, malloc(sizeof(struct ev_periodic)), revents_of_mask(EV_PERIODIC), (void*) ev_periodic_start, (void*) ev_periodic_stop);
  switch (Tag_val(a_periodic)) {
  case 0: {                     /* Absolute */
    ev_periodic_init((struct ev_periodic*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb,
                     Double_val(Field(a_periodic, 0)), 0.0,
                     NULL);
  } break;

  case 1: {                     /* Repeating */
    double periodic = Double_val(Field(a_periodic, 1));
    if (periodic <= 0.0) {
      caml_invalid_argument("Ev.periodic_init: negative repeat value for repeating event not allowed");
    }
    ev_periodic_init((struct ev_periodic*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb,
                     Double_val(Field(a_periodic, 0)), periodic,
                     NULL);
  } break;

  case 2: {                     /* Manual */
    Store_field(ml_io, IO_RESCHEDULE_CB_IDX, Field(a_periodic, 0));
    ev_periodic_init((struct ev_periodic*) Field(ml_io, IO_IO_IDX), (void*) evo_watcher_cb,
                     0.0, 0.0, evo_reschedule_cb);
  } break;

  default:
    assert(0);
  }
    
  CAMLreturn (ml_io);
}

//external periodic_set : periodic ev -> float -> float -> reschedule_cb -> unit = "evo_periodic_set"
CAMLprim value
evo_periodic_set(value ml_io, value a_periodic)
{
  CAMLparam2 (ml_io, a_periodic);
  struct ev_periodic* io = (void*) Field(ml_io, IO_IO_IDX);

  switch (Tag_val(a_periodic)) {
  case 0: {                     /* Absolute */
    Store_field(ml_io, IO_RESCHEDULE_CB_IDX, Val_int(0));
    ev_periodic_set(io,
                    Double_val(Field(a_periodic, 0)), 0.0,
                    NULL);
  } break;

  case 1: {                     /* Repeating */
    double periodic = Double_val(Field(a_periodic, 1));
    if (periodic <= 0.0) {
      caml_invalid_argument("Ev.periodic_set: negative repeat value for repeating event not allowed");
    }
    Store_field(ml_io, IO_RESCHEDULE_CB_IDX, Val_int(0));
    ev_periodic_set(io,
                    Double_val(Field(a_periodic, 0)), periodic,
                    NULL);
  } break;

  case 2: {                     /* Manual */
    Store_field(ml_io, IO_RESCHEDULE_CB_IDX, Field(a_periodic, 0));
    ev_periodic_set(io, 0.0, 0.0, evo_reschedule_cb);
  } break;

  default:
    assert(0);
  }
  
  CAMLreturn (ml_io);
}

//external periodic_get_at : periodic ev -> float = "evo_periodic_get_at"
ACCESSOR(periodic, at, caml_copy_double(io->at));

////////////////////////////////////////////////////////////////////////
// loop management
//external loop : loop -> run_loop_flag list -> unit = "evo_loop"
CAMLprim value
evo_loop(value ml_loop, value a_flags)
{
  CAMLparam2(ml_loop, a_flags);
  struct ev_loop* loop = unwrap_loop(ml_loop);
  if (Field(ml_loop, LOOP_RUNNING_IDX) == Val_true) {
    caml_invalid_argument("Ev.loop: loop is already running");
  }
  int flags = mask_of_run_loop_flags(a_flags);
  Store_field(ml_loop, LOOP_RUNNING_IDX, Val_true);
  enter_blocking_section();
  ev_loop(loop, flags);
  leave_blocking_section();
  Store_field(ml_loop, LOOP_RUNNING_IDX, Val_false);
  if (Field(ml_loop, LOOP_EXN_STORE) != Val_int(0)) {
    caml_raise(Field(ml_loop, LOOP_EXN_STORE));
  }
  CAMLreturn (Val_unit);
}

//external unloop : loop -> unloop_how -> unit = "evo_unloop"
CAMLprim value
evo_unloop(value a_loop, value a_how)
{
  CAMLparam2(a_loop, a_how);
  struct ev_loop* loop = unwrap_loop(a_loop);
  int how = Int_val(a_how);
  ev_unloop(loop,
            how == 0 ? EVUNLOOP_ONE :
                       EVUNLOOP_ALL);
  CAMLreturn (Val_unit);
}

//external default_loop : loop_flags -> loop
CAMLprim value
evo_default_loop(value a_flags)
{
  CAMLparam1 (a_flags);
  CAMLlocal1 (val);

  if (ev_version_major () != EV_VERSION_MAJOR
      || ev_version_minor () < EV_VERSION_MINOR) {
    caml_raise_constant(*get_named_value("version_mismatch_exception"));
  }

  if (gs_default_loop == Val_int(1)) {
    caml_invalid_argument("Ev.default_loop: cannot create a new default loop after the first one has been destroyed");
  }
  
  if (gs_default_loop == Val_int(0)) {
    int flags = mask_of_loop_flags(a_flags);
    struct ev_loop* loop = ev_default_loop(flags);
    if (loop) {
      caml_register_global_root(&gs_default_loop);
      gs_default_loop = wrap_loop(loop);
    }
  }
  if (gs_default_loop == Val_int(0)) {
    caml_raise_constant(*get_named_value("loop_init_failed_exception"));
  }
  CAMLreturn (gs_default_loop);
}

//external loop_new : loop_flags -> loop
CAMLprim value
evo_loop_new(value a_flags)
{
  CAMLparam1 (a_flags);
  CAMLlocal1 (val);

  if (ev_version_major () != EV_VERSION_MAJOR
      || ev_version_minor () < EV_VERSION_MINOR) {
    caml_raise_constant(*get_named_value("version_mismatch_exception"));
  }

  int flags = mask_of_loop_flags(a_flags);
  struct ev_loop* loop = ev_loop_new(flags);
  CAMLreturn (wrap_loop(loop));
}

//external set_exn_handler : loop -> exn_handler -> unit = "evo_set_exn_handler"
CAMLprim value
evo_set_exn_handler(value a_loop, value a_handler)
{
  CAMLparam2 (a_loop, a_handler);
  Store_field(a_loop, LOOP_EXN_IDX, a_handler);
  CAMLreturn (Val_unit);
}

//external loop_destroy : loop -> unit = "evo_loop_destroy"
CAMLprim value
evo_loop_destroy(value a_loop)
{
  CAMLparam1 (a_loop);
  struct ev_loop* loop = unwrap_loop(a_loop);
  if (Field(a_loop, LOOP_RUNNING_IDX) == Val_true) {
    caml_invalid_argument("Ev.loop_destroy: cannot destroy a running loop");
  }
  if (a_loop == gs_default_loop) {
    ev_default_destroy();
    gs_default_loop = Val_int(1);
  } else {
    ev_loop_destroy(loop);
  }
  Store_field(a_loop, LOOP_LOOP_IDX, Val_int(0));
  CAMLreturn (Val_unit);
}

//external forked : loop -> unit = "evo_forked"
CAMLprim value
evo_forked(value a_loop)
{
  CAMLparam1(a_loop);
  if (a_loop == gs_default_loop) {
    ev_default_fork();
  } else {
    struct ev_loop* loop = unwrap_loop(a_loop);
    ev_loop_fork(loop);
  }
  CAMLreturn (Val_unit);
}

//external set_io_collect_interval : loop -> float -> unit = "evo_set_io_collect_interval"
CAMLprim value
evo_set_io_collect_interval(value a_loop, value a_interval)
{
  CAMLparam2(a_loop, a_interval);
  struct ev_loop* loop = unwrap_loop(a_loop);
  ev_set_io_collect_interval(loop, Double_val(a_interval));
  CAMLreturn (Val_unit);
}

//external set_timeout_collect_interval : loop -> float -> unit = "evo_set_timeout_collect_interval"
CAMLprim value
evo_set_timeout_collect_interval(value a_loop, value a_interval)
{
  CAMLparam2(a_loop, a_interval);
  struct ev_loop* loop = unwrap_loop(a_loop);
  ev_set_timeout_collect_interval(loop, Double_val(a_interval));
  CAMLreturn (Val_unit);
}

//external loop_now : loop -> float = "evo_loop_now"
CAMLprim value
evo_loop_now(value a_loop)
{
  CAMLparam1(a_loop);
  struct ev_loop* loop = unwrap_loop(a_loop);
  CAMLreturn (caml_copy_double(ev_now(loop)));
}

//external is_default_loop : loop -> bool = "evo_is_default_loop"
CAMLprim value
evo_is_default_loop(value a_loop)
{
  CAMLparam1(a_loop);
  CAMLreturn (a_loop == gs_default_loop);
}

//external loop_count : loop -> int = "evo_loop_count"
CAMLprim value
evo_loop_count(value a_loop)
{
  CAMLparam1(a_loop);
  struct ev_loop* loop = unwrap_loop(a_loop);
  CAMLreturn (Val_int(ev_loop_count(loop)));
}

////////////////////////////////////////////////////////////////////////
// backend information
//external supported_backends : unit -> loop flag list = "evo_supported_backends"
CAMLprim value
evo_supported_backends(value a_unit)
{
  CAMLparam1 (a_unit);
  CAMLreturn (loop_flags_of_mask(ev_supported_backends()));
}

//external recommended_backends : unit -> loop flag list = "evo_recommended_backends"
CAMLprim value
evo_recommended_backends(value a_unit)
{
  CAMLparam1 (a_unit);
  CAMLreturn (loop_flags_of_mask(ev_recommended_backends()));
}

//external embeddable_backends : unit -> loop flag list = "evo_embeddable_backends"
CAMLprim value
evo_embeddable_backends(value a_unit)
{
  CAMLparam1 (a_unit);
  CAMLreturn (loop_flags_of_mask(ev_embeddable_backends()));
}



////////////////////////////////////////////////////////////////////////
// functions that work for all event types
//external is_active : 'a ev -> bool = "evo_is_active"
CAMLprim value
evo_is_active(value ml_io)
{
  CAMLparam1(ml_io);
  struct ev_watcher* io = (void*) Field(ml_io, IO_IO_IDX);
  CAMLreturn (ev_is_active(io) ? Val_true : Val_false);
}

//external is_pending : 'a ev -> bool = "evo_is_pending"
CAMLprim value
evo_is_pending(value ml_io)
{
  CAMLparam1(ml_io);
  struct ev_watcher* io = (void*) Field(ml_io, IO_IO_IDX);
  CAMLreturn (ev_is_pending(io) ? Val_true : Val_false);
}

//external get_priority : 'a ev -> int = "evo_get_priority"
CAMLprim value
evo_get_priority(value ml_io)
{
  CAMLparam1(ml_io);
  struct ev_watcher* io = (void*) Field(ml_io, IO_IO_IDX);
  CAMLreturn (Val_int(ev_priority(io)));
}

//external set_priority : 'a ev -> int -> unit = "evo_get_priority"
CAMLprim value
evo_set_priority(value ml_io, value a_priority)
{
  CAMLparam1(ml_io);
  struct ev_watcher* io = (void*) Field(ml_io, IO_IO_IDX);
  ev_set_priority(io, Int_val(a_priority));
  CAMLreturn (Val_unit);
}

//external get_loop : 'a ev -> loop = "evo_get_loop"
CAMLprim value
evo_get_loop(value ml_io)
{
  CAMLparam1(ml_io);
  CAMLlocal1(loop);
  value io = Field(ml_io, IO_LOOP_IDX);
  if (io == Val_int(0)) {
    caml_raise_constant(*get_named_value("no_loop_exception"));
  } else {
    loop = io;
  }
  CAMLreturn (loop);
}

//external invoke : 'a ev -> revents -> unit = "evo_invoke"
CAMLprim value
evo_invoke(value ml_io, value a_revents)
{
  CAMLparam2(ml_io, a_revents);
  CAMLlocal1(rv);
  
  rv = caml_callback2_exn(Field(ml_io, IO_CB_IDX), ml_io, a_revents);
  if (Is_exception_result(rv)) {
    rv = Extract_exception(rv);
    rv = caml_callback_exn(*get_named_value("handle_watcher_exception"), rv);
  }
  
  CAMLreturn (Val_unit);
}

//external clear_pending : 'a ev -> revents = "evo_clear_pending"
CAMLprim value
evo_clear_pending(value ml_io)
{
  CAMLparam1(ml_io);
  CAMLlocal2(loop, flags);
  struct ev_watcher* io = (void*) Field(ml_io, IO_IO_IDX);
  loop = Field(ml_io, IO_LOOP_IDX);
  if (loop == Val_int(0)) {
    caml_raise_constant(*get_named_value("no_loop_exception"));
  }
  flags = revents_of_mask(ev_clear_pending((void*) loop, io));
  CAMLreturn (flags);
}

//external io_set_cb : io ev -> io_cb -> unit = "evo_set_cb"
CAMLprim value
evo_set_cb(value ml_io, value a_cb)
{
  CAMLparam2(ml_io, a_cb);
  Store_field(ml_io, IO_CB_IDX, a_cb);
  CAMLreturn (Val_unit);
}

//external get_cb : io ev -> io_cb = "evo_get_cb"
CAMLprim value
evo_get_cb(value ml_io)
{
  CAMLparam1(ml_io);
  CAMLreturn (Field(ml_io, IO_CB_IDX));
}