CAMLprim value stub_asl_set(value m, value key, value val) {
CAMLparam3(m, key, val);
const char *c_key = strdup(String_val(key));
const char *c_val = strdup(String_val(val));
caml_release_runtime_system();
asl_set(Msg_val(m), c_key, c_val);
caml_acquire_runtime_system();
free((void*)c_key);
free((void*)c_val);
CAMLreturn(0);
}
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)));
}
value caml_curses_wmove(value mlwindow, value y, value x) {
CAMLparam3(mlwindow, y, x);
WINDOW *window = window_of_ml(mlwindow);
/* Move the cursor in the indicated window */
wmove(window, Int_val(y), Int_val(x));
CAMLreturn(Val_unit);
}
CAMLprim value
caml_gnttab_read(value v_gw, value v_off, value v_size)
{
CAMLparam3(v_gw, v_off, v_size);
CAMLlocal1(v_ret);
gnttab_wrap *gw = Gnttab_wrap_val(v_gw);
BUG_ON(gw->page == NULL);
v_ret = caml_alloc_string(Int_val(v_size));
memcpy(String_val(v_ret), gw->page + Int_val(v_off), Int_val(v_size));
CAMLreturn(v_ret);
}
value
v2v_xml_node_ptr_set_prop (value nodev, value namev, value valv)
{
CAMLparam3 (nodev, namev, valv);
xmlNodePtr node = (xmlNodePtr) nodev;
if (xmlSetProp (node, BAD_CAST String_val (namev), BAD_CAST String_val (valv))
== NULL)
caml_invalid_argument ("node_ptr_set_prop: failed to set property");
CAMLreturn (Val_unit);
}
CAMLprim value win_putenv(value var, value wvar, value v)
{
BOOL res;
CAMLparam3(var, wvar, v);
res = SetEnvironmentVariableW((LPCWSTR) String_val(wvar), (LPCWSTR) v);
if (res == 0) {
win32_maperr (GetLastError ());
uerror("putenv", var);
}
CAMLreturn (Val_unit);
}
value
create_tuple(value a, value b, value c){
CAMLparam3(a,b,c);
CAMLlocal1(tmp);
tmp=caml_alloc(3,0); // allocate 3 tag 0 on ocaml heap
Store_field(tmp,1,a);
Store_field(tmp,2,a);
Store_field(tmp,3,a);
CAMLreturn(tmp);
}
CAMLprim value ml_gtk_text_buffer_get_iter_at_line_index(value tb,
value l,
value c)
{
CAMLparam3(tb,l,c);
GtkTextIter res;
gtk_text_buffer_get_iter_at_line_offset(GtkTextBuffer_val(tb),
&res,
Int_val(l),
Int_val(c));
CAMLreturn(Val_GtkTextIter(&res));
}
value
sankoff_CAML_dist_2(value a, value b,value c) {
CAMLparam3(a,b,c);
eltarr_p eapD;
eltarr_p eapA;
eltarr_p eapR;
eapD = Sankoff_return_eltarr(a);
eapA = Sankoff_return_eltarr(b);
eapR = Sankoff_return_eltarr(c);
int res = sankoff_dist_2(eapD,eapA,eapR);
CAMLreturn(Val_int(res));
}
PREFIX value ml_evas_object_smart_callback_add(
value v_obj, value v_event, value v_func)
{
CAMLparam3(v_obj, v_event, v_func);
value* data = caml_stat_alloc(sizeof(value));
*data = v_func;
caml_register_global_root(data);
const char* event = String_val(v_event);
evas_object_smart_callback_add((Evas_Object*) v_obj, event,
ml_Evas_Smart_Cb, data);
CAMLreturn(Val_unit);
}
CAMLprim value Wrapper_FT_Load_Glyph(value face, value glyph_index, value load_flags)
{
CAMLparam3(face, glyph_index, load_flags);
FT_Face f;
f = *(FT_Face *)Data_custom_val(face);
if (FT_Load_Glyph(f, Int_val(glyph_index), Int_val(load_flags)))
failwith("FT_Load_Glyph");
CAMLreturn(Val_unit);
};
CAMLprim value ocamlyices_type_tuple3(value v_tau1, value v_tau2,
value v_tau3) {
CAMLparam3(v_tau1, v_tau2, v_tau3);
type_t res;
res = yices_tuple_type3(Type_val(v_tau1), Type_val(v_tau2), Type_val(v_tau3));
if (res == NULL_TYPE) {
_oy_error();
}
CAMLreturn(Val_type(res));
}
t_value ml_glgetactiveattrib (value program, value index, value bufsize)
{
CAMLparam3 (program, index, bufsize);
CAMLlocal1 (name);
GLsizei len;
GLint size;
GLenum type;
char *buffer = (char *)malloc (sizeof(char) * bufsize);
glGetActiveAttrib (Long_val(program), Int_val(index), Int_val(bufsize), &len, &size, &type, buffer);
name = caml_copy_string (buffer);
CAMLreturn (name);
}
value
sankoff_CAML_init_beta (value this_elt, value position, value cost)
{
CAMLparam3(this_elt,position,cost);
elt_p ep;
Sankoff_elt_custom_val(ep,this_elt);
int pos, c;
pos = Int_val(position);
c = Int_val(cost);
sankoff_set_beta(ep,pos,c);
CAMLreturn (Val_unit);
}
CAMLprim value spoc_cuda_set_block_shape(value ker, value block, value gi){
CAMLparam3(ker, block, gi);
CUfunction *kernel;
CUDA_GET_CONTEXT;
kernel = (CUfunction*) ker;
CUDA_CHECK_CALL(cuFuncSetBlockShape(*kernel, Int_val(Field(block,0)),Int_val(Field(block,1)),Int_val(Field(block,2))));
CUDA_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
CAMLprim value sunml_lsolver_call_atimes(value vcptr, value vv, value vz)
{
CAMLparam3(vcptr, vv, vz);
int r;
r = ATIMES_WITH_DATA(vcptr)->atimes_func(
ATIMES_WITH_DATA(vcptr)->atimes_data, NVEC_VAL(vv), NVEC_VAL(vz));
if (r != 0)
caml_raise_with_arg(LSOLVER_EXN(ATimesFailure), Val_bool(r > 0));
CAMLreturn(Val_unit);
}
CAMLprim value spoc_cuda_load_param_int64(value off, value ex, value val){
CAMLparam3(off, ex, val);
int offset;
char *extra;
long long i;
extra = (char*)ex;
offset = Int_val(Field(off, 0));
i = (long long) Int_val(val);
ADD_TO_PARAM_BUFFER(i, __alignof(i));
Store_field(off, 0, Val_int(offset));
CAMLreturn(Val_unit);
}
CAMLprim value spoc_cuda_load_param_float64(value off, value ex, value val){
CAMLparam3(off, ex, val);
int offset;
char *extra;
double f;
extra = (char*)ex;
offset = Int_val(Field(off, 0));
f = Double_val(val);
ADD_TO_PARAM_BUFFER(f, __alignof(f));
Store_field(off, 0, Val_int(offset));
CAMLreturn(Val_unit);
}
CAMLprim value ml_gsl_multimin_fminimizer_set(value S, value fun,
value X, value step_size)
{
CAMLparam3(S, X, step_size);
struct callback_params *p=CALLBACKPARAMS_VAL(S);
_DECLARE_VECTOR2(X,step_size);
_CONVERT_VECTOR2(X,step_size);
p->closure = fun;
gsl_multimin_fminimizer_set(GSLMULTIMINFMINIMIZER_VAL(S),
&(p->gslfun.mmf), &v_X, &v_step_size);
CAMLreturn(Val_unit);
}
CAMLprim value Wrapper_FT_Set_Char_Size(value face, value size, value dpi)
{
CAMLparam3(face, size, dpi);
FT_Face f;
f = *(FT_Face *)Data_custom_val(face);
if (FT_Set_Char_Size(f, 0, Int_val(size), Int_val(dpi), Int_val(dpi)))
failwith("FT_Set_Char_Size");
CAMLreturn(Val_unit);
};
CAMLprim value
caml_SDL_TTF_OpenFontIndex(value file, value ptsize, value index)
{
CAMLparam3(file, ptsize, index);
TTF_Font *font =
TTF_OpenFontIndex(
String_val(file), Int_val(ptsize), Int_val(index));
if (!font) error("Sdlttf.open_font_index");
CAMLreturn(Val_TTF_Font(font));
}
CAMLprim value cstring_of_binary_array (value src_arr, value src_idx, value src_len)
{
CAMLparam3 (src_arr, src_idx, src_len);
CAMLlocal1 (retval);
int len = Long_val(src_len);
char *retstr = (char *) calloc (len + 1, 1);
if (retstr == NULL) failwith ("unable to allocate internal buffer");
memcpy (retstr, (char *) Data_bigarray_val(src_arr) + (Long_val(src_idx)), len);
retval = copy_string (retstr);
free (retstr);
CAMLreturn (retval);
}
CAMLprim value setsockopt_stub(value sock, value sockopt, value val) {
CAMLparam3 (sock, sockopt, val);
int native_sockopt = Int_val(sockopt);
struct wrap *socket = Socket_val(sock);
int result = -1;
switch (native_sockopt) {
case ZMQ_SNDHWM:
case ZMQ_RCVHWM:
case ZMQ_RATE:
case ZMQ_RECOVERY_IVL:
case ZMQ_SNDBUF:
case ZMQ_RCVBUF:
case ZMQ_LINGER:
case ZMQ_RECONNECT_IVL_MAX:
case ZMQ_BACKLOG:
case ZMQ_MULTICAST_HOPS:
case ZMQ_RCVTIMEO:
case ZMQ_SNDTIMEO:
{
int optval = Int_val(val);
result = zmq_setsockopt(socket->wrapped, native_sockopt, &optval, sizeof(optval));
}
break;
case ZMQ_IDENTITY:
case ZMQ_SUBSCRIBE:
case ZMQ_UNSUBSCRIBE:
{
result = zmq_setsockopt(socket->wrapped,
native_sockopt,
String_val(val),
caml_string_length(val));
}
break;
case ZMQ_AFFINITY:
case ZMQ_MAXMSGSIZE:
{
int64 optval = Int64_val(val);
result = zmq_setsockopt(socket->wrapped, native_sockopt, &optval, sizeof(optval));
}
break;
default:
caml_failwith("Bidings error");
}
stub_raise_if (result == -1);
CAMLreturn (Val_unit);
}
value
sankoff_CAML_filter_character(value this_eltarr, value ecode_bigarr, value get_comp) {
CAMLparam3(this_eltarr,ecode_bigarr,get_comp);
CAMLlocal1(res);
int get_complementary = Int_val(get_comp);
int * ecode_arr = (int*) Data_bigarray_val(ecode_bigarr);
eltarr_p eap;
Sankoff_eltarr_custom_val(eap,this_eltarr);
int num_elts=eap->num_elts;
int res_num_elts=0;//must init to 0
int i;
elt_p ep;
int * sign_arr = (int*)calloc(num_elts,sizeof(int));
for (i=0;i<num_elts;i++) {
ep = &((eap->elts)[i]);
if(get_complementary) {
if( int_array_is_mem(ecode_arr,num_elts,ep->ecode) )
{ sign_arr[i]=0; }
else { sign_arr[i]=1; res_num_elts++; }
}
else {
if( int_array_is_mem(ecode_arr,num_elts,ep->ecode) )
{ sign_arr[i]=1; res_num_elts++; }
else sign_arr[i]=0;
}
}
eltarr_p res_eap;
res_eap = (eltarr_p)calloc(1,sizeof(struct elt_arr));
int num_states = eap->num_states;
res_eap->code = eap->code;
res_eap->num_states = eap->num_states;
res_eap->num_elts = res_num_elts;
res_eap->tcm = (int*)calloc(num_states*num_states,sizeof(int));
res_eap->is_identity = eap->is_identity;
memcpy (res_eap->tcm,eap->tcm,sizeof(int)*num_states*num_states);
res_eap->elts = (elt_p)calloc(res_num_elts,sizeof(struct elt));
elt_p res_elts = res_eap->elts;
int j=0;
for (i=0;i<num_elts;i++) {
if(sign_arr[i]==1) {
sankoff_create_empty_elt(&(res_elts[j]),num_states,-1);
sankoff_clone_elt(&(res_elts[j]),&((eap->elts)[i]));
j++;
}
}
free(sign_arr);
assert(j==res_num_elts);
res = caml_alloc_custom(&sankoff_custom_operations_eltarr,sizeof(eltarr_p),1,alloc_custom_max);
Sankoff_return_eltarr(res) = res_eap;
CAMLreturn(res);
}
CAMLprim value caml_mdb_dbi_open(value txn,value name,value flags){
CAMLparam3(txn,name,flags);
MDB_dbi dbi;
char*str=NULL;
if(caml_string_length(name))
str=String_val(name);
if(mdb_dbi_open((MDB_txn*)txn,str,Int_val(flags),&dbi)){
caml_failwith("error in mdb_dbi_open");
}
CAMLreturn(Val_int(dbi));
}
CAMLprim value iocp_ml_write(value fd, value vbuf, value vlen)
{
CAMLparam3(fd, vbuf, vlen);
CAMLlocal1(res);
intnat len = Long_val(vlen);
SOCKET s = Socket_val(fd);
char *buf = String_val(vbuf);
assert(Descr_kind_val(fd) == KIND_SOCKET);
res = Val_int(async_write(s, buf, len));
CAMLreturn(res);
/* async_write(s, buf, len); */
/* return Val_unit; */
}
CAMLprim value ocamlyices_type_function2(value v_dom1, value v_dom2,
value v_range) {
CAMLparam3(v_dom1, v_dom2, v_range);
type_t res;
res = yices_function_type2(Type_val(v_dom1), Type_val(v_dom2),
Type_val(v_range));
if (res == NULL_TYPE) {
_oy_error();
}
CAMLreturn(Val_type(res));
}
CAMLprim value
caml_SDL_BlitSurfs(
value src, value dst, value _dstrect)
{
CAMLparam3(src, dst, _dstrect);
SDL_Rect dstrect;
SDL_Rect_val(&dstrect, _dstrect);
int r = SDL_BlitSurface(
SDL_Surface_val(src), NULL,
SDL_Surface_val(dst), &dstrect);
if (r) caml_failwith("Sdlsurface.blit_surfs");
CAMLreturn(Val_unit);
}
CAMLprim value lwt_unix_socketpair_stub(value domain, value type,
value protocol) {
CAMLparam3(domain, type, protocol);
CAMLlocal1(result);
SOCKET sockets[2];
lwt_unix_socketpair(socket_domain_table[Int_val(domain)],
socket_type_table[Int_val(type)], Int_val(protocol),
sockets);
result = caml_alloc_tuple(2);
Store_field(result, 0, win_alloc_socket(sockets[0]));
Store_field(result, 1, win_alloc_socket(sockets[1]));
CAMLreturn(result);
}
CAMLprim value sundials_ml_fvector_scale(value s, value x, value z) {
CAMLparam3(s,x,z);
const double ds = Double_val(s);
struct caml_ba_array* ba_x = Caml_ba_array_val(x);
struct caml_ba_array* ba_z = Caml_ba_array_val(z);
double* dx = (double*) ba_x -> data;
double* dz = (double*) ba_z -> data;
for(int i = 0; i < ba_x->dim[0]; i++)
dz[i] = dx[i] * ds;
CAMLreturn(Val_unit);
}
