CAMLprim value getFileInfos (value path, value need_size) {
#ifdef __APPLE__
CAMLparam1(path);
CAMLlocal3(res, fInfo, length);
int retcode;
struct attrlist attrList;
unsigned long options = FSOPT_REPORT_FULLSIZE;
struct {
u_int32_t length;
char finderInfo [32];
off_t rsrcLength;
} __attribute__ ((packed)) attrBuf;
attrList.bitmapcount = ATTR_BIT_MAP_COUNT;
attrList.reserved = 0;
attrList.commonattr = ATTR_CMN_FNDRINFO;
attrList.volattr = 0; /* volume attribute group */
attrList.dirattr = 0; /* directory attribute group */
if (Bool_val (need_size))
attrList.fileattr = ATTR_FILE_RSRCLENGTH; /* file attribute group */
else
attrList.fileattr = 0;
attrList.forkattr = 0; /* fork attribute group */
retcode = getattrlist(String_val (path), &attrList, &attrBuf,
sizeof attrBuf, options);
if (retcode == -1) uerror("getattrlist", path);
if (Bool_val (need_size)) {
if (attrBuf.length != sizeof attrBuf)
unix_error (EINVAL, "getattrlist", path);
} else {
if (attrBuf.length != sizeof (u_int32_t) + 32)
unix_error (EINVAL, "getattrlist", path);
}
fInfo = alloc_string (32);
memcpy (String_val (fInfo), attrBuf.finderInfo, 32);
if (Bool_val (need_size))
length = copy_int64 (attrBuf.rsrcLength);
else
length = copy_int64 (0);
res = alloc_small (2, 0);
Field (res, 0) = fInfo;
Field (res, 1) = length;
CAMLreturn (res);
#else
unix_error (ENOSYS, "getattrlist", path);
#endif
}
static value val_of_result_pair (gsl_sf_result *re, gsl_sf_result *im)
{
CAMLparam0 ();
CAMLlocal3 (v, v_re, v_im);
v_re = val_of_result (re);
v_im = val_of_result (im);
v = alloc_small (2, 0);
Field (v, 0) = v_re;
Field (v, 1) = v_im;
CAMLreturn (v);
}
CAMLprim value caml_sys_get_argv(value unit)
{
CAMLparam0 (); /* unit is unused */
CAMLlocal3 (exe_name, argv, res);
exe_name = caml_copy_string(caml_exe_name);
argv = caml_copy_string_array((char const **) caml_main_argv);
res = caml_alloc_small(2, 0);
Field(res, 0) = exe_name;
Field(res, 1) = argv;
CAMLreturn(res);
}
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 QWidget_twin::acceptDrops() {
CAMLparam0();
CAMLlocal3(camlobj,_ans,meth);
printf("Calling QSpinBox::acceptDrops of object = %p\n",this);
GET_CAML_OBJECT(this,the_caml_object)
camlobj = (value) the_caml_object;
meth = caml_get_public_method( camlobj, caml_hash_variant("acceptDrops"));
assert(meth!=0);
_ans = caml_callback(meth, camlobj);;
bool ans = Bool_val(_ans);;
CAMLreturnT(bool,ans);
}
struct ev_info *process_debug_events(code_t code_start, value events_heap, mlsize_t *num_events) {
CAMLparam1(events_heap);
CAMLlocal3(l, ev, ev_start);
mlsize_t i, j;
struct ev_info *events;
/* Compute the size of the required event buffer. */
*num_events = 0;
for (i = 0; i < caml_array_length(events_heap); i++)
for (l = Field(events_heap, i); l != Val_int(0); l = Field(l, 1))
(*num_events)++;
events = malloc(*num_events * sizeof(struct ev_info));
if(events == NULL)
caml_fatal_error ("caml_add_debug_info: out of memory");
j = 0;
for (i = 0; i < caml_array_length(events_heap); i++) {
for (l = Field(events_heap, i); l != Val_int(0); l = Field(l, 1)) {
ev = Field(l, 0);
events[j].ev_pc = (code_t)((char*)code_start + Long_val(Field(ev, EV_POS)));
ev_start = Field(Field(ev, EV_LOC), LOC_START);
{
uintnat fnsz = caml_string_length(Field(ev_start, POS_FNAME)) + 1;
events[j].ev_filename = (char*)malloc(fnsz);
if(events[j].ev_filename == NULL)
caml_fatal_error ("caml_add_debug_info: out of memory");
memcpy(events[j].ev_filename,
String_val(Field(ev_start, POS_FNAME)),
fnsz);
}
events[j].ev_lnum = Int_val(Field(ev_start, POS_LNUM));
events[j].ev_startchr =
Int_val(Field(ev_start, POS_CNUM))
- Int_val(Field(ev_start, POS_BOL));
events[j].ev_endchr =
Int_val(Field(Field(Field(ev, EV_LOC), LOC_END), POS_CNUM))
- Int_val(Field(ev_start, POS_BOL));
j++;
}
}
Assert(j == *num_events);
qsort(events, *num_events, sizeof(struct ev_info), cmp_ev_info);
CAMLreturnT(struct ev_info *, events);
}
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 inline value val_of_result_e10(gsl_sf_result_e10 *result)
{
CAMLparam0();
CAMLlocal3(r, v, e) ;
v = copy_double(result->val);
e = copy_double(result->err);
r = alloc_small(3, 0);
Field(r, 0) = v;
Field(r, 1) = e;
Field(r, 2) = Val_int(result->e10);
CAMLreturn(r);
}
static void read_main_debug_info(struct debug_info *di)
{
CAMLparam0();
CAMLlocal3(events, evl, l);
char_os *exec_name;
int fd, num_events, orig, i;
struct channel *chan;
struct exec_trailer trail;
CAMLassert(di->already_read == 0);
di->already_read = 1;
if (caml_params->cds_file != NULL) {
exec_name = (char_os*) caml_params->cds_file;
} else {
exec_name = (char_os*) caml_params->exe_name;
}
fd = caml_attempt_open(&exec_name, &trail, 1);
if (fd < 0){
caml_fatal_error ("executable program file not found");
CAMLreturn0;
}
caml_read_section_descriptors(fd, &trail);
if (caml_seek_optional_section(fd, &trail, "DBUG") != -1) {
chan = caml_open_descriptor_in(fd);
num_events = caml_getword(chan);
events = caml_alloc(num_events, 0);
for (i = 0; i < num_events; i++) Op_val(events)[i] = Val_unit;
for (i = 0; i < num_events; i++) {
orig = caml_getword(chan);
evl = caml_input_val(chan);
caml_input_val(chan); /* Skip the list of absolute directory names */
/* Relocate events in event list */
for (l = evl; l != Val_int(0); l = Field_imm(l, 1)) {
value ev = Field_imm(l, 0);
Store_field (ev, EV_POS, Val_long(Long_val(Field(ev, EV_POS)) + orig));
}
/* Record event list */
Store_field(events, i, evl);
}
caml_close_channel(chan);
di->events = process_debug_events(caml_start_code, events, &di->num_events);
}
CAMLreturn0;
}
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));
}
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);
}
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));
}
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));
}
char * range_compress(const char ** c_nodes, const char* c_separator) {
CAMLparam0();
CAMLlocal3(caml_result, caml_nodes, caml_separator);
caml_nodes = copy_string_array(c_nodes);
caml_separator = caml_copy_string(c_separator);
caml_result = callback2_exn(*cb_range_compress, caml_nodes, caml_separator);
if (range_set_exception(caml_result))
CAMLreturn(NULL);
else
CAMLreturn(strdup(String_val(caml_result)));
}
CAMLprim value spoc_cublasSscal (value n, value alpha, value x, value incx, value dev){
CAMLparam5(n, alpha, x,incx, dev);
CAMLlocal3(dev_vec_array, dev_vec, gi);
CUdeviceptr d_A;
int id;
GET_VEC(x, d_A);
CUBLAS_GET_CONTEXT;
cublasSscal(Int_val(n), (float)(Double_val(alpha)), (float*)d_A, Int_val(incx));
CUBLAS_CHECK_CALL(cublasGetError());
CUDA_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
CAMLprim value spoc_cublasIsamin(value n, value x, value incx, value dev){
CAMLparam4(n,x,incx, dev);
CAMLlocal3(dev_vec_array, dev_vec, gi);
int res;
int id;
CUdeviceptr d_A;
GET_VEC(x, d_A);
CUBLAS_GET_CONTEXT;
res = cublasIsamin(Int_val(n), (float*)d_A, Int_val(incx));
CUBLAS_CHECK_CALL(cublasGetError());
CUDA_RESTORE_CONTEXT;
CAMLreturn(Val_int(res));
}
CAMLprim value netsys_poll_event_sources(value pav, value tmov)
{
#ifdef HAVE_POLL_AGGREG
struct poll_aggreg *pa;
int code;
int tmo;
int k;
int e;
#ifdef USABLE_EPOLL
struct epoll_event ee[EPOLL_NUM];
#endif
CAMLparam2(pav, tmov);
CAMLlocal3(r, r_item, r_cons);
tmo = Int_val(tmov);
pa = *(Poll_aggreg_val(pav));
#ifdef USABLE_EPOLL
caml_enter_blocking_section();
code = epoll_wait(pa->fd, ee, EPOLL_NUM, tmo);
e = errno;
caml_leave_blocking_section();
if (code == -1) unix_error(e, "epoll_wait", Nothing);
r = Val_int(0);
for (k=0; k<code; k++) {
if (ee[k].data.u64 == 1) { /* This is the reserved cancel_fd */
uint64_t buf;
int p;
p = read(pa->cancel_fd, (char *) &buf, 8);
}
else {
r_item = caml_alloc(3,0);
Store_field(r_item, 0, Val_long(ee[k].data.u64 >> 1));
Store_field(r_item, 1, Val_long(0)); /* i.e. mask = 0 */
Store_field(r_item, 2,
Val_int(translate_to_poll_events(ee[k].events)));
r_cons = caml_alloc(2,0);
Store_field(r_cons, 0, r_item);
Store_field(r_cons, 1, r);
r = r_cons;
}
};
#endif
CAMLreturn(r);
#else
invalid_argument("Netsys_posix.pull_event_sources not available");
#endif
}
CAMLprim value caml_modf_float_r(CAML_R, value f)
{
double frem;
CAMLparam1 (f);
CAMLlocal3 (res, quo, rem);
quo = caml_copy_double_r(ctx, modf (Double_val(f), &frem));
rem = caml_copy_double_r(ctx, frem);
res = caml_alloc_tuple_r(ctx, 2);
Field(res, 0) = quo;
Field(res, 1) = rem;
CAMLreturn (res);
}
static int callml_custom_setscalingvectors(SUNLinearSolver ls,
N_Vector s1, N_Vector s2)
{
CAMLparam0();
CAMLlocal3(r, ss1, ss2);
ss1 = Val_none;
if (s1 != NULL) Store_some(ss1, NVEC_BACKLINK(s1));
ss2 = Val_none;
if (s2 != NULL) Store_some(ss2, NVEC_BACKLINK(s2));
r = caml_callback2_exn(GET_OP(ls, SET_SCALING_VECTORS), ss1, ss2);
CAMLreturnT(int, CHECK_EXCEPTION_SUCCESS(r));
}
value build_host_val_list(host_val *vals, int num_vals) {
CAMLparam0();
CAMLlocal3(old_tail, new_tail, elt);
old_tail = Val_int(0);
int i;
for (i = num_vals - 1; i >= 0; i--) {
elt = host_val_contents(vals[i]);
new_tail = caml_alloc_tuple(2);
Store_field(new_tail, 0, elt);
Store_field(new_tail, 1, old_tail);
old_tail = new_tail;
}
CAMLreturn(old_tail);
}
CAMLprim value caml_modf_float(value f)
{
double frem;
CAMLparam1 (f);
CAMLlocal3 (res, quo, rem);
quo = caml_copy_double(modf (Double_val(f), &frem));
rem = caml_copy_double(frem);
res = caml_alloc_tuple(2);
Init_field(res, 0, quo);
Init_field(res, 1, rem);
CAMLreturn (res);
}
inline value copy_Eina_List_Elm_Map_Overlay(const Eina_List* list)
{
CAMLparam0();
CAMLlocal3(v, v1, v_overlay);
Eina_List* it;
Elm_Map_Overlay* overlay;
v = Val_int(0);
EINA_LIST_REVERSE_FOREACH(list, it, overlay) {
v1 = v;
v = caml_alloc(2, 0);
v_overlay = copy_Elm_Map_Overlay(overlay);
Store_field(v, 0, v_overlay);
Store_field(v, 1, v1);
}
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));
}
PREFIX value ml_Elm_Gesture_Line_Info_of_ptr(value v_ptr)
{
CAMLparam1(v_ptr);
CAMLlocal3(v_momentum, v_angle, v_info);
Elm_Gesture_Line_Info* info = voidp_val(v_ptr);
v_info = caml_alloc(2, 0);
Elm_Gesture_Momentum_Info* momentum = &(info->momentum);
v_momentum = copy_Elm_Gesture_Momentum_Info(momentum);
v_angle = copy_double(info->angle);
Store_field(v_info, 0,
ml_Elm_Gesture_Momentum_Info_of_ptr(v_momentum));
Store_field(v_info, 1, v_angle);
CAMLreturn(v_info);
}
static inline value mk_unix_error_exn(int errcode, char *cmdname, value cmdarg)
{
CAMLparam0();
CAMLlocal3(name, err, arg);
value res;
arg = cmdarg == Nothing ? caml_copy_string("") : cmdarg;
name = caml_copy_string(cmdname);
err = unix_error_of_code(errcode);
res = caml_alloc_small(4, 0);
Field(res, 0) = *unix_error_exn;
Field(res, 1) = err;
Field(res, 2) = name;
Field(res, 3) = arg;
CAMLreturn(res);
}
CAMLprim value spoc_cublasCaxpy (value n, value alpha, value x, value incx, value y, value incy, value dev){
CAMLparam5(n,alpha, x,incx, y);
CAMLxparam2(incy, dev);
CAMLlocal3(dev_vec_array, dev_vec, gi);
CUdeviceptr d_A;
CUdeviceptr d_B;
int id;
GET_VEC(x, d_A);
GET_VEC(y, d_B);
CUBLAS_GET_CONTEXT;
cublasCaxpy(Int_val(n), Complex_val(alpha), (cuComplex*)d_A, Int_val(incx), (cuComplex*)d_B, Int_val(incy));
CUBLAS_CHECK_CALL(cublasGetError());
CUDA_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
CAMLprim value spoc_cublasScopy (value n, value x, value incx, value y, value incy, value dev){
CAMLparam5(n,x,incx, y, incy);
CAMLxparam1(dev);
CAMLlocal3(dev_vec_array, dev_vec, gi);
int id;
CUdeviceptr d_A;
CUdeviceptr d_B;
GET_VEC(x, d_A);
GET_VEC(y, d_B);
CUBLAS_GET_CONTEXT;
cublasScopy(Int_val(n), (float*)d_A, Int_val(incx), (float*)d_B, Int_val(incy));
CUBLAS_CHECK_CALL(cublasGetError());
CUDA_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
//onMouseClicked: string->unit
void Controller::onMouseClicked(QString x0) {
CAMLparam0();
CAMLlocal3(_ans,_meth,_x0);
CAMLlocalN(_args,2);
CAMLlocal1(_cca0);
value _camlobj = this->_camlobjHolder;
Q_ASSERT(Is_block(_camlobj));
Q_ASSERT(Tag_val(_camlobj) == Object_tag);
_meth = caml_get_public_method(_camlobj, caml_hash_variant("onMouseClicked"));
_args[0] = _camlobj;
_cca0 = caml_copy_string(x0.toLocal8Bit().data() );
_args[1] = _cca0;
caml_callbackN(_meth, 2, _args);
CAMLreturn0;
}
CAMLprim value ml_gsl_sf_lnbeta_sgn_e(value x, value y)
{
gsl_sf_result res;
double sgn;
gsl_sf_lnbeta_sgn_e(Double_val(x), Double_val(y), &res, &sgn);
{
CAMLparam0();
CAMLlocal3(v,r,s);
r=val_of_result(&res);
s=copy_double(sgn);
v=alloc_small(2, 0);
Field(v, 0)=r;
Field(v, 1)=s;
CAMLreturn(v);
}
}
static void
camluv_check_cb(uv_check_t* uv_handle, int status)
{
camluv_enter_callback();
CAMLlocal3(check_cb, camluv_handle, camluv_status);
camluv_check_t *camluv_check =(camluv_check_t *)(uv_handle->data);
check_cb = camluv_check->check_cb;
camluv_handle = camluv_copy_check(camluv_check);
camluv_status = Val_int(status);
callback2(check_cb, camluv_handle, camluv_status);
camluv_leave_callback();
}
