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));
}
CAMLexport value caml_callback2_exn(value closure, value arg1, value arg2)
{
value arg[2];
arg[0] = arg1;
arg[1] = arg2;
return caml_callbackN_exn(closure, 2, arg);
}
static int jacfn(
realtype t,
N_Vector y,
N_Vector fy,
SlsMat Jac,
void *user_data,
N_Vector tmp1,
N_Vector tmp2,
N_Vector tmp3)
{
CAMLparam0();
CAMLlocalN (args, 2);
CAMLlocal3(session, cb, smat);
WEAK_DEREF (session, *(value*)user_data);
args[0] = sunml_cvode_make_jac_arg (t, y, fy,
sunml_cvode_make_triple_tmp (tmp1, tmp2, tmp3));
cb = CVODE_LS_CALLBACKS_FROM_ML(session);
cb = Field (cb, 0);
// always rewrap without caching (simplified backwards compatibility)
args[1] = sunml_matrix_sparse_wrap(Jac);
/* NB: Don't trigger GC while processing this return value! */
value r = caml_callbackN_exn (Field(cb, 0), 2, args);
CAMLreturnT(int, CHECK_EXCEPTION(session, r, RECOVERABLE));
}
CAMLexport value caml_callback3_exn(value closure,
value arg1, value arg2, value arg3)
{
value arg[3];
arg[0] = arg1;
arg[1] = arg2;
arg[2] = arg3;
return caml_callbackN_exn(closure, 3, arg);
}
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 int jacfn_withsens( /* IDASlsSparseJacFnB */
realtype t,
realtype cjB,
N_Vector yy,
N_Vector yp,
N_Vector *ys,
N_Vector *yps,
N_Vector yyB,
N_Vector ypB,
N_Vector resvalB,
SlsMat jacB,
void *user_data,
N_Vector tmp1B,
N_Vector tmp2B,
N_Vector tmp3B)
{
CAMLparam0();
CAMLlocalN(args, 4);
CAMLlocal4(session, bsensext, cb, smat);
WEAK_DEREF (session, *(value*)user_data);
bsensext = IDA_SENSEXT_FROM_ML(session);
cb = IDA_LS_CALLBACKS_FROM_ML(session);
cb = Field (cb, 0);
args[0] = sunml_idas_make_jac_arg(t, yy, yp, yyB, ypB, resvalB, cjB,
sunml_ida_make_triple_tmp (tmp1B, tmp2B, tmp3B));
int ns = Int_val(Field(bsensext, RECORD_IDAS_BWD_SESSION_NUMSENSITIVITIES));
args[1] = IDAS_BSENSARRAY1_FROM_EXT(bsensext);
sunml_idas_wrap_to_nvector_table(ns, args[1], ys);
args[2] = IDAS_BSENSARRAY2_FROM_EXT(bsensext);
sunml_idas_wrap_to_nvector_table(ns, args[2], yps);
smat = Field(cb, 1);
if (smat == Val_none) {
Store_some(smat, sunml_matrix_sparse_wrap(jacB));
Store_field(cb, 1, smat);
args[3] = Some_val(smat);
} else {
args[3] = Some_val(smat);
sunml_matrix_sparse_rewrap(args[3]);
}
/* NB: Don't trigger GC while processing this return value! */
value r = caml_callbackN_exn (Field(cb, 0), 4, args);
CAMLreturnT(int, CHECK_EXCEPTION(session, r, RECOVERABLE));
}
static int callml_custom_solve(SUNLinearSolver ls, SUNMatrix A, N_Vector x,
N_Vector b, realtype tol)
{
CAMLparam0();
CAMLlocal1(r);
CAMLlocalN(args, 4);
Store_field(args, 0, (A == NULL) ? Val_unit : MAT_BACKLINK(A));
Store_field(args, 1, NVEC_BACKLINK(x));
Store_field(args, 2, NVEC_BACKLINK(b));
Store_field(args, 3, caml_copy_double(tol));
r = caml_callbackN_exn(GET_OP(ls, SOLVE), 4, args);
CAMLreturnT(int, CHECK_EXCEPTION_SUCCESS(r));
}
static void
event_callback_wrapper_locked (guestfs_h *g,
void *data,
uint64_t event,
int event_handle,
int flags,
const char *buf, size_t buf_len,
const uint64_t *array, size_t array_len)
{
CAMLparam0 ();
CAMLlocal5 (gv, evv, ehv, bufv, arrayv);
CAMLlocal2 (rv, v);
value *root;
size_t i;
root = guestfs_get_private (g, "_ocaml_g");
gv = *root;
/* Only one bit should be set in 'event'. Which one? */
evv = Val_int (event_bitmask_to_event (event));
ehv = Val_int (event_handle);
bufv = caml_alloc_string (buf_len);
memcpy (String_val (bufv), buf, buf_len);
arrayv = caml_alloc (array_len, 0);
for (i = 0; i < array_len; ++i) {
v = caml_copy_int64 (array[i]);
Store_field (arrayv, i, v);
}
value args[5] = { gv, evv, ehv, bufv, arrayv };
rv = caml_callbackN_exn (*(value*)data, 5, args);
/* Callbacks shouldn't throw exceptions. There's not much we can do
* except to print it.
*/
if (Is_exception_result (rv))
fprintf (stderr,
"libguestfs: uncaught OCaml exception in event callback: %s",
caml_format_exception (Extract_exception (rv)));
CAMLreturn0;
}
static int
visitor_function_wrapper (const char *dir,
const char *filename,
const struct guestfs_statns *stat,
const struct guestfs_xattr_list *xattrs,
void *opaque)
{
CAMLparam0 ();
CAMLlocal5 (dirv, filenamev, statv, xattrsv, v);
struct visitor_function_wrapper_args *args = opaque;
assert (dir != NULL);
assert (stat != NULL);
assert (xattrs != NULL);
assert (args != NULL);
dirv = caml_copy_string (dir);
if (filename == NULL)
filenamev = Val_int (0); /* None */
else {
filenamev = caml_alloc (1, 0);
v = caml_copy_string (filename);
Store_field (filenamev, 0, v);
}
statv = copy_statns (stat);
xattrsv = copy_xattr_list (xattrs);
/* Call the visitor_function. */
value argsv[4] = { dirv, filenamev, statv, xattrsv };
v = caml_callbackN_exn (*args->fvp, 4, argsv);
if (Is_exception_result (v)) {
/* The visitor_function raised an exception. Store the exception
* in the 'exn' field on the stack of guestfs_int_mllib_visit, and
* return an error.
*/
*args->exnp = Extract_exception (v);
return -1;
}
/* No error, return normally. */
CAMLreturnT (int, 0);
}
static int jacfn_nosens( /* IDASlsSparseJacFnB */
realtype t,
realtype cjB,
N_Vector yy,
N_Vector yp,
N_Vector yyB,
N_Vector ypB,
N_Vector resvalB,
SlsMat jacB,
void *user_data,
N_Vector tmp1B,
N_Vector tmp2B,
N_Vector tmp3B)
{
CAMLparam0();
CAMLlocalN(args, 2);
CAMLlocal3(session, cb, smat);
WEAK_DEREF (session, *(value*)user_data);
cb = IDA_LS_CALLBACKS_FROM_ML(session);
cb = Field (cb, 0);
args[0] = sunml_idas_make_jac_arg(t, yy, yp, yyB, ypB, resvalB, cjB,
sunml_ida_make_triple_tmp (tmp1B, tmp2B, tmp3B));
smat = Field(cb, 1);
if (smat == Val_none) {
Store_some(smat, sunml_matrix_sparse_wrap(jacB));
Store_field(cb, 1, smat);
args[1] = Some_val(smat);
} else {
args[1] = Some_val(smat);
sunml_matrix_sparse_rewrap(args[1]);
}
/* NB: Don't trigger GC while processing this return value! */
value r = caml_callbackN_exn (Field(cb, 0), 2, args);
CAMLreturnT(int, CHECK_EXCEPTION(session, r, RECOVERABLE));
}
CAMLexport value caml_callback_exn(value closure, value arg1)
{
value arg[1];
arg[0] = arg1;
return caml_callbackN_exn(closure, 1, arg);
}
CAMLexport value caml_callbackN (value closure, int narg, value args[])
{
value res = caml_callbackN_exn(closure, narg, args);
if (Is_exception_result(res)) caml_raise(Extract_exception(res));
return res;
}
