[PATCH 10/28] libxl: ocaml: switch all functions over to take a context.

[Rob Hoes <rob.hoes@citrix.com>]

Since the context has a logger we can get rid of the logger built into these
bindings and use the xentoollog bindings instead.

The gc is of limited use when most things are freed with libxl_FOO_dispose,
so get rid of that too.

Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
 tools/ocaml/libs/xl/genwrap.py       |   44 ++--
 tools/ocaml/libs/xl/xenlight.ml.in   |    8 +-
 tools/ocaml/libs/xl/xenlight.mli.in  |    6 +-
 tools/ocaml/libs/xl/xenlight_stubs.c |  467 +++++++++-------------------------
 4 files changed, 145 insertions(+), 380 deletions(-)

diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index aaa16a8..b087817 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -8,23 +8,23 @@ import idl
 builtins = {
     "bool":                 ("bool",                   "%(c)s = Bool_val(%(o)s)",           "Val_bool(%(c)s)" ),
     "int":                  ("int",                    "%(c)s = Int_val(%(o)s)",            "Val_int(%(c)s)"  ),
-    "char *":               ("string",                 "%(c)s = dup_String_val(gc, %(o)s)", "caml_copy_string(%(c)s)"),
+    "char *":               ("string",                 "%(c)s = dup_String_val(%(o)s)", "caml_copy_string(%(c)s)"),
     "libxl_domid":          ("domid",                  "%(c)s = Int_val(%(o)s)",            "Val_int(%(c)s)"  ),
     "libxl_devid":          ("devid",                  "%(c)s = Int_val(%(o)s)",            "Val_int(%(c)s)"  ),
     "libxl_defbool":        ("bool option",            "%(c)s = Defbool_val(%(o)s)",        "Val_defbool(%(c)s)" ),
-    "libxl_uuid":           ("int array",              "Uuid_val(gc, lg, &%(c)s, %(o)s)",   "Val_uuid(&%(c)s)"),
-    "libxl_bitmap":         ("bool array",             "Bitmap_val(gc, lg, &%(c)s, %(o)s)",   "Val_bitmap(&%(c)s)"),    
-    "libxl_key_value_list": ("(string * string) list", "libxl_key_value_list_val(gc, lg, &%(c)s, %(o)s)",                              None),
-    "libxl_string_list":    ("string list",            "libxl_string_list_val(gc, lg, &%(c)s, %(o)s)",                                 "String_list_val(gc, lg, &%(c)s, %(o)s)"),
-    "libxl_mac":            ("int array",              "Mac_val(gc, lg, &%(c)s, %(o)s)",    "Val_mac(&%(c)s)"),
+    "libxl_uuid":           ("int array",              "Uuid_val(&%(c)s, %(o)s)",   "Val_uuid(&%(c)s)"),
+    "libxl_bitmap":         ("bool array",             "Bitmap_val(ctx, &%(c)s, %(o)s)",   "Val_bitmap(&%(c)s)"),    
+    "libxl_key_value_list": ("(string * string) list", "libxl_key_value_list_val(&%(c)s, %(o)s)",                              None),
+    "libxl_string_list":    ("string list",            "libxl_string_list_val(&%(c)s, %(o)s)",                                 "String_list_val(&%(c)s, %(o)s)"),
+    "libxl_mac":            ("int array",              "Mac_val(&%(c)s, %(o)s)",    "Val_mac(&%(c)s)"),
     "libxl_hwcap":          ("int32 array",            None,                                "Val_hwcap(&%(c)s)"),
     # The following needs to be sorted out later
     "libxl_cpuid_policy_list": ("unit",                "%(c)s = 0",                         "Val_unit"),
     }
 
