value* val_interval(int i, int j)
{
value v;
CLOSURE("Fd.interval");
v = caml_callback2(*closure, Val_int(i), Val_int(j));
return fcl_wrap(v);
}
void ml_xt_callback( Widget w, XtPointer cb_index, XtPointer cb_data )
{
caml_leave_blocking_section();
caml_callback2( caml_xt_cb, (value) cb_index, (value) cb_data );
//caml_callback( caml_xt_cb, (value) cb_index );
caml_enter_blocking_section();
}
CAMLprim void p_print_int_test(value b, value num) {
CAMLparam2(b, num);
intnat x = Long_val(num);
static value *buffer_add_char = NULL;
if(buffer_add_char == NULL) {
buffer_add_char = caml_named_value("Buffer__add_char");
if(buffer_add_char == NULL) {
caml_failwith("Could not find Buffer.add_char");
}
}
if(x < 0) {
caml_callback2(*buffer_add_char, b, Val_int((int)'-'));
// TODO: min_int
if(x == (1 << (8 * SIZEOF_PTR - 2))) {
intnat div_me = x / 10;
intnat mod_me = x % 10;
p_do_enough(b, (uintnat)(-div_me), buffer_add_char);
p_do_enough(b, (uintnat)(-mod_me), buffer_add_char);
} else {
p_do_enough(b, (uintnat)(-x), buffer_add_char);
}
} else {
p_do_enough(b, (uintnat)x, buffer_add_char);
}
CAMLreturn0;
}
value* cstr_ge(value* in1, value* in2)
{
value a;
CLOSURE ("ge");
a = caml_callback2(*closure, *in1, *in2);
return fcl_wrap(a);
}
value* cstr_and(value* in1, value* in2)
{
value a;
CLOSURE ("Cstr.and");
a = caml_callback2(*closure, *in1, *in2);
return fcl_wrap(a);
}
PREFIX void ml_Evas_Smart_Cb(void *data, Evas_Object *obj, void *event_info)
{
value *v_fun = (value*) data;
caml_callback2(*v_fun, (value) obj, (value) event_info);
}
value* arith_mul(value* val1, value* val2)
{
value a;
CLOSURE("arith_mul");
a = caml_callback2(*closure, *val1, *val2);
return fcl_wrap(a);
}
value caml_create_QQmlPropertyMap(value _func, value _unit) {
CAMLparam2(_func, _unit);
CAMLlocal1(_ans);
value *fv = (value*) malloc(sizeof(_func));
*fv = _func;
caml_register_global_root(fv);
CamlPropertyMap *propMap = new CamlPropertyMap();
_ans = caml_alloc_custom(&camlpropertymap_ops, sizeof(CamlPropertyMap*), 0, 1);
(*((CamlPropertyMap **) Data_custom_val(_ans))) = propMap;
propMap->saveCallback(fv);
QObject::connect(propMap, &CamlPropertyMap::valueChanged,
[fv](const QString& propName, const QVariant& var) {
caml_leave_blocking_section();
[&fv, &propName, &var]() {
CAMLparam0();
CAMLlocal2(_nameArg, _variantArg);
_nameArg = caml_copy_string( propName.toLocal8Bit().data() );
caml_callback2(*fv, _nameArg, Val_QVariant(_variantArg, var) );
CAMLreturn0;
}();
caml_enter_blocking_section();
} );
CAMLreturn(_ans);
}
PREFIX void ml_Evas_Smart_Cb_1(void *data, Evas_Object *obj, void *event_info)
{
value* v_data = (value*) data;
value v_fun = Field(*v_data, 1);
caml_callback2(v_fun, (value) obj, (value) event_info);
}
int add_two(int x, int y) {
/* if the shared lib is being loaded for the first time, call the OCaml initialization */
if (caml_add_two == NULL) {
caml_startup(NULL); /* no argv */
caml_add_two = caml_named_value("caml_add_two");
}
return Int_val(caml_callback2(*caml_add_two, Val_int(x), Val_int(y)));
}
static uint64 on_error (utp_callback_arguments *a)
{
CAMLparam0 ();
static value *on_error_fun = NULL;
if (on_error_fun == NULL) on_error_fun = caml_named_value ("utp_on_error");
caml_callback2 (*on_error_fun, Val_utp_socket (a->socket), Val_int (a->error_code));
CAMLreturn (0);
}
PREFIX void ml_Evas_Object_Box_Layout_0(
Evas_Object* obj, Evas_Object_Box_Data* priv, void* user_data)
{
CAMLparam0();
CAMLlocal1(v_fun);
value* v_user_data = (value*) user_data;
v_fun = Field(*v_user_data, 0);
caml_callback2(v_fun, (value) obj, (value) priv);
CAMLreturn0;
}
PREFIX void ml_Elm_Transit_Effect_Transition_Cb(
Elm_Transit_Effect* effect, Elm_Transit* tr, double progress)
{
CAMLparam0();
CAMLlocal1(v_progress);
value* v_fun = (value*) effect;
v_progress = copy_double(progress);
caml_callback2(*v_fun, (value) tr, v_progress);
CAMLreturn0;
}
int goals_array_solve(value** val, long len, heuristic h)
{
value array;
size_t i = 0;
CLOSURE("Goals.Array.solve");
// À la barbare
array = caml_alloc(len, 0);
for(; i < len; ++i)
Store_field(array, i, val[i][0]);
return Bool_val(caml_callback2(*closure, array, Val_int(h)));
}
Eina_Bool ml_Elm_Gen_Item_State_Get_Cb(
void* data, Evas_Object* obj, const char* part)
{
CAMLparam0();
CAMLlocal3(v_obj, v_part, v);
value* v_class = data;
v_obj = copy_Evas_Object(obj);
v_part = copy_string(part);
v = caml_callback2(Field(*v_class, 3), v_obj, v_part);
CAMLreturnT(Eina_Bool, Eina_Bool_val(v));
}
void caml_fatal_uncaught_exception(value exn)
{
caml_root handle_uncaught_exception =
caml_named_root("Printexc.handle_uncaught_exception");
if (handle_uncaught_exception)
/* [Printexc.handle_uncaught_exception] does not raise exception. */
caml_callback2(caml_read_root(handle_uncaught_exception), exn, Val_bool(DEBUGGER_IN_USE));
else
default_fatal_uncaught_exception(exn);
/* Terminate the process */
exit(2);
}
Evas_Object* ml_Elm_Gen_Item_Content_Get_Cb(
void* data, Evas_Object* obj, const char* part)
{
CAMLparam0();
CAMLlocal3(v_obj, v_part, v);
value* v_class = data;
v_part = copy_string(part);
v_obj = copy_Evas_Object(obj);
v = caml_callback2(Field(*v_class, 2), v_obj, v_part);
if(v == Val_int(0)) CAMLreturnT(Evas_Object*, NULL);
else CAMLreturnT(Evas_Object*, Evas_Object_val(Field(v, 0)));
}
static uint64 on_read (utp_callback_arguments* a)
{
CAMLparam0 ();
CAMLlocal1 (ba);
static value *on_read_fun = NULL;
if (on_read_fun == NULL) on_read_fun = caml_named_value ("utp_on_read");
ba = caml_ba_alloc_dims (CAML_BA_UINT8 | CAML_BA_C_LAYOUT, 1, (void *) a->buf, a->len);
caml_callback2 (*on_read_fun, Val_utp_socket (a->socket), ba);
utp_read_drained (a->socket);
CAMLreturn (0);
}
char* ml_Elm_Gen_Item_Text_Get_Cb(
void* data, Evas_Object* obj, const char* part)
{
CAMLparam0();
CAMLlocal3(v_obj, v_part, v);
value* v_class = data;
v_obj = copy_Evas_Object(obj);
v_part = copy_string(part);
v = caml_callback2(Field(*v_class, 1), v_obj, v_part);
char* r = strdup(String_val(v));
if(r == NULL) caml_raise_out_of_memory();
CAMLreturnT(char*, r);
}
static void typefind_element_have_type_cb(GstElement *_typefind, guint probability, GstCaps *caps, gpointer user_data)
{
typefind_element *tf = (typefind_element*)user_data;
assert(_typefind);
assert(caps);
//For some reason, we segfault if we register the C thread (I guess the implementation is monothreaded?)
/* caml_c_thread_register(); */
caml_acquire_runtime_system();
caml_callback2(tf->have_type_cb, Val_int(probability), value_of_caps(caps));
caml_release_runtime_system();
/* caml_c_thread_unregister(); */
}
int goals_array_solve_bt(value** val, long len, heuristic h, long* bt)
{
value array, v;
size_t i = 0;
CLOSURE("Goals.Array.solve_bt");
// À la barbare
array = caml_alloc(len, 0);
for(; i < len; ++i)
Store_field(array, i, val[i][0]);
v = caml_callback2(*closure, array, Val_int(h));
*bt = Int_val(Field(v, 1));
return Bool_val(Field(v, 0));
}
static void ml_gsl_error_handler(const char *reason, const char *file,
int line, int gsl_errno)
{
value exn_msg;
int ml_errno;
if (0 < gsl_errno && gsl_errno <= GSL_EOF)
ml_errno = gsl_errno + 1;
else if (GSL_CONTINUE <= gsl_errno && gsl_errno <= GSL_FAILURE)
ml_errno = gsl_errno + 2;
else
failwith("invalid GSL error code");
exn_msg = caml_copy_string(reason);
caml_callback2(Field(*ml_gsl_err_handler,0), Val_int(ml_errno), exn_msg);
}
void QWidget_twin::keyPressEvent(QKeyEvent *ev) {
CAMLparam0();
CAMLlocal3(meth,camlobj,_ev);
GET_CAML_OBJECT(this,camlobj); // get ocaml object from QObject's property
printf ("inside QWidget_twin::keyPressedEvent, camlobj = %p, this=%p\n", (void*)camlobj, this);
meth = caml_get_public_method( camlobj, caml_hash_variant("keyPressEvent"));
if (meth==0)
printf ("total fail\n");
printf ("tag of meth is %d\n", Tag_val(meth) );
printf("calling callback of meth = %p\n",(void*)meth);
setAbstrClass(_ev,QKeyEvent,ev);
value *caller = caml_named_value("make_qKeyEvent");
_ev = caml_callback(*caller, _ev);
caml_callback2(meth, camlobj,_ev);
printf ("exit from QWidget_twin::keyPressedEvent\n");
CAMLreturn0;
}
value* gcc_cstr(value* array, value** cards, long* values, long len)
{
value a, distribution;
size_t i = 0;
CLOSURE("Gcc.cstr");
distribution = caml_alloc(len, 0);
for(; i<len; ++i)
{
value b = caml_alloc(2, 0);
Store_field(b, 0, cards[i]);
Store_field(b, 1, Val_long(values[i]));
Store_field(distribution, i, b);
}
a = caml_callback2(*closure, *array, distribution);
return fcl_wrap(a);
}
void caml_fatal_uncaught_exception(value exn)
{
const value* handle_uncaught_exception =
caml_named_value("Printexc.handle_uncaught_exception");
if (handle_uncaught_exception)
/* [Printexc.handle_uncaught_exception] does not raise exception. */
caml_callback2(*handle_uncaught_exception, exn, Val_bool(DEBUGGER_IN_USE));
else
default_fatal_uncaught_exception(exn);
/* Terminate the process */
if (caml_abort_on_uncaught_exn) {
abort();
} else {
CAML_SYS_EXIT(2);
exit(2); /* Second exit needed for the Noreturn flag */
}
}
int goals_minimize(value** val, long len, value* expr, long* solution,
long* optimal)
{
value array, res;
size_t i = 0;
CLOSURE("Goals.minimize");
// À la barbare
array = caml_alloc(len, 0);
for(; i < len; ++i)
Store_field(array, i, val[i][0]);
res = caml_callback2(*closure, array, *expr);
if (res == Val_int(0))
return 0;
for (i=0; i < Wosize_val(Field(Field(res, 0), 1)); ++i)
solution[i] = Int_val(Field(Field(Field(res,0), 1), i));
*optimal = Int_val(Field(Field(res,0), 0));
return 1;
}
SRes ml_sevenzip_seek(void *object, CFileSize pos, ESzSeek origin)
{
CFileInStream *archive_in = (CFileInStream *) object;
CAMLparam0 ();
CAMLlocal3 (readable, seek, term);
readable = archive_in->readable;
seek = Field(readable, 1);
switch (origin) {
case SZ_SEEK_SET: term = Val_int(0); break;
case SZ_SEEK_CUR: term = Val_int(1); break;
case SZ_SEEK_END: term = Val_int(2); break;
}
caml_callback2(seek, Val_int(pos), term);
/* The GC might have moved the readable pointer */
archive_in->readable = readable;
CAMLreturnT(SRes, SZ_OK);
}
static value __caml_callb2( value a, value b ) {
return caml_callback2(*caml_named_value("dlcallb2"),a,b);
}
static value __callb2( value a, value b, value callb ) {
return caml_callback2(callb,a,b);
}
void p_do_enough(value b, uintnat y, value *buffer_add_char) {
CAMLparam1(b);
unsigned int q;
/*
static value *buffer_add_char = NULL;
if(buffer_add_char == NULL) {
buffer_add_char = caml_named_value("Buffer.add_char");
}
*/
if(y >= 100000) {
uintnat div_me = y / 100000;
uintnat mod_me = y % 100000;
p_do_enough(b, div_me, buffer_add_char);
y = mod_me;
goto P_DO_ENOUGH_5;
/*
} else if(y >= 10000) {
goto P_DO_ENOUGH_5;
} else if(y >= 1000) {
goto P_DO_ENOUGH_4;
} else if(y >= 100) {
goto P_DO_ENOUGH_3;
} else if(y >= 10) {
goto P_DO_ENOUGH_2;
} else {
goto P_DO_ENOUGH_1;
}
*/
} else if(y < 10000) {
if(y < 1000) {
if(y < 100) {
if(y < 10) {
goto P_DO_ENOUGH_1;
} else {
goto P_DO_ENOUGH_2;
}
} else {
goto P_DO_ENOUGH_3;
}
} else {
goto P_DO_ENOUGH_4;
}
} else {
goto P_DO_ENOUGH_5;
}
P_DO_ENOUGH_5:
q = y / 10000;
y = y % 10000;
if(buffer_add_char == NULL) {printf("FAIL\n");}
caml_callback2(*buffer_add_char, b, Val_int(q + 48));
P_DO_ENOUGH_4:
q = y / 1000;
y = y % 1000;
if(buffer_add_char == NULL) {printf("FAIL\n");}
caml_callback2(*buffer_add_char, b, Val_int(q + 48));
P_DO_ENOUGH_3:
q = y / 100;
y = y % 100;
if(buffer_add_char == NULL) {printf("FAIL\n");}
caml_callback2(*buffer_add_char, b, Val_int(q + 48));
P_DO_ENOUGH_2:
q = y / 10;
y = y % 10;
if(buffer_add_char == NULL) {printf("FAIL\n");}
caml_callback2(*buffer_add_char, b, Val_int(q + 48));
P_DO_ENOUGH_1:
q = y / 1;
y = y % 1;
if(buffer_add_char == NULL) {printf("FAIL\n");}
caml_callback2(*buffer_add_char, b, Val_int(q + 48));
CAMLreturn0;
}
