Exemplo n.º 1
0
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);
}
Exemplo n.º 2
0
value fortran_printtab(value ba)
{
  int dimx = Bigarray_val(ba)->dim[0];
  int dimy = Bigarray_val(ba)->dim[1];
  printtab_(Data_bigarray_val(ba), &dimx, &dimy);
  return Val_unit;
}
Exemplo n.º 3
0
/* T.F. additions - same style. We use these to distribute mesh info */
value caml_mpi_broadcast_bigarray_float(value data, value root, value comm)
{
  mlsize_t len = Bigarray_val(data)->dim[0];
  double *d = Data_bigarray_val(data);
  MPI_Bcast(d, len, MPI_DOUBLE, Int_val(root), Comm_val(comm));
  return Val_unit;
}
Exemplo n.º 4
0
/* 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);
}
Exemplo n.º 5
0
CAMLprim value string_to_binary_array (value dst_arr, value dst_idx, value src_str)
{
	CAMLparam3 (dst_arr, dst_idx, src_str);
	int len = string_length (src_str), idx = Long_val(dst_idx);
	if (idx + len > Bigarray_val(dst_arr)->dim[0]) invalid_argument ("Binarray.write");
	memcpy ((char *) Data_bigarray_val(dst_arr) + idx, String_val(src_str), len);
	CAMLreturn (Val_unit);
}
Exemplo n.º 6
0
value caml_mpi_broadcast_bigarray_nativeint(value data, value root, value comm)
{
  mlsize_t len = Bigarray_val(data)->dim[0];
  double *d = Data_bigarray_val(data);
  MPI_Bcast(d, len, MPI_LONG, Int_val(root), Comm_val(comm));
  /* According to the docs, MPI_LONG is right, even on LC64 machines. */
  return Val_unit;
}
Exemplo n.º 7
0
void gsl_multimin_callback_df(const gsl_vector *x, void *params, gsl_vector *G)
{
  int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT;
  struct callback_params *p=params;
  value x_barr, g_barr;
  int len = x->size;
  gsl_vector_view x_v, g_v;

  x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len);
  g_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len);
  x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len);
  g_v = gsl_vector_view_array(Data_bigarray_val(g_barr), len);

  gsl_vector_memcpy(&x_v.vector, x);
  callback2(Field(p->closure, 1), x_barr, g_barr);
  gsl_vector_memcpy(G, &g_v.vector);
}
Exemplo n.º 8
0
CAMLprim value string_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);
	retval = alloc_string (len);
	memmove (String_val(retval), (char *) Data_bigarray_val(src_arr) + (Long_val(src_idx)), len);
	CAMLreturn (retval);
}
Exemplo n.º 9
0
/* MULTIROOT CALLBACKS */
int gsl_multiroot_callback(const gsl_vector *x, void *params, gsl_vector *F)
{
  int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT;
  struct callback_params *p=params;
  value x_barr, f_barr;
  int len = x->size;
  gsl_vector_view x_v, f_v;

  x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len);
  f_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len);
  x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len);
  f_v = gsl_vector_view_array(Data_bigarray_val(f_barr), len);

  gsl_vector_memcpy(&x_v.vector, x);
  callback2(p->closure, x_barr, f_barr);
  gsl_vector_memcpy(F, &f_v.vector);
  return GSL_SUCCESS;
}
Exemplo n.º 10
0
int gsl_multiroot_callback_df(const gsl_vector *x, void *params, gsl_matrix *J)
{
  int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT;
  struct callback_params *p=params;
  value x_barr, j_barr;
  int len = x->size;
  gsl_vector_view x_v;
  gsl_matrix_view j_v;

  x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len);
  j_barr = alloc_bigarray_dims(barr_flags, 2, NULL, len, len);
  x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len);
  j_v = gsl_matrix_view_array(Data_bigarray_val(j_barr), len, len);

  gsl_vector_memcpy(&x_v.vector, x);
  callback2(Field(p->closure, 1), x_barr, j_barr);
  gsl_matrix_memcpy(J, &j_v.matrix);
  return GSL_SUCCESS;
}
Exemplo n.º 11
0
CAMLprim value ocaml_c_fastfield_eval_bigarray(value ml_funptr,
					 value ml_arr_in,
					 value ml_arr_out)
{
  CAMLparam3(ml_funptr, ml_arr_in, ml_arr_out);
  int success;
  field_function *fun;

  fun=(field_function *)Field(ml_funptr,0);

  if(fun==0)
    {
      CAMLreturn(Val_bool(0));
    }

  success=fun(Data_bigarray_val(ml_arr_in),Data_bigarray_val(ml_arr_out));
  
  CAMLreturn(Val_bool(success));
}
Exemplo n.º 12
0
/* MULTIFIT CALLBACKS */
int gsl_multifit_callback_f(const gsl_vector *X, void *params, gsl_vector *F)
{
  int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT;
  struct callback_params *parms=params;
  value x_barr, f_barr;
  size_t p = X->size;
  size_t n = F->size;
  gsl_vector_view x_v, f_v;

  x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, p);
  f_barr = alloc_bigarray_dims(barr_flags, 1, NULL, n);
  x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), p);
  f_v = gsl_vector_view_array(Data_bigarray_val(f_barr), n);

  gsl_vector_memcpy(&x_v.vector, X);
  callback2(Field(parms->closure, 0), x_barr, f_barr);
  gsl_vector_memcpy(F, &f_v.vector);
  return GSL_SUCCESS;
}
Exemplo n.º 13
0
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);
}
Exemplo n.º 14
0
Arquivo: sankoff.c Projeto: amnh/poy5
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);
}
Exemplo n.º 15
0
CAMLprim value stub_gntshr_munmap_batched(value xgh, value share) {
	CAMLparam2(xgh, share);
	CAMLlocal1(ml_map);
#ifdef HAVE_GNTSHR
	ml_map = Field(share, 1);

	int size = Bigarray_val(ml_map)->dim[0];
	int pages = size >> XC_PAGE_SHIFT;
#ifdef linux
	/* Bug in xen-4.4 libxc xc_linux_osdep implementation, work-around
	   by using the kernel interface directly. */
	int result = munmap(Data_bigarray_val(ml_map), size);
#else
	int result = xc_gntshr_munmap(_G(xgh), Data_bigarray_val(ml_map), pages);
#endif
	if(result != 0)
		failwith_xc(_G(xgh));
#else
	gntshr_missing();
#endif
	CAMLreturn(Val_unit);
}
Exemplo n.º 16
0
value ml_cv_convert_bigarray( value converter, value src, value dest ) {
    CAMLparam3( converter, src, dest );

    int n;
    n = Bigarray_val( dest )->dim[0];

    if ( n > Bigarray_val( src )->dim[0] ) {
        caml_raise_with_arg( *caml_named_value( "ut status exception" ), Val_int( UT_BAD_ARG ) );
    }

    if ( (Bigarray_val( src )->flags & BIGARRAY_KIND_MASK) == BIGARRAY_FLOAT32 ) {
        cv_convert_floats( UD_cv_converter_val( converter ), Data_bigarray_val( src ), n, Data_bigarray_val( dest ) );
    }
    else if ( (Bigarray_val( src )->flags & BIGARRAY_KIND_MASK) == BIGARRAY_FLOAT64 ) {
        cv_convert_doubles( UD_cv_converter_val( converter ), Data_bigarray_val( src ), n, Data_bigarray_val( dest ) );
    }
    else {
        caml_raise_with_arg( *caml_named_value( "ut status exception" ), Val_int( UT_BAD_ARG ) );
    }

    CAMLreturn( Val_unit );
}
Exemplo n.º 17
0
CAMLprim value
ml_sqlite3_column_blob_big (value s, value i)
{
  CAMLparam1(s);
  CAMLlocal1(r);
  intnat len;
  const void * data;
  len  = sqlite3_column_bytes (Sqlite3_stmt_val (s), Int_val (i));
  r = alloc_bigarray (BIGARRAY_UINT8 | BIGARRAY_C_LAYOUT, 1, NULL, &len);
  data = sqlite3_column_blob (Sqlite3_stmt_val (s), Int_val(i));
  memcpy (Data_bigarray_val(r), data, len);
  CAMLreturn(r);
}
Exemplo n.º 18
0
int gsl_multifit_callback_df(const gsl_vector *X, void *params, gsl_matrix *J)
{
  int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT;
  struct callback_params *parms=params;
  value x_barr, j_barr;
  size_t p = X->size;
  size_t n = J->size1;
  gsl_vector_view x_v;
  gsl_matrix_view j_v;
  value res;

  x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, p);
  j_barr = alloc_bigarray_dims(barr_flags, 2, NULL, n, p);
  x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), p);
  j_v = gsl_matrix_view_array(Data_bigarray_val(j_barr), n, p);

  gsl_vector_memcpy(&x_v.vector, X);
  res=callback2(Field(parms->closure, 1), x_barr, j_barr);
  if(Is_exception_result(res))
    return GSL_FAILURE;
  gsl_matrix_memcpy(J, &j_v.matrix);
  return GSL_SUCCESS;
}
Exemplo n.º 19
0
CAMLprim value cstruct_md5sum(value buffer, value offset, value length) {
    CAMLparam3(buffer, offset, length);
    CAMLlocal1(result);

    unsigned char* data;

    result = caml_alloc_string(MD5_DIGEST_LENGTH);
    data = (unsigned char*) Data_bigarray_val(buffer);
    data += Int_val(offset);

    MD5(data, Int_val(length), (unsigned char*) String_val(result));

    CAMLreturn(result);
}
Exemplo n.º 20
0
double gsl_multimin_callback_f(const gsl_vector *x, void *params)
{
  int barr_flags = BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT;
  struct callback_params *p=params;
  value x_barr;
  int len = x->size;
  gsl_vector_view x_v;
  value res;

  x_barr = alloc_bigarray_dims(barr_flags, 1, NULL, len);
  x_v = gsl_vector_view_array(Data_bigarray_val(x_barr), len);

  gsl_vector_memcpy(&x_v.vector, x);
  res=callback(Field(p->closure, 0), x_barr);
  return Double_val(res);
}
Exemplo n.º 21
0
CAMLprim value stub_sha1_update_bigarray(value ctx, value buf, value pos, value len)
{
	CAMLparam4(ctx, buf, pos, len);
	struct sha1_ctx ctx_dup;
	unsigned char *data = Data_bigarray_val(buf);

	ctx_dup = *GET_CTX_STRUCT(ctx);
	caml_release_runtime_system();
	sha1_update(&ctx_dup,
		data + Long_val(pos),
		Long_val(len));
	caml_acquire_runtime_system();
	*GET_CTX_STRUCT(ctx) = ctx_dup;

	CAMLreturn(Val_unit);
}
Exemplo n.º 22
0
static int ml_gsl_odeiv_jacobian(double t, const double y[],
				double *dfdy, double dfdt[],
				void *params)
{
  struct mlgsl_odeiv_params *p = params;
  value res, args[4];
  args[0] = copy_double(t);
  memcpy(Double_array_val(p->arr1), y, p->dim * sizeof(double));
  args[1] = p->arr1;
  Data_bigarray_val(p->mat) = dfdy;
  args[2] = p->mat;
  args[3] = p->arr2;
  res = callbackN_exn(p->jac_closure, 4, args);
  if(Is_exception_result(res))
    return GSL_FAILURE;
  memcpy(dfdt, Double_array_val(p->arr2), p->dim * sizeof(double));
  return GSL_SUCCESS;
}
Exemplo n.º 23
0
CAMLprim value
ml_osmesamakecurrent( value ctx, value buffer_ba, value _type,
                      value width, value height )
{
    GLenum type;
    GLboolean ret;
    void *buffer;
    buffer = (void *) Data_bigarray_val(buffer_ba);

    if (Int_val(_type) != 0) caml_invalid_argument("OSMesaMakeCurrent");
    type = GL_UNSIGNED_BYTE;

    ret = OSMesaMakeCurrent( (OSMesaContext) ctx, buffer, type,
                             Int_val(width), Int_val(height) );

    if (!ret) caml_failwith("OSMesaMakeCurrent");

    return Val_unit;
}
Exemplo n.º 24
0
CAMLprim value digest_array (value v_iarr)
{
	CAMLparam1(v_iarr);
	CAMLlocal1(result);
	MD5Context context;
	int len = Bigarray_val(v_iarr)->dim[0];
	unsigned char *buf = Data_bigarray_val(v_iarr);

	MD5Init (&context);
	while (len > 0) {
		int block = (len > 8192) ? 8192 : len;
		MD5Update (&context, buf, block);
		buf += block;
		len -= block;
	}

	result = alloc_string (16);
	MD5Final (&Byte_u(result, 0), &context);
	CAMLreturn(result);
}
Exemplo n.º 25
0
static void
ml_sqlite3_release_big (void *data)
{
  value c, p;
  p = Val_emptylist;
  c = big_root;
  while (c != Val_emptylist) 
    {
      void *d = Data_bigarray_val (Field (c, 0));
      value tl = Field (c, 1);

      if (d == data)
	{
	  if (p == Val_emptylist) /* c is the head */
	    big_root = tl;
	  else
	    Store_field(p, 1, tl);
	  return;
	}
      p = c;
      c = tl;
    }
  /* should not reach this point */
}
Exemplo n.º 26
0
CAMLprim value
magick_loader(value input)
{
    CAMLparam1(input);
    CAMLlocal2(pixel_matrix, res);
    Image *image_bloc;
    int image_type_code;
    int components;
    GLenum format;
    ExceptionInfo exception;
    GetExceptionInfo(&exception);
    {
        if (IsMagickInstantiated() == MagickFalse) {
            InitializeMagick(getenv("PWD"));
        }

        {
            ImageInfo *image_info;
            image_info = CloneImageInfo((ImageInfo *) NULL);
            switch (Tag_val(input))
            {
                /* given a filename of an image */
                case 0:
                    (void) strcpy(image_info->filename, String_val(Field(input,0)));
                    image_bloc = ReadImage(image_info, &exception);
                    break;

                /* given the image data in a buffer */
                case 1:
                    image_bloc = BlobToImage(
                        image_info,
                        (void *)String_val(Field(input,0)),
                        caml_string_length(Field(input,0)),
                        &exception);
                    break;
            }
            DestroyImageInfo(image_info);
        }

        if (exception.severity != UndefinedException) {
            if (image_bloc != (Image *) NULL) {
                DestroyImage(image_bloc);
            }
            DestroyExceptionInfo(&exception);
            caml_failwith( exception.reason );
            /* @TODO  exception.description */
        }

        if (image_bloc == (Image *) NULL) {
            DestroyExceptionInfo(&exception);
            caml_failwith("read image failed");
        }
    }
    {
        ImageType image_type;
        image_type = GetImageType( image_bloc, &exception );

        if (exception.severity != UndefinedException)
            caml_failwith( exception.reason );

        image_type_code = Val_ImageType(image_type, &components);

        if ( image_type_code == 11 )
            caml_failwith("getting image type failed");
    }
    {
        unsigned long x, y;
        unsigned long columns, rows;

        PixelPacket pixel;

        columns = image_bloc->columns;
        rows    = image_bloc->rows;

        const PixelPacket * pixel_packet_array;

        pixel_packet_array =
                AcquireImagePixels(
                         image_bloc,
                         0, 0, columns, rows,
                         &exception );

        if (exception.severity != UndefinedException) {
            caml_failwith(exception.reason);
        }

        {
            unsigned char *image;
            long ndx;
            long dims[3];
            dims[0] = columns;
            dims[1] = rows;
            dims[2] = components;
            pixel_matrix = alloc_bigarray(BIGARRAY_UINT8 | BIGARRAY_C_LAYOUT, 3, NULL, dims);
            image = Data_bigarray_val(pixel_matrix);
            for (x=0; x < columns; ++x) {
                for (y=0; y < rows; ++y) {
                    pixel = pixel_packet_array[(columns * y) + x];

                    ndx = (columns * y * components) + (x * components);
                    switch (components) {
                        case 1:
                            image[ndx + 0] = pixel.red   / SCALE;
                            break;
                        case 2:
                            image[ndx + 0] = pixel.red   / SCALE;
                            image[ndx + 1] = ( MaxMap - pixel.opacity ) / SCALE;
                            break;
                        case 3:
                            image[ndx + 0] = pixel.red   / SCALE;
                            image[ndx + 1] = pixel.green / SCALE;
                            image[ndx + 2] = pixel.blue  / SCALE;
                            break;
                        case 4:
                            image[ndx + 0] = pixel.red   / SCALE;
                            image[ndx + 1] = pixel.green / SCALE;
                            image[ndx + 2] = pixel.blue  / SCALE;
                            image[ndx + 3] = ( MaxMap - pixel.opacity ) / SCALE;
                            break;
                    }
                }
            }
        }

        switch (components) {
            case 1: format = GL_LUMINANCE; break;
            case 2: format = GL_LUMINANCE_ALPHA; break;
            case 3: format = GL_RGB; break;
            case 4: format = GL_RGBA; break;
        }

        res = alloc_tuple(5);
        Store_field(res, 0, pixel_matrix );
        Store_field(res, 1, Val_long(columns) );
        Store_field(res, 2, Val_long(rows) );
        Store_field(res, 3, Val_internal_format(components) );
        Store_field(res, 4, Val_pixel_data_format(format) );
    }
    DestroyExceptionInfo(&exception);
    DestroyImage(image_bloc);
    CAMLreturn(res);
}
Exemplo n.º 27
0
Arquivo: sankoff.c Projeto: amnh/poy5
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);
}
Exemplo n.º 28
0
/* As above, but unsafe; the advantage is that you don't need to know how long it might be. */
CAMLprim value unsafe_cstring_of_binary_array (value src_arr, value src_idx)
{
	return copy_string ((char *) Data_bigarray_val(src_arr) + (Int_val(src_idx)));
}
Exemplo n.º 29
0
t_value ml_glteximage3dwithpixels_native (
                   value _target_3d,
                   value level,
                   value _internal_format,
                   value width,
                   value height,
		   value depth,
                   value _pixel_data_format,
                   value _pixel_data_type,
                   value pixels )
{
	CAMLparam5 (_target_3d, level, _internal_format, width, height);
	CAMLxparam4 (depth, _pixel_data_format, _pixel_data_type, pixels);
	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_3d = conv_target_3d_table[Int_val(_target_3d)];
    	GLint  internal_format = conv_internal_format_table[Int_val(_internal_format)]; 
	
	
    	glTexImage3D( target_3d, Int_val(level), internal_format, Int_val(width), Int_val(height), Int_val(depth), 0, pixel_data_format, pixel_data_type, (const GLvoid *) Data_bigarray_val(pixels) );
		
	CAMLreturn (Val_unit);
}
Exemplo n.º 30
0
value c_printtab(value ba)
{
  printtab(Data_bigarray_val(ba));
  return Val_unit;
}