/* Allocate handles and deal with finalization. */
static void
guestfs_finalize (value gv)
{
guestfs_h *g = Guestfs_val (gv);
if (g) {
/* There is a nasty, difficult to solve case here where the
* user deletes events in one of the callbacks that we are
* about to invoke, resulting in a double-free. XXX
*/
size_t len, i;
value **roots = get_all_event_callbacks (g, &len);
value *v = guestfs_get_private (g, "_ocaml_g");
/* Close the handle: this could invoke callbacks from the list
* above, which is why we don't want to delete them before
* closing the handle.
*/
guestfs_close (g);
/* Now unregister the global roots. */
for (i = 0; i < len; ++i) {
caml_remove_global_root (roots[i]);
free (roots[i]);
}
free (roots);
caml_remove_global_root (v);
free (v);
}
}
PREFIX void ml_Elm_Transit_Del_Cb(void* data, Elm_Transit* tr)
{
value* v_fun = (value*) data;
caml_callback(*v_fun, (value) tr);
caml_remove_global_root(v_fun);
free(v_fun);
}
PREFIX void ml_Elm_Transit_Effect_End_Cb_free_only(
Elm_Transit_Effect* effect, Elm_Transit* tr)
{
value* v_fun = (value*) effect;
caml_remove_global_root(v_fun);
free(v_fun);
}
value get_value_and_remove_root(paranode node) {
CAMLparam0();
value v = ((paranode_t*)node)->v;
caml_remove_global_root(v);
//TODO: when to free(p)? I think it should still be here.
CAMLreturn(v);
}
/* hunpos destruction */
void hunpos_tagger_destroy(Hunpos hp, int* error)
{
CAMLparam0();
*error = 0;
caml_remove_global_root((value*) hp);
free(hp);
CAMLreturn0;
}
static void finalize_mp4(value e)
{
mp4_t *mp = Mp4_val(e);
if (mp->ff)
mp4ff_close(mp->ff);
if (mp->read_cb)
caml_remove_global_root(&mp->read_cb);
if (mp->write_cb)
caml_remove_global_root(&mp->write_cb);
if (mp->seek_cb)
caml_remove_global_root(&mp->seek_cb);
if (mp->trunc_cb)
caml_remove_global_root(&mp->trunc_cb);
free(mp);
}
/**
* Garbage collector callback
* this is actually unlikely to ever get called, since the integrator will probably
* be in use for the whole runtime and ocaml does not seem to run any finalizers on
* program termination
*/
void sundials_ml_ida_solver_finalize(value v) {
printf("Finalizing ida solver...\n");
caml_remove_global_root(ROOT(v));
free(ROOT(v));
IDAFree(IDA_MEM(v));
}
static void disconnect_have_type(typefind_element *tf)
{
if(tf->have_type_hid)
{
g_signal_handler_disconnect(tf->tf, tf->have_type_hid);
tf->have_type_hid = 0;
}
if(tf->have_type_cb)
{
caml_remove_global_root(&tf->have_type_cb);
tf->have_type_cb = 0;
}
}
static void disconnect_need_data(appsrc *as)
{
if(as->need_data_hid)
{
g_signal_handler_disconnect(as->appsrc, as->need_data_hid);
as->need_data_hid = 0;
}
if(as->need_data_cb)
{
caml_remove_global_root(&as->need_data_cb);
as->need_data_cb = 0;
}
}
static void disconnect_new_sample(appsink *as)
{
if(as->new_sample_hid)
{
g_signal_handler_disconnect(as->appsink, as->new_sample_hid);
as->new_sample_hid = 0;
}
if(as->new_sample_cb)
{
caml_remove_global_root(&as->new_sample_cb);
as->new_sample_cb = 0;
}
}
CAMLprim value caml_record_backtrace(value vflag)
{
int flag = Int_val(vflag);
if (flag != caml_backtrace_active) {
caml_backtrace_active = flag;
caml_backtrace_pos = 0;
if (flag) {
caml_register_global_root(&caml_backtrace_last_exn);
} else {
caml_remove_global_root(&caml_backtrace_last_exn);
}
}
return Val_unit;
}
void output_buffer_clear() {
int i;
for(i = 0; i < output_buffer_length; i++) {
union struct_field val = output_buffer[i].struct_data_val;
switch(output_buffer[i].struct_data_tag) {
case STRUCT_TBL:
tbl_struct_clear(&(val.tbl_val));
break;
case STRUCT_STR:
caml_remove_global_root(val.str_val);
break;
}
};
free(output_buffer);
}
void tbl_struct_clear(tbl_struct* tbl) {
size_t i;
for (i = 0; i < (tbl->tbl_value_len); i++) {
value_data val = (tbl->tbl_value_tbl)[i];
switch(val.value_data_tag) {
case VAL_INT:
break;
case VAL_PTR:
break;
case VAL_ABS:
// This is an abstract value so we unregister it
caml_remove_global_root(val.value_data_val.abs_val);
break;
}
}
free(tbl->tbl_value_tbl);
}
CAMLprim value caml_record_backtrace(value vflag)
{
int flag = Int_val(vflag);
if (flag != caml_backtrace_active) {
caml_backtrace_active = flag;
caml_backtrace_pos = 0;
if (flag) {
caml_register_global_root(&caml_backtrace_last_exn);
} else {
caml_remove_global_root(&caml_backtrace_last_exn);
}
/* Note: lazy initialization of caml_backtrace_buffer in
caml_stash_backtrace to simplify the interface with the thread
libraries */
}
return Val_unit;
}
/* Guestfs.delete_event_callback */
CAMLprim value
ocaml_guestfs_delete_event_callback (value gv, value ehv)
{
CAMLparam2 (gv, ehv);
char key[64];
int eh = Int_val (ehv);
guestfs_h *g = Guestfs_val (gv);
snprintf (key, sizeof key, "_ocaml_event_%d", eh);
value *root = guestfs_get_private (g, key);
if (root) {
caml_remove_global_root (root);
free (root);
guestfs_set_private (g, key, NULL);
guestfs_delete_event_callback (g, eh);
}
CAMLreturn (Val_unit);
}
CAML_object::~CAML_object() {
caml_remove_global_root(&v);
}
~OCamlCallback() {
caml_remove_global_root(&m_closure);
}
static void finalize_bus(value v)
{
bus_t *bus = Bus_data_val(v);
caml_remove_global_root(&bus->element);
free(bus);
}
QSingleFunc::~QSingleFunc() {
if (_saved_callback)
caml_remove_global_root(&_saved_callback);
}
void fcl_destroy(value* v)
{
caml_remove_global_root(v);
free(v);
}
