自学教程：C++ Data_custom_val函数代码示例

CAMLexport int64 caml_Int64_val(value v){  union { int32 i[2]; int64 j; } buffer;  buffer.i[0] = ((int32 *) Data_custom_val(v))[0];  buffer.i[1] = ((int32 *) Data_custom_val(v))[1];  return buffer.j;}

static int compare_pointers(value l_, value r_){  /* pointer comparison */  intptr_t l = (intptr_t)*(void **)Data_custom_val(l_);  intptr_t r = (intptr_t)*(void **)Data_custom_val(r_);  return (l > r) - (l < r);}

static void serialize_nat(value nat,                          uintnat * wsize_32,                          uintnat * wsize_64){  mlsize_t len = Wosize_val(nat) - 1;#ifdef ARCH_SIXTYFOUR  len = len * 2; /* two 32-bit words per 64-bit digit  */  if (len >= ((mlsize_t)1 << 32))    failwith("output_value: nat too big");#endif  serialize_int_4((int32) len);#if defined(ARCH_SIXTYFOUR) && defined(ARCH_BIG_ENDIAN)  { int32 * p;    mlsize_t i;    for (i = len, p = Data_custom_val(nat); i > 0; i -= 2, p += 2) {      serialize_int_4(p[1]);    /* low 32 bits of 64-bit digit */      serialize_int_4(p[0]);    /* high 32 bits of 64-bit digit */    }  }#else  serialize_block_4(Data_custom_val(nat), len);#endif  *wsize_32 = len * 4;  *wsize_64 = len * 4;}

value grappa_CAML_better_capping (value c_gene1, value c_gene2, value num_genes){    CAMLparam3(c_gene1,c_gene2,num_genes);    int NUM_GENES = Int_val(num_genes);    long dims[1]; dims[0] = NUM_GENES;    struct genome_struct *g1, *g2;    g1 = (struct genome_struct *) Data_custom_val (c_gene1);    g2 = (struct genome_struct *) Data_custom_val (c_gene2);    struct genome_struct * out_genome_list;    out_genome_list = (struct genome_struct *) malloc (sizeof (struct genome_struct) );    if ( out_genome_list == ( struct genome_struct * ) NULL )        failwith ("ERROR: genome_list in grappa_CAML_better_capping is NULL" );    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 )        failwith( "ERROR: gname of genome_list in grappa_CAML_better_capping is NULL" );    out_genome_list[0].genes =( int * ) malloc ( 3*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; //we don't need encoding and gnamePtr;    better_capping (g1->genes,g2->genes,NUM_GENES,g1->delimiters,g2->delimiters,g1->deli_num,g2->deli_num,out_genome_list);    struct genome_arr_t *out_genome_arr;    CAMLlocal1 (c_genome_arr);    c_genome_arr = alloc_custom(&genomeArrOps, sizeof(struct genome_arr_t), 1, 10000);    out_genome_arr = (struct genome_arr_t *) Data_custom_val(c_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); }

static int caml_cairo_compare_pointers(value v1, value v2){  void *p1 = * (void **) Data_custom_val(v1);  void *p2 = * (void **) Data_custom_val(v2);  if (p1 == p2) return(0);  else if (p1 < p2) return(-1);  else return(1);}

int camlidl_custom_mpq_compare(value val1, value val2){    int res;    __mpq_struct* mpq1;    __mpq_struct* mpq2;    mpq1 = (__mpq_struct*)(Data_custom_val(val1));    mpq2 = (__mpq_struct*)(Data_custom_val(val2));    res = mpq_cmp(mpq1,mpq2);    res = res > 0 ? 1 : res==0 ? 0 : -1;    return res;}

int camlidl_custom_mpq2_compare(value val1, value val2){    CAMLparam2(val1,val2);    int res;    __mpq_struct** mpq1;    __mpq_struct** mpq2;    mpq1 = (__mpq_struct**)(Data_custom_val(val1));    mpq2 = (__mpq_struct**)(Data_custom_val(val2));    res = mpq_cmp(*mpq1,*mpq2);    res = res > 0 ? 1 : res==0 ? 0 : -1;    CAMLreturn(res);}

CAMLexport value caml_copy_int64(int64 i){  value res = caml_alloc_custom(&caml_int64_ops, 8, 0, 1);#ifndef ARCH_ALIGN_INT64  Int64_val(res) = i;#else  union { int32 i[2]; int64 j; } buffer;  buffer.j = i;  ((int32 *) Data_custom_val(res))[0] = buffer.i[0];  ((int32 *) Data_custom_val(res))[1] = buffer.i[1];#endif  return res;}

void camlidl_custom_gmp_randstate2_finalize(value val){    CAMLparam1(val);    __gmp_randstate_struct** gmp_randstate = (__gmp_randstate_struct**)(Data_custom_val(val));    gmp_randclear(*gmp_randstate);    free(*gmp_randstate);}

long camlidl_custom_mpz2_hash(value val){    CAMLparam1(val);    __mpz_struct** mpz = (__mpz_struct**)(Data_custom_val(val));    long hash = mpz_get_si(*mpz);    CAMLreturn(hash);}

void camlidl_custom_mpz2_finalize(value val){    CAMLparam1(val);    __mpz_struct** mpz = (__mpz_struct**)(Data_custom_val(val));    mpz_clear(*mpz);    free(*mpz);}

CAMLprim value caml_copy_semaphore(sem_t *s) {  CAMLparam0();  CAMLlocal1(v);  v = caml_alloc_custom(&semaphore_custom_ops, sizeof(sem_t *), 0, 1);  memcpy(Data_custom_val(v), &s, sizeof(sem_t *));  CAMLreturn(v);}

CAMLprim value mmdb_ml_dump_per_ip(value ip, value mmdb){  CAMLparam2(ip, mmdb);  CAMLlocal1(pulled_string);  unsigned int len = caml_string_length(ip);  char *as_string = caml_strdup(String_val(ip));  if (strlen(as_string) != (size_t)len) {    caml_failwith("Could not copy IP address properly");  }  MMDB_s *as_mmdb = (MMDB_s*)Data_custom_val(mmdb);  int gai_error = 0, mmdb_error = 0;  MMDB_lookup_result_s *result = caml_stat_alloc(sizeof(*result));  *result = MMDB_lookup_string(as_mmdb, as_string, &gai_error, &mmdb_error);  MMDB_entry_data_list_s *entry_data_list = NULL;  int status = MMDB_get_entry_data_list(&result->entry, &entry_data_list);  check_status(status);  char *pulled_from_db = data_from_dump(entry_data_list);  pulled_string = caml_copy_string(pulled_from_db);  caml_stat_free(result);  caml_stat_free(as_string);  caml_stat_free(pulled_from_db);  free(entry_data_list);  as_mmdb = NULL;  CAMLreturn(pulled_string);}

CAMLprimvalue caml_extunix_ssi_signo_sys(value vssi){  CAMLparam1(vssi);  struct signalfd_siginfo *ssi = (void *)(Data_custom_val(vssi));  CAMLreturn(Val_int(caml_rev_convert_signal_number(ssi->ssi_signo)));}

CAMLprim value mmdb_ml_open(value s){  CAMLparam1(s);  CAMLlocal1(mmdb_handle);  if (polymorphic_variants.poly_bool == 0  ||      polymorphic_variants.poly_float == 0 ||      polymorphic_variants.poly_int == 0   ||      polymorphic_variants.poly_string == 0) {    polymorphic_variants.poly_bool = caml_hash_variant("Bool");    polymorphic_variants.poly_float = caml_hash_variant("Float");    polymorphic_variants.poly_int = caml_hash_variant("Int");    polymorphic_variants.poly_string = caml_hash_variant("String");  }  unsigned int len = caml_string_length(s);  char *copied = caml_strdup(String_val(s));  if (strlen(copied) != (size_t)len) {    caml_failwith("Could not open MMDB database");  }  MMDB_s *this_db = caml_stat_alloc(sizeof(*this_db));  int status = MMDB_open(copied, MMDB_MODE_MMAP, this_db);  mmdb_handle = caml_alloc_custom(&mmdb_custom_ops, sizeof(*this_db), 0, 1);  check_status(status);  memcpy(Data_custom_val(mmdb_handle), this_db, sizeof(*this_db));  caml_stat_free(this_db);  caml_stat_free(copied);  CAMLreturn(mmdb_handle);}

CAMLprim value glyph_to_bitmap(value glyph){  CAMLparam1(glyph);  CAMLlocal2(block, buffer);  FT_GlyphSlot   slot;  FT_Glyph       g;  FT_BitmapGlyph bm;  size_t         pitch;  size_t         new_pitch;  int i;  slot = *(FT_GlyphSlot *)Data_custom_val(glyph);  if (FT_Get_Glyph(slot, &g))    failwith("glyph_to_bitmap");  if (g->format != FT_GLYPH_FORMAT_BITMAP)  {    if (FT_Glyph_To_Bitmap(&g, FT_RENDER_MODE_MONO, 0, 1))    {      FT_Done_Glyph(g);      failwith("glyph_to_bitmap");    }  }  bm = (FT_BitmapGlyph)g;  pitch     = abs(bm->bitmap.pitch);  new_pitch = (bm->bitmap.width + 7) / 8;  block  = alloc_tuple(6);  buffer = alloc_string(bm->bitmap.rows * new_pitch);  if (bm->bitmap.pitch >= 0)  {    for (i = 0; i < bm->bitmap.rows; i++)      memcpy(String_val(buffer) + i * new_pitch,             bm->bitmap.buffer + i * pitch,             new_pitch);  }  else  {    for (i = 0; i < bm->bitmap.rows; i++)      memcpy(String_val(buffer) + i * new_pitch,             bm->bitmap.buffer + (bm->bitmap.rows - i) * pitch,             new_pitch);  }  Store_field(block, 0, Val_int(bm->left));  Store_field(block, 1, Val_int(bm->top));  Store_field(block, 2, Val_int(bm->bitmap.rows));  Store_field(block, 3, Val_int(bm->bitmap.width));  Store_field(block, 4, Val_int(new_pitch));  Store_field(block, 5, buffer);  FT_Done_Glyph(g);  CAMLreturn(block);};

value camlidl_mpz_ptr_c2ml(mpz_ptr* mpz){    value val;    val = alloc_custom(&camlidl_custom_mpz, sizeof(__mpz_struct), 0, 1);    *(((__mpz_struct*)(Data_custom_val(val)))) = *(*mpz);    return val;}

value Val_gribfield( gribfield *field ) {    gribfield **store;    value ret;    ret = caml_alloc_custom(&gribfield_custom_ops, sizeof(store), 0, 1);    store = Data_custom_val(ret);    *store = field;    return ret;}

CAMLprim value face_glyph(value face){  CAMLparam1(face);  CAMLlocal1(block);  FT_Face      f;  FT_GlyphSlot *g;  f = *(FT_Face *)Data_custom_val(face);  block = alloc(sizeof(FT_GlyphSlot), Abstract_tag);  g = (FT_GlyphSlot *)Data_custom_val(block);  *g = f->glyph;  CAMLreturn(block);};

value camlidl_gmp_randstate_ptr_c2ml(gmp_randstate_ptr* gmp_randstate){    value val;    val = alloc_custom(&camlidl_custom_gmp_randstate, sizeof(__gmp_randstate_struct), 0, 1);    *((__gmp_randstate_struct*)(Data_custom_val(val))) = *(*gmp_randstate);    return val;}

staticvaluewrap_ptr(struct custom_operations *custom, void* ptr){  value v = alloc_custom(custom, sizeof(void*), 0, 1);  * (void**) Data_custom_val(v) = ptr;  return v;}

long camlidl_custom_mpq2_hash(value val){    CAMLparam1(val);    __mpq_struct** mpq = (__mpq_struct**)(Data_custom_val(val));    unsigned long num = mpz_get_ui(mpq_numref(*mpq));    unsigned long den = mpz_get_ui(mpq_denref(*mpq));    long hash = num<den ? den/num : num/den;    CAMLreturn(hash);}

CAMLprim value Wrapper_FT_Get_Char_Index(value face, value charcode){  CAMLparam2(face, charcode);  FT_Face f;  f = *(FT_Face *)Data_custom_val(face);  CAMLreturn(Val_int(FT_Get_Char_Index(f, Int_val(charcode))));};

CAMLprim value Wrapper_FT_Attach_File(value face, value filename){  CAMLparam2(face, filename);  FT_Face f;  f = *(FT_Face *)Data_custom_val(face);  CAMLreturn(Val_int(FT_Attach_File(f, String_val(filename))));};

CAMLprim value has_ps_glyph_names(value f){  CAMLparam1(f);  FT_Face face;  face = *(FT_Face *)Data_custom_val(f);  CAMLreturn(Val_bool(FT_Has_PS_Glyph_Names(face) != 0));};

CAMLprim value Wrapper_FT_Get_Postscript_Name(value face){  CAMLparam1(face);  FT_Face f;  f = *(FT_Face *)Data_custom_val(face);  CAMLreturn(copy_string(FT_Get_Postscript_Name(f)));};

CAMLprim value is_sfnt(value f){  CAMLparam1(f);  FT_Face face;  face = *(FT_Face *)Data_custom_val(f);  CAMLreturn(Val_bool(FT_IS_SFNT(face) != 0));};

CAMLprim value face_num_glyphs(value face){  CAMLparam1(face);  FT_Face f;  f = *(FT_Face *)Data_custom_val(face);  CAMLreturn(Val_int(f->num_glyphs));};