CAMLprim value pattern_font_sort(value plist, value trim)
{
CAMLparam0();
CAMLlocal2(res, nres);
FcPattern *pat;
FcFontSet *match;
FcResult result;
int i;
pat = FcPattern_val(plist);
FcConfigSubstitute(NULL, pat, FcMatchPattern);
FcDefaultSubstitute(pat);
match = FcFontSort(NULL, pat, Bool_val(trim) ? FcTrue : FcFalse, NULL, &result);
/* Reconstruire la belle liste */
res = Val_int(0); /* empty list */
for(i = match->nfont; i >= 0; i--) {
nres = caml_alloc(2, 0);
Store_field(nres, 0, caml_copy_pattern(match->fonts[i]));
Store_field(nres, 1, res);
res = nres;
}
FcFontSetDestroy(match);
FcPatternDestroy(pat);
CAMLreturn(res);
}
CAMLprim value stub_sem_init(value c) {
CAMLparam1(c);
CAMLlocal2(result, perrno);
int rc, lerrno;
sem_t *s;
rc = -1;
caml_release_runtime_system();
if (NULL != (s = malloc(sizeof(sem_t)))) {
rc = sem_init(s, 0, Int_val(c));
lerrno = errno;
} else {
lerrno = ENOMEM;
free(s);
}
caml_acquire_runtime_system();
if (0 != rc) {
goto ERROR;
}
result = caml_alloc(1, 0); // Result.Ok
Store_field(result, 0, caml_copy_semaphore(s));
goto END;
ERROR:
perrno = caml_alloc(2, 0);
Store_field(perrno, 0, eunix); // `EUnix
Store_field(perrno, 1, unix_error_of_code(lerrno));
result = caml_alloc(1, 1); // Result.Error
Store_field(result, 0, perrno);
END:
CAMLreturn(result);
}
CAMLprim value netsys_return_all_not_event_fd(value nev)
{
#ifdef HAVE_POLL
struct not_event *ne;
CAMLparam1(nev);
CAMLlocal2(v1, v2);
ne = *(Not_event_val(nev));
v1 = Val_int(0);
if (ne->fd1 != -1) {
v2 = caml_alloc(2,0);
Store_field(v2, 0, Val_int(ne->fd1));
Store_field(v2, 1, v1);
v1 = v2;
};
if (ne->fd2 != -1) {
v2 = caml_alloc(2,0);
Store_field(v2, 0, Val_int(ne->fd2));
Store_field(v2, 1, v1);
v1 = v2;
};
CAMLreturn(v1);
#else
return Val_int(0);
#endif
}
CAMLprim value
stub_pcap_next (value p_p)
{
CAMLparam1 (p_p);
CAMLlocal2 (ret, ml_data);
pcap_t *p;
const u_char *packet;
struct pcap_pkthdr header;
p = (pcap_t *) p_p;
packet = pcap_next(p, &header);
if (packet == NULL) {
raise_error ("No next packet received");
}
ret = caml_alloc (3, 0);
Store_field (ret, 0, Val_int (header.len));
Store_field (ret, 1, Val_int (header.caplen));
ml_data = caml_alloc_string (header.caplen);
memcpy (String_val(ml_data), packet, header.caplen);
Store_field (ret, 2, ml_data);
CAMLreturn (ret);
}
CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol)
{
CAMLparam2 (filename, symbol);
CAMLlocal2 (res, v);
void *handle;
char *p;
/* TODO: dlclose in case of error... */
p = caml_strdup(String_val(filename));
caml_enter_blocking_section();
handle = caml_dlopen(p, 1, 1);
caml_leave_blocking_section();
caml_stat_free(p);
if (NULL == handle) {
res = caml_alloc(1,1);
v = caml_copy_string(caml_dlerror());
Store_field(res, 0, v);
} else {
res = caml_alloc(1,0);
v = caml_natdynlink_run(handle, symbol);
Store_field(res, 0, v);
}
CAMLreturn(res);
}
CAMLprim value stub_sem_wait(value sem) {
CAMLparam1(sem);
CAMLlocal2(result, perrno);
int rc, lerrno;
sem_t *s;
s = *Sem_val(sem);
if (NULL == s) {
lerrno = EINVAL;
goto ERROR;
}
caml_release_runtime_system();
rc = sem_wait(s);
lerrno = errno;
caml_acquire_runtime_system();
if (0 != rc) {
goto ERROR;
}
result = caml_alloc(1, 0); // Result.Ok
Store_field(result, 0, Val_unit);
goto END;
ERROR:
perrno = caml_alloc(2, 0);
Store_field(perrno, 0, eunix); // `EUnix
Store_field(perrno, 1, unix_error_of_code(lerrno));
result = caml_alloc(1, 1); // Result.Error
Store_field(result, 0, perrno);
END:
CAMLreturn(result);
}
value caml_from_fcvalue(FcValue v)
{
CAMLparam0();
CAMLlocal2(res, arr);
switch(v.type) {
case FcTypeVoid:
res = Val_int(0);
break;
case FcTypeInteger:
res = caml_alloc(1, 0);
Store_field(res, 0, Val_int(v.u.i));
break;
case FcTypeDouble:
res = caml_alloc(1, 1);
Store_field(res, 0, caml_copy_double(v.u.d));
break;
case FcTypeString:
res = caml_alloc(1, 2);
Store_field(res, 0, caml_copy_string((char *)v.u.s));
break;
case FcTypeBool:
res = caml_alloc(1, 3);
Store_field(res, 0, v.u.b ? Val_true : Val_false);
break;
case FcTypeMatrix:
res = caml_from_fcmatrix(v.u.m);
default:
/* caml_invalid_argument ? */
break;
}
CAMLreturn(res);
}
CAMLprim value
tun_opendev(value devname, value kind, value pi, value persist, value user, value group)
{
CAMLparam5(devname, kind, pi, persist, user);
CAMLxparam1(group);
CAMLlocal2(res, dev_caml);
char dev[IFNAMSIZ];
int fd;
#if defined (__APPLE__) && defined (__MACH__)
if (caml_string_length(devname) < 4)
caml_failwith("On MacOSX, you need to specify the name of the device, e.g. tap0");
#endif
memset(dev, 0, sizeof dev);
memcpy(dev, String_val(devname), caml_string_length(devname));
// All errors are already checked by tun_alloc, returned fd is valid
// otherwise it would have crashed before
fd = tun_alloc(dev, Int_val(kind), Bool_val(pi), Bool_val(persist), Int_val(user), Int_val(group));
res = caml_alloc_tuple(2);
dev_caml = caml_copy_string(dev);
Store_field(res, 0, Val_int(fd));
Store_field(res, 1, dev_caml);
CAMLreturn(res);
}
CAMLprim value
iface_addr(value ifap)
{
CAMLparam0();
CAMLlocal2(ret, opt);
struct ifaddrs *c_ifap = (struct ifaddrs *)ifap;
if(c_ifap->ifa_addr == NULL)
CAMLreturn(Val_int(0));
uint16_t family = c_ifap->ifa_addr->sa_family;
if (family != AF_INET)
opt = Val_int(0);
else
{
opt = caml_alloc(1, 0);
ret = caml_alloc(3, 0);
Store_field(ret, 0, caml_copy_int32(ipv4_of_sockaddr(c_ifap->ifa_addr)));
Store_field(ret, 1, caml_copy_int32(ipv4_of_sockaddr(c_ifap->ifa_netmask)));
#if defined (__linux__)
Store_field(ret, 2, caml_copy_int32(ipv4_of_sockaddr(c_ifap->ifa_flags & IFF_BROADCAST ?
c_ifap->ifa_ifu.ifu_broadaddr :
c_ifap->ifa_ifu.ifu_dstaddr
)));
#elif defined(__APPLE__) && defined (__MACH__)
Store_field(ret, 2, caml_copy_int32(ipv4_of_sockaddr(c_ifap->ifa_dstaddr)));
#endif
Store_field(opt, 0, ret);
}
CAMLreturn(opt);
}
CAMLprim value caml_zmq_poll(value poll, value timeout) {
CAMLparam2 (poll, timeout);
CAMLlocal2 (events, some);
int n = CAML_ZMQ_Poll_val(poll)->num_elems;
zmq_pollitem_t *items = CAML_ZMQ_Poll_val(poll)->poll_items;
int tm = Int_val(timeout);
caml_release_runtime_system();
int num_event_sockets = zmq_poll(items, n, tm);
caml_acquire_runtime_system();
caml_zmq_raise_if(num_event_sockets == -1);
events = caml_alloc(n, 0);
int i;
for(i = 0; i < n; i++) {
if (!((items[i].revents & ZMQ_POLLIN) || (items[i].revents & ZMQ_POLLOUT))) {
Store_field(events, i, Val_int(0)); /* None */
} else {
some = caml_alloc(1, 0);
Store_field(some, 0, CAML_ZMQ_Val_mask(items[i].revents));
Store_field(events, i, some);
}
}
CAMLreturn (events);
}
static int call_back (
HRASCONN hrasconn,
int istate,
char state[],
int ierror,
char error[] )
{
value_t args[6], ret;
CAMLparam0 ();
CAMLlocal2 (v_state, v_error);
if ( *cb_info.p_closure == 0 )
return -1;
v_state = copy_string ( state?state:"" );
v_error = copy_string ( error?error:"" );
args[0] = Val_int (LOWORD(hrasconn));
args[1] = Val_int (HIWORD(hrasconn));
args[2] = Val_int ( istate );
args[3] = v_state;
args[4] = Val_int ( error );
args[5] = v_error;
ret = callbackN ( *cb_info.p_closure, 6, args );
CAMLreturn ( Bool_val ( ret ) );
return 0; /* dummy ! */
}
CAMLprim value
stub_start_info_get(value unit)
{
CAMLparam1(unit);
CAMLlocal2(result, tmp);
char buf[MAX_GUEST_CMDLINE+1];
result = caml_alloc_tuple(16);
memcpy(buf, start_info.magic, sizeof(start_info.magic));
buf[sizeof(start_info.magic)] = 0;
tmp = caml_copy_string(buf);
Store_field(result, 0, tmp);
Store_field(result, 1, Val_int(start_info.nr_pages));
Store_field(result, 2, Val_int(start_info.shared_info));
Store_field(result, 3, Val_int(start_info.flags));
Store_field(result, 4, Val_int(start_info.store_mfn));
Store_field(result, 5, Val_int(start_info.store_evtchn));
Store_field(result, 6, Val_int(start_info.console.domU.mfn));
Store_field(result, 7, Val_int(start_info.console.domU.evtchn));
Store_field(result, 8, Val_int(start_info.pt_base));
Store_field(result, 9, Val_int(start_info.nr_pt_frames));
Store_field(result, 10, Val_int(start_info.mfn_list));
Store_field(result, 11, Val_int(start_info.mod_start));
Store_field(result, 12, Val_int(start_info.mod_len));
memcpy(buf, start_info.cmd_line, MAX_GUEST_CMDLINE);
buf[MAX_GUEST_CMDLINE] = 0;
tmp = caml_copy_string(buf);
Store_field(result, 13, tmp);
Store_field(result, 14, Val_int(start_info.first_p2m_pfn));
Store_field(result, 15, Val_int(start_info.nr_p2m_frames));
CAMLreturn(result);
}
/* Convert the raw backtrace to a data structure usable from OCaml */
CAMLprim value caml_convert_raw_backtrace_slot(value backtrace_slot)
{
CAMLparam1(backtrace_slot);
CAMLlocal2(p, fname);
struct caml_loc_info li;
if (!caml_debug_info_available())
caml_failwith("No debug information available");
caml_extract_location_info(caml_raw_backtrace_slot_val(backtrace_slot), &li);
if (li.loc_valid) {
fname = caml_copy_string(li.loc_filename);
p = caml_alloc_small(5, 0);
Field(p, 0) = Val_bool(li.loc_is_raise);
Field(p, 1) = fname;
Field(p, 2) = Val_int(li.loc_lnum);
Field(p, 3) = Val_int(li.loc_startchr);
Field(p, 4) = Val_int(li.loc_endchr);
} else {
p = caml_alloc_small(1, 1);
Field(p, 0) = Val_bool(li.loc_is_raise);
}
CAMLreturn(p);
}
static value Val_physinfo(libxl_physinfo *c_val)
{
CAMLparam0();
CAMLlocal2(v, hwcap);
int i;
hwcap = caml_alloc_tuple(8);
for (i = 0; i < 8; i++)
Store_field(hwcap, i, caml_copy_int32(c_val->hw_cap[i]));
v = caml_alloc_tuple(11);
Store_field(v, 0, Val_int(c_val->threads_per_core));
Store_field(v, 1, Val_int(c_val->cores_per_socket));
Store_field(v, 2, Val_int(c_val->max_cpu_id));
Store_field(v, 3, Val_int(c_val->nr_cpus));
Store_field(v, 4, Val_int(c_val->cpu_khz));
Store_field(v, 5, caml_copy_int64(c_val->total_pages));
Store_field(v, 6, caml_copy_int64(c_val->free_pages));
Store_field(v, 7, caml_copy_int64(c_val->scrub_pages));
Store_field(v, 8, Val_int(c_val->nr_nodes));
Store_field(v, 9, hwcap);
Store_field(v, 10, caml_copy_int32(c_val->phys_cap));
CAMLreturn(v);
}
static value find_handle(LPSELECTRESULT iterResult, value readfds, value writefds, value exceptfds)
{
CAMLparam3(readfds, writefds, exceptfds);
CAMLlocal2(result, list);
int i;
switch( iterResult->EMode )
{
case SELECT_MODE_READ:
list = readfds;
break;
case SELECT_MODE_WRITE:
list = writefds;
break;
case SELECT_MODE_EXCEPT:
list = exceptfds;
break;
};
for(i=0; list != Val_unit && i < iterResult->lpOrigIdx; ++i )
{
list = Field(list, 1);
}
if (list == Val_unit)
failwith ("select.c: original file handle not found");
result = Field(list, 0);
CAMLreturn( result );
}
/*
* Read a line into a string buffer.
* Returns a string option, None at EOF.
*/
value caml_readline(value prompt_arg) {
CAMLparam1(prompt_arg);
CAMLlocal2(v, b);
char *line;
#if READLINE
line = readline(String_val(prompt_arg));
/* Readline returns null on EOF */
if(line == NULL) {
/* None */
CAMLreturn(Val_int(0));
}
/* This (probably) copies the line */
if(line != NULL && *line != '\0') {
/* Add nonempty lines to the history */
add_history(line);
}
#else /* No READLINE */
char *bufp;
bufp = malloc(MAX_LINE_LENGTH);
if(bufp == NULL) {
/* Pretend that we have reached EOF */
CAMLreturn(Val_int(0));
}
/* Get the line (make sure string is terminated) */
bufp[MAX_LINE_LENGTH - 1] = '\0';
fputs(String_val(prompt_arg), stdout);
fflush(stdout);
line = fgets(bufp, MAX_LINE_LENGTH - 1, stdin);
/* Readline returns null on EOF */
if(line == NULL) {
/* None */
free(bufp);
CAMLreturn(Val_int(0));
}
#endif /* READLINE enabled? */
/* Copy the line */
v = copy_string(line);
/* Some v */
b = alloc(1, 0);
Field(b, 0) = v;
/* Free the buffer */
free(line);
CAMLreturn(b);
}
value ep_wait(value v_epfd, value v_maxevents, value v_timeout)
{
CAMLparam3(v_epfd, v_maxevents, v_timeout);
CAMLlocal2(v_res, v_flags);
int maxevents = Int_val(v_maxevents);
struct kevent *evs;
int nb;
if (maxevents <= 0) caml_invalid_argument("kqueue wait with maxevents <= 0");
/* evs = caml_stat_alloc(maxevents); */
evs = malloc(maxevents * sizeof (struct kevent));
int t = Int_val(v_timeout);
struct timespec *ptout;
if (t<0) {
ptout = NULL;
} else {
time_t sec = t/1000;
long nano = (t-sec*1000)*1000000;
struct timespec tout = {sec, nano};
ptout = &tout;
}
/* fflush(stdout); */
nb = kevent(Int_val(v_epfd), NULL, 0, evs, maxevents, ptout);
if (nb < 0) {
caml_stat_free(evs);
int err = errno;
errno = 0;
/* fprintf(stderr, "kqueue error -1 with WAIT\n"); */
caml_failwith(strerror(err));
}
v_res = caml_alloc(nb, 0);
/* FIXME? */
while (--nb >= 0) {
value v_ev;
struct kevent *ev = &evs[nb];
if (ev->flags & EV_ERROR) {
fprintf(stderr, "kqueue error: \"%s\"\n", strerror(ev->data));
exit(EXIT_FAILURE);
} else {
//v_flags = caml_copy_int32(ev->fflags); //WHY THIS ??
v_ev = caml_alloc_small(2, 0);
Field(v_ev, 0) = Val_int(ev->ident);
Field(v_ev, 1) = Val_int(ev->filter); // filter like EVFILT_READ/WRITE
Store_field(v_res, nb, v_ev);
}
}
free(evs);
/* caml_stat_free(evs); */
CAMLreturn(v_res);
}
CAMLprim value perform_llistxattr(value file)
{
CAMLparam1(file);
CAMLlocal2(l, prev);
ssize_t siz, i;
char *p, *porig;
siz = LLISTXATTR(String_val(file), NULL, 0);
if (siz == 0 || errno == EPERM || errno == EACCES)
CAMLreturn(Val_int(0));
if(siz < 0) {
printf("llistxattr on %s failed, error %i: %s\n", String_val(file), errno, strerror(errno));
caml_failwith("llistxattr");
}
porig = p = malloc(siz);
siz = LLISTXATTR(String_val(file), p, siz);
if(siz < 0) {
free(p);
caml_failwith("llistxattr");
}
prev = Val_int(0);
for(i = 0; i < siz;) {
l = caml_alloc(2, 0);
Store_field(l, 0, caml_copy_string(p));
Store_field(l, 1, prev);
prev = l;
while(*p++) /* skip */ i++;
++i;
}
free(porig);
CAMLreturn(l);
}
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);
}
CAMLprim value NAME(value vCMP, value vN,
value vOFSX, value vINCX, value vX)
{
CAMLparam2(vCMP, vX);
#if defined(OCAML_SORT_CALLBACK)
CAMLlocal2(va, vb);
#endif
const size_t GET_INT(N);
int GET_INT(INCX);
VEC_PARAMS(X);
NUMBER *const base_ptr = X_data;
const size_t max_thresh = MAX_THRESH * sizeof(NUMBER) * INCX;
if (N == 0) CAMLreturn(Val_unit);
#ifndef OCAML_SORT_CALLBACK
caml_enter_blocking_section(); /* Allow other threads */
#endif
#define QUICKSORT_LT(a, b) OCAML_SORT_LT((*a), (*b))
QUICKSORT(NUMBER, base_ptr, INCX, max_thresh);
#undef QUICKSORT_LT
#ifndef OCAML_SORT_CALLBACK
caml_leave_blocking_section(); /* Disallow other threads */
#endif
CAMLreturn(Val_unit);
}
CAMLprim value ocaml_faad_mp4_metadata(value m)
{
CAMLparam1(m);
CAMLlocal2(ans,v);
mp4_t *mp = Mp4_val(m);
int i, n;
char *tag, *item;
caml_enter_blocking_section();
n = mp4ff_meta_get_num_items(mp->ff);
caml_leave_blocking_section();
ans = caml_alloc_tuple(n);
for (i = 0; i < n; i++)
{
tag = NULL;
item = NULL;
caml_enter_blocking_section();
mp4ff_meta_get_by_index(mp->ff, i, &item, &tag);
caml_leave_blocking_section();
assert(item && tag);
v = caml_alloc_tuple(2);
Store_field(v, 0, caml_copy_string(item));
Store_field(v, 1, caml_copy_string(tag));
Store_field(ans, i, v);
free(item);
free(tag);
}
CAMLreturn(ans);
}
/* 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);
}
CAMLprim value glyph_to_bitmap(value glyph)
{
CAMLparam1(glyph);
CAMLlocal2(block, buffer);
FT_GlyphSlot slot;
FT_Glyph g;
FT_BitmapGlyph bm;
size_t pitch;
size_t new_pitch;
int i;
slot = *(FT_GlyphSlot *)Data_custom_val(glyph);
if (FT_Get_Glyph(slot, &g))
failwith("glyph_to_bitmap");
if (g->format != FT_GLYPH_FORMAT_BITMAP)
{
if (FT_Glyph_To_Bitmap(&g, FT_RENDER_MODE_MONO, 0, 1))
{
FT_Done_Glyph(g);
failwith("glyph_to_bitmap");
}
}
bm = (FT_BitmapGlyph)g;
pitch = abs(bm->bitmap.pitch);
new_pitch = (bm->bitmap.width + 7) / 8;
block = alloc_tuple(6);
buffer = alloc_string(bm->bitmap.rows * new_pitch);
if (bm->bitmap.pitch >= 0)
{
for (i = 0; i < bm->bitmap.rows; i++)
memcpy(String_val(buffer) + i * new_pitch,
bm->bitmap.buffer + i * pitch,
new_pitch);
}
else
{
for (i = 0; i < bm->bitmap.rows; i++)
memcpy(String_val(buffer) + i * new_pitch,
bm->bitmap.buffer + (bm->bitmap.rows - i) * pitch,
new_pitch);
}
Store_field(block, 0, Val_int(bm->left));
Store_field(block, 1, Val_int(bm->top));
Store_field(block, 2, Val_int(bm->bitmap.rows));
Store_field(block, 3, Val_int(bm->bitmap.width));
Store_field(block, 4, Val_int(new_pitch));
Store_field(block, 5, buffer);
FT_Done_Glyph(g);
CAMLreturn(block);
};
value mycamlparam (value v, value fun, value arg)
{
CAMLparam3 (v, fun, arg);
CAMLlocal2 (x, y);
x = v;
y = callback (fun, arg);
v = x;
CAMLreturn (v);
}
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));
}
void range_set_altpath(const char * c_path) {
CAMLparam0();
CAMLlocal2(caml_result, caml_path);
caml_path = caml_copy_string(c_path);
caml_result = callback_exn(*cb_range_set_altpath, caml_path);
range_set_exception(caml_result);
CAMLreturn0;
}
CAMLprim value caml_sys_get_config(value unit)
{
CAMLparam0 (); /* unit is unused */
CAMLlocal2 (result, ostype);
ostype = caml_copy_string(OCAML_OS_TYPE);
result = caml_alloc_small (2, 0);
Field(result, 0) = ostype;
Field(result, 1) = Val_long (8 * sizeof(value));
CAMLreturn (result);
}
PREFIX void ml_Evas_Object_Event_Cb_mouse_down(
void* data, Evas* e, Evas_Object *obj, void* event_info)
{
CAMLparam0();
CAMLlocal2(v_fun, v_ev);
value* d = (value*) data;
v_fun = *d;
v_ev = copy_Evas_Event_Mouse_Down((Evas_Event_Mouse_Down*) event_info);
caml_callback3(v_fun, (value) e, (value) obj, v_ev);
CAMLreturn0;
}
PREFIX void ml_Edje_Signal_Cb(
void* data, Evas_Object* obj, const char* emission, const char* source)
{
CAMLparam0();
CAMLlocal2(v_emission, v_source);
value* v_fun = (value*) data;
v_emission = copy_string(emission);
v_source = copy_string(source);
caml_callback3(*v_fun, (value) obj, v_emission, v_source);
CAMLreturn0;
}
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);
}
