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));
};
