libxl: ocaml: drop the ocaml heap lock before calling into libxl

Ocaml has a heap lock which must be held whenever ocaml code is running. Ocaml
usually drops this lock when it enters a potentially blocking low-level
function, such as writing to a file. Libxl has its own lock, which it may
acquire when being called.

Things get interesting when libxl calls back into ocaml code. There is a risk
of ending up in a deadlock when a thread holds both locks at the same time,
then temporarily drop the ocaml lock, while another thread calls another libxl
function.

To avoid deadlocks, we drop the ocaml heap lock before entering libxl, and
reacquire it in callbacks to ocaml. This way, the ocaml heap lock is never held
together with the libxl lock, except in osevent registration callbacks, and
xentoollog callbacks. If we guarantee to not call any libxl functions inside
those callbacks, we can avoid deadlocks.

This patch handle the dropping and reacquiring of the ocaml heap lock by the
caml_enter_blocking_section and caml_leave_blocking_section functions, and
related macros. We are also careful to not call any functions that access the
ocaml heap while the ocaml heap lock is dropped. This often involves copying
ocaml values to C before dropping the ocaml lock.

The ao_how in aohow_val is now malloc'ed, just to make this function a little
easier to use.

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>

diff --git a/tools/ocaml/libs/xentoollog/Makefile b/tools/ocaml/libs/xentoollog/Makefile
index e535ba5c16e7cbdd1c9334a892f65bc93cf61c99..471b42811d5455b9ee32d54464b30584c6941b83 100644 (file)
--- a/tools/ocaml/libs/xentoollog/Makefile
+++ b/tools/ocaml/libs/xentoollog/Makefile
@@ -2,6 +2,9 @@ TOPLEVEL=$(CURDIR)/../..
 XEN_ROOT=$(TOPLEVEL)/../..
 include $(TOPLEVEL)/common.make
 
+# allow mixed declarations and code
+CFLAGS += -Wno-declaration-after-statement
+
 CFLAGS += $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest)
 OCAMLINCLUDE +=
 

diff --git a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
index 122ed0de4f38fef7484453d7dbbdabf255df3c11..aadc3d1b0bcce0d3eecab16ee2b34d708d1354e9 100644 (file)
--- a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
+++ b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
@@ -31,6 +31,11 @@
 
 #include "caml_xentoollog.h"
 
+/* The following is equal to the CAMLreturn macro, but without the return */
+#define CAMLdone do{ \
+caml_local_roots = caml__frame; \
+}while (0)
+
 #define XTL ((xentoollog_logger *) Xtl_val(handle))
 
 static char * dup_String_val(value s)
@@ -81,6 +86,7 @@ static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
        const char *format,
        va_list al)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        CAMLlocalN(args, 4);
        struct caml_xtl *xtl = (struct caml_xtl*)logger;
@@ -101,7 +107,8 @@ static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
        free(msg);
 
        caml_callbackN(*func, 4, args);
-       CAMLreturn0;
+       CAMLdone;
+       caml_enter_blocking_section();
 }
 
 static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
@@ -109,6 +116,7 @@ static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
        const char *doing_what /* no \r,\n */,
        int percent, unsigned long done, unsigned long total)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        CAMLlocalN(args, 5);
        struct caml_xtl *xtl = (struct caml_xtl*)logger;
@@ -125,7 +133,8 @@ static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
        args[4] = caml_copy_int64(total);
 
        caml_callbackN(*func, 5, args);
-       CAMLreturn0;
+       CAMLdone;
+       caml_enter_blocking_section();
 }
 
 static void xtl_destroy(struct xentoollog_logger *logger)

diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile
index 0408cc259244aa8be68a97c9109cfad229339600..61eb44c9f313f4ea7596aea77b20d66c528e3b9a 100644 (file)
--- a/tools/ocaml/libs/xl/Makefile
+++ b/tools/ocaml/libs/xl/Makefile
@@ -2,8 +2,9 @@ TOPLEVEL=$(CURDIR)/../..
 XEN_ROOT=$(TOPLEVEL)/../..
 include $(TOPLEVEL)/common.make
 
-# ignore unused generated functions
-CFLAGS += -Wno-unused
+# ignore unused generated functions and allow mixed declarations and code
+CFLAGS += -Wno-unused -Wno-declaration-after-statement
+
 CFLAGS += $(CFLAGS_libxenlight)
 CFLAGS += -I ../xentoollog
 

diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 1d299baf541a6983a2752c669e5175be3af419ec..c1a9229bb18ee7dab25f02df15c9c3ef481d7b15 100644 (file)
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -34,6 +34,11 @@
 
 #include "caml_xentoollog.h"
 
+/* The following is equal to the CAMLreturn macro, but without the return */
+#define CAMLdone do{ \
+caml_local_roots = caml__frame; \
+}while (0)
+
 #define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x)))
 #define CTX ((libxl_ctx *) Ctx_val(ctx))
 
@@ -374,6 +379,7 @@ static char *String_option_val(value v)
 
 void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        CAMLlocal2(error, tmp);
        static value *func = NULL;
@@ -399,11 +405,15 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
 
        caml_remove_global_root(p);
        free(p);
+
+       CAMLdone;
+       caml_enter_blocking_section();
 }
 
-static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how *ao_how)
+static libxl_asyncop_how *aohow_val(value async)
 {
        CAMLparam1(async);
+       libxl_asyncop_how *ao_how = NULL;
        value *p;
 
        if (async != Val_none) {
@@ -418,12 +428,12 @@ static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how *ao_how)
                        failwith_xl(ERROR_NOMEM, "cannot allocate value");
                *p = Some_val(async);
                caml_register_global_root(p);
+               ao_how = malloc(sizeof(*ao_how));
                ao_how->callback = async_callback;
                ao_how->u.for_callback = (void *) p;
-               CAMLreturnT(libxl_asyncop_how *, ao_how);
        }
-       else
-               CAMLreturnT(libxl_asyncop_how *, NULL);
+
+       CAMLreturnT(libxl_asyncop_how *, ao_how);
 }
 
 value stub_libxl_domain_create_new(value ctx, value domain_config, value async, value unit)
@@ -432,7 +442,7 @@ value stub_libxl_domain_create_new(value ctx, value domain_config, value async,
        int ret;
        libxl_domain_config c_dconfig;
        uint32_t c_domid;
-       libxl_asyncop_how ao_how;
+       libxl_asyncop_how *ao_how;
 
        libxl_domain_config_init(&c_dconfig);
        ret = domain_config_val(CTX, &c_dconfig, domain_config);
@@ -441,9 +451,13 @@ value stub_libxl_domain_create_new(value ctx, value domain_config, value async,
                failwith_xl(ret, "domain_create_new");
        }
 
-       ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid,
-               aohow_val(async, &ao_how), NULL);
+       ao_how = aohow_val(async);
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid, ao_how, NULL);
+       caml_leave_blocking_section();
 
+       free(ao_how);
        libxl_domain_config_dispose(&c_dconfig);
 
        if (ret != 0)
@@ -460,7 +474,8 @@ value stub_libxl_domain_create_restore(value ctx, value domain_config, value par
        libxl_domain_config c_dconfig;
        libxl_domain_restore_params c_params;
        uint32_t c_domid;
-       libxl_asyncop_how ao_how;
+       libxl_asyncop_how *ao_how;
+       int restore_fd;
 
        libxl_domain_config_init(&c_dconfig);
        ret = domain_config_val(CTX, &c_dconfig, domain_config);
@@ -476,9 +491,15 @@ value stub_libxl_domain_create_restore(value ctx, value domain_config, value par
                failwith_xl(ret, "domain_create_restore");
        }
 
-       ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, Int_val(Field(params, 0)),
-               &c_params, aohow_val(async, &ao_how), NULL);
+       ao_how = aohow_val(async);
+       restore_fd = Int_val(Field(params, 0));
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, restore_fd,
+               &c_params, ao_how, NULL);
+       caml_leave_blocking_section();
 
+       free(ao_how);
        libxl_domain_config_dispose(&c_dconfig);
        libxl_domain_restore_params_dispose(&c_params);
 
