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 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);
}
value f_i7_caml(value i0, value i1, value i2, value i3, value i4, value i5, value i6) {
CAMLparam5(i0,i1,i2,i3,i4);
CAMLxparam2(i5,i6);
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);
CAMLreturn(Val_int(f_i7(ii0,ii1,ii2,ii3,ii4,ii5,ii6)));
}
CAMLprim value spoc_cublasCaxpy (value n, value alpha, value x, value incx, value y, value incy, value dev){
CAMLparam5(n,alpha, x,incx, y);
CAMLxparam2(incy, dev);
CAMLlocal3(dev_vec_array, dev_vec, gi);
CUdeviceptr d_A;
CUdeviceptr d_B;
int id;
GET_VEC(x, d_A);
GET_VEC(y, d_B);
CUBLAS_GET_CONTEXT;
cublasCaxpy(Int_val(n), Complex_val(alpha), (cuComplex*)d_A, Int_val(incx), (cuComplex*)d_B, Int_val(incy));
CUBLAS_CHECK_CALL(cublasGetError());
CUDA_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
value f_i12_caml(value i0, value i1, value i2, value i3, value i4, value i5, value i6, value i7, value i8, value i9, value i10, value i11) {
CAMLparam5(i0,i1,i2,i3,i4);
CAMLxparam5(i5,i6,i7,i8,i9);
CAMLxparam2(i10,i11);
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);
int ii8 = Int_val(i8);
int ii9 = Int_val(i9);
int ii10= Int_val(i10);
int ii11= Int_val(i11);
CAMLreturn(Val_int(f_i12(ii0,ii1,ii2,ii3,ii4,ii5,ii6,ii7,ii8,ii9,ii10,ii11)));
}
CAMLprim value spoc_cublasSrotm (value n, value x, value incx, value y, value incy, value sparam, value dev){
CAMLparam5(n,x,incx, y, incy);
CAMLxparam2(sparam, dev);
CAMLlocal4(dev_vec_array, dev_vec, res, gi);
CUdeviceptr d_A;
CUdeviceptr d_B;
CUdeviceptr d_C;
float result;
int id;
GET_VEC(x, d_A);
GET_VEC(y, d_B);
GET_VEC(sparam, d_C);
CUBLAS_GET_CONTEXT;
cublasSrotm(Int_val(n), (float*)d_A, Int_val(incx), (float*)d_B, Int_val(incy), (float*)sparam);
CUBLAS_CHECK_CALL(cublasGetError());
CUBLAS_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
t_value ml_glteximage2dnopixels_native (
value _target_2d,
value level,
value _internal_format,
value width,
value height,
value _pixel_data_format,
value _pixel_data_type)
{
CAMLparam5 (_target_2d, level, _internal_format, width, height);
CAMLxparam2 (_pixel_data_format, _pixel_data_type);
GLenum pixel_data_format = conv_pixel_data_format_table[Int_val(_pixel_data_format)];
GLenum pixel_data_type = conv_pixel_data_type_table[Int_val(_pixel_data_type)];
GLenum target_2d = conv_target_2d_table[Int_val(_target_2d)];
GLint internal_format = conv_internal_format_table[Int_val(_internal_format)];
glTexImage2D( target_2d, Int_val(level), internal_format, Int_val(width), Int_val(height), 0, pixel_data_format, pixel_data_type, NULL );
CAMLreturn (Val_unit);
}
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);
}
CAMLprim value stub_new_client_session_native(value keys, value sid, value cipherSpec,
value cert_cb, value extensions, value ext_cb,
value flags)
{
CAMLparam5(keys, sid, cipherSpec, cert_cb, extensions);
CAMLxparam2(ext_cb, flags);
ssl_t *ssl;
int rc;
rc=matrixSslNewClientSession(&ssl, sslKeys_t_val(keys), NULL, /*sslSessionId_t_val(sid), */
Int_val(cipherSpec), certCb, NULL, NULL, 0);
if(rc != MATRIXSSL_REQUEST_SEND) {
fprintf(stderr,"rc=%d\n",rc);
caml_failwith("New client session failed");
}
CAMLreturn(alloc_ssl_t(ssl));
}
CAMLprim value spoc_cuda_launch_grid(value off, value ker, value grid, value block, value ex, value gi, value queue_id){
CAMLparam5(ker, grid, ex, block, gi);
CAMLxparam2(off, queue_id);
CUfunction *kernel;
int gridX, gridY, gridZ, blockX, blockY, blockZ;
int offset;
char* extra;
void* extra2[5];
offset = Int_val(Field(off, 0));
gridX = Int_val(Field(grid,0));
gridY = Int_val(Field(grid,1));
gridZ = Int_val(Field(grid,2));
blockX = Int_val(Field(block,0));
blockY = Int_val(Field(block,1));
blockZ = Int_val(Field(block,2));
CUDA_GET_CONTEXT;
kernel = (CUfunction*) ker;
extra = (char*)ex;
extra2[0] = CU_LAUNCH_PARAM_BUFFER_POINTER;
extra2[1] = extra;
extra2[2] = CU_LAUNCH_PARAM_BUFFER_SIZE;
extra2[3] = &offset;
extra2[4] = CU_LAUNCH_PARAM_END;
CUDA_CHECK_CALL(cuLaunchKernel(*kernel,
gridX, gridY, gridZ,
blockX, blockY, blockZ,
0, queue[Int_val(queue_id)],
NULL, extra2));
Store_field(off, 0, Val_int(offset));
free(extra);
CUDA_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
CAMLprim value stub_xc_domain_save(value handle, value fd, value domid,
value max_iters, value max_factors,
value flags, value hvm)
{
CAMLparam5(handle, fd, domid, max_iters, max_factors);
CAMLxparam2(flags, hvm);
struct save_callbacks callbacks;
uint32_t c_flags;
uint32_t c_domid;
int r;
unsigned long generation_id_addr;
c_flags = caml_convert_flag_list(flags, suspend_flag_list);
c_domid = _D(domid);
memset(&callbacks, 0, sizeof(callbacks));
callbacks.data = (void*) c_domid;
callbacks.suspend = dispatch_suspend;
callbacks.switch_qemu_logdirty = switch_qemu_logdirty;
caml_enter_blocking_section();
generation_id_addr = xenstore_get(c_domid, GENERATION_ID_ADDRESS);
r = xc_domain_save(_H(handle), Int_val(fd), c_domid,
Int_val(max_iters), Int_val(max_factors),
c_flags, &callbacks, Bool_val(hvm)
#ifdef XENGUEST_4_2
,generation_id_addr
#endif
);
caml_leave_blocking_section();
if (r)
failwith_oss_xc(_H(handle), "xc_domain_save");
CAMLreturn(Val_unit);
}
value
sankoff_CAML_create_eltarr (value is_identity, value taxon_code, value code, value number_of_states, value ecode_bigarr, value states_bigarr, value tcm_bigarr) {
CAMLparam5(is_identity,taxon_code,code,number_of_states,ecode_bigarr);
CAMLxparam2(states_bigarr,tcm_bigarr);
CAMLlocal1(res);
int num_states;
num_states = Int_val(number_of_states);
int tcode = Int_val(taxon_code);
int iside = Int_val(is_identity);
int mycode = Int_val(code);
int * cost_mat; int dimcm1, dimcm2;
int * states_arrarr; int dims1, dims2;
int * ecode_arr; int dim;
ecode_arr = (int*) Data_bigarray_val(ecode_bigarr);
dim = Bigarray_val(ecode_bigarr)->dim[0];//number of elts
states_arrarr = (int*) Data_bigarray_val(states_bigarr);
dims1 = Bigarray_val(states_bigarr)->dim[0]; //number of elts
dims2 = Bigarray_val(states_bigarr)->dim[1]; //number of states in each elt
if (dim!=dims1) failwith ("sankoff.c, size of ecode array != number of charactors");
if (dims2!= num_states) failwith ("sankoff.c, size of states array != number of states");
cost_mat = (int*) Data_bigarray_val(tcm_bigarr);
dimcm1 = Bigarray_val(tcm_bigarr)->dim[0];//number of states
dimcm2 = Bigarray_val(tcm_bigarr)->dim[1];//number of states
if ((dimcm1!=dimcm2)||(dimcm1!=dims2))
failwith ("sankoff.c, wrong size of costmat between states");
eltarr_p neweltarr;
//alloc struct elt_arr
neweltarr = (eltarr_p)calloc(1,sizeof(struct elt_arr));
neweltarr->code = mycode;
neweltarr->taxon_code = tcode;
neweltarr->left_taxon_code = tcode;
neweltarr->right_taxon_code = tcode;
neweltarr->sum_cost = 0;
neweltarr->num_states = dimcm1;
neweltarr->num_elts = dim;
neweltarr->is_identity = iside;
//alloc its pointers
neweltarr->tcm = (int*)calloc(dimcm1*dimcm2,sizeof(int));
memcpy(neweltarr->tcm,cost_mat,sizeof(int) * dimcm1 * dimcm2);
neweltarr->elts = (elt_p)calloc(dim,sizeof(struct elt));
int i; int j;
int * states_arr;
elt_p newelt;
for (i=0;i<dim;i++)
{
newelt = &((neweltarr->elts)[i]);
assert(newelt!=NULL);
newelt->ecode = ecode_arr[i];
newelt->num_states = num_states;
newelt->states = (int*)calloc( num_states, sizeof(int) );
newelt->leftstates = (int*)calloc( num_states, sizeof(int) );
newelt->rightstates = (int*)calloc( num_states, sizeof(int) );
//for new median_3
if (median_3_su) {
newelt->left_costdiff_mat = (int*)calloc(num_states*num_states,sizeof(int));
newelt->right_costdiff_mat = (int*)calloc(num_states*num_states,sizeof(int));
}
states_arr = sankoff_move_to_line_i(states_arrarr,dims1,dims2,i);
//the infinity on ocaml side is diff from here, so we pass -1 instead
//memcpy(newelt->states,states_arr,sizeof(int)*num_states);
for (j=0;j<num_states;j++) {
(newelt->states)[j] = ( states_arr[j]==(-1) ) ? infinity : states_arr[j];
}
newelt->beta = (int*)calloc(num_states,sizeof(int));
newelt->e = (int*)calloc(num_states,sizeof(int));
newelt->m = (int*)calloc(num_states,sizeof(int));
sankoff_canonize(newelt,cost_mat);
}
res = caml_alloc_custom (&sankoff_custom_operations_eltarr,sizeof (eltarr_p), 1,alloc_custom_max);
Sankoff_return_eltarr(res) = neweltarr;
CAMLreturn(res);
}
value_t c_win32_dial (
value_t _mt,
value_t _entryName,
value_t phoneNumber,
value_t userName,
value_t password,
value_t domain,
value_t callback )
{
char * entryName = String_val ( _entryName );
int mt = Bool_val ( _mt );
DWORD dwRet;
RASDIALPARAMS rdParams;
HRASCONN hRasConn;
CAMLparam5 ( mt, _entryName, phoneNumber, userName, password );
CAMLxparam2 ( domain, callback );
printf ( "Callback passed = 0x%08x, deref = 0x%08x\n",
(unsigned) callback, (unsigned)(*(void **)callback) );
fflush ( stdout );
hRasConn = NULL;
rdParams.dwSize = sizeof(RASDIALPARAMS);
lstrcpy(rdParams.szEntryName, entryName );
lstrcpy(rdParams.szPhoneNumber, String_val ( phoneNumber ) );
lstrcpy(rdParams.szCallbackNumber, "" );
lstrcpy(rdParams.szUserName, String_val ( userName ) );
lstrcpy(rdParams.szPassword, String_val ( password ) );
lstrcpy(rdParams.szDomain, String_val ( domain ) );
cb_info.g_status = 0;
cb_info.mt = mt;
cb_info.p_closure = &callback;
cb_info.entryName = entryName;
textout ( mtINFO, "Dialing %s", entryName );
if (debug_print)
printf ( "I am inside c_win32_dial!\n" );
if ( mt )
enter_blocking_section ();
dwRet = RasDial ( NULL, NULL, &rdParams, 1L,
(RASDIALFUNC) RasDialFunc1, &hRasConn );
if ( mt )
leave_blocking_section ();
if ( dwRet )
{
char szBuf[256];
if ( RasGetErrorString( dwRet, szBuf, 256 ) != 0 )
wsprintf( (LPSTR)szBuf, "Undefined RAS Dial Error (%ld).",
dwRet );
textout ( mtERR, "Error attempting to connect: %s", szBuf );
hangup ( hRasConn );
}
CAMLreturn (Val_bool ( 1 ));
return 0; /* dummy, to shut down warning */
}