-DEVICE_FUNCTIONS = [ ("add",            ["t", "domid", "unit"]),
-                     ("remove",         ["t", "domid", "unit"]),
-                     ("destroy",        ["t", "domid", "unit"]),
+DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid", "unit"]),
+                     ("remove",         ["ctx", "t", "domid", "unit"]),
+                     ("destroy",        ["ctx", "t", "domid", "unit"]),
                    ]
 
 functions = { # ( name , [type1,type2,....] )
@@ -33,13 +33,13 @@ functions = { # ( name , [type1,type2,....] )
     "device_disk":    DEVICE_FUNCTIONS,
     "device_nic":     DEVICE_FUNCTIONS,
     "device_pci":     DEVICE_FUNCTIONS,
-    "physinfo":       [ ("get",            ["unit", "t"]),
+    "physinfo":       [ ("get",            ["ctx", "t"]),
                       ],
-    "cputopology":    [ ("get",            ["unit", "t array"]),
+    "cputopology":    [ ("get",            ["ctx", "t array"]),
                       ],
     "domain_sched_params":
-                      [ ("get",            ["domid", "t"]),
-                        ("set",            ["domid", "t", "unit"]),
+                      [ ("get",            ["ctx", "domid", "t"]),
+                        ("set",            ["ctx", "domid", "t", "unit"]),
                       ],
 }
 def stub_fn_name(ty, name):
@@ -229,7 +229,7 @@ def c_val(ty, c, o, indent="", parent = None):
         for e in ty.values:
             s += "    case %d: *%s = %s; break;\n" % (n, c, e.name)
             n += 1
-        s += "    default: failwith_xl(\"cannot convert value to %s\", lg); break;\n" % ty.typename
+        s += "    default: failwith_xl(\"cannot convert value to %s\"); break;\n" % ty.typename
         s += "}"
     elif isinstance(ty, idl.KeyedUnion):
         s += "{\n"
@@ -242,7 +242,7 @@ def c_val(ty, c, o, indent="", parent = None):
                                                     parent + ty.keyvar.name,
                                                     f.enumname)
                 n += 1
-        s += "\t\t    default: failwith_xl(\"variant handling bug %s%s (long)\", lg); break;\n" % (parent, ty.keyvar.name)        
+        s += "\t\t    default: failwith_xl(\"variant handling bug %s%s (long)\"); break;\n" % (parent, ty.keyvar.name)        
         s += "\t\t}\n"
         s += "\t} else {\n"
         s += "\t\t/* Is block... */\n"
@@ -258,7 +258,7 @@ def c_val(ty, c, o, indent="", parent = None):
                 s += "%s" % c_val(f.type, fexpr, "Field(%s, 0)" % o, indent=indent+"\t\t        ")
                 s += "break;\n"
                 n += 1
-        s += "\t\t    default: failwith_xl(\"variant handling bug %s%s (block)\", lg); break;\n" % (parent, ty.keyvar.name)
+        s += "\t\t    default: failwith_xl(\"variant handling bug %s%s (block)\"); break;\n" % (parent, ty.keyvar.name)
         s += "\t\t}\n"
         s += "\t}\n"
         s += "}"
@@ -271,14 +271,14 @@ def c_val(ty, c, o, indent="", parent = None):
             s += "%s\n" % c_val(f.type, fexpr, "Field(%s, %d)" % (o,n), parent=nparent)
             n = n + 1
     else:
-        s += "%s_val(gc, lg, %s, %s);" % (ty.rawname, ty.pass_arg(c, parent is None, passby=idl.PASS_BY_REFERENCE), o)
+        s += "%s_val(ctx, %s, %s);" % (ty.rawname, ty.pass_arg(c, parent is None, passby=idl.PASS_BY_REFERENCE), o)
     
     return s.replace("\n", "\n%s" % indent)
 
 def gen_c_val(ty, indent=""):
     s = "/* Convert caml value to %s */\n" % ty.rawname
     
-    s += "static int %s_val (caml_gc *gc, struct caml_logger *lg, %s, value v)\n" % (ty.rawname, ty.make_arg("c_val", passby=idl.PASS_BY_REFERENCE))
+    s += "static int %s_val (libxl_ctx *ctx, %s, value v)\n" % (ty.rawname, ty.make_arg("c_val", passby=idl.PASS_BY_REFERENCE))
     s += "{\n"
     s += "\tCAMLparam1(v);\n"
     s += "\n"
@@ -327,7 +327,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag = None):
         for e in ty.values:
             s += "    case %s: %s = Int_val(%d); break;\n" % (e.name, o, n)
             n += 1
-        s += "    default: failwith_xl(\"cannot convert value from %s\", lg); break;\n" % ty.typename
+        s += "    default: failwith_xl(\"cannot convert value from %s\"); break;\n" % ty.typename
         s += "}"
     elif isinstance(ty, idl.KeyedUnion):
         n = 0
@@ -351,7 +351,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag = None):
                 m += 1
                 #s += "\t        %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n)
             s += "\t        break;\n"
-        s += "\t    default: failwith_xl(\"cannot convert value from %s\", lg); break;\n" % ty.typename
+        s += "\t    default: failwith_xl(\"cannot convert value from %s\"); break;\n" % ty.typename
         s += "\t}"
     elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is None):
         s += "{\n"
