Libguestfs - Aug 2019 - [PATCH libnbd 2/2] ocaml: Remove NBD.Buffer.free function, use the completion callback instead.

In this patch series we use the newly introduced free callback
on the completion function to dererence the OCaml NBD.Buffer.
I will make the same kind of change for Python later in a
separate series.

The completion function is always called at the C level, even
if the OCaml program didn't use the optional argument.  That's
because the free callback doesn't run otherwise.

There is a case for having the free callback run even if there is no
registered callback:

  nbd_aio_pread (nbd, buf, sizeof buf, 0,
                 (nbd_completion_callback) { .callback = NULL,
                                             .free = completion_free },
                 0);

but the semantics of that are a bit weird.  Why would you need to
"free" a callback which doesn't exist?  Would it be correct for
the
library to free the callback immediately, rather than after the
theoretical completion callback would have run?

Rich.

Just a simple refactoring.
---
 generator/generator | 71 +++++++++++++++++++++++++++------------------
 1 file changed, 43 insertions(+), 28 deletions(-)

diff --git a/generator/generator b/generator/generator
index 16729cd..a31821d 100755
--- a/generator/generator
+++ b/generator/generator
@@ -4940,7 +4940,8 @@ let print_ocaml_closure_wrapper { cbname; cbargs }   
assert (List.length argnames <= 5);
   pr "  CAMLlocal%d (%s);\n" (List.length argnames)
     (String.concat ", " argnames);
-  pr "  CAMLlocal3 (fnv, exn, rv);\n";
+  pr "  CAMLlocal2 (exn, rv);\n";
+  pr "  const struct user_data *data = user_data;\n";
   pr "  int r;\n";
   pr "  value args[%d];\n" (List.length argnames);
   pr "\n";
@@ -4969,9 +4970,7 @@ let print_ocaml_closure_wrapper { cbname; cbargs }  
   List.iteri (fun i n -> pr "  args[%d] = %s;\n" i n) argnames;
 
-  pr "  fnv = * (value *) user_data;\n";
-
-  pr "  rv = caml_callbackN_exn (fnv, %d, args);\n"
+  pr "  rv = caml_callbackN_exn (data->fnv, %d, args);\n"
     (List.length argnames);
 
   List.iter (
@@ -5034,15 +5033,7 @@ let print_ocaml_closure_wrapper { cbname; cbargs }    pr
";\n";
   pr "  caml_enter_blocking_section ();\n";
   pr "  return ret;\n";
-  pr "}\n";
-
-  pr "static void\n";
-  pr "%s_free (void *user_data)\n" cbname;
-  pr "{\n";
-  pr "  caml_remove_generational_global_root (user_data);\n";
-  pr "  free (user_data);\n";
-  pr "}\n";
-  pr "\n"
+  pr "}\n"
 
 let print_ocaml_binding (name, { args; optargs; ret })    (* Get the names of
all the value arguments including the handle. *)
@@ -5093,14 +5084,13 @@ let print_ocaml_binding (name, { args; optargs; ret })  
pr "    /* The function may save a reference to the closure, so we\n";
        pr "     * must treat it as a possible GC root.\n";
        pr "     */\n";
-       pr "    %s_callback.user_data = malloc (sizeof (value));\n"
cbname;
-       pr "    if (%s_callback.user_data == NULL)\n" cbname;
-       pr "      caml_raise_out_of_memory ();\n";
-       pr "    *(value *)%s_callback.user_data = Field (%sv, 0);\n"
-         cbname cbname;
-       pr "    caml_register_generational_global_root
(%s_callback.user_data);\n" cbname;
+       pr "    struct user_data *user_data = alloc_user_data ();\n";
+       pr "\n";
+       pr "    user_data->fnv = Field (%sv, 0);\n" cbname;
+       pr "    caml_register_generational_global_root
(&user_data->fnv);\n";
        pr "    %s_callback.callback = %s_wrapper;\n" cbname cbname;
-       pr "    %s_callback.free = %s_free;\n" cbname cbname;
+       pr "    %s_callback.user_data = user_data;\n" cbname;
+       pr "    %s_callback.free = free_user_data;\n" cbname;
        pr "  }\n";
     | OFlags (n, { flag_prefix }) ->
        pr "  uint32_t %s;\n" n;
@@ -5133,14 +5123,13 @@ let print_ocaml_binding (name, { args; optargs; ret })  
pr "  /* The function may save a reference to the closure, so we\n";
        pr "   * must treat it as a possible GC root.\n";
        pr "   */\n";
-       pr "  nbd_%s_callback %s_callback = { .callback = %s_wrapper, .free
= %s_free };\n"
-         cbname cbname cbname cbname;
-       pr "  %s_callback.user_data = malloc (sizeof (value));\n"
cbname;
-       pr "  if (%s_callback.user_data == NULL) caml_raise_out_of_memory
();\n"
-         cbname;
-       pr "  *(value *)%s_callback.user_data = %sv;\n" cbname cbname;
-       pr "  caml_register_generational_global_root
(%s_callback.user_data);\n"
-         cbname
+       pr "  struct user_data *user_data = alloc_user_data ();\n";
+       pr "  user_data->fnv = %sv;\n" cbname;
+       pr "  caml_register_generational_global_root
(&user_data->fnv);\n";
+       pr "  nbd_%s_callback %s_callback;\n" cbname cbname;
+       pr "  %s_callback.callback = %s_wrapper;\n" cbname cbname;
+       pr "  %s_callback.user_data = user_data;\n" cbname;
+       pr "  %s_callback.free = free_user_data;\n" cbname
     | Enum (n, { enum_prefix }) ->
        pr "  int %s = %s_val (%sv);\n" n enum_prefix n
     | Flags (n, { flag_prefix }) ->
