value ml_ut_format( value u, value encoding, value names, value basic, value max_length ) {
CAMLparam5( u, encoding, names, basic, max_length );
CAMLlocal1( ml_buf );
int opts =
Int_val( encoding ) |
(Int_val( basic ) ? UT_DEFINITION : 0) |
(Int_val( names ) ? UT_NAMES : 0);
int result;
char *buf;
buf = (char *)malloc( sizeof(char) * Int_val( max_length ) );
if ( buf == NULL ) {
caml_failwith( "Unable to allocate buffer" );
}
result = ut_format( UD_ut_unit_val( u ), buf, Int_val( max_length ), opts );
if ( result == -1 ) {
caml_raise_with_arg( *caml_named_value( "ut status exception" ), Val_int( ut_get_status() ) );
}
ml_buf = caml_copy_string( buf );
free( buf );
CAMLreturn( ml_buf );
}
CAMLprim value sunml_idas_superlumtb_init (value vparent_which,
value vneqs, value vnnz,
value vnthreads, value vusesens)
{
CAMLparam5(vparent_which, vneqs, vnnz, vnthreads, vusesens);
#if SUNDIALS_LIB_VERSION < 300
void *ida_mem = IDA_MEM_FROM_ML (Field(vparent_which, 0));
int which = Int_val(Field(vparent_which, 1));
int flag;
flag = IDASuperLUMTB (ida_mem, which, Int_val(vnthreads), Int_val(vneqs),
Int_val(vnnz));
CHECK_FLAG ("IDASuperLUMTB", flag);
if (Bool_val(vusesens)) {
flag = IDASlsSetSparseJacFnBS(ida_mem, which, jacfn_withsens);
CHECK_FLAG("IDASlsSetSparseJacFnBS", flag);
} else {
flag = IDASlsSetSparseJacFnB (ida_mem, which, jacfn_nosens);
CHECK_FLAG("IDASlsSetSparseJacFnB", flag);
}
#else
caml_raise_constant(SUNDIALS_EXN(NotImplementedBySundialsVersion));
#endif
CAMLreturn (Val_unit);
}
CAMLprim value stub_xc_hvm_build_native(value xc_handle, value domid,
value mem_max_mib, value mem_start_mib, value image_name, value store_evtchn, value console_evtchn)
{
CAMLparam5(xc_handle, domid, mem_max_mib, mem_start_mib, image_name);
CAMLxparam2(store_evtchn, console_evtchn);
CAMLlocal1(result);
char *image_name_c = strdup(String_val(image_name));
char *error[256];
xc_interface *xch;
unsigned long store_mfn=0;
unsigned long console_mfn=0;
int r;
struct flags f;
/* The xenguest interface changed and was backported to XCP: */
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
struct xc_hvm_build_args args;
#endif
get_flags(&f, _D(domid));
xch = _H(xc_handle);
configure_vcpus(xch, _D(domid), f);
configure_tsc(xch, _D(domid), f);
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
args.mem_size = (uint64_t)Int_val(mem_max_mib) << 20;
args.mem_target = (uint64_t)Int_val(mem_start_mib) << 20;
args.mmio_size = f.mmio_size_mib << 20;
args.image_file_name = image_name_c;
#endif
caml_enter_blocking_section ();
#if defined(XENGUEST_HAS_HVM_BUILD_ARGS) || (__XEN_LATEST_INTERFACE_VERSION__ >= 0x00040200)
r = xc_hvm_build(xch, _D(domid), &args);
#else
r = xc_hvm_build_target_mem(xch, _D(domid),
Int_val(mem_max_mib),
Int_val(mem_start_mib),
image_name_c);
#endif
caml_leave_blocking_section ();
free(image_name_c);
if (r)
failwith_oss_xc(xch, "hvm_build");
r = hvm_build_set_params(xch, _D(domid), Int_val(store_evtchn), &store_mfn,
Int_val(console_evtchn), &console_mfn, f);
if (r)
failwith_oss_xc(xch, "hvm_build_params");
result = caml_alloc_tuple(2);
Store_field(result, 0, caml_copy_nativeint(store_mfn));
Store_field(result, 1, caml_copy_nativeint(console_mfn));
CAMLreturn(result);
}
void simulation_set_pose3d_stub(value sim_val, value name_val,
value gx_val, value gy_val, value gz_val, value groll_val,
value gpitch_val, value gyaw_val)
{
CAMLparam5(sim_val, name_val, gx_val, gy_val, gz_val);
// CAMLxparam3(groll_val, gpitch_val, gyaw_val);
playerc_simulation_t *sim = Simulation_val(sim_val);
char *name = String_val(name_val);
double gx = Double_val(gx_val);
double gy = Double_val(gy_val);
double gz = Double_val(gz_val);
double groll = Double_val(groll_val);
double gpitch = Double_val(gpitch_val);
double gyaw = Double_val(gyaw_val);
DPRINTF("setting sim %p pose3d: name - %s gx = %f gy = %f gz = %f groll = %f gpitch = %f gyaw = %f\n",
sim, name, gx, gy, gz, groll, gpitch, gyaw);
if(playerc_simulation_set_pose3d(sim, name, gx, gy, gz, groll, gpitch, gyaw))
exception_playerc_error();
DPRINTF("set sim %p pose3d: name - %s gx = %f gy = %f gz = %f groll = %f gpitch = %f gyaw = %f\n",
sim, name, gx, gy, gz, groll, gpitch, gyaw);
CAMLreturn0;
}
CAMLprim value sunml_lsolver_call_psolve(value vcptr, value vr, value vz,
value vtol, value vlr)
{
CAMLparam5(vcptr, vr, vz, vtol, vlr);
caml_raise_constant(SUNDIALS_EXN(NotImplementedBySundialsVersion));
CAMLreturn(Val_unit);
}
CAMLprim value
caml_udpv4_sendto(value v_fd, value v_str, value v_off, value v_len, value v_dst)
{
CAMLparam5(v_fd, v_str, v_off, v_len, v_dst);
CAMLlocal2(v_ret, v_err);
unsigned char *buf = String_val(v_str) + Int_val(v_off);
size_t len = Int_val(v_len);
int fd = Int_val(v_fd);
struct sockaddr_in sa;
socklen_t sa_len = sizeof(sa);
bzero(&sa, sizeof sa);
sa.sin_family = AF_INET;
sa.sin_addr.s_addr = htonl(Int32_val(Field(v_dst, 0)));
sa.sin_port = htons(Int_val(Field(v_dst, 1)));
int r = sendto(fd, buf, len, MSG_DONTWAIT, (struct sockaddr *)&sa, sa_len);
if (r < 0) {
if (errno == EAGAIN || errno==EWOULDBLOCK)
Val_WouldBlock(v_ret);
else {
v_err = caml_copy_string(strerror(errno));
Val_Err(v_ret, v_err);
}
} else {
Val_OK(v_ret, Val_int(r));
}
CAMLreturn(v_ret);
}
CAMLprim value stub_mmap_init(value fd, value pflag, value mflag,
value len, value offset)
{
CAMLparam5(fd, pflag, mflag, len, offset);
CAMLlocal1(result);
int c_pflag, c_mflag;
switch (Int_val(pflag)) {
case 0: c_pflag = PROT_READ; break;
case 1: c_pflag = PROT_WRITE; break;
case 2: c_pflag = PROT_READ|PROT_WRITE; break;
default: caml_invalid_argument("protectiontype");
}
switch (Int_val(mflag)) {
case 0: c_mflag = MAP_SHARED; break;
case 1: c_mflag = MAP_PRIVATE; break;
default: caml_invalid_argument("maptype");
}
result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag);
if (mmap_interface_init(GET_C_STRUCT(result), Int_val(fd),
c_pflag, c_mflag,
Int_val(len), Int_val(offset)))
caml_failwith("mmap");
CAMLreturn(result);
}
//+ external put : t -> ?txn:txn -> key:string -> data:string
//+ -> put_flag list -> unit = "caml_db_put"
value caml_db_put(value db, value txn_opt, value vkey,
value vdata, value vflags) {
CAMLparam5(db, txn_opt, vkey, vdata, vflags);
DBT key, data;
int flags, err;
DB_TXN *txn;
if (Is_None(txn_opt)) { txn = NULL; }
else {
test_txn_closed(Some_val(txn_opt));
txn = UW_txn(Some_val(txn_opt));
}
test_db_closed(db);
zerob(&key,sizeof(DBT)); zerob(&data,sizeof(DBT));
key.data = String_val(vkey);
key.size = string_length(vkey);
data.data = String_val(vdata);
data.size = string_length(vdata);
flags = convert_flag_list(vflags, db_put_flags);
err = UW_db(db)->put(UW_db(db), txn, &key, &data, flags);
if (err != 0) {
if (err == DB_KEYEXIST) {raise_key_exists();}
UW_db(db)->err(UW_db(db),err,"caml_db_put");
}
CAMLreturn (Val_unit);
}
CAMLprim value
caml_backpack_mq_setattr(value val_mq, value val_flags)
{
CAMLparam2(val_mq, val_flags);
struct mq_attr attr = {
.mq_flags = caml_convert_flag_list(val_flags, mqueue_flags)
};
if (mq_setattr(Int_val(val_mq), &attr, NULL) == -1)
uerror("mq_setattr", Nothing);
CAMLreturn(Val_unit);
}
CAMLprim value
caml_backpack_mq_send(value val_mq, value val_buff, value val_ofs,
value val_len, value val_prio)
{
CAMLparam5(val_mq, val_buff, val_ofs, val_len, val_prio);
if (mq_send(Int_val(val_mq), &Byte(val_buff, Long_val(val_ofs)),
Long_val(val_len), Int_val(val_prio)) == -1)
uerror("mq_send", Nothing);
CAMLreturn(Val_unit);
}
value hdf5_h5l_get_name_by_idx(value loc_v, value group_name_v, value index_field_v,
value order_v, value lapl_v, value n_v)
{
CAMLparam5(loc_v, group_name_v, index_field_v, order_v, lapl_v);
CAMLxparam1(n_v);
CAMLlocal1(name_v);
hid_t loc_id = Hid_val(loc_v), lapl_id = H5P_opt_val(lapl_v);
const char *group_name = String_val(group_name_v);
H5_index_t index_field = H5_index_val(index_field_v);
H5_iter_order_t order = H5_iter_order_val(order_v);
hsize_t n = Int_val(n_v);
char *name;
ssize_t size;
size = H5Lget_name_by_idx(loc_id, group_name, index_field, order, n, NULL, 0, lapl_id);
if (size < 0)
fail();
size++;
name = malloc(size);
if (name == NULL)
caml_raise_out_of_memory();
size = H5Lget_name_by_idx(loc_id, group_name, index_field, order, n, name, size,
lapl_id);
if (size < 0)
{
free(name);
fail();
}
name_v = caml_copy_string(name);
free(name);
CAMLreturn(name_v);
}
CAMLprim value quota_modify (value v_user_or_group, value v_id,
value v_path, value v_bytes_limit, value v_inodes_limit)
{
int id, cmd;
struct dqblk quota;
CAMLparam5(v_user_or_group, v_id, v_path, v_bytes_limit, v_inodes_limit);
id = Int_val(v_id);
cmd = quota_command(v_user_or_group, QUOTA_MODIFY_COMMAND);
memset("a, 0, sizeof(quota));
quota.dqb_bsoftlimit = Int63_val(Field(v_bytes_limit, 0)) / QUOTA_BYTES_PER_SPACE_UNIT;
quota.dqb_bhardlimit = Int63_val(Field(v_bytes_limit, 1)) / QUOTA_BYTES_PER_SPACE_UNIT;
quota.dqb_btime = (time_t) Double_val(Field(v_bytes_limit, 2));
quota.dqb_isoftlimit = Int63_val(Field(v_inodes_limit, 0));
quota.dqb_ihardlimit = Int63_val(Field(v_inodes_limit, 1));
quota.dqb_itime = (time_t) Double_val(Field(v_inodes_limit, 2));
QUOTA_SET_VALID_FIELDS(quota);
if (quota_control(String_val(v_path), cmd, id, (caddr_t)"a))
unix_error(errno, "Unix.Quota: unable to set quota", v_path);
CAMLreturn(Val_unit);
}
CAMLprim value spoc_cublasDgemm(value transa, value transb,
value m, value n, value k,
value alpha, value a, value lda,
value b, value ldb, value beta, value c, value ldc, value dev){
CAMLparam5(transa, transb, m, n, k);
CAMLxparam5(alpha, a, lda, b, ldb);
CAMLxparam4(beta, c, ldc, dev);
CAMLlocal3(dev_vec_array, dev_vec, gi);
CUdeviceptr d_A;
CUdeviceptr d_B;
CUdeviceptr d_C;
int id;
gi = Field(dev, 0);
id = Int_val(Field(gi, 7));
GET_VEC(a, d_A);
GET_VEC(b, d_B);
GET_VEC(c, d_C);
//CUBLAS_GET_CONTEXT;
CUBLAS_GET_CONTEXT;
cublasDgemm (Int_val(transa), Int_val(transb), Int_val(m), Int_val(n),
Int_val(k), (double)Double_val(alpha), (double*) d_A, Int_val(lda),
(double*) d_B, Int_val(ldb), (double) Double_val(beta),
(double *)d_C, Int_val(ldc));
CUDA_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
/* Fill a buffer from a slice of a Binarary.t */
CAMLprim value string_from_binary_array (value src_arr, value buffer, value src_idx, value src_len, value dst_idx)
{
CAMLparam5 (src_arr, buffer, src_idx, src_len, dst_idx);
char *dst = (String_val(buffer)) + (Long_val(dst_idx));
memmove (dst, (char *) Data_bigarray_val(src_arr) + (Long_val(src_idx)), Long_val(src_len));
CAMLreturn (Val_unit);
}
CAMLprim value spoc_cublasSetMatrix (value rows, value cols, value a, value lda, value b, value ldb, value dev){
CAMLparam5(rows, cols, a, lda, b);
CAMLxparam2(ldb, dev);
CAMLlocal4(dev_vec_array, dev_vec, gi, bigArray);
CUdeviceptr d_B;
void* h_A;
int type_size = sizeof(double);
int tag;
int id;
gi = Field(dev, 0);
id = Int_val(Field(gi, 7));
GET_VEC(b, d_B);
GET_HOST_VEC (a, h_A);
CUBLAS_GET_CONTEXT;
int custom = 0;
GET_TYPE_SIZE;
//printf("rows : %d, col: %d, type_size : %d, lda :%d, ldb : %d\n", Int_val(rows), Int_val(cols), type_size, Int_val (lda), Int_val(ldb));
//fflush(stdout);
CUBLAS_CHECK_CALL(cublasSetMatrix(Int_val(rows), Int_val(cols), type_size, h_A, Int_val(lda), (void*) d_B, Int_val(ldb)));
CUBLAS_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
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);
}
value caml_vc_funType3(value vc, value a1, value a2, value a3, value tr)
{
CAMLparam5(vc,a1,a2,a3,tr);
CAMLreturn(alloc_Type(vc_funType3(VC_val(vc),Type_val(a1),
Type_val(a2),Type_val(a3),
Type_val(tr))));
}
//+ external dopen : t -> string -> db_type -> open_flag list
//+ -> int -> unit = "caml_db_open"
value caml_db_open(value db, value vfname,
value vdbtype, value vflags,
value vmode){
CAMLparam5(db, vfname, vdbtype, vflags, vmode);
int err;
char *fname = String_val(vfname);
int flags = convert_flag_list(vflags,db_open_flags);
int dbtype = Flag_val(vdbtype,db_types);
test_db_closed(db);
err = UW_db(db)->open(UW_db(db),
NULL,
fname,
NULL, /* no support for multiple databases in
a single file */
dbtype,
flags, /* automatic transaction on database open */
Long_val(vmode) );
if (err != 0) {
UW_db(db)->err(UW_db(db),err,
"caml_db_open");
}
CAMLreturn (Val_unit);
}
CAMLprim value
caml_udpv4_recvfrom(value v_fd, value v_str, value v_off, value v_len, value v_src)
{
CAMLparam5(v_fd, v_str, v_off, v_len, v_src);
CAMLlocal3(v_ret, v_err, v_inf);
unsigned char *buf = String_val(v_str) + Int_val(v_off);
size_t len = Int_val(v_len);
int fd = Int_val(v_fd);
struct sockaddr_in sa;
socklen_t sa_len = sizeof(sa);
int r = recvfrom(fd, (void *)buf, len, MSG_DONTWAIT, (struct sockaddr *)&sa, &sa_len);
if (r < 0) {
if (errno == EAGAIN || errno==EWOULDBLOCK)
Val_WouldBlock(v_ret);
else {
v_err = caml_copy_string(strerror(errno));
Val_Err(v_ret, v_err);
}
} else {
v_inf = caml_alloc_tuple(3);
Store_field(v_inf, 0, caml_copy_int32(ntohl(sa.sin_addr.s_addr)));
Store_field(v_inf, 1, Val_int(ntohs(sa.sin_port)));
Store_field(v_inf, 2, Val_int(r));
Val_OK(v_ret, v_inf);
}
CAMLreturn(v_ret);
}
value caml_vc_bvWriteToMemoryArray(value vc, value arr, value bi,
value e, value num)
{
CAMLparam5(vc,arr,bi,e,num);
CAMLreturn(alloc_Expr(vc_bvWriteToMemoryArray(VC_val(vc),Expr_val(arr),
Expr_val(bi),Expr_val(e),
Int_val(num))));
}
CAMLprim value sunml_nvec_par_n_vlinearsum(value va, value vx, value vb, value vy,
value vz)
{
CAMLparam5(va, vx, vb, vy, vz);
N_VLinearSum_Parallel(Double_val(va), NVEC_VAL(vx), Double_val(vb),
NVEC_VAL(vy), NVEC_VAL(vz));
CAMLreturn (Val_unit);
}
void tbstub_change_cell(value caml_x, value caml_y, value caml_ch, value caml_fg, value caml_bg) {
CAMLparam5(caml_x, caml_y, caml_ch, caml_fg, caml_bg);
tb_change_cell(Int_val(caml_x), Int_val(caml_y), Int32_val(caml_ch), Int_val(caml_fg), Int_val(caml_bg));
CAMLreturn0;
}
void hdf5_h5l_move(value src_loc_v, value src_name_v, value dest_loc_v, value lcpl_v,
value lapl_v, value dest_name_v)
{
CAMLparam5(src_loc_v, src_name_v, dest_loc_v, lcpl_v, lapl_v);
CAMLxparam1(dest_name_v);
raise_if_fail(H5Lmove(Hid_val(src_loc_v), String_val(src_name_v), Hid_val(dest_loc_v),
String_val(dest_name_v), H5P_opt_val(lcpl_v), H5P_opt_val(lapl_v)));
CAMLreturn0;
}
value hdf5_h5l_create_hard(value obj_loc_v, value obj_name_v, value link_loc_v,
value lcpl_v, value lapl_v, value link_name_v)
{
CAMLparam5(obj_loc_v, obj_name_v, link_loc_v, lcpl_v, lapl_v);
CAMLxparam1(link_name_v);
CAMLreturn(alloc_h5l(H5Lcreate_hard(Hid_val(obj_loc_v), String_val(obj_name_v),
Hid_val(link_loc_v), String_val(link_name_v), H5P_opt_val(lcpl_v),
H5P_opt_val(lapl_v))));
}
value f_i5_caml(value i0, value i1, value i2, value i3, value i4) {
CAMLparam5(i0,i1,i2,i3,i4);
int ii0 = Int_val(i0);
int ii1 = Int_val(i1);
int ii2 = Int_val(i2);
int ii3 = Int_val(i3);
int ii4 = Int_val(i4);
CAMLreturn(Val_int(f_i5(ii0,ii1,ii2,ii3,ii4)));
}
CAMLprim value caml_extunix_linkat(value v_olddirfd, value v_oldname, value v_newdirfd, value v_newname, value v_flags)
{
CAMLparam5(v_olddirfd, v_oldname, v_newdirfd, v_newname, v_flags);
int ret = 0;
int flags = caml_convert_flag_list(v_flags, at_flags_table);
flags &= AT_SYMLINK_FOLLOW; /* only allowed flag here */
ret = linkat(Int_val(v_olddirfd), String_val(v_oldname), Int_val(v_newdirfd), String_val(v_newname), flags);
if (ret != 0) uerror("linkat", v_oldname);
CAMLreturn(Val_unit);
}
/* Writes to a page from an OCaml string */
CAMLprim value
caml_page_write(value v_src, value v_srcoff, value v_dst, value v_dstoff, value v_len)
{
CAMLparam5(v_src, v_srcoff, v_dst, v_dstoff, v_len);
char *page = (char *)v_dst;
if (Int_val(v_dstoff) + Int_val(v_len) >= PAGE_SIZE || caml_string_length(v_src) + Int_val(v_srcoff) < Int_val(v_len))
caml_array_bound_error();
memcpy(page + Int_val(v_srcoff), String_val(v_src) + Int_val(v_srcoff), Int_val(v_len));
CAMLreturn(Val_unit);
}
value f_i6_caml(value i0, value i1, value i2, value i3, value i4, value i5) {
CAMLparam5(i0,i1,i2,i3,i4);
CAMLxparam1(i5);
int ii0 = Int_val(i0);
int ii1 = Int_val(i1);
int ii2 = Int_val(i2);
int ii3 = Int_val(i3);
int ii4 = Int_val(i4);
int ii5 = Int_val(i5);
CAMLreturn(Val_int(f_i6(ii0,ii1,ii2,ii3,ii4,ii5)));
}
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 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);
}
value f_i8_caml(value i0, value i1, value i2, value i3, value i4, value i5, value i6, value i7) {
CAMLparam5(i0,i1,i2,i3,i4);
CAMLxparam3(i5,i6,i7);
int ii0 = Int_val(i0);
int ii1 = Int_val(i1);
int ii2 = Int_val(i2);
int ii3 = Int_val(i3);
int ii4 = Int_val(i4);
int ii5 = Int_val(i5);
int ii6 = Int_val(i6);
int ii7 = Int_val(i7);
CAMLreturn(Val_int(f_i8(ii0,ii1,ii2,ii3,ii4,ii5,ii6,ii7)));
}