value* interval_ismember(value* in, int inf, int sup)
{
value a;
CLOSURE ("Interval.is_member");
a = caml_callback3(*closure, *in, Val_int(inf), Val_int(sup));
return fcl_wrap(a);
}
/* Added in 1.18 without a useful documentation. */
Evas_Object* ml_Elm_Gen_Item_Reusable_Content_Get_Cb(void* data, Evas_Object* obj, const char *part, Evas_Object *old)
{
CAMLparam0();
CAMLlocal4(v_obj, v_part, v_old, v);
value* v_class = data;
v_obj = copy_Evas_Object(obj);
v_part = copy_string(part);
v_old = copy_Evas_Object(old);
v = caml_callback3(Field(*v_class, 5), v_obj, v_part, v_old);
CAMLreturnT(Evas_Object*, Evas_Object_opt_val(v));
}
PREFIX void ml_Evas_Object_Event_Cb_mouse_down(
void* data, Evas* e, Evas_Object *obj, void* event_info)
{
CAMLparam0();
CAMLlocal2(v_fun, v_ev);
value* d = (value*) data;
v_fun = *d;
v_ev = copy_Evas_Event_Mouse_Down((Evas_Event_Mouse_Down*) event_info);
caml_callback3(v_fun, (value) e, (value) obj, v_ev);
CAMLreturn0;
}
PREFIX void ml_Edje_Signal_Cb(
void* data, Evas_Object* obj, const char* emission, const char* source)
{
CAMLparam0();
CAMLlocal2(v_emission, v_source);
value* v_fun = (value*) data;
v_emission = copy_string(emission);
v_source = copy_string(source);
caml_callback3(*v_fun, (value) obj, v_emission, v_source);
CAMLreturn0;
}
return_val_t run_function(int id,
host_val *globals, int num_globals,
host_val *args, int num_args,
char** kwd_arg_names, host_val* kwd_arg_values, int num_kwd_args) {
CAMLparam0();
CAMLlocal3(ocaml_globals, ocaml_actuals, ocaml_result);
printf("[run_function] %d globals, %d args, %d kwd args\n", num_globals, num_args, num_kwd_args);
ocaml_globals = build_host_val_list(globals, num_globals);
ocaml_actuals = mk_actual_args(args, num_args, kwd_arg_names, kwd_arg_values, num_kwd_args);
ocaml_result = caml_callback3(*ocaml_run_function, Val_int(id), ocaml_globals, ocaml_actuals);
CAMLreturnT(return_val_t, translate_return_value(ocaml_result));
}
static uint64 on_accept (utp_callback_arguments *a)
{
CAMLparam0 ();
CAMLlocal2 (addr, val);
union sock_addr_union sock_addr;
socklen_param_type sock_addr_len;
static value *on_accept_fun = NULL;
if (on_accept_fun == NULL) on_accept_fun = caml_named_value ("utp_on_accept");
sock_addr_len = sizeof (struct sockaddr_in);
memcpy (&sock_addr.s_inet, (struct sockaddr_in *) a->address, sock_addr_len);
addr = alloc_sockaddr (&sock_addr, sock_addr_len, 0);
caml_callback3 (*on_accept_fun, Val_utp_context (a->context), Val_utp_socket (a->socket), addr);
CAMLreturn (0);
}
static uint64 on_sendto (utp_callback_arguments *a)
{
CAMLparam0 ();
CAMLlocal2 (addr, buf);
union sock_addr_union sock_addr;
socklen_param_type sock_addr_len;
static value *on_sendto_fun = NULL;
if (on_sendto_fun == NULL) on_sendto_fun = caml_named_value ("utp_on_sendto");
sock_addr_len = sizeof (struct sockaddr_in);
memcpy (&sock_addr.s_inet, (struct sockaddr_in *) a->address, sock_addr_len);
addr = alloc_sockaddr (&sock_addr, sock_addr_len, 0);
buf = caml_ba_alloc_dims (CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, (void *) a->buf, a->len);
caml_callback3 (*on_sendto_fun, Val_utp_context (a->context), addr, buf);
CAMLreturn (0);
}
value mk_actual_ast_args(
paranode *args,
int num_args,
char** keywords,
paranode* keyword_values,
int num_keyword_args) {
CAMLparam0();
CAMLlocal3(pos_list, kwd_list, kwd_values_list);
CAMLlocal1(actual_args);
printf("Creating args, n_positional = %d, n_kwd = %d\n", num_args, num_keyword_args);
pos_list = mk_val_list(args, num_args);
kwd_list = build_str_list(keywords, num_keyword_args);
kwd_values_list = mk_val_list(keyword_values, num_keyword_args);
actual_args = \
caml_callback3(*ocaml_mk_actual_args, pos_list, kwd_list, kwd_values_list);
CAMLreturn(actual_args);
}
void handle_callret( const ADDRINT addr, const THREADID tid, UINT32 type )
{
CAMLparam0();
CAMLlocal3( caml_addr, caml_tid, caml_type );
static value *proc_handle_callret = NULL;
if ( !proc_handle_callret ) {
proc_handle_callret = caml_named_value( "handle_callret" );
}
caml_addr = caml_copy_nativeint( (long) addr );
caml_tid = Val_int( (int) tid );
caml_type = Val_int( (int) type );
caml_callback3( *proc_handle_callret, caml_addr, caml_tid, caml_type );
CAMLreturn0;
}
value mk_actual_args(
host_val *args,
int num_args,
char** keywords,
host_val* keyword_values,
int num_keyword_args) {
CAMLparam0();
CAMLlocal3(pos_list, kwd_list, kwd_values_list);
CAMLlocal2(actual_args, ocaml_fn);
printf("Creating host_val args, n_positional = %d, n_kwd = %d\n", num_args, num_keyword_args);
pos_list = build_host_val_list(args, num_args);
kwd_list = build_str_list(keywords, num_keyword_args);
kwd_values_list = build_host_val_list(keyword_values, num_keyword_args);
ocaml_fn = *caml_named_value("mk_actual_args");
actual_args = \
caml_callback3(ocaml_fn, pos_list, kwd_list, kwd_values_list);
CAMLreturn(actual_args);
}
static value __callb3( value a, value b, value c, value callb ) {
return caml_callback3(callb,a,b,c);
}
/* Wrapper for replacing the poll function of glib. It calls the ocaml
wrapper which adds all the file-descriptors that lwt want to
monitor: */
gint lwt_glib_poll(GPollFD *ufds, guint nfds, gint timeout)
{
value pointer = caml_alloc_custom(&pointer_ops, sizeof(GPollFD*), 0, 1);
GPollFD_val(pointer) = ufds;
return Int_val(caml_callback3(*caml_named_value("lwt-glib-select"), pointer, Val_int(nfds), Val_int(timeout)));
}