@@ -379,14 +379,14 @@ def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag = None):
             n = n + 1
         s += "}"
     else:
-        s += "%s = Val_%s(gc, lg, %s);" % (o, ty.rawname, ty.pass_arg(c, parent is None))
+        s += "%s = Val_%s(%s);" % (o, ty.rawname, ty.pass_arg(c, parent is None))
     
     return s.replace("\n", "\n%s" % indent).rstrip(indent)
 
 def gen_Val_ocaml(ty, indent=""):
     s = "/* Convert %s to a caml value */\n" % ty.rawname
 
-    s += "static value Val_%s (caml_gc *gc, struct caml_logger *lg, %s)\n" % (ty.rawname, ty.make_arg(ty.rawname+"_c"))
+    s += "static value Val_%s (%s)\n" % (ty.rawname, ty.make_arg(ty.rawname+"_c"))
     s += "{\n"
     s += "\tCAMLparam0();\n"
     s += "\tCAMLlocal1(%s_ocaml);\n" % ty.rawname
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in
index 22c647f..319c593 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -25,8 +25,8 @@ 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"
+external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger"
+external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq"
+external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
 
-let _ = Callback.register_exception "xl.error" (Error "register_callback")
+let _ = Callback.register_exception "Xenlight.Error" (Error(""))
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in
index fef8df5..c797ceb 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -25,6 +25,6 @@ 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"
+external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger"
+external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq"
+external send_debug_keys : ctx -> 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 d495a6c..c65d22d 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -31,49 +31,7 @@
 
 #define CTX ((libxl_ctx *)ctx)
 
-struct caml_logger {
-	struct xentoollog_logger logger;
-	int log_offset;
-	char log_buf[2048];
-};
-
-typedef struct caml_gc {
-	int offset;
-	void *ptrs[64];
-} caml_gc;
-
-static void log_vmessage(struct xentoollog_logger *logger, xentoollog_level level,
-                  int errnoval, const char *context, const char *format, va_list al)
-{
-	struct caml_logger *ologger = (struct caml_logger *) logger;
-
-	ologger->log_offset += vsnprintf(ologger->log_buf + ologger->log_offset,
-	                                 2048 - ologger->log_offset, format, al);
-}
-
-static void log_destroy(struct xentoollog_logger *logger)
-{
-}
-
-#define INIT_STRUCT() libxl_ctx *ctx; struct caml_logger lg; struct caml_gc gc; gc.offset = 0;
-
-#define INIT_CTX()  \
-	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) \
-		failwith_xl("cannot init context", &lg);
-
-#define FREE_CTX()  \
-	gc_free(&gc); \
-	caml_leave_blocking_section(); \
-	libxl_ctx_free(ctx)
-
-static char * dup_String_val(caml_gc *gc, value s)
+static char * dup_String_val(value s)
 {
 	int len;
 	char *c;
@@ -81,25 +39,16 @@ static char * dup_String_val(caml_gc *gc, value s)
 	c = calloc(len + 1, sizeof(char));
 	if (!c)
 		caml_raise_out_of_memory();
-	if (gc) gc->ptrs[gc->offset++] = c;
 	memcpy(c, String_val(s), len);
 	return c;
 }
 
