[Xen-devel] [PATCH 09/28] libxl: ocaml: allocate a long lived libxl context.

[Rob Hoes <rob.hoes@xxxxxxxxxx>]

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@xxxxxxxxxx>
Signed-off-by: Rob Hoes <rob.hoes@xxxxxxxxxx>
---
 tools/ocaml/libs/xl/META.in          |    1 +
 tools/ocaml/libs/xl/Makefile         |    2 ++
 tools/ocaml/libs/xl/xenlight.ml.in   |    5 +++++
 tools/ocaml/libs/xl/xenlight.mli.in  |    5 +++++
 tools/ocaml/libs/xl/xenlight_stubs.c |   26 +++++++++++++++++++++++++-
 5 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/tools/ocaml/libs/xl/META.in b/tools/ocaml/libs/xl/META.in
index 9c4405a..06efae6 100644
--- a/tools/ocaml/libs/xl/META.in
+++ b/tools/ocaml/libs/xl/META.in
@@ -1,4 +1,5 @@
 version = "@VERSION@"
 description = "Xen Toolstack Library"
+requires = "xentoollog"
 archive(byte) = "xl.cma"
 archive(native) = "xl.cmxa"
diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile
index c9e5274..79f07a5 100644
--- a/tools/ocaml/libs/xl/Makefile
+++ b/tools/ocaml/libs/xl/Makefile
@@ -10,6 +10,8 @@ OBJS = xenlight
 INTF = xenlight.cmi
 LIBS = xenlight.cma xenlight.cmxa
 
+OCAMLINCLUDE += -I ../xentoollog
+
 LIBS_xenlight = $(LDLIBS_libxenlight)
 
 xenlight_OBJS = $(OBJS)
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in 
b/tools/ocaml/libs/xl/xenlight.ml.in
index dcc1a38..22c647f 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -20,6 +20,11 @@ type devid = int
 
 (* @@LIBXL_TYPES@@ *)
 
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
+
 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"
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in 
b/tools/ocaml/libs/xl/xenlight.mli.in
index 3fd0165..fef8df5 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -20,6 +20,11 @@ type devid = int
 
 (* @@LIBXL_TYPES@@ *)
 
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
+
 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"
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c 
b/tools/ocaml/libs/xl/xenlight_stubs.c
index 8046238..d495a6c 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -29,6 +29,8 @@
 #include <libxl.h>
 #include <libxl_utils.h>
 
+#define CTX ((libxl_ctx *)ctx)
+
 struct caml_logger {
        struct xentoollog_logger logger;
        int log_offset;
@@ -59,6 +61,8 @@ static void log_destroy(struct xentoollog_logger *logger)
        lg.logger.vmessage = log_vmessage; \
        lg.logger.destroy = log_destroy; \
        lg.logger.progress = NULL; \
+       lg.log_offset = 0; \
+       memset(&lg.log_buf,0,sizeof(lg.log_buf));       \
        caml_enter_blocking_section(); \
        ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger 
*) &lg); \
        if (ret != 0) \
@@ -77,7 +81,7 @@ static char * dup_String_val(caml_gc *gc, value s)
        c = calloc(len + 1, sizeof(char));
        if (!c)
                caml_raise_out_of_memory();
-       gc->ptrs[gc->offset++] = c;
+       if (gc) gc->ptrs[gc->offset++] = c;
        memcpy(c, String_val(s), len);
        return c;
 }
@@ -94,9 +98,29 @@ static void failwith_xl(char *fname, struct caml_logger *lg)
 {
        char *s;
        s = (lg) ? lg->log_buf : fname;
+       printf("Error: %s\n", fname);
        caml_raise_with_string(*caml_named_value("xl.error"), s);
 }
 
+CAMLprim value stub_libxl_ctx_alloc(value logger)
+{
+       CAMLparam1(logger);
+       libxl_ctx *ctx;
+       int ret;
+
+       ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger 
*) logger);
+       if (ret != 0) \
+               failwith_xl("cannot init context", NULL);
+       CAMLreturn((value)ctx);
+}
+
+CAMLprim value stub_libxl_ctx_free(value ctx)
+{
+       CAMLparam1(ctx);
+       libxl_ctx_free(CTX);
+       CAMLreturn(Val_unit);
+}
+
 static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
 {
        void *ptr;
-- 
1.7.10.4


_______________________________________________
Xen-devel mailing list
Xen-devel@xxxxxxxxxxxxx
http://lists.xen.org/xen-devel