Mailing List Archive

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID bdd9c3e423d7f505f93edf413a92ad7b47ed9e39
# Parent 2b433b1523e4295bb1ed74a7b71e2a20e00f1802
libxl: ocaml: allocate a long lived libxl context.

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.

As a starting point convert list_domains and send_debug_keys and
implement simple tests which use them. These are just PoC of the
infrastructure, I don't intend to add one for every function...

Signed-off-by: Ian Campbell <ian.campbell@citrix.com>

diff -r 2b433b1523e4 -r bdd9c3e423d7 .gitignore
--- a/.gitignore Tue Nov 20 17:22:21 2012 +0000
+++ b/.gitignore Tue Nov 20 17:22:21 2012 +0000
@@ -365,7 +365,8 @@ tools/ocaml/libs/xl/xenlight.ml
tools/ocaml/libs/xl/xenlight.mli
tools/ocaml/xenstored/oxenstored
tools/ocaml/test/xtl
-
+tools/ocaml/test/send_debug_keys
+tools/ocaml/test/list_domains
tools/debugger/kdd/kdd
tools/firmware/etherboot/ipxe.tar.gz
tools/firmware/etherboot/ipxe/
diff -r 2b433b1523e4 -r bdd9c3e423d7 .hgignore
--- a/.hgignore Tue Nov 20 17:22:21 2012 +0000
+++ b/.hgignore Tue Nov 20 17:22:21 2012 +0000
@@ -306,6 +306,8 @@
^tools/ocaml/libs/xl/xenlight\.mli$
^tools/ocaml/xenstored/oxenstored$
^tools/ocaml/test/xtl$
+^tools/ocaml/test/send_debug_keys$
+^tools/ocaml/test/list_domains$
^tools/autom4te\.cache$
^tools/config\.h$
^tools/config\.log$
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/Makefile
--- a/tools/ocaml/libs/xl/Makefile Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/Makefile Tue Nov 20 17:22:21 2012 +0000
@@ -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 -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/xenlight.ml.in
--- a/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 +0000
@@ -13,6 +13,8 @@
* GNU Lesser General Public License for more details.
*)

+open Xentoollog
+
exception Error of string

type domid = int
@@ -24,8 +26,15 @@ end

(* @@LIBXL_TYPES@@ *)

+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
+
+external list_domain: ctx -> Dominfo.t list = "stub_libxl_list_domain"
+
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"
+external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"

let _ = Callback.register_exception "xl.error" (Error "register_callback")
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/xenlight.mli.in
--- a/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 +0000
@@ -13,6 +13,8 @@
* GNU Lesser General Public License for more details.
*)

+open Xentoollog
+
exception Error of string

