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); }
CAMLprim value 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); }
value caml_QQmlPropertyMap_insert(value _map, value _propName, value _variant) { CAMLparam3(_map, _propName, _variant); // copy and paste from the generated file for QAbstractModel subclass // TODO: move this conversion to the lablqml QVariant newval; if (Is_block(_variant)) { if (caml_hash_variant("bool") == Field(_variant,0) ) // without cast it will create Qvariant of int newval = QVariant::fromValue( (bool)Bool_val(Field(_variant,1)) ); else if (caml_hash_variant("string") == Field(_variant,0) ) newval = QVariant::fromValue(QString(String_val(Field(_variant,1)))); else if (caml_hash_variant("int") == Field(_variant,0) ) newval = QVariant::fromValue(Int_val(Field(_variant,1))); else if (caml_hash_variant("float") == Field(_variant,0) ) newval = QVariant::fromValue(Double_val(Field(_variant,1))); else if (caml_hash_variant("qobject") == Field(_variant,0) ) newval = QVariant::fromValue((QObject*) (Field(Field(_variant,1),0))); else Q_ASSERT_X(false, "While converting OCaml value to QVariant", "Unknown variant tag"); } else { // empty QVariant newval = QVariant(); } CamlPropertyMap *map = (*(CamlPropertyMap**) (Data_custom_val(_map))); Q_ASSERT_X(map != NULL, __func__, "Trying to use QQmlPropertyMap object which is NULL"); map->insert( QString(String_val(_propName)), newval); CAMLreturn(Val_unit); }
value caml_create_QQmlPropertyMap(value _func, value _unit) { CAMLparam2(_func, _unit); CAMLlocal1(_ans); value *fv = (value*) malloc(sizeof(_func)); *fv = _func; caml_register_global_root(fv); CamlPropertyMap *propMap = new CamlPropertyMap(); _ans = caml_alloc_custom(&camlpropertymap_ops, sizeof(CamlPropertyMap*), 0, 1); (*((CamlPropertyMap **) Data_custom_val(_ans))) = propMap; propMap->saveCallback(fv); QObject::connect(propMap, &CamlPropertyMap::valueChanged, [fv](const QString& propName, const QVariant& var) { caml_leave_blocking_section(); [&fv, &propName, &var]() { CAMLparam0(); CAMLlocal2(_nameArg, _variantArg); _nameArg = caml_copy_string( propName.toLocal8Bit().data() ); caml_callback2(*fv, _nameArg, Val_QVariant(_variantArg, var) ); CAMLreturn0; }(); caml_enter_blocking_section(); } ); CAMLreturn(_ans); }
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; }
static value wrap_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)); };