@@ -5259,6 +5248,32 @@ let generate_ocaml_nbd_c ()    pr "#pragma GCC
diagnostic ignored \"-Wmissing-prototypes\"\n";
   pr "\n";
 
+  pr "/* This is passed to *_wrapper as the user_data pointer";
+  pr " * and freed in the free_user_data function below.\n";
+  pr " */\n";
+  pr "struct user_data {\n";
+  pr "  value fnv;      /* GC root pointing to OCaml function. */\n";
+  pr "};\n";
+  pr "\n";
+  pr "static struct user_data *\n";
+  pr "alloc_user_data (void)\n";
+  pr "{\n";
+  pr "  struct user_data *data = calloc (1, sizeof *data);\n";
+  pr "  if (data == NULL)\n";
+  pr "    caml_raise_out_of_memory ();\n";
+  pr "  return data;\n";
+  pr "}\n";
+  pr "\n";
+  pr "static void\n";
+  pr "free_user_data (void *user_data)\n";
+  pr "{\n";
+  pr "  struct user_data *data = user_data;\n";
+  pr "\n";
+  pr "  caml_remove_generational_global_root (&data->fnv);\n";
+  pr "  free (data);\n";
+  pr "}\n";
+  pr "\n";
+
   List.iter print_ocaml_closure_wrapper all_closures;
   List.iter print_ocaml_enum_val all_enums;
   List.iter print_ocaml_flag_val all_flags;
-- 
2.22.0

By using the completion free callback function we don't need to
manually free the buffer.

Note that after this patch OClosures are always called from OCaml,
because we might need the side effect of freeing the buffer.

This reverts part of commit fef1c281a65d061127bf178e5f8cfca0a2475c56.
---
 generator/generator              | 59 +++++++++++++++++++++-----------
 ocaml/buffer.c                   | 22 ------------
 ocaml/examples/asynch_copy.ml    |  4 +--
 ocaml/libnbd-ocaml.pod           | 22 ------------
 ocaml/tests/test_590_aio_copy.ml |  4 +--
 5 files changed, 41 insertions(+), 70 deletions(-)

diff --git a/generator/generator b/generator/generator
index a31821d..704c57e 100755
--- a/generator/generator
+++ b/generator/generator
@@ -4742,10 +4742,6 @@ module Buffer : sig
   (** Allocate an uninitialized buffer.  The parameter is the size
       in bytes. *)
 
-  val free : t -> unit
-  (** The buffer must be manually freed when it is no longer used.
-      An AIO completion callback is usually a good place. *)
-
   val to_bytes : t -> bytes
   (** Copy buffer to an OCaml [bytes] object. *)
 
@@ -4843,7 +4839,6 @@ let ()  module Buffer = struct
   type t
   external alloc : int -> t = \"nbd_internal_ocaml_buffer_alloc\"
-  external free : t -> unit = \"nbd_internal_ocaml_buffer_free\"
   external to_bytes : t -> bytes =
\"nbd_internal_ocaml_buffer_to_bytes\"
   external of_bytes : bytes -> t =
\"nbd_internal_ocaml_buffer_of_bytes\"
   external size : t -> int = \"nbd_internal_ocaml_buffer_size\"
@@ -4945,6 +4940,12 @@ let print_ocaml_closure_wrapper { cbname; cbargs }    pr
"  int r;\n";
   pr "  value args[%d];\n" (List.length argnames);
   pr "\n";
