CAMLprim value lwt_unix_blit_bytes_bytes(value val_buf1, value val_ofs1, value val_buf2, value val_ofs2, value val_len)
{
memmove((char*)Caml_ba_data_val(val_buf2) + Long_val(val_ofs2),
(char*)Caml_ba_data_val(val_buf1) + Long_val(val_ofs1),
Long_val(val_len));
return Val_unit;
}
CAMLprim value
caml_blit_bigstring_to_bigstring(value val_buf1, value val_ofs1, value val_buf2, value val_ofs2, value val_len)
{
memmove((char*)Caml_ba_data_val(val_buf2) + Long_val(val_ofs2),
(char*)Caml_ba_data_val(val_buf1) + Long_val(val_ofs1),
Long_val(val_len));
return Val_unit;
}
CAMLprim value bigstring_marshal_data_size_stub(value v_pos, value v_bstr)
{
CAMLparam1(v_bstr);
value v_str = (value) Caml_ba_data_val(v_bstr);
value v_res = caml_marshal_data_size(v_str, v_pos);
CAMLreturn(v_res);
}
CAMLprim value ocaml_gstreamer_buffer_of_data(value _ba, value _off, value _len)
{
CAMLparam1(_ba);
int bufoff = Int_val(_off);
int buflen = Int_val(_len);
GstBuffer *gstbuf;
GstMapInfo map;
gboolean bret;
assert(buflen+bufoff <= Caml_ba_array_val(_ba)->dim[0]);
caml_release_runtime_system();
gstbuf = gst_buffer_new_and_alloc(buflen);
bret = gst_buffer_map(gstbuf, &map, GST_MAP_WRITE);
caml_acquire_runtime_system();
if(!bret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
memcpy(map.data, (unsigned char*)Caml_ba_data_val(_ba)+bufoff, buflen);
caml_release_runtime_system();
gst_buffer_unmap(gstbuf, &map);
caml_acquire_runtime_system();
CAMLreturn(value_of_buffer(gstbuf));
}
CAMLprim value ocaml_gstreamer_appsrc_push_buffer_data(value _as, value _buf)
{
CAMLparam2(_as, _buf);
int buflen = Caml_ba_array_val(_buf)->dim[0];
appsrc *as = Appsrc_val(_as);
GstBuffer *gstbuf;
GstMapInfo map;
GstFlowReturn ret;
gboolean bret;
caml_release_runtime_system();
gstbuf = gst_buffer_new_and_alloc(buflen);
bret = gst_buffer_map(gstbuf, &map, GST_MAP_WRITE);
caml_acquire_runtime_system();
if(!bret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
memcpy(map.data, (unsigned char*)Caml_ba_data_val(_buf), buflen);
caml_release_runtime_system();
gst_buffer_unmap(gstbuf, &map);
ret = gst_app_src_push_buffer(as->appsrc, gstbuf);
caml_acquire_runtime_system();
if (ret != GST_FLOW_OK) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
CAMLreturn(Val_unit);
}
CAMLprim value stub_blk_read(value sector, value buffer, value num) {
CAMLparam3(sector, buffer, num);
uint64_t sec = Int64_val(sector);
uint8_t *data = Caml_ba_data_val(buffer);
int n = Int_val(num);
int ret = 0;
assert(Caml_ba_array_val(buffer)->num_dims == 1);
//printf("Solo5 blk read: sec=%d num=%d\n", sec, n);
ret = solo5_blk_read_sync(sec, data, &n);
if ( ret )
printf("virtio read failed... %d from sector=%d\n", n, sec);
#if 0
{
int i;
for (i = 0; i < n; i++) {
printf("%02x ", (uint8_t) data[i]);
if ( i % 16 == 15 )
printf("\n");
}
printf("\n");
}
#endif
CAMLreturn(Val_bool(!ret));
}
/* 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 ocaml_duppy_write_ba(value _fd, value ba, value _ofs, value _len)
{
CAMLparam2(ba,_fd) ;
int fd = GET_FD(_fd);
long ofs = Long_val(_ofs);
long len = Long_val(_len);
void *buf = Caml_ba_data_val(ba);
int ret;
int written = 0;
while (len > 0) {
caml_enter_blocking_section();
ret = write(fd, buf+ofs, len);
caml_leave_blocking_section();
if (ret == -1) {
if ((errno == EAGAIN || errno == EWOULDBLOCK) && written > 0) break;
uerror("write", Nothing);
}
written += ret;
ofs += ret;
len -= ret;
}
CAMLreturn(Val_long(written));
}
CAMLprim value
stub_ba_send(value fd, value val_buf, value val_ofs, value val_len)
{
CAMLparam4(fd, val_buf, val_ofs, val_len);
int ret = 0;
#ifdef WIN32
char *data = (char*)Caml_ba_data_val(val_buf) + Long_val(val_ofs);
size_t c_len = Int_val(val_len);
SOCKET s = Socket_val(fd);
DWORD err = 0;
caml_release_runtime_system();
ret = send(s, data, c_len, 0);
if (ret == SOCKET_ERROR) err = WSAGetLastError();
caml_acquire_runtime_system();
if (err) {
win32_maperr(err);
uerror("read", Nothing);
}
#else
caml_failwith("AF_HYPERV only available on Windows");
#endif
CAMLreturn(Val_int(ret));
}
CAMLprim value
caml_get_addr(value page)
{
CAMLparam1(page);
CAMLlocal1(int64);
void *data = Caml_ba_data_val(page);
int64 = caml_copy_int64((uint64_t) data);
CAMLreturn(int64);
}
CAMLprim value stub_utp_write (value socket, value buf, value off, value len)
{
CAMLparam4(socket, buf, off, len);
ssize_t written;
written = utp_write (Utp_socket_val (socket), Caml_ba_data_val(buf) + Int_val(off), Int_val(len));
if (written < 0) caml_failwith ("utp_write");
CAMLreturn (Val_int (written));
}
CAMLprim value
mirage_get_addr(value page)
{
CAMLparam1(page);
CAMLlocal1(nativeint);
void *data = Caml_ba_data_val(page);
nativeint = caml_copy_nativeint((intnat) data);
CAMLreturn(nativeint);
}
CAMLprim value stub_atomic_fetch_and_uint8(value buf, value idx, value val)
{
CAMLparam3(buf, idx, val);
uint8_t c_val = (uint8_t)Int_val(val);
uint8_t *ptr = Caml_ba_data_val(buf) + Int_val(idx);
if (Int_val(idx) >= Caml_ba_array_val(buf)->dim[0])
caml_invalid_argument("idx");
CAMLreturn(Val_int((uint8_t)__sync_fetch_and_and(ptr, c_val)));
}
CAMLprim value stub_utp_process_udp (value context, value addr, value buf, value off, value len)
{
CAMLparam5 (context, addr, buf, off, len);
union sock_addr_union sock_addr;
socklen_param_type addr_len;
int handled;
get_sockaddr (addr, &sock_addr, &addr_len);
handled = utp_process_udp (Utp_context_val (context), Caml_ba_data_val (buf) + Int_val (off), Int_val (len), &sock_addr.s_gen, addr_len);
CAMLreturn (Val_bool (handled));
}
CAMLprim value ocaml_f0r_update2(value plugin, value instance, value time, value inframe1, value inframe2, value inframe3, value outframe)
{
CAMLparam5(plugin, instance, time, inframe1, inframe2);
CAMLxparam2(inframe3, outframe);
f0r_instance_t *i = Instance_val(instance);
plugin_t *p = Plugin_val(plugin);
double t = Double_val(time);
const uint32_t *in1, *in2, *in3;
uint32_t *out = Caml_ba_data_val(outframe);
in1 = Is_block(inframe1)?Caml_ba_data_val(Field(inframe1,0)):NULL;
in2 = Is_block(inframe2)?Caml_ba_data_val(Field(inframe2,0)):NULL;
in3 = Is_block(inframe3)?Caml_ba_data_val(Field(inframe3,0)):NULL;
caml_release_runtime_system();
p->update2(i, t, in1, in2, in3, out);
caml_acquire_runtime_system();
CAMLreturn(Val_unit);
}
/* noalloc */
value bap_disasm_set_memory_stub(value d,
value base,
value data,
value off,
value len) {
bap_disasm_set_memory(Int_val(d),
Int64_val(base),
(const char *)Caml_ba_data_val(data),
Int_val(off),
Int_val(len));
return Val_unit;
}
CAMLprim value lo_write_ba_stub(value v_conn, value v_fd,
value v_buf, value v_pos, value v_len)
{
CAMLparam2(v_conn, v_buf);
PGconn *conn = get_conn(v_conn);
value v_res;
size_t len = Long_val(v_len);
char *buf = ((char *) Caml_ba_data_val(v_buf)) + Long_val(v_pos);
caml_enter_blocking_section();
v_res = Val_long(lo_write(conn, Int_val(v_fd), buf, len));
caml_leave_blocking_section();
CAMLreturn(v_res);
}
CAMLprim value stub_gnttab_unmap(value xgh, value array)
{
CAMLparam2(xgh, array);
int size = Caml_ba_array_val(array)->dim[0];
int pages = size >> XC_PAGE_SHIFT;
int result = xc_gnttab_munmap(_G(xgh), Caml_ba_data_val(array), pages);
if(result!=0) {
caml_failwith("Failed to unmap grant");
}
CAMLreturn(Val_unit);
}
CAMLprim value ocaml_gstreamer_appsink_pull_buffer(value _as, value string_mode)
{
CAMLparam1(_as);
CAMLlocal1(ans);
appsink *as = Appsink_val(_as);
GstSample *gstsample;
GstBuffer *gstbuf;
GstMapInfo map;
intnat len;
gboolean ret;
caml_release_runtime_system();
gstsample = gst_app_sink_pull_sample(as->appsink);
caml_acquire_runtime_system();
if (!gstsample)
{
if (gst_app_sink_is_eos(as->appsink))
caml_raise_constant(*caml_named_value("gstreamer_exn_eos"));
else
caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
}
caml_release_runtime_system();
gstbuf = gst_sample_get_buffer(gstsample);
caml_acquire_runtime_system();
if (!gstbuf) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
caml_release_runtime_system();
ret = gst_buffer_map(gstbuf, &map, GST_MAP_READ);
caml_acquire_runtime_system();
if (!ret) caml_raise_constant(*caml_named_value("gstreamer_exn_failure"));
len = map.size;
if (string_mode == Val_false) {
ans = caml_ba_alloc(CAML_BA_C_LAYOUT | CAML_BA_UINT8, 1, NULL, &len);
memcpy(Caml_ba_data_val(ans), map.data, len);
} else {
ans = caml_alloc_string(len);
memcpy(String_val(ans), map.data, len);
}
caml_release_runtime_system();
gst_buffer_unmap(gstbuf, &map);
gst_sample_unref(gstsample);
caml_acquire_runtime_system();
CAMLreturn(ans);
}
CAMLprim value ocaml_f0r_update(value plugin, value instance, value time, value inframe, value outframe)
{
CAMLparam5(plugin, instance, time, inframe, outframe);
f0r_instance_t *i = Instance_val(instance);
plugin_t *p = Plugin_val(plugin);
double t = Double_val(time);
const uint32_t *in;
uint32_t *out = Caml_ba_data_val(outframe);
if (Is_block(inframe))
in = Caml_ba_data_val(Field(inframe,0));
else
in = NULL;
caml_release_runtime_system();
if (p->update)
p->update(i, t, in, out);
else
p->update2(i, t, in, NULL, NULL, out);
caml_acquire_runtime_system();
CAMLreturn(Val_unit);
}
CAMLprim value lwt_unix_bytes_read_job(value val_fd, value val_buffer, value val_offset, value val_length)
{
struct filedescr *fd = (struct filedescr *)Data_custom_val(val_fd);
LWT_UNIX_INIT_JOB(job, bytes_read, 0);
job->kind = fd->kind;
if (fd->kind == KIND_HANDLE)
job->fd.handle = fd->fd.handle;
else
job->fd.socket = fd->fd.socket;
job->buffer = (char*)Caml_ba_data_val(val_buffer) + Long_val(val_offset);
job->length = Long_val(val_length);
job->error_code = 0;
return lwt_unix_alloc_job(&(job->job));
}
CAMLprim value ocaml_smf_event_new_from_pointer(value msg, value length)
{
CAMLparam2(msg, length);
CAMLlocal1(ret);
smf_event_t *event;
event = smf_event_new_from_pointer(Caml_ba_data_val(msg), Int_val(length));
if(event == NULL)
{
smf_err(0);
}
ret = create_event(event);
CAMLreturn(ret);
}
CAMLprim value stub_xc_gntshr_munmap(value xgh, value share) {
CAMLparam2(xgh, share);
CAMLlocal1(ml_map);
#ifdef HAVE_GNTSHR
ml_map = Field(share, 1);
int size = Caml_ba_array_val(ml_map)->dim[0];
int pages = size >> XC_PAGE_SHIFT;
int result = xc_gntshr_munmap(_G(xgh), Caml_ba_data_val(ml_map), pages);
if(result != 0)
failwith_xc(_G(xgh));
#else
gntshr_missing();
#endif
CAMLreturn(Val_unit);
}
CAMLprim value ml_text_encode_bigarray(value cd_val, value buf_val, value pos_val, value len_val, value code_val)
{
CAMLparam5(cd_val, buf_val, pos_val, len_val, code_val);
uint32_t code = Int_val(code_val);
size_t len = Long_val(len_val);
size_t in_left = 4;
char *in_bytes = (char*)&code;
size_t out_left = len;
char *out_bytes = (char*)Caml_ba_data_val(buf_val) + Long_val(pos_val);
iconv(Iconv_val(cd_val), &in_bytes, &in_left, &out_bytes, &out_left);
if (in_left == 0) {
value result = caml_alloc_tuple(1);
Store_field(result, 0, Val_int(len - out_left));
CAMLreturn(result);
} else if (errno == E2BIG)
CAMLreturn(Val_need_more);
else
CAMLreturn(Val_error);
}
CAMLprim value NAME_PERM(value vCMP, value vN,
value vOFSP, value vINCP, value vP,
value vOFSX, value vINCX, value vX)
{
CAMLparam3(vCMP, vP, vX);
#if defined(OCAML_SORT_CALLBACK)
CAMLlocal2(va, vb);
#endif
const size_t GET_INT(N);
int GET_INT(INCX),
GET_INT(INCP);
VEC_PARAMS(X);
intnat OFSX = Long_val(vOFSX);
intnat *P_data = ((intnat *) Caml_ba_data_val(vP)) + (Long_val(vOFSP) - 1);
size_t i;
NUMBER *const X = X_data - OFSX; /* so P values are FORTRAN indices */
intnat *const base_ptr = P_data;
const size_t max_thresh = MAX_THRESH * sizeof(intnat) * INCP;
if (N == 0) CAMLreturn(Val_unit);
#ifndef OCAML_SORT_CALLBACK
caml_enter_blocking_section(); /* Allow other threads */
#endif
/* Initialize the permutation to the "identity". */
for(i = 0; i < N; i += 1)
P_data[i * INCP] = OFSX + i * INCX;
#define QUICKSORT_LT(a, b) OCAML_SORT_LT((X[*a]), (X[*b]))
QUICKSORT(intnat, base_ptr, INCP, max_thresh);
#undef QUICKSORT_LT
#ifndef OCAML_SORT_CALLBACK
caml_leave_blocking_section(); /* Disallow other threads */
#endif
CAMLreturn(Val_unit);
}
CAMLprim __pure value get_sptr_ptr_stub(char **sptr_ptr, value v_buf)
{
return Val_long(*sptr_ptr - (char *) Caml_ba_data_val(v_buf));
}
static inline char * get_bstr(value v_bstr, value v_pos)
{
return (char *) Caml_ba_data_val(v_bstr) + Long_val(v_pos);
}
static inline __pure char * get_buf(value v_buf, value v_pos)
{
return (char *) Caml_ba_data_val(v_buf) + Long_val(v_pos);
}
CAMLprim value lwt_unix_fill_bytes(value val_buf, value val_ofs, value val_len, value val_char)
{
memset((char*)Caml_ba_data_val(val_buf) + Long_val(val_ofs), Int_val(val_char), Long_val(val_len));
return Val_unit;
}
CAMLprim value bin_prot_get_float_offset(value buf, value pos)
{
return (value)((char *)Caml_ba_data_val(buf) + Long_val(pos));
}
