/* 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));
}
