/* Adapted from sundials-2.5.0/src/nvec_par/nvector_parallel.c: N_VCloneEmpty_Parallel */ static N_Vector clone_parallel(N_Vector w) { CAMLparam0(); CAMLlocal2(v_payload, w_payload); N_Vector v; N_VectorContent_Parallel content; if (w == NULL) CAMLreturnT (N_Vector, NULL); w_payload = NVEC_BACKLINK(w); struct caml_ba_array *w_ba = Caml_ba_array_val(Field(w_payload, 0)); /* Create vector (we need not copy the data) */ v_payload = caml_alloc_tuple(3); Store_field(v_payload, 0, caml_ba_alloc(w_ba->flags, w_ba->num_dims, NULL, w_ba->dim)); Store_field(v_payload, 1, Field(w_payload, 1)); Store_field(v_payload, 2, Field(w_payload, 2)); v = sunml_alloc_cnvec(sizeof(struct _N_VectorContent_Parallel), v_payload); if (v == NULL) CAMLreturnT (N_Vector, NULL); content = (N_VectorContent_Parallel) v->content; /* Create vector operation structure */ sunml_clone_cnvec_ops(v, w); /* Attach lengths and communicator */ content->local_length = NV_LOCLENGTH_P(w); content->global_length = NV_GLOBLENGTH_P(w); content->comm = NV_COMM_P(w); content->own_data = 0; content->data = Caml_ba_data_val(Field(v_payload, 0)); CAMLreturnT(N_Vector, v); }
Hunpos hunpos_tagger_new(const char* model_file, const char* morph_table_file, int max_guessed_tags, int theta, int* error) { *error = 0; if(model_file == NULL) { *error = 3; return NULL; } if(morph_table_file == NULL) { morph_table_file = ""; } /* Startup OCaml */ if (is_initialized == 0) { is_initialized = 1; char* dummyargv[2]; dummyargv[0]=""; dummyargv[1]=NULL; caml_startup(dummyargv); } CAMLparam0(); /* get hunpos init function from ocaml */ static value* init_fun; if (init_fun == NULL) { init_fun = caml_named_value("init_from_files"); } Hunpos tagger_fun = (Hunpos) malloc(sizeof(value)); *((value*)tagger_fun) = 0; // we pass some argument to the function CAMLlocalN ( args, 4 ); args[0] = caml_copy_string(model_file); args[1] = caml_copy_string(morph_table_file); args[2] = Val_int(max_guessed_tags); args[3] = Val_int(theta); /* due to the garbage collector we have to register the */ /* returned value not to be deallocated */ caml_register_global_root(tagger_fun); value* t = tagger_fun; *t = caml_callbackN_exn( *init_fun, 4, args ); if (Is_exception_result(*t)) { *error = 1; CAMLreturnT(Hunpos, NULL); } // CAMLreturn1(tagger_fun) CAMLreturnT(Hunpos,tagger_fun); }
static realtype callml_custom_resnorm(SUNLinearSolver ls) { CAMLparam0(); CAMLlocal1(r); r = caml_callback_exn(GET_OP(ls, GET_RES_NORM), Val_unit); if (Is_exception_result (r)) { sunml_warn_discarded_exn (Extract_exception (r), "user-defined res norm handler"); CAMLreturnT(realtype, 0.0); } CAMLreturnT(realtype, Double_val(r)); }
static N_Vector callml_custom_resid(SUNLinearSolver ls) { CAMLparam0(); CAMLlocal1(r); r = caml_callback_exn(GET_OP(ls, GET_RES_ID), Val_unit); if (Is_exception_result (r)) { sunml_warn_discarded_exn (Extract_exception (r), "user-defined res id handler"); CAMLreturnT(N_Vector, NULL); } CAMLreturnT(N_Vector, NVEC_VAL(r)); }
herr_t hdf5_h5l_operator(hid_t group, const char *name, const H5L_info_t *info, void *op_data) { CAMLparam0(); CAMLlocal5(ret, info_v, address_v, args0, args1); CAMLlocal2(args2, args3); value args[4]; struct operator_data *operator_data = op_data; args0 = alloc_h5l(group); args1 = caml_copy_string(name); args2 = Val_h5l_info(info); args3 = *operator_data->operator_data; args[0] = args0; args[1] = args1; args[2] = args2; args[3] = args3; ret = caml_callbackN_exn(*operator_data->callback, 4, args); if (Is_exception_result(ret)) { *(operator_data->exception) = Extract_exception(ret); return -1; } CAMLreturnT(herr_t, H5_iter_val(ret)); }
paranode mk_array(paranode *elts, int num_elts, source_info_t *src_info) { CAMLparam0(); CAMLlocal1(array); array = caml_alloc(1, Exp_Array); Store_field(array, 0, mk_val_list(elts, num_elts)); CAMLreturnT(paranode, mk_node(array, src_info)); }
paranode mk_tuple(paranode *elts, int num_elts, source_info_t *src_info) { CAMLparam0(); CAMLlocal1(tuple); tuple = caml_alloc(1, Exp_Tuple); Store_field(tuple, 0, mk_val_list(elts, num_elts)); CAMLreturnT(paranode, mk_node(tuple, src_info)); }
paranode mk_none(source_info_t *src_info) { CAMLparam0(); CAMLlocal1(v); v = caml_alloc(1, Exp_None); Store_field(v, 0, Val_int(0)); CAMLreturnT(paranode, mk_node(v, src_info)); }
paranode mk_root(value v) { CAMLparam1(v); paranode_t* p = (paranode_t*)malloc(sizeof(paranode_t)); caml_register_global_root(&(p->v)); p->v = v; CAMLreturnT(paranode, p); }
ssize_t recvmmsg_assume_fd_is_nonblocking( value v_fd, struct iovec *iovecs, value v_count, value v_srcs, struct mmsghdr *hdrs) { CAMLparam3(v_fd, v_count, v_srcs); CAMLlocal1(v_sockaddrs); size_t total_len = 0; union sock_addr_union addrs[Int_val(v_count)]; int i; for (i = 0; i < Int_val(v_count); i++) { hdrs[i].msg_hdr.msg_name = (Is_block(v_srcs) ? &addrs[i].s_gen : 0); hdrs[i].msg_hdr.msg_namelen = (Is_block(v_srcs) ? sizeof(addrs[i]) : 0); #if DEBUG fprintf(stderr, "i=%d, count=%d, is_some srcs=%d\n", i, Int_val(v_count), Is_block(v_srcs)); #endif total_len += iovecs[i].iov_len; hdrs[i].msg_hdr.msg_iov = &iovecs[i]; hdrs[i].msg_hdr.msg_iovlen = 1; hdrs[i].msg_hdr.msg_control = 0; hdrs[i].msg_hdr.msg_controllen = 0; hdrs[i].msg_hdr.msg_flags = 0; /* We completely ignore msg_flags and ancillary data (msg_control) for now. In the future, users may be interested in this. */ } ssize_t n_read; /* pszilagyi: This is only 64k in unix_utils.h, which we will very quickly overrun with recvmmsg and then maybe Jumbo frames. bnigito has already observed the Pico feed filling over 32 recvmmsg buffers in a single call, in a test scenario. */ if (total_len > THREAD_IO_CUTOFF) { caml_enter_blocking_section(); n_read = recvmmsg(Int_val(v_fd), hdrs, Int_val(v_count), 0, 0); caml_leave_blocking_section(); } else n_read = recvmmsg(Int_val(v_fd), hdrs, Int_val(v_count), 0, 0); if (n_read == -1) { /* bnigito via pszilagyi: This prototype performance tweak saves the allocation of an exception in common cases, at the cost of conflating reception of an empty message with nothing to do. */ if (errno == EWOULDBLOCK || errno == EAGAIN) n_read = -errno; else uerror("recvmmsg_assume_fd_is_nonblocking", Nothing); } else { if (Is_block(v_srcs)) { /* Some */ v_sockaddrs = Field(v_srcs, 0); for (i = 0; (unsigned)i < n_read && (unsigned)i < Wosize_val(v_sockaddrs); i++) Store_field(v_sockaddrs, i, alloc_sockaddr(&addrs[i], hdrs[i].msg_hdr.msg_namelen, -1)); } } CAMLreturnT(ssize_t, n_read); }
Evas_Event_Flags ml_Elm_Gesture_Event_Cb(void* data, void* event_info) { CAMLparam0(); CAMLlocal1(v_event_info); value* v_fun = data; v_event_info = copy_voidp(event_info); caml_callback(*v_fun, v_event_info); CAMLreturnT(Evas_Event_Flags, EVAS_EVENT_FLAG_ON_HOLD); }
paranode mk_bool_paranode(int b, source_info_t *src_info) { //printf("C: mk_bool: %d\n", b); CAMLparam0(); CAMLlocal1(val); val = caml_alloc(1, PARNUM_BOOL); Store_field(val, 0, Val_int(b)); CAMLreturnT(paranode, mk_num(val, src_info)); }
paranode mk_float_paranode(float f, source_info_t *src_info) { //printf("C: mk_float: %f\n", f); CAMLparam0(); CAMLlocal1(val); val = caml_alloc(1, PARNUM_FLOAT32); Store_field(val, 0, caml_copy_double((double)f)); CAMLreturnT(paranode, mk_num(val, src_info)); }
paranode mk_return(paranode* args, int num_args, source_info_t *src_info) { //printf("C: ast_stubs.mk_return with %d args\n", num_args); CAMLparam0(); CAMLlocal2(ret, ret_args); ret_args = mk_val_list(args, num_args); ret = caml_alloc(1, Exp_Return); Store_field(ret, 0, ret_args); CAMLreturnT(paranode, mk_node(ret, src_info)); }
paranode mk_num(value val, source_info_t *src_info) { CAMLparam1(val); CAMLlocal1(num); num = caml_alloc(1, Exp_Num); Store_field(num, 0, val); CAMLreturnT(paranode, mk_node(num, src_info)); }
paranode mk_int64_paranode(int64_t l, source_info_t *src_info) { CAMLparam0(); CAMLlocal1(val); val = caml_alloc(1, PARNUM_INT64); Store_field(val, 0, caml_copy_int64(l)); CAMLreturnT(paranode, mk_num(val, src_info)); }
paranode mk_str(char *str, source_info_t *src_info) { CAMLparam0(); CAMLlocal1(exp_str); exp_str = caml_alloc(1, Exp_Str); Store_field(exp_str, 0, caml_copy_string(str)); CAMLreturnT(paranode, mk_node(exp_str, src_info)); }
paranode mk_double_paranode(double d, source_info_t *src_info) { //printf("C: mk_double: %f\n", d); CAMLparam0(); CAMLlocal1(val); val = caml_alloc(1, PARNUM_FLOAT64); Store_field(val, 0, caml_copy_double(d)); CAMLreturnT(paranode, mk_num(val, src_info)); }
paranode get_prim(char* prim_name) { CAMLparam0(); CAMLlocal1(prim); // build the var expression prim = caml_callback(*ocaml_get_prim, caml_copy_string(prim_name)); // build the node and return CAMLreturnT(paranode, mk_root(prim)); }
paranode mk_int32_paranode(int32_t i, source_info_t *src_info) { //printf("C: mk_int32: %d\n", i); CAMLparam0(); CAMLlocal1(val); val = caml_alloc(1, PARNUM_INT32); Store_field(val, 0, caml_copy_int32(i)); CAMLreturnT(paranode, mk_num(val, src_info)); }
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)); }
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)); }
paranode mk_block(paranode *stmts, int num_stmts, source_info_t *src_info) { //printf("C: Making you a block of %d statements\n", num_stmts); CAMLparam0(); CAMLlocal2(block, stmt_list); stmt_list = mk_val_list(stmts, num_stmts); block = caml_alloc(1, Exp_Block); Store_field(block, 0, stmt_list); paranode wrapped_block = mk_node(block, src_info); printf("wrapped block: %d (%p)\n", wrapped_block, wrapped_block); printf(" |-- contains value: %d\n", wrapped_block->v); CAMLreturnT(paranode, wrapped_block); }
static DWORD caml_list_length (value lst) { DWORD res; CAMLparam1 (lst); CAMLlocal1 (l); for (res = 0, l = lst; l != Val_int(0); l = Field(l, 1), res++) { } CAMLreturnT(DWORD, res); }
paranode mk_countloop(paranode count, paranode body, source_info_t *src_info) { CAMLparam0(); CAMLlocal3(val_count, val_body, loop); val_count = get_value_and_remove_root(count); val_body = get_value_and_remove_root(body); loop = caml_alloc(2, Exp_CountLoop); Store_field(loop, 0, val_count); Store_field(loop, 1, val_body); CAMLreturnT(paranode, mk_node(loop, src_info)); }
paranode mk_whileloop(paranode test, paranode body, source_info_t *src_info) { CAMLparam0(); CAMLlocal3(val_test, val_body, loop); val_test = get_value_and_remove_root(test); val_body = get_value_and_remove_root(body); loop = caml_alloc(2, Exp_WhileLoop); Store_field(loop, 0, val_test); Store_field(loop, 1, val_body); CAMLreturnT(paranode, mk_node(loop, src_info)); }
ADDRINT check_postdom() { CAMLparam0(); CAMLlocal1( ret ); static value *proc_check_postdom = NULL; if ( !proc_check_postdom ) { proc_check_postdom = caml_named_value( "check_postdom" ); } ret = caml_callback( *proc_check_postdom, Val_unit ); CAMLreturnT( ADDRINT, Nativeint_val( ret ) ); }
CAMLexport caml_root caml_create_root(value init) { CAMLparam1(init); value v = caml_alloc_shr(3, 0); caml_initialize_field(v, 0, init); caml_initialize_field(v, 1, Val_int(1)); caml_plat_lock(&roots_mutex); caml_initialize_field(v, 2, roots_all); roots_all = v; caml_plat_unlock(&roots_mutex); CAMLreturnT(caml_root, (caml_root)v); }
paranode mk_var(char *str, source_info_t *src_info) { //printf("C: mk_var: %s\n", str); CAMLparam0(); CAMLlocal1(var); // build the var expression var = caml_alloc(1, Exp_Var); Store_field(var, 0, caml_copy_string(str)); // build the node and return CAMLreturnT(paranode, mk_node(var, src_info)); }
paranode mk_assign(paranode* lhs, int num_ids, paranode rhs, source_info_t *src_info) { CAMLparam0(); CAMLlocal3(id_list, val_rhs, assignment); id_list = mk_val_list(lhs, num_ids); val_rhs = get_value_and_remove_root(rhs); assignment = caml_alloc(2, Exp_Assign); Store_field(assignment, 0, id_list); Store_field(assignment, 1, val_rhs); CAMLreturnT(paranode, mk_node(assignment, src_info)); }