+  pr "  /* The C callback is always registered, even if there's no
OCaml\n";
+  pr "   * callback.  This is because we may need to unregister
an\n";
+  pr "   * associated persistent buffer.\n";
+  pr "   */\n";
+  pr "  if (data->fnv == 0)\n";
+  pr "    CAMLreturnT (int, 0);\n";
 
   List.iter (
     function
@@ -5079,19 +5080,19 @@ let print_ocaml_binding (name, { args; optargs; ret })  
List.iter (
     function
     | OClosure { cbname } ->
-       pr "  nbd_%s_callback %s_callback = {0};\n" cbname cbname;
+       pr "  nbd_%s_callback %s_callback;\n" cbname cbname;
+       pr "  struct user_data *%s_user_data = alloc_user_data ();\n"
cbname;
        pr "  if (%sv != Val_int (0)) { /* Some closure */\n" cbname;
        pr "    /* The function may save a reference to the closure, so
we\n";
        pr "     * must treat it as a possible GC root.\n";
        pr "     */\n";
-       pr "    struct user_data *user_data = alloc_user_data ();\n";
-       pr "\n";
-       pr "    user_data->fnv = Field (%sv, 0);\n" cbname;
-       pr "    caml_register_generational_global_root
(&user_data->fnv);\n";
-       pr "    %s_callback.callback = %s_wrapper;\n" cbname cbname;
-       pr "    %s_callback.user_data = user_data;\n" cbname;
-       pr "    %s_callback.free = free_user_data;\n" cbname;
+       pr "    %s_user_data->fnv = Field (%sv, 0);\n" cbname
cbname;
+       pr "    caml_register_generational_global_root
(&%s_user_data->fnv);\n"
+         cbname;
        pr "  }\n";
+       pr "  %s_callback.callback = %s_wrapper;\n" cbname cbname;
+       pr "  %s_callback.user_data = %s_user_data;\n" cbname cbname;
+       pr "  %s_callback.free = free_user_data;\n" cbname;
     | OFlags (n, { flag_prefix }) ->
        pr "  uint32_t %s;\n" n;
        pr "  if (%sv != Val_int (0)) /* Some [ list of %s.t ] */\n"
@@ -5120,15 +5121,16 @@ let print_ocaml_binding (name, { args; optargs; ret })  
pr "  void *%s = %s_buf->data;\n" n n;
        pr "  size_t %s = %s_buf->len;\n" count n
     | Closure { cbname } ->
+       pr "  nbd_%s_callback %s_callback;\n" cbname cbname;
+       pr "  struct user_data *%s_user_data = alloc_user_data ();\n"
cbname;
        pr "  /* The function may save a reference to the closure, so
we\n";
        pr "   * must treat it as a possible GC root.\n";
        pr "   */\n";
-       pr "  struct user_data *user_data = alloc_user_data ();\n";
-       pr "  user_data->fnv = %sv;\n" cbname;
-       pr "  caml_register_generational_global_root
(&user_data->fnv);\n";
-       pr "  nbd_%s_callback %s_callback;\n" cbname cbname;
+       pr "  %s_user_data->fnv = %sv;\n" cbname cbname;
+       pr "  caml_register_generational_global_root
(&%s_user_data->fnv);\n"
+         cbname;
        pr "  %s_callback.callback = %s_wrapper;\n" cbname cbname;
-       pr "  %s_callback.user_data = user_data;\n" cbname;
+       pr "  %s_callback.user_data = %s_user_data;\n" cbname cbname;
        pr "  %s_callback.free = free_user_data;\n" cbname
     | Enum (n, { enum_prefix }) ->
        pr "  int %s = %s_val (%sv);\n" n enum_prefix n
@@ -5154,6 +5156,19 @@ let print_ocaml_binding (name, { args; optargs; ret })   
pr "  uint64_t %s = Int64_val (%sv);\n" n n
   ) args;
 
+  (* If there is a BytesPersistIn/Out parameter then we need to
+   * register it as a global root and save that into the
+   * completion_callback.user_data so the root is removed on
+   * command completion.
+   *)
+  List.iter (
+    function
+    | BytesPersistIn (n, _) | BytesPersistOut (n, _) ->
+       pr "  completion_user_data->bufv = %sv;\n" n;
+       pr "  caml_register_generational_global_root
(&completion_user_data->bufv);\n"
+    | _ -> ()
+  ) args;
+
   let ret_c_type = C.type_of_ret ret and errcode = C.errcode_of_ret ret in
   pr "  %s r;\n" ret_c_type;
   pr "\n";
@@ -5252,7 +5267,8 @@ let generate_ocaml_nbd_c ()    pr " * and freed in
the free_user_data function below.\n";
   pr " */\n";
   pr "struct user_data {\n";
-  pr "  value fnv;      /* GC root pointing to OCaml function. */\n";
+  pr "  value fnv;     /* Optional GC root pointing to OCaml function.
*/\n";
+  pr "  value bufv;    /* Optional GC root pointing to persistent buffer.
*/\n";
   pr "};\n";
   pr "\n";
   pr "static struct user_data *\n";
@@ -5269,7 +5285,10 @@ let generate_ocaml_nbd_c ()    pr "{\n";
   pr "  struct user_data *data = user_data;\n";
   pr "\n";
-  pr "  caml_remove_generational_global_root (&data->fnv);\n";
+  pr "  if (data->fnv != 0)\n";
+  pr "    caml_remove_generational_global_root
(&data->fnv);\n";
+  pr "  if (data->bufv != 0)\n";
+  pr "    caml_remove_generational_global_root
(&data->bufv);\n";
   pr "  free (data);\n";
   pr "}\n";
   pr "\n";
diff --git a/ocaml/buffer.c b/ocaml/buffer.c
index 837eece..0c0fe00 100644
--- a/ocaml/buffer.c
+++ b/ocaml/buffer.c
@@ -36,10 +36,6 @@ nbd_buffer_finalize (value bv)
 {
   struct nbd_buffer *b = NBD_buffer_val (bv);
 
-  /* Usually if this frees the buffer it indicates a bug in the
-   * program.  The buffer should have been manually freed before
-   * this.  But there's nothing we can do here, so free it.
-   */
   free (b->data);
 }
 
@@ -60,21 +56,6 @@ nbd_internal_ocaml_buffer_alloc (value sizev)
   CAMLreturn (rv);
 }
 
