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
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);
}
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_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 spoc_cublasScopy (value n, value x, value incx, value y, value incy, value dev){
CAMLparam5(n,x,incx, y, incy);
CAMLxparam1(dev);
CAMLlocal3(dev_vec_array, dev_vec, gi);
int id;
CUdeviceptr d_A;
CUdeviceptr d_B;
GET_VEC(x, d_A);
GET_VEC(y, d_B);
CUBLAS_GET_CONTEXT;
cublasScopy(Int_val(n), (float*)d_A, Int_val(incx), (float*)d_B, Int_val(incy));
CUBLAS_CHECK_CALL(cublasGetError());
CUDA_RESTORE_CONTEXT;
CAMLreturn(Val_unit);
}
CAMLprim value spoc_cublasSdot (value n, value x, value incx, value y, value incy, value dev){
CAMLparam5(n,x,incx, y, incy);
CAMLxparam1(dev);
CAMLlocal4(dev_vec_array, dev_vec, res, gi);
float result;
int id;
CUdeviceptr d_A;
CUdeviceptr d_B;
GET_VEC(x, d_A);
GET_VEC(y, d_B);
CUBLAS_GET_CONTEXT;
result = cublasSdot(Int_val(n), (float*)d_A, Int_val(incx), (float*)d_B, Int_val(incy));
CUBLAS_CHECK_CALL(cublasGetError());
res = caml_copy_double((double)result);
CUDA_RESTORE_CONTEXT;
CAMLreturn(res);
}
value f_i11_caml(value i0, value i1, value i2, value i3, value i4, value i5, value i6, value i7, value i8, value i9, value i10) {
CAMLparam5(i0,i1,i2,i3,i4);
CAMLxparam5(i5,i6,i7,i8,i9);
CAMLxparam1(i10);
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);
CAMLreturn(Val_int(f_i11(ii0,ii1,ii2,ii3,ii4,ii5,ii6,ii7,ii8,ii9,ii10)));
}
// INPUT a texture target, a level, an offset, a size, a pixel format, some data
// OUTPUT nothing, binds an subimage to the current texture2D
CAMLprim value
caml_tex_subimage_2D_native(value target, value lvl, value off, value size, value fmt, value data)
{
CAMLparam5(target, lvl, off, size, fmt);
CAMLxparam1(data);
glTexSubImage2D(Target_val(target),
Int_val(lvl),
Int_val(Field(off,0)),
Int_val(Field(off,1)),
Int_val(Field(size,0)),
Int_val(Field(size,1)),
PixelFormat_val(fmt),
GL_UNSIGNED_BYTE,
String_val(data));
CAMLreturn(Val_unit);
}
// INPUT a texture target, a level, a pixel format, a size, a texture format, some data
// OUTPUT nothing, binds an image to the current texture2D
CAMLprim value
caml_tex_image_2D_native(value target, value lvl, value fmt, value size, value tfmt, value data)
{
CAMLparam5(target, fmt, size, tfmt, data);
CAMLxparam1(lvl);
glTexImage2D(Target_val(target),
Int_val(lvl),
TextureFormat_val(tfmt),
Int_val(Field(size,0)),
Int_val(Field(size,1)),
0,
PixelFormat_val(fmt),
GL_UNSIGNED_BYTE,
(data == Val_none)? NULL : String_val(Some_val(data)));
CAMLreturn(Val_unit);
}
value hdf5_h5l_iterate(value group_v, value index_type_v, value order_v, value idx_v,
value op_v, value op_data_v)
{
CAMLparam5(group_v, index_type_v, order_v, idx_v, op_v);
CAMLxparam1(op_data_v);
CAMLlocal1(exception);
struct operator_data op_data;
hsize_t idx, ret;
op_data.callback = &op_v;
op_data.operator_data = &op_data_v;
op_data.exception = &exception;
idx = Is_block(idx_v) ? Int_val(Field(Field(idx_v, 0), 0)) : 0;
exception = Val_unit;
ret = H5Literate(Hid_val(group_v), H5_index_val(index_type_v),
H5_iter_order_val(order_v), Is_block(idx_v) ? &idx : NULL, hdf5_h5l_operator,
&op_data);
if (Is_block(idx_v))
Store_field(Field(idx_v, 0), 0, Val_int(idx));
if (exception != Val_unit)
caml_raise(exception);
CAMLreturn(Val_h5_iter(ret));
}
CAMLprim value stub_xc_domain_restore(value handle, value fd, value domid,
value store_evtchn, value store_domid,
value console_evtchn, value console_domid,
value hvm, value no_incr_generationid)
{
CAMLparam5(handle, fd, domid, store_evtchn, console_evtchn);
CAMLxparam1(hvm);
CAMLlocal1(result);
unsigned long store_mfn, console_mfn;
domid_t c_store_domid, c_console_domid;
unsigned long c_vm_generationid_addr;
char c_vm_generationid_addr_s[32];
unsigned int c_store_evtchn, c_console_evtchn;
int r;
size_t size, written;
struct flags f;
get_flags(&f,_D(domid));
c_store_evtchn = Int_val(store_evtchn);
c_store_domid = Int_val(store_domid);
c_console_evtchn = Int_val(console_evtchn);
c_console_domid = Int_val(console_domid);
#ifdef HVM_PARAM_VIRIDIAN
xc_set_hvm_param(_H(handle), _D(domid), HVM_PARAM_VIRIDIAN, f.viridian);
#endif
configure_vcpus(_H(handle), _D(domid), f);
caml_enter_blocking_section();
r = xc_domain_restore(_H(handle), Int_val(fd), _D(domid),
c_store_evtchn, &store_mfn,
#ifdef XENGUEST_4_2
c_store_domid,
#endif
c_console_evtchn, &console_mfn,
#ifdef XENGUEST_4_2
c_console_domid,
#endif
Bool_val(hvm), f.pae, 0 /*superpages*/
#ifdef XENGUEST_4_2
,
Bool_val(no_incr_generationid),
&c_vm_generationid_addr,
NULL /* restore_callbacks */
#endif
);
if (!r) {
size = sizeof(c_vm_generationid_addr_s) - 1; /* guarantee a NULL remains on the end */
written = snprintf(c_vm_generationid_addr_s, size, "0x%lx", c_vm_generationid_addr);
if (written < size)
r = xenstore_puts(_D(domid), c_vm_generationid_addr_s, GENERATION_ID_ADDRESS);
else {
syslog(LOG_ERR|LOG_DAEMON,"Failed to write %s (%d >= %d)", GENERATION_ID_ADDRESS, written, size);
r = 1;
}
}
caml_leave_blocking_section();
if (r)
failwith_oss_xc(_H(handle), "xc_domain_restore");
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);
}
CAMLprim value stub_xc_linux_build_native(value xc_handle, value domid,
value mem_max_mib, value mem_start_mib,
value image_name, value ramdisk_name,
value cmdline, value features,
value flags, value store_evtchn,
value console_evtchn)
{
CAMLparam5(xc_handle, domid, mem_max_mib, mem_start_mib, image_name);
CAMLxparam5(ramdisk_name, cmdline, features, flags, store_evtchn);
CAMLxparam1(console_evtchn);
CAMLlocal1(result);
unsigned long store_mfn;
unsigned long console_mfn;
int r;
struct xc_dom_image *dom;
char c_protocol[64];
/* Copy the ocaml values into c-land before dropping the mutex */
xc_interface *xch = _H(xc_handle);
unsigned int c_mem_start_mib = Int_val(mem_start_mib);
uint32_t c_domid = _D(domid);
char *c_image_name = strdup(String_val(image_name));
char *c_ramdisk_name = ramdisk_name == None_val ? NULL : strdup(String_val(Field(ramdisk_name, 0)));
unsigned long c_flags = Int_val(flags);
unsigned int c_store_evtchn = Int_val(store_evtchn);
unsigned int c_console_evtchn = Int_val(console_evtchn);
struct flags f;
get_flags(&f,c_domid);
xc_dom_loginit(xch);
dom = xc_dom_allocate(xch, String_val(cmdline), String_val(features));
if (!dom)
failwith_oss_xc(xch, "xc_dom_allocate");
configure_vcpus(xch, c_domid, f);
configure_tsc(xch, c_domid, f);
#ifdef XC_HAVE_DECOMPRESS_LIMITS
if ( xc_dom_kernel_max_size(dom, f.kernel_max_size) )
failwith_oss_xc(xch, "xc_dom_kernel_max_size");
if ( xc_dom_ramdisk_max_size(dom, f.ramdisk_max_size) )
failwith_oss_xc(xch, "xc_dom_ramdisk_max_size");
#else
if ( f.kernel_max_size || f.ramdisk_max_size ) {
syslog(LOG_WARNING|LOG_DAEMON,"Kernel/Ramdisk limits set, but no support compiled in");
}
#endif
caml_enter_blocking_section();
r = xc_dom_linux_build(xch, dom, c_domid, c_mem_start_mib,
c_image_name, c_ramdisk_name, c_flags,
c_store_evtchn, &store_mfn,
c_console_evtchn, &console_mfn);
caml_leave_blocking_section();
#ifndef XEN_UNSTABLE
strncpy(c_protocol, xc_dom_get_native_protocol(dom), 64);
#else
memset(c_protocol, '\0', 64);
#endif
free(c_image_name);
free(c_ramdisk_name);
xc_dom_release(dom);
if (r != 0)
failwith_oss_xc(xch, "xc_dom_linux_build");
result = caml_alloc_tuple(3);
Store_field(result, 0, caml_copy_nativeint(store_mfn));
Store_field(result, 1, caml_copy_nativeint(console_mfn));
Store_field(result, 2, caml_copy_string(c_protocol));
CAMLreturn(result);
}
value
grappa_CAML_inv_med
(value medsov, value c_gene1, value c_gene2, value c_gene3, value num_genes,value circular)
{
int debug=0;
CAMLparam5(medsov,c_gene1,c_gene2,c_gene3,num_genes);
CAMLxparam1(circular);
CAMLlocal1(res);
int MEDIAN_SOLVER;
struct genome_struct *g1, *g2, *g3;
struct genome_struct *gen[3];
struct genome_struct *out_genome_list;
struct genome_arr_t *out_genome_arr;
int CIRCULAR;
int NUM_GENES;
int num_cond;
int old_max_num_genes;
//int multichromosome=0;
MEDIAN_SOLVER = Int_val(medsov);
g1 = (struct genome_struct *) Data_custom_val (c_gene1);
g2 = (struct genome_struct *) Data_custom_val (c_gene2);
g3 = (struct genome_struct *) Data_custom_val (c_gene3);
CIRCULAR = Int_val(circular);
NUM_GENES = Int_val(num_genes);
long dims[1]; dims[0] = NUM_GENES;
condense3_mem_t * cond3mem_p; cond3mem_p = &CONDENSE3_MEM;
convert_mem_t * convertmem_p; convertmem_p = &CONVERT_MEM;
old_max_num_genes = cond3mem_p->max_num_genes;
if (debug) {
printf("grappa_interface.grappa_CAML_inv_med,MEDIAN_SOLVER=%d,MAX_NAME=%d\n",MEDIAN_SOLVER,MAX_NAME);
fflush(stdout); }
out_genome_list =
( struct genome_struct * ) malloc ( 1 *
sizeof ( struct genome_struct ) );
if ( out_genome_list == ( struct genome_struct * ) NULL )fprintf ( stderr, "ERROR: genome_list NULL\n" );
out_genome_list[0].gnamePtr =
( char * ) malloc ( MAX_NAME * sizeof ( char ) );
sprintf (out_genome_list[0].gnamePtr, "%i", 0);
if ( out_genome_list[0].gnamePtr == ( char * ) NULL )
{
fprintf ( stderr, "ERROR: gname NULL\n" );
};
out_genome_list[0].genes =( int * ) malloc ( NUM_GENES * sizeof ( int ) );
out_genome_list[0].delimiters = (int *) malloc (NUM_GENES * sizeof (int) );
out_genome_list[0].magic_number = GRAPPA_MAGIC_NUMBER;
out_genome_list[0].encoding = NULL;
if (old_max_num_genes >= NUM_GENES) {}
else
{
//free_mem_4_all ();
ini_mem_4_all (NUM_GENES);
free_mem_4_invdist (&INVDIST_MEM);
ini_mem_4_invdist (NUM_GENES);
free_mem_4_albert ();
ini_mem_4_albert (NUM_GENES);
free_mem_4_siepel ();
ini_mem_4_siepel(NUM_GENES);
free_mem_4_cond3 ();
ini_mem_4_cond3 (NUM_GENES);
free_mem_4_convert();
ini_mem_4_convert(NUM_GENES);
free_mem_4_mgr();
mgr_ini_mem(NUM_GENES);
//3 times of original gene size is the worst case for multi-chromosome.
}
/* debug msg
fprintf(stdout,"in gene list = [");
int x=0;
for(x=0;x<NUM_GENES;x++)
fprintf(stdout,"%d,",g1->genes[x]);
fprintf(stdout,"]; \n");
for(x=0;x<NUM_GENES;x++)
fprintf(stdout,"%d,",g2->genes[x]);
fprintf(stdout,"]; \n");
for(x=0;x<NUM_GENES;x++)
fprintf(stdout,"%d,",g3->genes[x]);
fprintf(stdout,"]; \n");
fflush(stdout);
debug msg */
if(MEDIAN_SOLVER<7)
{
condense3 ( g1->genes,
g2->genes,
g3->genes,
cond3mem_p->con_g1->genes,
cond3mem_p->con_g2->genes,
cond3mem_p->con_g3->genes,
NUM_GENES, &num_cond,
cond3mem_p->pred1, cond3mem_p->pred2,
cond3mem_p->picked, cond3mem_p->decode );
//when 3 input array are the same num_cond = 0
//when 2 out of 3 input array are the same, num_cond could be 0
//either way, median solver in grappa/mgr will crush.
//either way, median3 solver will not be called from genAli.ml.
//I add the if (num_cond>0) else... here just in case.
if (num_cond>0)
{
gen[0] = cond3mem_p->con_g1;
gen[1] = cond3mem_p->con_g2;
gen[2] = cond3mem_p->con_g3;
switch (MEDIAN_SOLVER)
{
case 1: //Alberto Capara median solver
if ( CIRCULAR )
albert_inversion_median_circular
( gen,num_cond,cond3mem_p->con_med->genes );
else
albert_inversion_median_noncircular
(gen,num_cond,cond3mem_p->con_med->genes );
break;
case 2: //A. Siepel median solver
find_reversal_median ( cond3mem_p->con_med, gen, num_cond, &SIEPEL_MEM );
break;
case 3: //Exact median solver
convert2_to_tsp ( gen[0], gen[1], gen[2], convertmem_p->adjl, convertmem_p->adjp,
num_cond, CIRCULAR );
bbtsp ( 2 * num_cond, cond3mem_p->con_med->genes,
FALSE, /* cannot use median that does not exist */
gen[0]->genes, gen[1]->genes, gen[2]->genes,
convertmem_p->adjl,
convertmem_p->neighbors,
convertmem_p->stack,
convertmem_p->outcycle,
convertmem_p->degree,
convertmem_p->otherEnd,
convertmem_p->edges,
CIRCULAR );
break;
case 4: //Greedy median solver
convert2_to_tsp ( gen[0], gen[1], gen[2], convertmem_p->adjl, convertmem_p->adjp,
num_cond, CIRCULAR );
coalestsp ( 2 * num_cond, cond3mem_p->con_med->genes,FALSE,
gen[0]->genes, gen[1]->genes, gen[2]->genes,
convertmem_p->adjl,
convertmem_p->neighbors,
convertmem_p->stack,
convertmem_p->outcycle,
convertmem_p->degree,
convertmem_p->otherEnd,
convertmem_p->edges,
CIRCULAR );
break;
/* case5 and case6 need the CONCORDE package */
// http://www.tsp.gatech.edu//concorde/downloads/downloads.htm
#ifdef USE_CONCORDE
case 5: //SimpleLK TSP median solver
convert_to_tsp ( gen[0], gen[1],
gen[2], num_cond, CIRCULAR,
convertmem_p->weights );
greedylk ( 2 * num_cond, convertmem_p->weights,
cond3mem_p->con_med->genes,
convertmem_p->incycle,
convertmem_p->outcycle );
break;
case 6: //ChainedLK TSP median solver
convert_to_tsp ( gen[0], gen[1],
gen[2], num_cond, CIRCULAR,
convertmem_p->weights );
chlinkern ( 2 * num_cond,
convertmem_p->weights,
cond3mem_p->con_med->genes,
convertmem_p->incycle, convertmem_p->outcycle );
break;
#endif
default:
fprintf(stderr, "unknown choice of median solver !\n");
break;
}
decode3 ( out_genome_list->genes, cond3mem_p->con_med->genes,
cond3mem_p->pred1, cond3mem_p->decode, num_cond );
}
else
{
int x=0;
for(x=0;x<NUM_GENES;x++)
{
out_genome_list->genes[x] = g1->genes[x];
out_genome_list->delimiters[x] = g1->delimiters[x];
}
// memcpy (out_genome_list->genes, g1->genes, NUM_GENES);
// memcpy (out_genome_list->delimiters, g1->delimiters, NUM_GENES);
out_genome_list->deli_num = g1->deli_num;
out_genome_list->genome_num = g1->genome_num;
}
}
else// MEDIAN_SOLVER == 7, MGR median solver
{
mgr_med (g1->genes,g2->genes,g3->genes,g1->delimiters,g2->delimiters,g3->delimiters,g1->deli_num,g2->deli_num,g3->deli_num, NUM_GENES,CIRCULAR,out_genome_list);
}
/* debug msg
fprintf(stdout,"out_genome_list = [");
int xx=0;
for(xx=0;xx<NUM_GENES;xx++)
fprintf(stdout,"%d,",out_genome_list->genes[xx]);
fprintf(stdout,"]; delimiters = [");
for(xx=0;xx<out_genome_list->deli_num;xx++)
fprintf(stdout,"%d",out_genome_list->delimiters[xx]);
fprintf(stdout,"]\n");
fflush(stdout);
debug msg */
CAMLlocal1 (c_genome_arr);
c_genome_arr = alloc_custom(&genomeArrOps, sizeof(struct genome_arr_t), 1, 1000000);
out_genome_arr = (struct genome_arr_t *) Data_custom_val(c_genome_arr);
// fprintf(stdout, "inv_med , genome list addr=%p\n",out_genome_arr);
out_genome_arr->magic_number = GRAPPA_MAGIC_NUMBER;
out_genome_arr->genome_ptr = out_genome_list;
assert( GRAPPA_MAGIC_NUMBER == out_genome_list[0].magic_number);
out_genome_arr->num_genome = 1;
out_genome_arr->num_gene = NUM_GENES;
CAMLreturn(c_genome_arr);
}