[Libguestfs] [PATCH nbdkit 6/6] ocaml: Fix thread registration for OCaml 5
Richard W.M. Jones
rjones at redhat.com
Wed Jun 21 21:08:57 UTC 2023
OCaml 5 is strict about registering threads before calling OCaml heap
functions, and will abort the program with this error if you don't do
this correctly:
Fatal error: no domain lock held
Fix this as explained in the comment.
Note (as it's not explained well in the documentation): Threads
created from C are placed in OCaml thread domain 0. In order to add
them to this domain, the main program must not hold on to the runtime
system lock (for domain 0, because that's what caml_startup gives
you). For this to work we must only hold this lock in the main
program briefly around calls to OCaml code, which means we must
release the runtime system after calling caml_startup as we did in an
earlier commit.
---
plugins/cc/nbdkit-cc-plugin.pod | 4 +--
plugins/ocaml/nbdkit-ocaml-plugin.pod | 3 +-
plugins/ocaml/Makefile.am | 2 +-
tests/Makefile.am | 4 +--
plugins/ocaml/plugin.c | 52 +++++++++++++++++++++++++--
tests/test-cc-ocaml.sh | 2 +-
tests/cc_shebang.ml | 2 +-
7 files changed, 59 insertions(+), 10 deletions(-)
diff --git a/plugins/cc/nbdkit-cc-plugin.pod b/plugins/cc/nbdkit-cc-plugin.pod
index f55f74ab0..e393457c4 100644
--- a/plugins/cc/nbdkit-cc-plugin.pod
+++ b/plugins/cc/nbdkit-cc-plugin.pod
@@ -89,7 +89,7 @@ C<CC=g++> as a parameter to exec nbdkit.
=head2 Using this plugin with OCaml
nbdkit cc CC=ocamlopt \
- CFLAGS="-output-obj -runtime-variant _pic -I +unix unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
+ CFLAGS="-output-obj -runtime-variant _pic -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
source.ml
OCaml plugin scripts can be created using this trick:
@@ -97,7 +97,7 @@ OCaml plugin scripts can be created using this trick:
(*/.)>/dev/null 2>&1
exec nbdkit cc "$0" \
CC=ocamlopt \
- CFLAGS="-output-obj -runtime-variant _pic -I +unix unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
+ CFLAGS="-output-obj -runtime-variant _pic -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
"$@"
*)
(* followed by OCaml code for the plugin here *)
diff --git a/plugins/ocaml/nbdkit-ocaml-plugin.pod b/plugins/ocaml/nbdkit-ocaml-plugin.pod
index e4a8cf0b0..f1e06d3e2 100644
--- a/plugins/ocaml/nbdkit-ocaml-plugin.pod
+++ b/plugins/ocaml/nbdkit-ocaml-plugin.pod
@@ -53,7 +53,8 @@ using this command:
ocamlopt.opt -output-obj -runtime-variant _pic \
-o nbdkit-myplugin-plugin.so \
- -I +unix unix.cmxa NBDKit.cmx myplugin.ml \
+ -I +unix unix.cmxa -I +threads threads.cmxa \
+ NBDKit.cmx myplugin.ml \
-cclib -lnbdkitocaml
You can then use C<nbdkit-myplugin-plugin.so> as an nbdkit plugin (see
diff --git a/plugins/ocaml/Makefile.am b/plugins/ocaml/Makefile.am
index e7faae506..a61550cb9 100644
--- a/plugins/ocaml/Makefile.am
+++ b/plugins/ocaml/Makefile.am
@@ -84,7 +84,7 @@ noinst_SCRIPTS = nbdkit-ocamlexample-plugin.so
nbdkit-ocamlexample-plugin.so: example.cmx libnbdkitocaml.la NBDKit.cmi NBDKit.cmx
$(OCAMLOPT) $(OCAMLOPTFLAGS) \
-output-obj -runtime-variant _pic -o $@ \
- -I +unix unix.cmxa NBDKit.cmx $< \
+ -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx $< \
-cclib -L.libs -cclib -lnbdkitocaml
example.cmx: example.ml NBDKit.cmi NBDKit.cmx
$(OCAMLOPT) $(OCAMLOPTFLAGS) -c $< -o $@
diff --git a/tests/Makefile.am b/tests/Makefile.am
index d8a640e1e..32ebb7002 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -1185,7 +1185,7 @@ OCAML_PLUGIN_DEPS = \
test-ocaml-plugin.so: test_ocaml_plugin.cmx $(OCAML_PLUGIN_DEPS)
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml \
-output-obj -runtime-variant _pic -o $@ \
- -I +unix unix.cmxa NBDKit.cmx $< \
+ -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx $< \
-cclib -L../plugins/ocaml/.libs -cclib -lnbdkitocaml
test_ocaml_plugin.cmx: test_ocaml_plugin.ml $(OCAML_PLUGIN_DEPS)
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml -c $< -o $@
@@ -1194,7 +1194,7 @@ test-ocaml-errorcodes-plugin.so: \
test_ocaml_errorcodes_plugin.cmx $(OCAML_PLUGIN_DEPS)
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml \
-output-obj -runtime-variant _pic -o $@ \
- -I +unix unix.cmxa NBDKit.cmx $< \
+ -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx $< \
-cclib -L../plugins/ocaml/.libs -cclib -lnbdkitocaml
test_ocaml_errorcodes_plugin.cmx: \
test_ocaml_errorcodes_plugin.ml $(OCAML_PLUGIN_DEPS)
diff --git a/plugins/ocaml/plugin.c b/plugins/ocaml/plugin.c
index a4671d6ed..eaa88a925 100644
--- a/plugins/ocaml/plugin.c
+++ b/plugins/ocaml/plugin.c
@@ -260,9 +260,31 @@ cleanup_wrapper (void)
CAMLreturn0;
}
+/* A note about nbdkit threads and OCaml:
+ *
+ * OCaml requires that all C threads are registered and unregistered.
+ *
+ * For the main thread callbacks like load, config, get_ready [above
+ * this comment] we don't need to do anything.
+ *
+ * For the connected callbacks [below this comment] nbdkit creates its
+ * own threads but does not provide a way to intercept thread creation
+ * or destruction. However we can register the current thread in
+ * every callback, and unregister the thread only call_wrapper.
+ *
+ * This is safe and cheap: Registering a thread is basically free if
+ * the thread is already registered (the OCaml code checks a
+ * thread-local variable to see if it needs to register). nbdkit will
+ * always call the .close method, which does not necessarily indicate
+ * that the thread is being destroyed, but if the thread is reused we
+ * will register the same thread again when .open or similar is called
+ * next time.
+ */
+
static int
preconnect_wrapper (int readonly)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -279,6 +301,7 @@ preconnect_wrapper (int readonly)
static int
list_exports_wrapper (int readonly, int is_tls, struct nbdkit_exports *exports)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal2 (rv, v);
@@ -311,6 +334,7 @@ list_exports_wrapper (int readonly, int is_tls, struct nbdkit_exports *exports)
static const char *
default_export_wrapper (int readonly, int is_tls)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -330,6 +354,7 @@ default_export_wrapper (int readonly, int is_tls)
static void *
open_wrapper (int readonly)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -351,12 +376,13 @@ open_wrapper (int readonly)
}
/* We always have a close function, since we need to unregister the
- * global root and free the handle.
+ * global root, free the handle and unregister the thread.
*/
static void
close_wrapper (void *h)
{
- ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
+ caml_c_thread_register ();
+ caml_acquire_runtime_system ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -370,6 +396,8 @@ close_wrapper (void *h)
caml_remove_generational_global_root (h);
free (h);
+ caml_release_runtime_system ();
+ caml_c_thread_unregister ();
CAMLreturn0;
}
@@ -377,6 +405,7 @@ close_wrapper (void *h)
static const char *
export_description_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -395,6 +424,7 @@ export_description_wrapper (void *h)
static int64_t
get_size_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -414,6 +444,7 @@ static int
block_size_wrapper (void *h,
uint32_t *minimum, uint32_t *preferred, uint32_t *maximum)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -456,6 +487,7 @@ block_size_wrapper (void *h,
static int
can_write_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -472,6 +504,7 @@ can_write_wrapper (void *h)
static int
can_flush_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -488,6 +521,7 @@ can_flush_wrapper (void *h)
static int
is_rotational_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -504,6 +538,7 @@ is_rotational_wrapper (void *h)
static int
can_trim_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -520,6 +555,7 @@ can_trim_wrapper (void *h)
static int
can_zero_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -536,6 +572,7 @@ can_zero_wrapper (void *h)
static int
can_fua_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -552,6 +589,7 @@ can_fua_wrapper (void *h)
static int
can_fast_zero_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -568,6 +606,7 @@ can_fast_zero_wrapper (void *h)
static int
can_cache_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -584,6 +623,7 @@ can_cache_wrapper (void *h)
static int
can_extents_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -600,6 +640,7 @@ can_extents_wrapper (void *h)
static int
can_multi_conn_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -646,6 +687,7 @@ static int
pread_wrapper (void *h, void *buf, uint32_t count, uint64_t offset,
uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
@@ -676,6 +718,7 @@ static int
pwrite_wrapper (void *h, const void *buf, uint32_t count, uint64_t offset,
uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, strv, offsetv, flagsv);
@@ -697,6 +740,7 @@ pwrite_wrapper (void *h, const void *buf, uint32_t count, uint64_t offset,
static int
flush_wrapper (void *h, uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal2 (rv, flagsv);
@@ -715,6 +759,7 @@ flush_wrapper (void *h, uint32_t flags)
static int
trim_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
@@ -736,6 +781,7 @@ trim_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
static int
zero_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
@@ -758,6 +804,7 @@ static int
extents_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags,
struct nbdkit_extents *extents)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal5 (rv, countv, offsetv, flagsv, v);
@@ -798,6 +845,7 @@ extents_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags,
static int
cache_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
diff --git a/tests/test-cc-ocaml.sh b/tests/test-cc-ocaml.sh
index 3b4f6a553..9458201a4 100755
--- a/tests/test-cc-ocaml.sh
+++ b/tests/test-cc-ocaml.sh
@@ -61,6 +61,6 @@ cleanup_fn rm -f $out
rm -f $out
nbdkit -U - cc $script a=1 b=2 c=3 d=4 \
- CC="$OCAMLOPT" CFLAGS="-output-obj -runtime-variant _pic -I $SRCDIR/../plugins/ocaml -I +unix unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
+ CC="$OCAMLOPT" CFLAGS="-output-obj -runtime-variant _pic -I $SRCDIR/../plugins/ocaml -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
--run 'nbdinfo --size $uri' > $out
test "$(cat $out)" -eq $((512 * 2048))
diff --git a/tests/cc_shebang.ml b/tests/cc_shebang.ml
index 619b08bb5..05ca77b64 100755
--- a/tests/cc_shebang.ml
+++ b/tests/cc_shebang.ml
@@ -4,7 +4,7 @@
# shell as an impossible command which is ignored. The line below is
# run by the shell and ignored by OCaml.
-exec nbdkit cc "$0" CC=ocamlopt CFLAGS="-output-obj -runtime-variant _pic -I +unix unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml" "$@"
+exec nbdkit cc "$0" CC=ocamlopt CFLAGS="-output-obj -runtime-variant _pic -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx -cclib -lnbdkitocaml" "$@"
*)
open Printf
--
2.41.0
More information about the Libguestfs
mailing list