type domid = int
@@ -20,6 +22,13 @@ 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 list_domain: ctx -> Dominfo.t list = "stub_libxl_list_domain"
+
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"
+external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/xenlight_stubs.c
--- a/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 +0000
@@ -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 xentoollo
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
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,35 @@ static void failwith_xl(char *fname, str
{
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;
+
+ caml_enter_blocking_section();
+ ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *) logger);
+ if (ret != 0) \
+ failwith_xl("cannot init context", NULL);
+ caml_leave_blocking_section();
+ CAMLreturn((value)ctx);
+}
+
+CAMLprim value stub_libxl_ctx_free(value ctx)
+{
+ CAMLparam1(ctx);
+
+ caml_enter_blocking_section();
+ libxl_ctx_free(CTX);
+ caml_leave_blocking_section();
+
+ CAMLreturn(Val_unit);
+}
+
static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
{
void *ptr;
@@ -311,6 +341,39 @@ static value Val_hwcap(libxl_hwcap *c_va

#include "_libxl_types.inc"

+value stub_libxl_list_domain(value ctx)
+{
+ CAMLparam1(ctx);
+ CAMLlocal2( cli, cons );
+ struct caml_gc gc;
+ libxl_dominfo *info;
+ int i, nr;
+
+ gc.offset = 0;
+ info = libxl_list_domain(CTX, &nr);
+ if (info == NULL)
+ failwith_xl("list_domain", NULL);
+
+ cli = Val_emptylist;
+
+ for (i = nr - 1; i >= 0; i--) {
+ cons = caml_alloc(2, 0);
+
+ /* Head */
+ Store_field(cons, 0, Val_dominfo(&gc, NULL, &info[i]));
+ /* Tail */
+ Store_field(cons, 1, cli);
+
+ cli = cons;
+ }
+
+ libxl_dominfo_list_free(info, nr);
+
+ gc_free(&gc);
+
+ CAMLreturn(cli);
+}
+
value stub_xl_device_disk_add(value info, value domid)
{
CAMLparam2(info, domid);
@@ -637,20 +700,20 @@ value stub_xl_send_sysrq(value domid, va
CAMLreturn(Val_unit);
}

-value stub_xl_send_debug_keys(value keys)
+value stub_xl_send_debug_keys(value ctx, value keys)
{
- CAMLparam1(keys);
+ CAMLparam2(ctx, keys);
int ret;
char *c_keys;
- INIT_STRUCT();

- c_keys = dup_String_val(&gc, keys);
+ c_keys = dup_String_val(NULL, keys);

- INIT_CTX();
- ret = libxl_send_debug_keys(ctx, c_keys);
+ ret = libxl_send_debug_keys(CTX, c_keys);
if (ret != 0)
- failwith_xl("send_debug_keys", &lg);
- FREE_CTX();
+ failwith_xl("send_debug_keys", NULL);
+
+ free(c_keys);
+
CAMLreturn(Val_unit);
}

diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/test/Makefile
--- a/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000
@@ -3,18 +3,31 @@ OCAML_TOPLEVEL = $(CURDIR)/..
include $(OCAML_TOPLEVEL)/common.make

OCAMLINCLUDE += \
- -I $(OCAML_TOPLEVEL)/libs/xentoollog
+ -I $(OCAML_TOPLEVEL)/libs/xentoollog \
+ -I $(OCAML_TOPLEVEL)/libs/xl

-OBJS = xtl
+OBJS = xtl send_debug_keys list_domains

-PROGRAMS = xtl
+PROGRAMS = xtl send_debug_keys list_domains

xtl_LIBS = \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa

xtl_OBJS = xtl

-OCAML_PROGRAM = xtl
+send_debug_keys_LIBS = \
+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+send_debug_keys_OBJS = send_debug_keys
+
+list_domains_LIBS = \
+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+list_domains_OBJS = list_domains
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains

all: $(PROGRAMS)

diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/test/list_domains.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/list_domains.ml Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,26 @@
+open Arg
+open Printf
+open Xentoollog
+open Xenlight
+
+let bool_as_char b c = if b then c else '-'
+
+let print_dominfo dominfo =
+ let id = dominfo.Xenlight.Dominfo.domid
+ and running = bool_as_char dominfo.Xenlight.Dominfo.running 'r'
+ and blocked = bool_as_char dominfo.Xenlight.Dominfo.blocked 'b'
+ and paused = bool_as_char dominfo.Xenlight.Dominfo.paused 'p'
+ and shutdown = bool_as_char dominfo.Xenlight.Dominfo.shutdown 's'
+ and dying = bool_as_char dominfo.Xenlight.Dominfo.dying 'd'
+ and memory = dominfo.Xenlight.Dominfo.current_memkb
+ in
+ printf "Dom %d: %c%c%c%c%c %LdKB\n" id running blocked paused shutdown dying memory
+
+let _ =
+ let logger = Xentoollog.create_stdio_logger (*~level:Xentoollog.Debug*) () in
+ let ctx = Xenlight.ctx_alloc logger in
+ let domains = Xenlight.list_domain ctx in
+ List.iter (fun d -> print_dominfo d) domains;
+ Xenlight.ctx_free ctx;
+ Xentoollog.destroy logger;
+
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/test/send_debug_keys.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/send_debug_keys.ml Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,17 @@
+open Arg
+open Printf
+open Xentoollog
+open Xenlight
+
+let send_keys ctx s =
+ printf "Sending debug key %s\n" s;
+ Xenlight.send_debug_keys ctx s;
+ ()
+
+let _ =
+ let logger = Xentoollog.create_stdio_logger () in
+ let ctx = Xenlight.ctx_alloc logger in
+ Arg.parse [
+ ] (fun s -> send_keys ctx s) "usage: send_debug_keys <keys>";
+ Xenlight.ctx_free ctx;
+ Xentoollog.destroy logger

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