[Libguestfs] [PATCH 2/4] ocaml: Allow Guestfs.t handle to be garbage collected.
Richard W.M. Jones
rjones at redhat.com
Tue Oct 6 15:05:45 UTC 2015
** NB: This is an API break for OCaml programs using Guestfs.event_callback. **
Because of the way I implemented Guestfs.event_callback which had the
Guestfs.t handle as the first parameter, we had to store the (OCaml)
Guestfs.t handle in the C handle's private data area. To do that, we
had to create a global root pointing to the handle.
This of course meant that the handle could not be garbage collected
(thanks Roman Kagan for spotting this).
This changes the API of Guestfs.event_callback so that a handle is no
longer passed. The OCaml handle can now be garbage collected again.
For programs that need the Guestfs.t handle in the callback function
(which turns out to be *none* of the OCaml programs we have written),
you can do:
g#set_event_callback (callback_fn g) [Guestfs.EVENT_FOO];
But since the closure passed to Guestfs.set_event_callback is still
(unavoidably) registered as a global root, that will trap a reference
to the handle, so the handle won't be able to be garbage collected
until you delete the callback.
---
generator/ocaml.ml | 10 +++-------
mllib/progress.ml | 4 ++--
ocaml/guestfs-c.c | 24 +++---------------------
ocaml/t/guestfs_410_close_event.ml | 2 +-
ocaml/t/guestfs_420_log_messages.ml | 2 +-
ocaml/t/guestfs_430_progress_messages.ml | 2 +-
6 files changed, 11 insertions(+), 33 deletions(-)
diff --git a/generator/ocaml.ml b/generator/ocaml.ml
index 8b4e1aa..5d92fcb 100644
--- a/generator/ocaml.ml
+++ b/generator/ocaml.ml
@@ -107,8 +107,7 @@ val event_all : event list
type event_handle
(** The opaque event handle which can be used to delete event callbacks. *)
-type event_callback =
- t -> event -> event_handle -> string -> int64 array -> unit
+type event_callback = event -> event_handle -> string -> int64 array -> unit
(** The event callback. *)
val set_event_callback : t -> event_callback -> event list -> event_handle
@@ -117,9 +116,7 @@ val set_event_callback : t -> event_callback -> event list -> event_handle
Note that if the closure captures a reference to the handle,
this reference will prevent the handle from being
- automatically closed by the garbage collector. Since the
- handle is passed to the event callback, with careful programming
- it should be possible to avoid capturing the handle in the closure. *)
+ automatically closed by the garbage collector. *)
val delete_event_callback : t -> event_handle -> unit
(** [delete_event_callback g eh] removes a previously registered
@@ -321,8 +318,7 @@ let event_all = [
type event_handle = int
-type event_callback =
- t -> event -> event_handle -> string -> int64 array -> unit
+type event_callback = event -> event_handle -> string -> int64 array -> unit
external set_event_callback : t -> event_callback -> event list -> event_handle
= \"ocaml_guestfs_set_event_callback\"
diff --git a/mllib/progress.ml b/mllib/progress.ml
index 8cf5875..b6b3b60 100644
--- a/mllib/progress.ml
+++ b/mllib/progress.ml
@@ -38,13 +38,13 @@ let set_up_progress_bar ?(machine_readable = false) (g : Guestfs.guestfs) =
let bar = progress_bar_init ~machine_readable in
(* Reset the progress bar before every libguestfs function. *)
- let enter_callback g event evh buf array =
+ let enter_callback event evh buf array =
if event = G.EVENT_ENTER then
progress_bar_reset bar
in
(* A progress event: move the progress bar. *)
- let progress_callback g event evh buf array =
+ let progress_callback event evh buf array =
if event = G.EVENT_PROGRESS && Array.length array >= 4 then (
let position = array.(2)
and total = array.(3) in
diff --git a/ocaml/guestfs-c.c b/ocaml/guestfs-c.c
index 1ee5ba7..08998af 100644
--- a/ocaml/guestfs-c.c
+++ b/ocaml/guestfs-c.c
@@ -78,8 +78,6 @@ guestfs_finalize (value gv)
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.
@@ -92,9 +90,6 @@ guestfs_finalize (value gv)
free (roots[i]);
}
free (roots);
-
- caml_remove_generational_global_root (v);
- free (v);
}
}
@@ -156,7 +151,6 @@ ocaml_guestfs_create (value environmentv, value close_on_exitv, value unitv)
CAMLlocal1 (gv);
unsigned flags = 0;
guestfs_h *g;
- value *v;
if (environmentv != Val_int (0) &&
!Bool_val (Field (environmentv, 0)))
@@ -174,14 +168,6 @@ ocaml_guestfs_create (value environmentv, value close_on_exitv, value unitv)
gv = Val_guestfs (g);
- /* Store the OCaml handle into the C handle. This is only so we can
- * map the C handle to the OCaml handle in event_callback_wrapper.
- */
- v = guestfs_int_safe_malloc (g, sizeof *v);
- *v = gv;
- caml_register_generational_global_root (v);
- guestfs_set_private (g, "_ocaml_g", v);
-
CAMLreturn (gv);
}
@@ -358,14 +344,10 @@ event_callback_wrapper_locked (guestfs_h *g,
const uint64_t *array, size_t array_len)
{
CAMLparam0 ();
- CAMLlocal5 (gv, evv, ehv, bufv, arrayv);
+ CAMLlocal4 (evv, ehv, bufv, arrayv);
CAMLlocal2 (rv, v);
- value *root;
size_t i;
- root = guestfs_get_private (g, "_ocaml_g");
- gv = *root;
-
/* Only one bit should be set in 'event'. Which one? */
evv = Val_int (event_bitmask_to_event (event));
@@ -380,9 +362,9 @@ event_callback_wrapper_locked (guestfs_h *g,
Store_field (arrayv, i, v);
}
- value args[5] = { gv, evv, ehv, bufv, arrayv };
+ value args[4] = { evv, ehv, bufv, arrayv };
- rv = caml_callbackN_exn (*(value*)data, 5, args);
+ rv = caml_callbackN_exn (*(value*)data, 4, args);
/* Callbacks shouldn't throw exceptions. There's not much we can do
* except to print it.
diff --git a/ocaml/t/guestfs_410_close_event.ml b/ocaml/t/guestfs_410_close_event.ml
index e8dd626..13c3220 100644
--- a/ocaml/t/guestfs_410_close_event.ml
+++ b/ocaml/t/guestfs_410_close_event.ml
@@ -18,7 +18,7 @@
let close_invoked = ref 0
-let close _ _ _ _ _ =
+let close _ _ _ _ =
incr close_invoked
let () =
diff --git a/ocaml/t/guestfs_420_log_messages.ml b/ocaml/t/guestfs_420_log_messages.ml
index 673a88f..b58dbd9 100644
--- a/ocaml/t/guestfs_420_log_messages.ml
+++ b/ocaml/t/guestfs_420_log_messages.ml
@@ -20,7 +20,7 @@ open Printf
let log_invoked = ref 0
-let log g ev eh buf array =
+let log ev eh buf array =
let eh : int = Obj.magic eh in
printf "event logged: event=%s eh=%d buf=%S array=[%s]\n"
diff --git a/ocaml/t/guestfs_430_progress_messages.ml b/ocaml/t/guestfs_430_progress_messages.ml
index 26deee0..3d1cc3f 100644
--- a/ocaml/t/guestfs_430_progress_messages.ml
+++ b/ocaml/t/guestfs_430_progress_messages.ml
@@ -18,7 +18,7 @@
let callback_invoked = ref 0
-let callback _ _ _ _ _ = incr callback_invoked
+let callback _ _ _ _ = incr callback_invoked
let () =
let g = new Guestfs.guestfs () in
--
2.5.0
More information about the Libguestfs
mailing list