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