-static void gc_free(caml_gc *gc)
+static void failwith_xl(char *fname)
 {
-	int i;
-	for (i = 0; i < gc->offset; i++) {
-		free(gc->ptrs[i]);
-	}
-}
-
-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);
+	value *exc = caml_named_value("Xenlight.Error");
+	if (!exc)
+		caml_invalid_argument("Exception Xenlight.Error not initialized, please link xl.cma");
+	caml_raise_with_string(*exc, fname);
 }
 
 CAMLprim value stub_libxl_ctx_alloc(value logger)
@@ -110,7 +59,7 @@ CAMLprim value stub_libxl_ctx_alloc(value logger)
 
 	ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *) logger);
 	if (ret != 0) \
-		failwith_xl("cannot init context", NULL);
+		failwith_xl("cannot init context");
 	CAMLreturn((value)ctx);
 }
 
@@ -121,16 +70,6 @@ CAMLprim value stub_libxl_ctx_free(value ctx)
 	CAMLreturn(Val_unit);
 }
 
-static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
-{
-	void *ptr;
-	ptr = calloc(nmemb, size);
-	if (!ptr)
-		caml_raise_out_of_memory();
-	gc->ptrs[gc->offset++] = ptr;
-	return ptr;
-}
-
 static int list_len(value v)
 {
 	int len = 0;
@@ -141,8 +80,7 @@ static int list_len(value v)
 	return len;
 }
 
