libxl: ocaml: allocate a long lived libxl context.
authorRob Hoes <rob.hoes@citrix.com>
Wed, 6 Nov 2013 17:49:44 +0000 (17:49 +0000)
committerIan Campbell <ian.campbell@citrix.com>
Mon, 11 Nov 2013 15:38:26 +0000 (15:38 +0000)
Rather than allocating a new context for every libxl call begin to
switch to a model where a context is allocated by the caller and may
then be used for multiple calls down into the library.

Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
tools/ocaml/libs/xl/META.in
tools/ocaml/libs/xl/Makefile
tools/ocaml/libs/xl/xenlight.ml.in
tools/ocaml/libs/xl/xenlight.mli.in
tools/ocaml/libs/xl/xenlight_stubs.c

index fe2c60b8bd96b993a47e8118371eadc65522a4b9..3f0c5526cb2eb12dfa2b072303d1b4f09ba95d1d 100644 (file)
@@ -1,4 +1,5 @@
 version = "@VERSION@"
 description = "Xen Toolstack Library"
+requires = "xentoollog"
 archive(byte) = "xenlight.cma"
 archive(native) = "xenlight.cmxa"
index 4195bfc8e5b29717af684fa7aa2e616e39422d5a..0408cc259244aa8be68a97c9109cfad229339600 100644 (file)
@@ -5,11 +5,14 @@ include $(TOPLEVEL)/common.make
 # ignore unused generated functions
 CFLAGS += -Wno-unused
 CFLAGS += $(CFLAGS_libxenlight)
+CFLAGS += -I ../xentoollog
 
 OBJS = xenlight
 INTF = xenlight.cmi
 LIBS = xenlight.cma xenlight.cmxa
 
+OCAMLINCLUDE += -I ../xentoollog
+
 LIBS_xenlight = $(LDLIBS_libxenlight)
 
 xenlight_OBJS = $(OBJS)
index dcc1a38bb72203773d91a033ee41ae48b9f39674..3d663d8b23a3d5298dadb92643df3b6a4b2d2782 100644 (file)
@@ -20,6 +20,10 @@ type devid = int
 
 (* @@LIBXL_TYPES@@ *)
 
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+
 external send_trigger : domid -> trigger -> int -> unit = "stub_xl_send_trigger"
 external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
 external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys"
index 3fd0165796dbda626f98f9e2e277c01caf097697..96d859c8c00249e58872ca72ff70834d8b3c1ca6 100644 (file)
@@ -20,6 +20,10 @@ type devid = int
 
 (* @@LIBXL_TYPES@@ *)
 
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+
 external send_trigger : domid -> trigger -> int -> unit = "stub_xl_send_trigger"
 external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
 external send_debug_keys : domid -> string -> unit = "stub_xl_send_debug_keys"
index a7bf6ba9105e2fbb5a60429b0de449f376fb54e8..c26226f2e0b8e7f6dd67bba38cbb4bff554e8df7 100644 (file)
@@ -21,6 +21,7 @@
 #include <caml/signals.h>
 #include <caml/fail.h>
 #include <caml/callback.h>
+#include <caml/custom.h>
 
 #include <sys/mman.h>
 #include <stdint.h>
 #include <libxl.h>
 #include <libxl_utils.h>
 
+#include "caml_xentoollog.h"
+
+#define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x)))
+#define CTX ((libxl_ctx *) Ctx_val(ctx))
+
 struct caml_logger {
        struct xentoollog_logger logger;
        int log_offset;
@@ -97,6 +103,37 @@ static void failwith_xl(char *fname, struct caml_logger *lg)
        caml_raise_with_string(*caml_named_value("xl.error"), s);
 }
 
+void ctx_finalize(value ctx)
+{
+       libxl_ctx_free(CTX);
+}
+
+static struct custom_operations libxl_ctx_custom_operations = {
+       "libxl_ctx_custom_operations",
+       ctx_finalize /* custom_finalize_default */,
+       custom_compare_default,
+       custom_hash_default,
+       custom_serialize_default,
+       custom_deserialize_default
+};
+
+CAMLprim value stub_libxl_ctx_alloc(value logger)
+{
+       CAMLparam1(logger);
+       CAMLlocal1(handle);
+       libxl_ctx *ctx;
+       int ret;
+
+       ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (xentoollog_logger *) Xtl_val(logger));
+       if (ret != 0) \
+               failwith_xl("cannot init context", NULL);
+
+       handle = caml_alloc_custom(&libxl_ctx_custom_operations, sizeof(ctx), 0, 1);
+       Ctx_val(handle) = ctx;
+
+       CAMLreturn(handle);
+}
+
 static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
 {
        void *ptr;