CAMLprim value spoc_cuda_custom_load_param_vec(value off, value ex, value A, value v){
CAMLparam4(off, ex, A, v);
CAMLlocal1(customArray);
cu_vector* cuv;
CUdeviceptr d_A;
char *extra;
int offset;
int seek;
int type_size;
int tag;
void* ptr;
seek = Int_val(Field(v,10));
customArray = Field (Field(v, 1), 0);
type_size = Int_val(Field(Field(customArray, 1),1));
extra = (char*)ex;
offset = Int_val(Field(off, 0));
cuv = (cu_vector*)Field(A, 1);
d_A = cuv->cu_vector;
ptr = (void*) (size_t) d_A + seek * type_size;
ADD_TO_PARAM_BUFFER(ptr, __alignof(d_A));
Store_field(off, 0, Val_int(offset));
CAMLreturn(Val_unit);
}
CAMLprim value sunml_spils_qr_sol(value vn, value vh, value vq, value vb)
{
CAMLparam4(vn, vh, vq, vb);
int r;
int n = Int_val(vn);
#if SUNDIALS_ML_SAFE == 1
struct caml_ba_array *bh = ARRAY2_DATA(vh);
intnat hm = bh->dim[1];
intnat hn = bh->dim[0];
if (hn < n + 1)
caml_invalid_argument("qr_sol: h is too small (< n + 1).");
if (hm < n)
caml_invalid_argument("qr_sol: h is too small (< n).");
if (ARRAY1_LEN(vq) < 2 * n)
caml_invalid_argument("qr_sol: q is too small (< 2n).");
if (ARRAY1_LEN(vb) < n + 1)
caml_invalid_argument("qr_sol: b is too small (< n + 1).");
#endif
r = QRsol(n, ARRAY2_ACOLS(vh), REAL_ARRAY(vq), REAL_ARRAY(vb));
if (r != 0) {
caml_raise_with_arg(MATRIX_EXN_TAG(ZeroDiagonalElement),
Val_long(r));
}
CAMLreturn (Val_unit);
}
value caml_curses_newwin(value nlines, value ncols, value beginy, value beginx) {
CAMLparam4(nlines, ncols, beginy, beginx);
failwith("No ncurses support enabled");
CAMLreturn(Val_unit);
}
CAMLprim value netsys_openat(value dirfd, value path, value flags, value perm)
{
#ifdef HAVE_AT
CAMLparam4(dirfd, path, flags, perm);
int ret, cv_flags;
char * p;
/* shamelessly copied from ocaml distro */
cv_flags = convert_flag_list(flags, open_flag_table);
p = stat_alloc(string_length(path) + 1);
strcpy(p, String_val(path));
enter_blocking_section();
ret = openat(Int_val(dirfd), p, cv_flags, Int_val(perm));
leave_blocking_section();
stat_free(p);
if (ret == -1) uerror("openat", path);
#if defined(NEED_CLOEXEC_EMULATION) && defined(FD_CLOEXEC)
if (convert_flag_list(flags, open_cloexec_table) != 0) {
int flags = fcntl(Int_val(dirfd), F_GETFD, 0);
if (flags == -1 || fcntl(Int_val(dirfd), F_SETFD, flags | FD_CLOEXEC) == -1)
uerror("openat", path);
}
#endif
CAMLreturn (Val_int(ret));
#else
invalid_argument("Netsys_posix.openat not available");
#endif
}
CAMLprim value caml_mdb_del(value txn,value dbi,value key,value data){
CAMLparam4(txn,dbi,key,data);
MDB_val key_,data_;
key_.mv_data=String_val(key);
key_.mv_size=caml_string_length(key);
int ret;
if(data ==Val_int(0)){
if((ret=mdb_del( (MDB_txn*)txn, (MDB_dbi) Int_val(dbi), &key_, NULL ))){
if(ret==MDB_NOTFOUND) {
static value *exn=NULL;
if(exn==NULL) exn=caml_named_value("lmdb_not_found");
caml_raise_constant(*exn);
} else
caml_failwith("error in mdb_del");
}
} else {
value x=Field(data,0);
data_.mv_data=String_val(x);
data_.mv_size=caml_string_length(x);
if((ret=mdb_del( (MDB_txn*)txn, (MDB_dbi) Int_val(dbi), &key_, &data_ ))){
caml_failwith("error in mdb_del");
}
}
CAMLreturn0;
}
//+ external get : t -> ?txn:txn -> string -> get_flag list -> string
//+ = "caml_db_get"
value caml_db_get(value db, value txn_opt, value vkey, value vflags) {
CAMLparam4(db, txn_opt, vkey, vflags);
DBT key,data;
int flags, err;
DB_TXN *txn;
CAMLlocal1(rval);
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);
flags = convert_flag_list(vflags, db_get_flags);
err = UW_db(db)->get(UW_db(db), txn, &key, &data, flags);
if (err != 0) {
////fprintf(stderr,"Error found: %d\n",err); fflush(stderr);
if (err == DB_NOTFOUND) { raise_not_found(); }
UW_db(db)->err(UW_db(db),err,"caml_db_get");
}
// FIX: this currently uses an extra, unnecessary copy in order to simplify
// memory management.
rval = alloc_string(data.size);
memcpy (String_val(rval), data.data, data.size);
CAMLreturn (rval);
}
//+ external init_both : t -> key:string -> data:string
//+ -> get_flag list -> unit = "caml_cursor_init_both"
value caml_cursor_init_both(value cursor, value vkey,
value vdata , value vflags
) {
CAMLparam4(cursor,vkey,vdata,vflags);
DBT key,data;
int flags;
int err;
/* int ctr = 0; */
flags = convert_flag_list(vflags,cursor_get_flags) | DB_GET_BOTH;
test_cursor_closed(cursor);
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);
err = UW_cursor(cursor)->c_get(UW_cursor(cursor), &key, &data, flags);
if (err != 0) {
if (err == DB_NOTFOUND) { raise_not_found (); }
raise_db(db_strerror(err));
}
CAMLreturn (Val_unit);
}
CAMLprim value stub_gnttab_map_fresh(
value xgh,
value reference,
value domid,
value writable
)
{
CAMLparam4(xgh, reference, domid, writable);
CAMLlocal2(pair, contents);
void *map =
xc_gnttab_map_grant_ref(_G(xgh), Int_val(domid), Int_val(reference),
Bool_val(writable)?PROT_READ | PROT_WRITE:PROT_READ);
if(map==NULL) {
caml_failwith("Failed to map grant ref");
}
contents = caml_ba_alloc_dims(XC_GNTTAB_BIGARRAY, 1,
map, 1 << XC_PAGE_SHIFT);
pair = caml_alloc_tuple(2);
Store_field(pair, 0, contents); /* grant_handle */
Store_field(pair, 1, contents); /* Io_page.t */
CAMLreturn(pair);
}
CAMLprim value caml_extunix_renameat(value v_oldfd, value v_oldname, value v_newfd, value v_newname)
{
CAMLparam4(v_oldfd, v_oldname, v_newfd, v_newname);
int ret = renameat(Int_val(v_oldfd), String_val(v_oldname), Int_val(v_newfd), String_val(v_newname));
if (ret != 0) uerror("renameat", v_oldname);
CAMLreturn(Val_unit);
}
//+ external ajoin : ?nosort:bool -> db -> cursor array -> get_flag list ->
//+ cursor = "caml_join_cursors"
//+ let join ?nosort db cursor_list get_flag_list =
//+ ajoin ?nosort db (Array.of_list cursor_list) get_flag_list
value caml_join_cursors(value vnosort, value db,
value vcursors, value vflags) {
CAMLparam4(vnosort,db,vcursors,vflags);
CAMLlocal1(rval);
DBC *jcurs; // pointer to joined cursor
int carray_len = Wosize_val(vcursors);
int flags = convert_flag_list(vflags,cursor_get_flags);
DBC *cursors[carray_len + 1];
int i;
if (Is_Some(vnosort) && Bool_val(vnosort)) {
flags = flags | DB_JOIN_NOSORT;
}
for (i=0; i < carray_len; i++) {
if (UW_cursor_closed(Field(vcursors,i))) {
invalid_argument("caml_join_cursors: Attempt to use closed cursor");
}
cursors[i] = UW_cursor(Field(vcursors,i));
}
cursors[i] = NULL;
test_db_closed(db);
UW_db(db)->join(UW_db(db),cursors,&jcurs,flags);
rval = alloc_custom(&cursor_custom,Camlcursor_wosize,0,1);
UW_cursor(rval) = jcurs;
UW_cursor_closed(rval) = False;
CAMLreturn (rval);
}
value caml_vc_recordTypeN(value vc, value fields, value types, value num)
{
char **fs;
Type *ts;
int i;
CAMLparam4(vc,fields,types,num);
CAMLlocal1(result);
fs = (char **)malloc(Int_val(num) * sizeof(char *));
if( !fs )
caml_failwith("malloc returned NULL in vc_recordTypeN wrapper");
ts = (Type *)malloc(Int_val(num) * sizeof(Type));
if( !ts ) {
free( fs );
caml_failwith("malloc returned NULL in vc_recordTypeN wrapper");
}
for( i = 0; i < Int_val(num); i++ ) {
fs[i] = String_val(Field(fields,i));
ts[i] = Type_val(Field(types,i));
}
result = alloc_Type(vc_recordTypeN(VC_val(vc),fs,ts,Int_val(num)));
free(ts);
free(fs);
CAMLreturn(result);
}
CAMLprim value caml_ml_input(value vchannel, value buff, value vstart,
value vlength)
{
CAMLparam4 (vchannel, buff, vstart, vlength);
struct channel * channel = Channel(vchannel);
intnat start, len;
int n, avail, nread;
Lock(channel);
/* We cannot call caml_getblock here because buff may move during
caml_do_read */
start = Long_val(vstart);
len = Long_val(vlength);
n = len >= INT_MAX ? INT_MAX : (int) len;
avail = channel->max - channel->curr;
if (n <= avail) {
memmove(&Byte(buff, start), channel->curr, n);
channel->curr += n;
} else if (avail > 0) {
memmove(&Byte(buff, start), channel->curr, avail);
channel->curr += avail;
n = avail;
} else {
nread = caml_do_read(channel->fd, channel->buff,
channel->end - channel->buff);
channel->offset += nread;
channel->max = channel->buff + nread;
if (n > nread) n = nread;
memmove(&Byte(buff, start), channel->buff, n);
channel->curr = channel->buff + n;
}
Unlock(channel);
CAMLreturn (Val_long(n));
}
value caml_vc_setStrSeqFlag(value flags, value name, value str, value val)
{
CAMLparam4(flags,name,str,val);
vc_setStrSeqFlag(Flags_val(flags),String_val(name),
String_val(val),Int_val(val));
CAMLreturn(Val_unit);
}
CAMLprim value stub_sockopt_set_sock_keepalives(value fd, value count, value idle, value interval)
{
CAMLparam4(fd, count, idle, interval);
int c_fd = Int_val(fd);
int optval;
socklen_t optlen=sizeof(optval);
optval = Int_val(count);
if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPCNT, &optval, optlen) < 0) {
uerror("setsockopt(TCP_KEEPCNT)", Nothing);
}
#if defined(__linux__)
optval = Int_val(idle);
if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPIDLE, &optval, optlen) < 0) {
uerror("setsockopt(TCP_KEEPIDLE)", Nothing);
}
#endif
optval = Int_val(interval);
if(setsockopt(c_fd, TCP_LEVEL, TCP_KEEPINTVL, &optval, optlen) < 0) {
uerror("setsockopt(TCP_KEEPINTVL)", Nothing);
}
CAMLreturn(Val_unit);
}
CAMLprim value stub_sha1_update(value ctx, value data, value ofs, value len)
{
CAMLparam4(ctx, data, ofs, len);
sha1_update(GET_CTX_STRUCT(ctx), String_val(data) + Int_val(ofs), Int_val(len));
CAMLreturn(Val_unit);
}
CAMLprim value caml_mdb_cursor_get(value curs,value key,value data,value op){
CAMLparam4(curs,key,data,op);
CAMLlocal3(result,mlkey,mldata);
MDB_val key_,data_;
key_.mv_data=String_val(key);
key_.mv_size=caml_string_length(key);
data_.mv_data=String_val(data);
data_.mv_size=caml_string_length(data);
int ret;
if((ret=mdb_cursor_get( (MDB_cursor*)curs, &key_, &data_, Int_val(op) ))){
if(ret==MDB_NOTFOUND) {
static value *exn=NULL;
if(exn==NULL) exn=caml_named_value("lmdb_not_found");
caml_raise_constant(*exn);
} else
caml_failwith("error in mdb_cursor_get");
}
mlkey=caml_alloc_string(key_.mv_size);
memcpy(String_val(mlkey),key_.mv_data,key_.mv_size);
mldata=caml_alloc_string(data_.mv_size);
memcpy(String_val(mldata),data_.mv_data,data_.mv_size);
result=caml_alloc(2,0);
Store_field(result,0,mlkey);
Store_field(result,1,mldata);
CAMLreturn(result);
}
value
caml_drawtext(value string, value pos, value matches, value colors) {
CAMLparam4(string, pos, matches, colors);
size_t size = textw(dc, String_val (string));
int x = Int_val(Field(pos, 0));
if (bottom)
/* magic formula */
dc->y = mh - (bh - dc->font.ascent - 1 + Int_val(Field(pos, 1)) * bh);
else
dc->y = dc->font.ascent+1 + Int_val(Field(pos, 1)) * bh;
drawrect(dc, x, dc->y-dc->font.ascent-1, size, bh, True, getcolor(dc, String_val(Field(colors, 2))));
int start, stop;
unsigned long fg;
int xoff = x + dc->font.height/2;
const char *str = String_val (string);
value head;
while (matches != Val_int(0)) {
head = Field (matches, 0);
matches = Field (matches, 1);
dc->x = xoff;
fg = getcolor(dc, String_val(Int_val(Field(head, 0)) == 0 ? Field(colors, 0) : Field(colors, 1)));
start = Int_val(Field (head, 1));
stop = Int_val(Field (head, 2));
xoff += drawtext(dc, str, start, stop, fg);
}
CAMLreturn(Val_int(x + size));
}
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 ml_QObject_connect (value sender, value signal, value receiver, value member) {
CAMLparam4(sender,signal,receiver,member);
char *sg = String_val(signal);
char *sl = String_val(member);
int len1 = strlen(sg), len2 = strlen(sl);
char cc1[len1+2];
char cc2[len2+2];
// printf("signal = %s, slot = %s\n", sg, sl);
cc1[len1+1] = cc2[len2+1] = '\0';
cc1[0] = '2'; cc2[0] = '1';
int i=1;
for ( ;i<=len1; ++i) cc1[i] = sg[i-1];
for (i=1;i<=len2; ++i) cc2[i] = sl[i-1];
// QString s1 = QString("2%1").arg(QString(sg)),
// s2 = QString("1%1").arg(QString(sl));
// printf("signal = %s, slot = %s\n", s1.toLocal8Bit().data(), s2.toLocal8Bit().data() );
// const char *loc1 = s1.toLocal8Bit().data();
// const char *loc2 = s2.toLocal8Bit().data();
printf ("trying to connect %s -> %s\n", cc1, cc2);
CAMLreturn(
Val_bool
(QObject::connect(QObject_val(sender),
cc1,
QObject_val(receiver),
cc2) ) );
}
CAMLprim value stub_gnttab_map_fresh(value i, value r, value d, value w)
{
CAMLparam4(i, r, d, w);
/* The OCaml code will never call this because gnttab_allocates is false */
printk("FATAL ERROR: stub_gnttab_map_fresh called\n");
caml_failwith("stub_gnttab_map_fresh");
}
CAMLprim value stub_load_rsa_keys(value keys, value cert, value priv, value trustedCA)
{
CAMLparam4(keys,cert,priv,trustedCA);
unsigned char *c_cert = (unsigned char *)strdup(String_val(cert));
unsigned char *c_priv = (unsigned char *)strdup(String_val(priv));
unsigned char *c_trustedCA = (unsigned char *)strdup(String_val(trustedCA));
int cert_len = caml_string_length(cert);
int priv_len = caml_string_length(priv);
int trustedCA_len = caml_string_length(trustedCA);
fprintf(stderr,"Got lens: %d %d %d\n",cert_len,priv_len,trustedCA_len);
if(cert_len==0) c_cert=NULL;
if(priv_len==0) c_priv=NULL;
if(trustedCA_len==0) c_trustedCA=NULL;
int rc;
rc=matrixSslLoadRsaKeysMem(sslKeys_t_val(keys), c_cert, cert_len, c_priv, priv_len,
c_trustedCA, trustedCA_len);
if(rc<0) {
fprintf(stderr,"rc=%d\n",rc);
caml_failwith("Failed to load certificates");
}
CAMLreturn(Val_unit);
}
CAMLprim value caml_mdb_env_open(value env,value path,value flags,value mode){
CAMLparam4(env,path,flags,mode);
if(mdb_env_open((MDB_env*)env,String_val(path),Int_val(flags),Int_val(mode))){
caml_failwith("error in mdb_env_open");
}
CAMLreturn(env);
}
value f_i4_caml(value i0, value i1, value i2, value i3) {
CAMLparam4(i0,i1,i2,i3);
int ii0 = Int_val(i0);
int ii1 = Int_val(i1);
int ii2 = Int_val(i2);
int ii3 = Int_val(i3);
CAMLreturn(Val_int(f_i4(ii0,ii1,ii2,ii3)));
}
CAMLprim value ocaml_faad_mp4_open_read(value metaonly, value read, value write, value seek, value trunc)
{
CAMLparam4(read, write, seek, trunc);
CAMLlocal1(ans);
mp4_t *mp = malloc(sizeof(mp4_t));
mp->fd = -1;
mp->ff_cb.read = read_cb;
mp->read_cb = read;
caml_register_global_root(&mp->read_cb);
if (Is_block(write))
{
mp->ff_cb.write = write_cb;
mp->write_cb = Field(write, 0);
caml_register_global_root(&mp->write_cb);
}
else
{
mp->ff_cb.write = NULL;
mp->write_cb = 0;
}
if (Is_block(seek))
{
mp->ff_cb.seek = seek_cb;
mp->seek_cb = Field(seek, 0);
caml_register_global_root(&mp->seek_cb);
}
else
{
mp->ff_cb.seek = NULL;
mp->seek_cb = 0;
}
if (Is_block(trunc))
{
mp->ff_cb.truncate = trunc_cb;
mp->trunc_cb = Field(trunc, 0);
caml_register_global_root(&mp->trunc_cb);
}
else
{
mp->ff_cb.truncate = NULL;
mp->trunc_cb = 0;
}
mp->ff_cb.user_data = mp;
caml_enter_blocking_section();
if(Bool_val(metaonly))
mp->ff = mp4ff_open_read_metaonly(&mp->ff_cb);
else
mp->ff = mp4ff_open_read(&mp->ff_cb);
caml_leave_blocking_section();
assert(mp->ff);
ans = caml_alloc_custom(&mp4_ops, sizeof(mp4_t*), 1, 0);
Mp4_val(ans) = mp;
CAMLreturn(ans);
}
CAMLprim value stub_sha1_update(value ctx, value data, value ofs, value len)
{
CAMLparam4(ctx, data, ofs, len);
sha1_update(GET_CTX_STRUCT(ctx), (unsigned char *) data + Long_val(ofs),
Long_val(len));
CAMLreturn(Val_unit);
}
CAMLprim value cstring_to_binary_array (value dst_arr, value dst_idx, value dst_len, value src_str)
{
CAMLparam4 (dst_arr, dst_idx, dst_len, src_str);
int len = string_length (src_str), idx = Long_val(dst_idx), dlen = Long_val(dst_len);
if (idx + dlen > Bigarray_val(dst_arr)->dim[0] || len > dlen) invalid_argument ("Binarray.write_sz");
memcpy ((char *) Data_bigarray_val(dst_arr) + idx, String_val(src_str), len);
memset ((char *) Data_bigarray_val(dst_arr) + idx + len, 0, dlen - len);
CAMLreturn (Val_unit);
}
void hdf5_h5lt_make_dataset(value loc_id_v, value dset_name_v, value type_id_v,
value buffer_v)
{
CAMLparam4(loc_id_v, dset_name_v, type_id_v, buffer_v);
struct caml_ba_array *buffer = Caml_ba_array_val(buffer_v);
raise_if_fail(H5LTmake_dataset(Hid_val(loc_id_v), String_val(dset_name_v),
buffer->num_dims, (const hsize_t*) buffer->dim, Hid_val(type_id_v), buffer->data));
CAMLreturn0;
}
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
caml_gnttab_grant_access(value v_ref, value v_bs, value v_domid, value v_readonly)
{
CAMLparam4(v_ref, v_bs, v_domid, v_readonly);
grant_ref_t ref = Int32_val(v_ref);
char *page = String_val(Field(v_bs, 0)) + (Int_val(Field(v_bs,1)) / 8);
ASSERT(((unsigned long)page) % PAGE_SIZE == 0);
gnttab_grant_access(ref, page, Int_val(v_domid), Bool_val(v_readonly));
CAMLreturn(Val_unit);
}
CAMLprim value
netcgi2_apache_request_output(value rv, value bufv, value ofsv, value lenv)
{
CAMLparam4(rv, bufv, ofsv, lenv);
request_rec *r = Request_rec_val(rv);
int ofs = Int_val(ofsv);
int len = Int_val(lenv);
int i = ap_rwrite(String_val(bufv) + ofs, len, r);
CAMLreturn(Val_int (i));
}