@@ -492,8 +513,12 @@ value stub_libxl_domain_shutdown(value ctx, value domid)
 {
        CAMLparam2(ctx, domid);
        int ret;
+       uint32_t c_domid = Int_val(domid);
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_shutdown(CTX, c_domid);
+       caml_leave_blocking_section();
 
-       ret = libxl_domain_shutdown(CTX, Int_val(domid));
        if (ret != 0)
                failwith_xl(ret, "domain_shutdown");
 
@@ -504,8 +529,12 @@ value stub_libxl_domain_reboot(value ctx, value domid)
 {
        CAMLparam2(ctx, domid);
        int ret;
+       uint32_t c_domid = Int_val(domid);
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_reboot(CTX, c_domid);
+       caml_leave_blocking_section();
 
-       ret = libxl_domain_reboot(CTX, Int_val(domid));
        if (ret != 0)
                failwith_xl(ret, "domain_reboot");
 
@@ -516,9 +545,15 @@ value stub_libxl_domain_destroy(value ctx, value domid, value async, value unit)
 {
        CAMLparam4(ctx, domid, async, unit);
        int ret;
-       libxl_asyncop_how ao_how;
+       uint32_t c_domid = Int_val(domid);
+       libxl_asyncop_how *ao_how = aohow_val(async);
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_destroy(CTX, c_domid, ao_how);
+       caml_leave_blocking_section();
+
+       free(ao_how);
 
-       ret = libxl_domain_destroy(CTX, Int_val(domid), aohow_val(async, &ao_how));
        if (ret != 0)
                failwith_xl(ret, "domain_destroy");
 
@@ -529,10 +564,16 @@ value stub_libxl_domain_suspend(value ctx, value domid, value fd, value async, v
 {
        CAMLparam5(ctx, domid, fd, async, unit);
        int ret;
-       libxl_asyncop_how ao_how;
+       uint32_t c_domid = Int_val(domid);
+       int c_fd = Int_val(fd);
+       libxl_asyncop_how *ao_how = aohow_val(async);
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_suspend(CTX, c_domid, c_fd, 0, ao_how);
+       caml_leave_blocking_section();
+
+       free(ao_how);
 
-       ret = libxl_domain_suspend(CTX, Int_val(domid), Int_val(fd), 0,
-               aohow_val(async, &ao_how));
        if (ret != 0)
                failwith_xl(ret, "domain_suspend");
 
@@ -543,8 +584,12 @@ value stub_libxl_domain_pause(value ctx, value domid)
 {
        CAMLparam2(ctx, domid);
        int ret;
+       uint32_t c_domid = Int_val(domid);
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_pause(CTX, c_domid);
+       caml_leave_blocking_section();
 
-       ret = libxl_domain_pause(CTX, Int_val(domid));
        if (ret != 0)
                failwith_xl(ret, "domain_pause");
 
@@ -555,8 +600,12 @@ value stub_libxl_domain_unpause(value ctx, value domid)
 {
        CAMLparam2(ctx, domid);
        int ret;
+       uint32_t c_domid = Int_val(domid);
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_unpause(CTX, c_domid);
+       caml_leave_blocking_section();
 
-       ret = libxl_domain_unpause(CTX, Int_val(domid));
        if (ret != 0)
                failwith_xl(ret, "domain_unpause");
 
@@ -573,13 +622,16 @@ value stub_xl_device_##type##_##op(value ctx, value info, value domid,    \
        CAMLparam5(ctx, info, domid, async, unit);                      \
        libxl_device_##type c_info;                                     \
        int ret, marker_var;                                            \
-       libxl_asyncop_how ao_how;                                       \
+       uint32_t c_domid = Int_val(domid);                              \
+       libxl_asyncop_how *ao_how = aohow_val(async);                   \
                                                                        \
        device_##type##_val(CTX, &c_info, info);                        \
                                                                        \
-       ret = libxl_##fn##_##op(CTX, Int_val(domid), &c_info,           \
-               aohow_val(async, &ao_how));                             \
+       caml_enter_blocking_section();                                  \
+       ret = libxl_##fn##_##op(CTX, c_domid, &c_info, ao_how);         \
+       caml_leave_blocking_section();                                  \
                                                                        \
+       free(ao_how);                                                   \
        libxl_device_##type##_dispose(&c_info);                         \
                                                                        \
        if (ret != 0)                                                   \
@@ -605,9 +657,16 @@ value stub_xl_device_nic_of_devid(value ctx, value domid, value devid)
        CAMLparam3(ctx, domid, devid);
        CAMLlocal1(nic);
        libxl_device_nic c_nic;
-       libxl_devid_to_device_nic(CTX, Int_val(domid), Int_val(devid), &c_nic);
+       uint32_t c_domid = Int_val(domid);
+       int c_devid = Int_val(devid);
+
+       caml_enter_blocking_section();
+       libxl_devid_to_device_nic(CTX, c_domid, c_devid, &c_nic);
+       caml_leave_blocking_section();
+
        nic = Val_device_nic(&c_nic);
        libxl_device_nic_dispose(&c_nic);
+
        CAMLreturn(nic);
 }
 
@@ -617,11 +676,12 @@ value stub_xl_device_nic_list(value ctx, value domid)
        CAMLlocal2(list, temp);
        libxl_device_nic *c_list;
        int i, nb;
-       uint32_t c_domid;
-
-       c_domid = Int_val(domid);
+       uint32_t c_domid = Int_val(domid);
 
+       caml_enter_blocking_section();
        c_list = libxl_device_nic_list(CTX, c_domid, &nb);
+       caml_leave_blocking_section();
+
        if (!c_list)
                failwith_xl(ERROR_FAIL, "nic_list");
 
@@ -645,11 +705,12 @@ value stub_xl_device_disk_list(value ctx, value domid)
        CAMLlocal2(list, temp);
        libxl_device_disk *c_list;
        int i, nb;
-       uint32_t c_domid;
-
-       c_domid = Int_val(domid);
+       uint32_t c_domid = Int_val(domid);
 
+       caml_enter_blocking_section();
        c_list = libxl_device_disk_list(CTX, c_domid, &nb);
+       caml_leave_blocking_section();
+
        if (!c_list)
                failwith_xl(ERROR_FAIL, "disk_list");
 
@@ -672,9 +733,19 @@ value stub_xl_device_disk_of_vdev(value ctx, value domid, value vdev)
        CAMLparam3(ctx, domid, vdev);
        CAMLlocal1(disk);
        libxl_device_disk c_disk;
-       libxl_vdev_to_device_disk(CTX, Int_val(domid), String_val(vdev), &c_disk);
+       char *c_vdev;
+       uint32_t c_domid = Int_val(domid);
+
+       c_vdev = strdup(String_val(vdev));
+
+       caml_enter_blocking_section();
+       libxl_vdev_to_device_disk(CTX, c_domid, c_vdev, &c_disk);
+       caml_leave_blocking_section();
+
        disk = Val_device_disk(&c_disk);
        libxl_device_disk_dispose(&c_disk);
+       free(c_vdev);
+
        CAMLreturn(disk);
 }
 
@@ -684,11 +755,12 @@ value stub_xl_device_pci_list(value ctx, value domid)
        CAMLlocal2(list, temp);
        libxl_device_pci *c_list;
        int i, nb;
-       uint32_t c_domid;
-
-       c_domid = Int_val(domid);
+       uint32_t c_domid = Int_val(domid);
 
+       caml_enter_blocking_section();
        c_list = libxl_device_pci_list(CTX, c_domid, &nb);
+       caml_leave_blocking_section();
+
        if (!c_list)
                failwith_xl(ERROR_FAIL, "pci_list");
 
@@ -711,10 +783,13 @@ value stub_xl_device_pci_assignable_add(value ctx, value info, value rebind)
        CAMLparam3(ctx, info, rebind);
        libxl_device_pci c_info;
        int ret, marker_var;
+       int c_rebind = (int) Bool_val(rebind);
 
        device_pci_val(CTX, &c_info, info);
 
-       ret = libxl_device_pci_assignable_add(CTX, &c_info, (int) Bool_val(rebind));
+       caml_enter_blocking_section();
+       ret = libxl_device_pci_assignable_add(CTX, &c_info, c_rebind);
+       caml_leave_blocking_section();
 
        libxl_device_pci_dispose(&c_info);
 
@@ -729,10 +804,13 @@ value stub_xl_device_pci_assignable_remove(value ctx, value info, value rebind)
        CAMLparam3(ctx, info, rebind);
        libxl_device_pci c_info;
        int ret, marker_var;
+       int c_rebind = (int) Bool_val(rebind);
 
        device_pci_val(CTX, &c_info, info);
 
-       ret = libxl_device_pci_assignable_remove(CTX, &c_info, (int) Bool_val(rebind));
+       caml_enter_blocking_section();
+       ret = libxl_device_pci_assignable_remove(CTX, &c_info, c_rebind);
+       caml_leave_blocking_section();
 
        libxl_device_pci_dispose(&c_info);
 
@@ -750,7 +828,10 @@ value stub_xl_device_pci_assignable_list(value ctx)
        int i, nb;
        uint32_t c_domid;
 
+       caml_enter_blocking_section();
        c_list = libxl_device_pci_assignable_list(CTX, &nb);
+       caml_leave_blocking_section();
+
        if (!c_list)
                failwith_xl(ERROR_FAIL, "pci_assignable_list");
 
@@ -775,7 +856,9 @@ value stub_xl_physinfo_get(value ctx)
        libxl_physinfo c_physinfo;
        int ret;
 
+       caml_enter_blocking_section();
        ret = libxl_get_physinfo(CTX, &c_physinfo);
+       caml_leave_blocking_section();
 
        if (ret != 0)
                failwith_xl(ret, "get_physinfo");
@@ -794,7 +877,9 @@ value stub_xl_cputopology_get(value ctx)
        libxl_cputopology *c_topology;
        int i, nr;
 
+       caml_enter_blocking_section();
        c_topology = libxl_get_cpu_topology(CTX, &nr);
+       caml_leave_blocking_section();
 
        if (!c_topology)
                failwith_xl(ERROR_FAIL, "get_cpu_topologyinfo");
@@ -822,7 +907,10 @@ value stub_xl_dominfo_list(value ctx)
        libxl_dominfo *c_domlist;
        int i, nb;
 
+       caml_enter_blocking_section();
        c_domlist = libxl_list_domain(CTX, &nb);
+       caml_leave_blocking_section();
+
        if (!c_domlist)
                failwith_xl(ERROR_FAIL, "dominfo_list");
 
@@ -847,8 +935,12 @@ value stub_xl_dominfo_get(value ctx, value domid)
        CAMLlocal1(dominfo);
        libxl_dominfo c_dominfo;
        int ret;
+       uint32_t c_domid = Int_val(domid);
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_info(CTX, &c_dominfo, c_domid);
+       caml_leave_blocking_section();
 
-       ret = libxl_domain_info(CTX, &c_dominfo, Int_val(domid));
        if (ret != 0)
                failwith_xl(ERROR_FAIL, "domain_info");
        dominfo = Val_dominfo(&c_dominfo);
@@ -862,8 +954,12 @@ value stub_xl_domain_sched_params_get(value ctx, value domid)
        CAMLlocal1(scinfo);
        libxl_domain_sched_params c_scinfo;
        int ret;
+       uint32_t c_domid = Int_val(domid);
+
+       caml_enter_blocking_section();
+       ret = libxl_domain_sched_params_get(CTX, c_domid, &c_scinfo);
+       caml_leave_blocking_section();
 
-       ret = libxl_domain_sched_params_get(CTX, Int_val(domid), &c_scinfo);
        if (ret != 0)
                failwith_xl(ret, "domain_sched_params_get");
 
@@ -879,10 +975,13 @@ value stub_xl_domain_sched_params_set(value ctx, value domid, value scinfo)
        CAMLparam3(ctx, domid, scinfo);
        libxl_domain_sched_params c_scinfo;
        int ret;
+       uint32_t c_domid = Int_val(domid);
 
        domain_sched_params_val(CTX, &c_scinfo, scinfo);
 
-       ret = libxl_domain_sched_params_set(CTX, Int_val(domid), &c_scinfo);
+       caml_enter_blocking_section();
+       ret = libxl_domain_sched_params_set(CTX, c_domid, &c_scinfo);
+       caml_leave_blocking_section();
 
        libxl_domain_sched_params_dispose(&c_scinfo);
 
@@ -896,12 +995,15 @@ value stub_xl_send_trigger(value ctx, value domid, value trigger, value vcpuid)
 {
        CAMLparam4(ctx, domid, trigger, vcpuid);
        int ret;
+       uint32_t c_domid = Int_val(domid);
        libxl_trigger c_trigger = LIBXL_TRIGGER_UNKNOWN;
+       int c_vcpuid = Int_val(vcpuid);
 
        trigger_val(CTX, &c_trigger, trigger);
 
-       ret = libxl_send_trigger(CTX, Int_val(domid),
-                                c_trigger, Int_val(vcpuid));
+       caml_enter_blocking_section();
+       ret = libxl_send_trigger(CTX, c_domid, c_trigger, c_vcpuid);
+       caml_leave_blocking_section();
 
        if (ret != 0)
                failwith_xl(ret, "send_trigger");
@@ -913,8 +1015,12 @@ value stub_xl_send_sysrq(value ctx, value domid, value sysrq)
 {
        CAMLparam3(ctx, domid, sysrq);
        int ret;
+       uint32_t c_domid = Int_val(domid);
+       int c_sysrq = Int_val(sysrq);
 
-       ret = libxl_send_sysrq(CTX, Int_val(domid), Int_val(sysrq));
+       caml_enter_blocking_section();
+       ret = libxl_send_sysrq(CTX, c_domid, c_sysrq);
+       caml_leave_blocking_section();
 
        if (ret != 0)
                failwith_xl(ret, "send_sysrq");
@@ -930,7 +1036,10 @@ value stub_xl_send_debug_keys(value ctx, value keys)
 
        c_keys = dup_String_val(keys);
 
+       caml_enter_blocking_section();
        ret = libxl_send_debug_keys(CTX, c_keys);
+       caml_leave_blocking_section();
+
        free(c_keys);
 
        if (ret != 0)
@@ -954,9 +1063,12 @@ value stub_libxl_xen_console_read_start(value ctx, value clear)
 {
        CAMLparam2(ctx, clear);
        CAMLlocal1(handle);
+       int c_clear = Int_val(clear);
        libxl_xen_console_reader *cr;
 
-       cr = libxl_xen_console_read_start(CTX, Int_val(clear));
+       caml_enter_blocking_section();
+       cr = libxl_xen_console_read_start(CTX, c_clear);
+       caml_leave_blocking_section();
 
        handle = caml_alloc_custom(&libxl_console_reader_custom_operations, sizeof(cr), 0, 1);
        Console_reader_val(handle) = cr;
@@ -986,7 +1098,9 @@ value stub_libxl_xen_console_read_line(value ctx, value reader)
        char *c_line;
        libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
 
+       caml_enter_blocking_section();
        ret = libxl_xen_console_read_line(CTX, cr, &c_line);
+       caml_leave_blocking_section();
 
        if (ret < 0)
                failwith_xl(ret, "xen_console_read_line");
@@ -1003,7 +1117,9 @@ value stub_libxl_xen_console_read_finish(value ctx, value reader)
        CAMLparam2(ctx, reader);
        libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
 
+       caml_enter_blocking_section();
        libxl_xen_console_read_finish(CTX, cr);
+       caml_leave_blocking_section();
 
        CAMLreturn(Val_unit);
 }
@@ -1095,6 +1211,7 @@ value Val_poll_events(short events)
 int fd_register(void *user, int fd, void **for_app_registration_out,
                      short events, void *for_libxl)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        CAMLlocalN(args, 4);
        static value *func = NULL;
@@ -1111,12 +1228,15 @@ int fd_register(void *user, int fd, void **for_app_registration_out,
        args[3] = (value) for_libxl;
 
        caml_callbackN(*func, 4, args);
-       CAMLreturn(0);
+       CAMLdone;
+       caml_enter_blocking_section();
+       return 0;
 }
 
 int fd_modify(void *user, int fd, void **for_app_registration_update,
                    short events)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        CAMLlocalN(args, 3);
        static value *func = NULL;
@@ -1132,11 +1252,14 @@ int fd_modify(void *user, int fd, void **for_app_registration_update,
        args[2] = Val_poll_events(events);
 
        caml_callbackN(*func, 3, args);
-       CAMLreturn(0);
+       CAMLdone;
+       caml_enter_blocking_section();
+       return 0;
 }
 
 void fd_deregister(void *user, int fd, void *for_app_registration)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        CAMLlocalN(args, 2);
        static value *func = NULL;
@@ -1151,12 +1274,14 @@ void fd_deregister(void *user, int fd, void *for_app_registration)
        args[1] = Val_int(fd);
 
        caml_callbackN(*func, 2, args);
-       CAMLreturn0;
+       CAMLdone;
+       caml_enter_blocking_section();
 }
 
 int timeout_register(void *user, void **for_app_registration_out,
                           struct timeval abs, void *for_libxl)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        CAMLlocalN(args, 4);
        static value *func = NULL;
@@ -1173,12 +1298,15 @@ int timeout_register(void *user, void **for_app_registration_out,
        args[3] = (value) for_libxl;
 
        caml_callbackN(*func, 4, args);
-       CAMLreturn(0);
+       CAMLdone;
+       caml_enter_blocking_section();
+       return 0;
 }
 
 int timeout_modify(void *user, void **for_app_registration_update,
                          struct timeval abs)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        static value *func = NULL;
        value *p = (value *) user;
@@ -1189,13 +1317,16 @@ int timeout_modify(void *user, void **for_app_registration_update,
        }
 
        caml_callback(*func, *p);
-       CAMLreturn(0);
+       CAMLdone;
+       caml_enter_blocking_section();
+       return 0;
 }
 
 void timeout_deregister(void *user, void *for_app_registration)
 {
+       caml_leave_blocking_section();
        failwith_xl(ERROR_FAIL, "timeout_deregister not yet implemented");
-       return;
+       caml_enter_blocking_section();
 }
 
 value stub_libxl_osevent_register_hooks(value ctx, value user)
@@ -1221,7 +1352,9 @@ value stub_libxl_osevent_register_hooks(value ctx, value user)
        *p = user;
        caml_register_global_root(p);
 
+       caml_enter_blocking_section();
        libxl_osevent_register_hooks(CTX, hooks, (void *) p);
+       caml_leave_blocking_section();
 
        result = caml_alloc(1, Abstract_tag);
        *((libxl_osevent_hooks **) result) = hooks;
@@ -1233,15 +1366,25 @@ value stub_libxl_osevent_occurred_fd(value ctx, value for_libxl, value fd,
        value events, value revents)
 {
        CAMLparam5(ctx, for_libxl, fd, events, revents);
-       libxl_osevent_occurred_fd(CTX, (void *) for_libxl, Int_val(fd),
-               Poll_events_val(events), Poll_events_val(revents));
+       int c_fd = Int_val(fd);
+       short c_events = Poll_events_val(events);
+       short c_revents = Poll_events_val(revents);
+
+       caml_enter_blocking_section();
+       libxl_osevent_occurred_fd(CTX, (void *) for_libxl, c_fd, c_events, c_revents);
+       caml_leave_blocking_section();
+
        CAMLreturn(Val_unit);
 }
 
 value stub_libxl_osevent_occurred_timeout(value ctx, value for_libxl)
 {
        CAMLparam2(ctx, for_libxl);
+
+       caml_enter_blocking_section();
        libxl_osevent_occurred_timeout(CTX, (void *) for_libxl);
+       caml_leave_blocking_section();
+
        CAMLreturn(Val_unit);
 }
 
@@ -1252,6 +1395,7 @@ struct user_with_ctx {
 
 void event_occurs(void *user, libxl_event *event)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        CAMLlocalN(args, 2);
        struct user_with_ctx *c_user = (struct user_with_ctx *) user;
@@ -1267,12 +1411,14 @@ void event_occurs(void *user, libxl_event *event)
        libxl_event_free(c_user->ctx, event);
 
        caml_callbackN(*func, 2, args);
-       CAMLreturn0;
+       CAMLdone;
+       caml_enter_blocking_section();
 }
 
 void disaster(void *user, libxl_event_type type,
                      const char *msg, int errnoval)
 {
+       caml_leave_blocking_section();
        CAMLparam0();
        CAMLlocalN(args, 4);
        struct user_with_ctx *c_user = (struct user_with_ctx *) user;
@@ -1289,7 +1435,8 @@ void disaster(void *user, libxl_event_type type,
        args[3] = Val_int(errnoval);
 
        caml_callbackN(*func, 4, args);
-       CAMLreturn0;
+       CAMLdone;
+       caml_enter_blocking_section();
 }
 
 value stub_libxl_event_register_callbacks(value ctx, value user)
@@ -1313,7 +1460,10 @@ value stub_libxl_event_register_callbacks(value ctx, value user)
        hooks->event_occurs = event_occurs;
        hooks->disaster = disaster;
 
+       caml_enter_blocking_section();
        libxl_event_register_callbacks(CTX, hooks, (void *) c_user);
+       caml_leave_blocking_section();
+
        result = caml_alloc(1, Abstract_tag);
        *((libxl_event_hooks **) result) = hooks;
 
@@ -1323,9 +1473,13 @@ value stub_libxl_event_register_callbacks(value ctx, value user)
 value stub_libxl_evenable_domain_death(value ctx, value domid, value user)
 {
        CAMLparam3(ctx, domid, user);
+       uint32_t c_domid = Int_val(domid);
+       int c_user = Int_val(user);
        libxl_evgen_domain_death *evgen_out;
 
-       libxl_evenable_domain_death(CTX, Int_val(domid), Int_val(user), &evgen_out);
+       caml_enter_blocking_section();
+       libxl_evenable_domain_death(CTX, c_domid, c_user, &evgen_out);
+       caml_leave_blocking_section();
 
        CAMLreturn(Val_unit);
 }