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; }