-/* Free an NBD persistent buffer (only the C buffer, not the
- * OCaml object).
- */
-value
-nbd_internal_ocaml_buffer_free (value bv)
-{
-  CAMLparam1 (bv);
-  struct nbd_buffer *b = NBD_buffer_val (bv);
-
-  free (b->data);
-  b->data = NULL;
-
-  CAMLreturn (Val_unit);
-}
-
 /* Copy an NBD persistent buffer to an OCaml bytes. */
 value
 nbd_internal_ocaml_buffer_to_bytes (value bv)
@@ -83,9 +64,6 @@ nbd_internal_ocaml_buffer_to_bytes (value bv)
   CAMLlocal1 (rv);
   struct nbd_buffer *b = NBD_buffer_val (bv);
 
-  if (b->data == NULL)          /* Buffer has been freed. */
-    caml_invalid_argument ("NBD.Buffer.to_bytes used on freed
buffer");
-
   rv = caml_alloc_string (b->len);
   memcpy (Bytes_val (rv), b->data, b->len);
 
diff --git a/ocaml/examples/asynch_copy.ml b/ocaml/examples/asynch_copy.ml
index 8057118..d5dcc60 100644
--- a/ocaml/examples/asynch_copy.ml
+++ b/ocaml/examples/asynch_copy.ml
@@ -31,11 +31,9 @@ let asynch_copy src dst    in
 
   (* This callback is called when any pwrite to the destination
-   * has completed.  We have to manually free the buffer here
-   * as it is no longer used.
+   * has completed.
    *)
   let write_completed buf _ -    NBD.Buffer.free buf;
     (* By returning 1 here we auto-retire the pwrite command. *)
     1
   in
diff --git a/ocaml/libnbd-ocaml.pod b/ocaml/libnbd-ocaml.pod
index d370113..ae8fb88 100644
--- a/ocaml/libnbd-ocaml.pod
+++ b/ocaml/libnbd-ocaml.pod
@@ -33,28 +33,6 @@ which is the printable error message.  The second is the raw
C<errno>,
 if available (see L<nbd_get_errno(3)>).  The raw C<errno> is not
 compatible with errors in the OCaml C<Unix> module unfortunately.
 
-=head1 AIO BUFFERS
-
-Some libnbd asynchronous I/O (AIO) calls require a buffer parameter
-which persists after the call finishes.  For example C<NBD.aio_pread>
-starts a command which continues reading into the C<NBD.Buffer.t>
-parameter in subsequent calls after the original C<aio_pread> call
-returns.
-
-For these cases you must create a C<NBD.Buffer.t> and ensure that it
-is not garbage collected until the command completes.  The easiest way
-to do this is to use the C<*_callback> variants and free the buffer in
-the callback:
-
- let buf = NBD.Buffer.alloc 512 in
- NBD.aio_pread_callback h buf 0_L (
-   (* This is called when the command has completed. *)
-   fun _ ->
-     NBD.Buffer.free buf;
-     (* Returning 1 from this callback auto-retires the command. *)
-     1
- )
-
 =head1 EXAMPLES
 
 This directory contains examples written in OCaml:
diff --git a/ocaml/tests/test_590_aio_copy.ml b/ocaml/tests/test_590_aio_copy.ml
index defb4cb..ac490ef 100644
--- a/ocaml/tests/test_590_aio_copy.ml
+++ b/ocaml/tests/test_590_aio_copy.ml
@@ -53,11 +53,9 @@ let asynch_copy src dst    in
 
   (* This callback is called when any pwrite to the destination
-   * has completed.  We have to manually free the buffer here
-   * as it is no longer used.
+   * has completed.
    *)
   let write_completed buf _ -    NBD.Buffer.free buf;
     bytes_written := !bytes_written + NBD.Buffer.size buf;
     (* By returning 1 here we auto-retire the pwrite command. *)
     1
-- 
2.22.0

On 8/14/19 2:31 PM, Richard W.M. Jones wrote:
> In this patch series we use the newly introduced free callback
> on the completion function to dererence the OCaml NBD.Buffer.
> I will make the same kind of change for Python later in a
> separate series.
> 
> The completion function is always called at the C level, even
> if the OCaml program didn't use the optional argument.  That's
> because the free callback doesn't run otherwise.
> 
> There is a case for having the free callback run even if there is no
> registered callback:
> 
>   nbd_aio_pread (nbd, buf, sizeof buf, 0,
>                  (nbd_completion_callback) { .callback = NULL,
>                                              .free = completion_free },
Presumably you'd also want some .user_data there?

If we are going to insist on a non-NULL .callback when .free is
non-NULL, that should probably be enforced by the generator for OClosure
(we are already ensured non-NULL .callback for Closure).
>                  0);
> 
> but the semantics of that are a bit weird.  Why would you need to
> "free" a callback which doesn't exist?  Would it be correct
for the
> library to free the callback immediately, rather than after the
> theoretical completion callback would have run?
I could live with 'if .free is non-NULL, free(user_data) is called after
the point that callback would be used, regardless of whether .callback
was NULL'.  Perhaps my idea of consolidating free callbacks into just
retirement code will make that easier (because then we don't have the
mess of whether .callback has to be changed to NULL on the fly to track
whether .free still needs to be called; instead we set .free to NULL
once it is done).

-- 
Eric Blake, Principal Software Engineer
Red Hat, Inc.           +1-919-301-3226
Virtualization:  qemu.org | libvirt.org

On 8/14/19 2:31 PM, Richard W.M. Jones wrote:
> By using the completion free callback function we don't need to
> manually free the buffer.
> 
> Note that after this patch OClosures are always called from OCaml,
> because we might need the side effect of freeing the buffer.
> 
> This reverts part of commit fef1c281a65d061127bf178e5f8cfca0a2475c56.
> ---
>  generator/generator              | 59 +++++++++++++++++++++-----------
>  ocaml/buffer.c                   | 22 ------------
>  ocaml/examples/asynch_copy.ml    |  4 +--
>  ocaml/libnbd-ocaml.pod           | 22 ------------
>  ocaml/tests/test_590_aio_copy.ml |  4 +--
>  5 files changed, 41 insertions(+), 70 deletions(-)
Series looks good to me.
> @@ -4945,6 +4940,12 @@ let print_ocaml_closure_wrapper { cbname; cbargs }
>    pr "  int r;\n";
>    pr "  value args[%d];\n" (List.length argnames);
>    pr "\n";
> +  pr "  /* The C callback is always registered, even if there's
no OCaml\n";
> +  pr "   * callback.  This is because we may need to unregister
an\n";
> +  pr "   * associated persistent buffer.\n";
> +  pr "   */\n";
> +  pr "  if (data->fnv == 0)\n";
> +  pr "    CAMLreturnT (int, 0);\n";
This is what you would change if, per the cover letter question, we
decide to allow .callback=NULL + .free=something to call
free(.user_data).  But always calling .callback, and having it
short-circuit when OCaml did not provide a function to call, is sane too.

-- 
Eric Blake, Principal Software Engineer
Red Hat, Inc.           +1-919-301-3226
Virtualization:  qemu.org | libvirt.org