-static int libxl_key_value_list_val(caml_gc *gc, struct caml_logger *lg,
-				    libxl_key_value_list *c_val,
+static int libxl_key_value_list_val(libxl_key_value_list *c_val,
 				    value v)
 {
 	CAMLparam1(v);
@@ -152,24 +90,22 @@ static int libxl_key_value_list_val(caml_gc *gc, struct caml_logger *lg,
 
 	nr = list_len(v);
 
-	array = gc_calloc(gc, (nr + 1) * 2, sizeof(char *));
+	array = calloc((nr + 1) * 2, sizeof(char *));
 	if (!array)
 		caml_raise_out_of_memory();
 
 	for (i=0; v != Val_emptylist; i++, v = Field(v, 1) ) {
 		elem = Field(v, 0);
 
-		array[i * 2] = dup_String_val(gc, Field(elem, 0));
-		array[i * 2 + 1] = dup_String_val(gc, Field(elem, 1));
+		array[i * 2] = dup_String_val(Field(elem, 0));
+		array[i * 2 + 1] = dup_String_val(Field(elem, 1));
 	}
 
 	*c_val = array;
 	CAMLreturn(0);
 }
 
-static int libxl_string_list_val(caml_gc *gc, struct caml_logger *lg,
-				 libxl_string_list *c_val,
-				 value v)
+static int libxl_string_list_val(libxl_string_list *c_val, value v)
 {
 	CAMLparam1(v);
 	int nr, i;
@@ -177,12 +113,12 @@ static int libxl_string_list_val(caml_gc *gc, struct caml_logger *lg,
 
 	nr = list_len(v);
 
-	array = gc_calloc(gc, (nr + 1), sizeof(char *));
+	array = calloc(nr + 1, sizeof(char *));
 	if (!array)
 		caml_raise_out_of_memory();
 
 	for (i=0; v != Val_emptylist; i++, v = Field(v, 1) )
-		array[i] = dup_String_val(gc, Field(v, 0));
+		array[i] = dup_String_val(Field(v, 0));
 
 	*c_val = array;
 	CAMLreturn(0);
@@ -215,7 +151,7 @@ static value Val_mac (libxl_mac *c_val)
 	CAMLreturn(v);
 }
 
-static int Mac_val(caml_gc *gc, struct caml_logger *lg, libxl_mac *c_val, value v)
+static int Mac_val(libxl_mac *c_val, value v)
 {
 	CAMLparam1(v);
 	int i;
@@ -242,10 +178,21 @@ static value Val_bitmap (libxl_bitmap *c_val)
 	CAMLreturn(v);
 }
 
-static int Bitmap_val(caml_gc *gc, struct caml_logger *lg,
-		      libxl_bitmap *c_val, value v)
+static int Bitmap_val(libxl_ctx *ctx, libxl_bitmap *c_val, value v)
 {
-	abort(); /* XXX */
+	CAMLparam1(v);
+	int i, len = Wosize_val(v);
+
+	c_val->size = 0;
+	if (len > 0 && !libxl_bitmap_alloc(ctx, c_val, len))
+		failwith_xl("cannot allocate bitmap");
+	for (i=0; i<len; i++) {
+		if (Int_val(Field(v, i)))
+			libxl_bitmap_set(c_val, i);
+		else
+			libxl_bitmap_reset(c_val, i);
+	}
+	CAMLreturn(0);
 }
 
 static value Val_uuid (libxl_uuid *c_val)
@@ -263,7 +210,7 @@ static value Val_uuid (libxl_uuid *c_val)
 	CAMLreturn(v);
 }
 
-static int Uuid_val(caml_gc *gc, struct caml_logger *lg, libxl_uuid *c_val, value v)
+static int Uuid_val(libxl_uuid *c_val, value v)
 {
 	CAMLparam1(v);
 	int i;
@@ -317,254 +264,74 @@ static value Val_hwcap(libxl_hwcap *c_val)
 
 #include "_libxl_types.inc"
 
-value stub_xl_device_disk_add(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_disk c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_disk_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_disk_add(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("disk_add", &lg);
-	FREE_CTX();
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_disk_del(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_disk c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_disk_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_disk_remove(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("disk_del", &lg);
-	FREE_CTX();
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_nic_add(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_nic c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_nic_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_nic_add(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("nic_add", &lg);
-	FREE_CTX();
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_nic_del(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_nic c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_nic_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_nic_remove(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("nic_del", &lg);
-	FREE_CTX();
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vkb_add(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_vkb c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_vkb_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_vkb_add(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("vkb_add", &lg);
-	FREE_CTX();
-
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vkb_remove(value info, value domid)
-{
-	CAMLparam1(domid);
-	libxl_device_vkb c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_vkb_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_vkb_remove(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("vkb_clean_shutdown", &lg);
-	FREE_CTX();
-
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vkb_destroy(value info, value domid)
-{
-	CAMLparam1(domid);
-	libxl_device_vkb c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_vkb_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_vkb_destroy(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("vkb_hard_shutdown", &lg);
-	FREE_CTX();
-
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vfb_add(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_vfb c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_vfb_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_vfb_add(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("vfb_add", &lg);
-	FREE_CTX();
-
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vfb_remove(value info, value domid)
-{
-	CAMLparam1(domid);
-	libxl_device_vfb c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_vfb_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_vfb_remove(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("vfb_clean_shutdown", &lg);
-	FREE_CTX();
-
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vfb_destroy(value info, value domid)
+#define _STRINGIFY(x) #x
+#define STRINGIFY(x) _STRINGIFY(x)
+
+#define _DEVICE_ADDREMOVE(type,op)					\
+value stub_xl_device_##type##_##op(value ctx, value info, value domid)	\
+{									\
+	CAMLparam3(ctx, info, domid);					\
+	libxl_device_##type c_info;					\
+	int ret, marker_var;						\
+									\
+	device_##type##_val(CTX, &c_info, info);			\
+									\
+	ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, 0); \
+									\
+	libxl_device_##type##_dispose(&c_info);				\
+									\
+	if (ret != 0)							\
+		failwith_xl(STRINGIFY(type) "_" STRINGIFY(op));		\
+									\
+	CAMLreturn(Val_unit);						\
+}
+
+#define DEVICE_ADDREMOVE(type) \
+	_DEVICE_ADDREMOVE(type, add) \
+ 	_DEVICE_ADDREMOVE(type, remove) \
+ 	_DEVICE_ADDREMOVE(type, destroy)
+
+DEVICE_ADDREMOVE(disk)
+DEVICE_ADDREMOVE(nic)
+DEVICE_ADDREMOVE(vfb)
+DEVICE_ADDREMOVE(vkb)
+DEVICE_ADDREMOVE(pci)
+
+value stub_xl_physinfo_get(value ctx)
 {
-	CAMLparam1(domid);
-	libxl_device_vfb c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_vfb_val(&gc, &lg, &c_info, info);
-
-	INIT_CTX();
-	ret = libxl_device_vfb_destroy(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("vfb_hard_shutdown", &lg);
-	FREE_CTX();
-
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_pci_add(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_pci c_info;
+	CAMLparam1(ctx);
+	CAMLlocal1(physinfo);
+	libxl_physinfo c_physinfo;
 	int ret;
-	INIT_STRUCT();
 
-	device_pci_val(&gc, &lg, &c_info, info);
+	ret = libxl_get_physinfo(CTX, &c_physinfo);
 
-	INIT_CTX();
-	ret = libxl_device_pci_add(ctx, Int_val(domid), &c_info, 0);
 	if (ret != 0)
-		failwith_xl("pci_add", &lg);
-	FREE_CTX();
-
-	CAMLreturn(Val_unit);
-}
+		failwith_xl("get_physinfo");
 
-value stub_xl_device_pci_remove(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_pci c_info;
-	int ret;
-	INIT_STRUCT();
+	physinfo = Val_physinfo(&c_physinfo);
 
-	device_pci_val(&gc, &lg, &c_info, info);
+	libxl_physinfo_dispose(&c_physinfo);
 
-	INIT_CTX();
-	ret = libxl_device_pci_remove(ctx, Int_val(domid), &c_info, 0);
-	if (ret != 0)
-		failwith_xl("pci_remove", &lg);
-	FREE_CTX();
-
-	CAMLreturn(Val_unit);
-}
-
-value stub_xl_physinfo_get(value unit)
-{
-	CAMLparam1(unit);
-	CAMLlocal1(physinfo);
-	libxl_physinfo c_physinfo;
-	int ret;
-	INIT_STRUCT();
-
-	INIT_CTX();
-	ret = libxl_get_physinfo(ctx, &c_physinfo);
-	if (ret != 0)
-		failwith_xl("physinfo", &lg);
-	FREE_CTX();
-
-	physinfo = Val_physinfo(&gc, &lg, &c_physinfo);
 	CAMLreturn(physinfo);
 }
 
-value stub_xl_cputopology_get(value unit)
+value stub_xl_cputopology_get(value ctx)
 {
-	CAMLparam1(unit);
+	CAMLparam1(ctx);
 	CAMLlocal2(topology, v);
 	libxl_cputopology *c_topology;
-	int i, nr, ret;
-	INIT_STRUCT();
+	int i, nr;
 
-	INIT_CTX();
+	c_topology = libxl_get_cpu_topology(CTX, &nr);
 
-	c_topology = libxl_get_cpu_topology(ctx, &nr);
-	if (ret != 0)
-		failwith_xl("topologyinfo", &lg);
+	if (!c_topology)
+		failwith_xl("topologyinfo");
 
 	topology = caml_alloc_tuple(nr);
 	for (i = 0; i < nr; i++) {
 		if (c_topology[i].core != LIBXL_CPUTOPOLOGY_INVALID_ENTRY)
-			v = Val_some(Val_cputopology(&gc, &lg, &c_topology[i]));
+			v = Val_some(Val_cputopology(&c_topology[i]));
 		else
 			v = Val_none;
 		Store_field(topology, i, v);
@@ -572,91 +339,89 @@ value stub_xl_cputopology_get(value unit)
 
 	libxl_cputopology_list_free(c_topology, nr);
 
-	FREE_CTX();
 	CAMLreturn(topology);
 }
 
-value stub_xl_domain_sched_params_get(value domid)
+value stub_xl_domain_sched_params_get(value ctx, value domid)
 {
-	CAMLparam1(domid);
+	CAMLparam2(ctx, domid);
 	CAMLlocal1(scinfo);
 	libxl_domain_sched_params c_scinfo;
 	int ret;
-	INIT_STRUCT();
 
-	INIT_CTX();
-	ret = libxl_domain_sched_params_get(ctx, Int_val(domid), &c_scinfo);
+	ret = libxl_domain_sched_params_get(CTX, Int_val(domid), &c_scinfo);
 	if (ret != 0)
-		failwith_xl("domain_sched_params_get", &lg);
-	FREE_CTX();
+		failwith_xl("domain_sched_params_get");
+
+	scinfo = Val_domain_sched_params(&c_scinfo);
+
+	libxl_domain_sched_params_dispose(&c_scinfo);
 
-	scinfo = Val_domain_sched_params(&gc, &lg, &c_scinfo);
 	CAMLreturn(scinfo);
 }
 
-value stub_xl_domain_sched_params_set(value domid, value scinfo)
+value stub_xl_domain_sched_params_set(value ctx, value domid, value scinfo)
 {
-	CAMLparam2(domid, scinfo);
+	CAMLparam3(ctx, domid, scinfo);
 	libxl_domain_sched_params c_scinfo;
 	int ret;
-	INIT_STRUCT();
 
-	domain_sched_params_val(&gc, &lg, &c_scinfo, scinfo);
+	domain_sched_params_val(CTX, &c_scinfo, scinfo);
+
+	ret = libxl_domain_sched_params_set(CTX, Int_val(domid), &c_scinfo);
+
+	libxl_domain_sched_params_dispose(&c_scinfo);
 
-	INIT_CTX();
-	ret = libxl_domain_sched_params_set(ctx, Int_val(domid), &c_scinfo);
 	if (ret != 0)
-		failwith_xl("domain_sched_params_set", &lg);
-	FREE_CTX();
+		failwith_xl("domain_sched_params_set");
 
 	CAMLreturn(Val_unit);
 }
 
-value stub_xl_send_trigger(value domid, value trigger, value vcpuid)
+value stub_xl_send_trigger(value ctx, value domid, value trigger, value vcpuid)
 {
-	CAMLparam3(domid, trigger, vcpuid);
+	CAMLparam4(ctx, domid, trigger, vcpuid);
 	int ret;
 	libxl_trigger c_trigger = LIBXL_TRIGGER_UNKNOWN;
-	INIT_STRUCT();
 
-	trigger_val(&gc, &lg, &c_trigger, trigger);
+	trigger_val(CTX, &c_trigger, trigger);
+
+	ret = libxl_send_trigger(CTX, Int_val(domid),
+				 c_trigger, Int_val(vcpuid));
 
-	INIT_CTX();
-	ret = libxl_send_trigger(ctx, Int_val(domid), c_trigger, Int_val(vcpuid));
 	if (ret != 0)
-		failwith_xl("send_trigger", &lg);
-	FREE_CTX();
+		failwith_xl("send_trigger");
+
 	CAMLreturn(Val_unit);
 }
 
-value stub_xl_send_sysrq(value domid, value sysrq)
+value stub_xl_send_sysrq(value ctx, value domid, value sysrq)
 {
-	CAMLparam2(domid, sysrq);
+	CAMLparam3(ctx, domid, sysrq);
 	int ret;
-	INIT_STRUCT();
 
-	INIT_CTX();
-	ret = libxl_send_sysrq(ctx, Int_val(domid), Int_val(sysrq));
+	ret = libxl_send_sysrq(CTX, Int_val(domid), Int_val(sysrq));
+
 	if (ret != 0)
-		failwith_xl("send_sysrq", &lg);
-	FREE_CTX();
+		failwith_xl("send_sysrq");
+
 	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(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");
+
+	free(c_keys);
+
 	CAMLreturn(Val_unit);
 }
 
-- 
1.7.10.4