xen-devel.lists.xenproject.org archive mirror
 help / color / mirror / Atom feed
* [PATCH 01 of 15] libxl: move definition of libxl_domain_config into the IDL
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
@ 2012-11-20 17:23 ` Ian Campbell
  2012-12-19 14:34   ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 02 of 15] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Ian Campbell
                   ` (23 subsequent siblings)
  24 siblings, 1 reply; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432136 0
# Node ID 601dc257a740d3a6047667731007283a4dcb9600
# Parent  c893596e2d4c7ddd62a3704ea5460be4e5be38df
libxl: move definition of libxl_domain_config into the IDL

Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
---
Posted during 4.2 freeze and deferred until 4.3...

diff -r c893596e2d4c -r 601dc257a740 tools/libxl/libxl.h
--- a/tools/libxl/libxl.h	Tue Nov 20 17:22:10 2012 +0000
+++ b/tools/libxl/libxl.h	Tue Nov 20 17:22:16 2012 +0000
@@ -474,26 +474,6 @@ typedef struct {
 
 #define LIBXL_VERSION 0
 
-typedef struct {
-    libxl_domain_create_info c_info;
-    libxl_domain_build_info b_info;
-
-    int num_disks, num_nics, num_pcidevs, num_vfbs, num_vkbs, num_vtpms;
-
-    libxl_device_disk *disks;
-    libxl_device_nic *nics;
-    libxl_device_pci *pcidevs;
-    libxl_device_vfb *vfbs;
-    libxl_device_vkb *vkbs;
-    libxl_device_vtpm *vtpms;
-
-    libxl_action_on_shutdown on_poweroff;
-    libxl_action_on_shutdown on_reboot;
-    libxl_action_on_shutdown on_watchdog;
-    libxl_action_on_shutdown on_crash;
-} libxl_domain_config;
-char *libxl_domain_config_to_json(libxl_ctx *ctx, libxl_domain_config *p);
-
 /* context functions */
 int libxl_ctx_alloc(libxl_ctx **pctx, int version,
                     unsigned flags /* none currently defined */,
diff -r c893596e2d4c -r 601dc257a740 tools/libxl/libxl_create.c
--- a/tools/libxl/libxl_create.c	Tue Nov 20 17:22:10 2012 +0000
+++ b/tools/libxl/libxl_create.c	Tue Nov 20 17:22:16 2012 +0000
@@ -24,43 +24,6 @@
 #include <xenguest.h>
 #include <xen/hvm/hvm_info_table.h>
 
-void libxl_domain_config_init(libxl_domain_config *d_config)
-{
-    memset(d_config, 0, sizeof(*d_config));
-    libxl_domain_create_info_init(&d_config->c_info);
-    libxl_domain_build_info_init(&d_config->b_info);
-}
-
-void libxl_domain_config_dispose(libxl_domain_config *d_config)
-{
-    int i;
-
-    for (i=0; i<d_config->num_disks; i++)
-        libxl_device_disk_dispose(&d_config->disks[i]);
-    free(d_config->disks);
-
-    for (i=0; i<d_config->num_nics; i++)
-        libxl_device_nic_dispose(&d_config->nics[i]);
-    free(d_config->nics);
-
-    for (i=0; i<d_config->num_pcidevs; i++)
-        libxl_device_pci_dispose(&d_config->pcidevs[i]);
-    free(d_config->pcidevs);
-
-    for (i=0; i<d_config->num_vfbs; i++)
-        libxl_device_vfb_dispose(&d_config->vfbs[i]);
-    free(d_config->vfbs);
-
-    for (i=0; i<d_config->num_vkbs; i++)
-        libxl_device_vkb_dispose(&d_config->vkbs[i]);
-    free(d_config->vkbs);
-
-    libxl_device_vtpm_list_free(d_config->vtpms, d_config->num_vtpms);
-
-    libxl_domain_create_info_dispose(&d_config->c_info);
-    libxl_domain_build_info_dispose(&d_config->b_info);
-}
-
 int libxl__domain_create_info_setdefault(libxl__gc *gc,
                                          libxl_domain_create_info *c_info)
 {
diff -r c893596e2d4c -r 601dc257a740 tools/libxl/libxl_json.c
--- a/tools/libxl/libxl_json.c	Tue Nov 20 17:22:10 2012 +0000
+++ b/tools/libxl/libxl_json.c	Tue Nov 20 17:22:16 2012 +0000
@@ -786,158 +786,6 @@ out:
     return ret;
 }
 
-yajl_gen_status libxl_domain_config_gen_json(yajl_gen hand,
-                                             libxl_domain_config *p)
-{
-    yajl_gen_status s;
-    int i;
-
-    s = yajl_gen_map_open(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"c_info",
-                        sizeof("c_info")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = libxl_domain_create_info_gen_json(hand, &p->c_info);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"b_info",
-                        sizeof("b_info")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = libxl_domain_build_info_gen_json(hand, &p->b_info);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"disks",
-                        sizeof("disks")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = yajl_gen_array_open(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    for (i = 0; i < p->num_disks; i++) {
-        s = libxl_device_disk_gen_json(hand, &p->disks[i]);
-        if (s != yajl_gen_status_ok)
-            goto out;
-    }
-    s = yajl_gen_array_close(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"nics",
-                        sizeof("nics")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = yajl_gen_array_open(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    for (i = 0; i < p->num_nics; i++) {
-        s = libxl_device_nic_gen_json(hand, &p->nics[i]);
-        if (s != yajl_gen_status_ok)
-            goto out;
-    }
-    s = yajl_gen_array_close(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"pcidevs",
-                        sizeof("pcidevs")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = yajl_gen_array_open(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    for (i = 0; i < p->num_pcidevs; i++) {
-        s = libxl_device_pci_gen_json(hand, &p->pcidevs[i]);
-        if (s != yajl_gen_status_ok)
-            goto out;
-    }
-    s = yajl_gen_array_close(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"vfbs",
-                        sizeof("vfbs")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = yajl_gen_array_open(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    for (i = 0; i < p->num_vfbs; i++) {
-        s = libxl_device_vfb_gen_json(hand, &p->vfbs[i]);
-        if (s != yajl_gen_status_ok)
-            goto out;
-    }
-    s = yajl_gen_array_close(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"vkbs",
-                        sizeof("vkbs")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = yajl_gen_array_open(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    for (i = 0; i < p->num_vkbs; i++) {
-        s = libxl_device_vkb_gen_json(hand, &p->vkbs[i]);
-        if (s != yajl_gen_status_ok)
-            goto out;
-    }
-    s = yajl_gen_array_close(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"on_poweroff",
-                        sizeof("on_poweroff")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = libxl_action_on_shutdown_gen_json(hand, &p->on_poweroff);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"on_reboot",
-                        sizeof("on_reboot")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = libxl_action_on_shutdown_gen_json(hand, &p->on_reboot);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"on_watchdog",
-                        sizeof("on_watchdog")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = libxl_action_on_shutdown_gen_json(hand, &p->on_watchdog);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_string(hand, (const unsigned char *)"on_crash",
-                        sizeof("on_crash")-1);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    s = libxl_action_on_shutdown_gen_json(hand, &p->on_crash);
-    if (s != yajl_gen_status_ok)
-        goto out;
-
-    s = yajl_gen_map_close(hand);
-    if (s != yajl_gen_status_ok)
-        goto out;
-    out:
-    return s;
-}
-
-char *libxl_domain_config_to_json(libxl_ctx *ctx, libxl_domain_config *p)
-{
-    return libxl__object_to_json(ctx, "libxl_domain_config",
-                        (libxl__gen_json_callback)&libxl_domain_config_gen_json,
-                        (void *)p);
-}
-
 /*
  * Local variables:
  * mode: C
diff -r c893596e2d4c -r 601dc257a740 tools/libxl/libxl_types.idl
--- a/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:10 2012 +0000
+++ b/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:16 2012 +0000
@@ -401,6 +401,23 @@ libxl_device_vtpm = Struct("device_vtpm"
     ("uuid",             libxl_uuid),
 ])
 
+libxl_domain_config = Struct("domain_config", [
+    ("c_info", libxl_domain_create_info),
+    ("b_info", libxl_domain_build_info),
+
+    ("disks", Array(libxl_device_disk, "num_disks")),
+    ("nics", Array(libxl_device_nic, "num_nics")),
+    ("pcidevs", Array(libxl_device_pci, "num_pcidevs")),
+    ("vfbs", Array(libxl_device_vfb, "num_vfbs")),
+    ("vkbs", Array(libxl_device_vkb, "num_vkbs")),
+    ("vtpms", Array(libxl_device_vtpm, "num_vtpms")),
+
+    ("on_poweroff", libxl_action_on_shutdown),
+    ("on_reboot", libxl_action_on_shutdown),
+    ("on_watchdog", libxl_action_on_shutdown),
+    ("on_crash", libxl_action_on_shutdown),
+    ])
+
 libxl_diskinfo = Struct("diskinfo", [
     ("backend", string),
     ("backend_id", uint32),
diff -r c893596e2d4c -r 601dc257a740 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:10 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:16 2012 +0000
@@ -283,6 +283,7 @@ if __name__ == '__main__':
         "cpupoolinfo",
         "domain_create_info",
         "domain_build_info",
+        "domain_config",
         "vcpuinfo",
         "event",
         ]

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 02 of 15] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
  2012-11-20 17:23 ` [PATCH 01 of 15] libxl: move definition of libxl_domain_config into the IDL Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 03 of 15] libxl: idl: Allow KeyedUnion members to be empty Ian Campbell
                   ` (22 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 8195cb0ebac691ae94e97939362f4d345891b4a7
# Parent  601dc257a740d3a6047667731007283a4dcb9600
libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN

libxl_dominfo.shutdown_reason is valid iff (shutdown||dying). This is a bit
annoying when generating language bindings since it needs all sorts of special
casing. Just introduce an explicit value instead.

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

diff -r 601dc257a740 -r 8195cb0ebac6 tools/libxl/libxl.c
--- a/tools/libxl/libxl.c	Tue Nov 20 17:22:16 2012 +0000
+++ b/tools/libxl/libxl.c	Tue Nov 20 17:22:21 2012 +0000
@@ -526,7 +526,7 @@ static void xcinfo2xlinfo(const xc_domai
     if (xlinfo->shutdown || xlinfo->dying)
         xlinfo->shutdown_reason = (xcinfo->flags>>XEN_DOMINF_shutdownshift) & XEN_DOMINF_shutdownmask;
     else
-        xlinfo->shutdown_reason  = ~0;
+        xlinfo->shutdown_reason = LIBXL_SHUTDOWN_REASON_UNKNOWN;
 
     xlinfo->current_memkb = PAGE_TO_MEMKB(xcinfo->tot_pages);
     xlinfo->shared_memkb = PAGE_TO_MEMKB(xcinfo->shr_pages);
diff -r 601dc257a740 -r 8195cb0ebac6 tools/libxl/libxl_types.idl
--- a/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:16 2012 +0000
+++ b/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:21 2012 +0000
@@ -118,14 +118,15 @@ libxl_scheduler = Enumeration("scheduler
     (7, "arinc653"),
     ])
 
-# Consistent with SHUTDOWN_* in sched.h
+# Consistent with SHUTDOWN_* in sched.h (apart from UNKNOWN)
 libxl_shutdown_reason = Enumeration("shutdown_reason", [
+    (-1, "unknown"),
     (0, "poweroff"),
     (1, "reboot"),
     (2, "suspend"),
     (3, "crash"),
     (4, "watchdog"),
-    ])
+    ], init_val = "LIBXL_SHUTDOWN_REASON_UNKNOWN")
 
 libxl_vga_interface_type = Enumeration("vga_interface_type", [
     (1, "CIRRUS"),

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 03 of 15] libxl: idl: Allow KeyedUnion members to be empty
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
  2012-11-20 17:23 ` [PATCH 01 of 15] libxl: move definition of libxl_domain_config into the IDL Ian Campbell
  2012-11-20 17:23 ` [PATCH 02 of 15] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 04 of 15] libxl: ocaml: fix code intended to output comments before definitions Ian Campbell
                   ` (21 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 739989dcd108c6dac61aa9c87be2a75feafb9871
# Parent  8195cb0ebac691ae94e97939362f4d345891b4a7
libxl: idl: Allow KeyedUnion members to be empty

This is useful when the key enum has an "invalid" option and avoids
the need to declare a dummy struct. Use this for domain_build_info
resulting in the generated API changing like so:
    --- tools/libxl/_libxl_BACKUP_types.h
    +++ tools/libxl/_libxl_types.h
    @@ -377,8 +377,6 @@ typedef struct libxl_domain_build_info {
                 const char * features;
                 libxl_defbool e820_host;
             } pv;
    -        struct {
    -        } invalid;
         } u;
     } libxl_domain_build_info;
     void libxl_domain_build_info_dispose(libxl_domain_build_info *p);

+ a related change to the JSON generation.

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

diff -r 8195cb0ebac6 -r 739989dcd108 tools/libxl/gentest.py
--- a/tools/libxl/gentest.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/libxl/gentest.py	Tue Nov 20 17:22:21 2012 +0000
@@ -46,7 +46,8 @@ def gen_rand_init(ty, v, indent = "    "
         for f in ty.fields:
             (nparent,fexpr) = ty.member(v, f, parent is None)
             s += "case %s:\n" % f.enumname
-            s += gen_rand_init(f.type, fexpr, indent + "    ", nparent)
+            if f.type is not None:
+                s += gen_rand_init(f.type, fexpr, indent + "    ", nparent)
             s += "    break;\n"
         s += "}\n"
     elif isinstance(ty, idl.Struct) \
diff -r 8195cb0ebac6 -r 739989dcd108 tools/libxl/gentypes.py
--- a/tools/libxl/gentypes.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/libxl/gentypes.py	Tue Nov 20 17:22:21 2012 +0000
@@ -45,6 +45,8 @@ def libxl_C_type_define(ty, indent = "")
             s += "typedef %s %s {\n" % (ty.kind, ty.typename)
 
         for f in ty.fields:
+            if isinstance(ty, idl.KeyedUnion) and f.type is None: continue
+            
             x = libxl_C_instance_of(f.type, f.name)
             if f.const:
                 x = "const " + x
@@ -67,7 +69,8 @@ def libxl_C_type_dispose(ty, v, indent =
         for f in ty.fields:
             (nparent,fexpr) = ty.member(v, f, parent is None)
             s += "case %s:\n" % f.enumname
-            s += libxl_C_type_dispose(f.type, fexpr, indent + "    ", nparent)
+            if f.type is not None:
+                s += libxl_C_type_dispose(f.type, fexpr, indent + "    ", nparent)
             s += "    break;\n"
         s += "}\n"
     elif isinstance(ty, idl.Array):
@@ -115,7 +118,8 @@ def _libxl_C_type_init(ty, v, indent = "
             for f in ty.fields:
                 (nparent,fexpr) = ty.member(v, f, parent is None)
                 s += "case %s:\n" % f.enumname
-                s += _libxl_C_type_init(f.type, fexpr, "    ", nparent)
+                if f.type is not None:
+                    s += _libxl_C_type_init(f.type, fexpr, "    ", nparent)
                 s += "    break;\n"
             s += "}\n"
         else:
@@ -214,7 +218,8 @@ def libxl_C_type_gen_json(ty, v, indent 
         for f in ty.fields:
             (nparent,fexpr) = ty.member(v, f, parent is None)
             s += "case %s:\n" % f.enumname
-            s += libxl_C_type_gen_json(f.type, fexpr, indent + "    ", nparent)
+            if f.type is not None:
+                s += libxl_C_type_gen_json(f.type, fexpr, indent + "    ", nparent)
             s += "    break;\n"
         s += "}\n"
     elif isinstance(ty, idl.Struct) and (parent is None or ty.json_fn is None):
diff -r 8195cb0ebac6 -r 739989dcd108 tools/libxl/libxl_types.idl
--- a/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:21 2012 +0000
@@ -338,7 +338,7 @@ libxl_domain_build_info = Struct("domain
                                       # Use host's E820 for PCI passthrough.
                                       ("e820_host", libxl_defbool),
                                       ])),
-                 ("invalid", Struct(None, [])),
+                 ("invalid", None),
                  ], keyvar_init_val = "LIBXL_DOMAIN_TYPE_INVALID")),
     ], dir=DIR_IN
 )

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 04 of 15] libxl: ocaml: fix code intended to output comments before definitions
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (2 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 03 of 15] libxl: idl: Allow KeyedUnion members to be empty Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 05 of 15] libxl: ocaml: support for Arrays in bindings generator Ian Campbell
                   ` (20 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID be294b1cdd00dac5d3a1b42faf06656902b99e5b
# Parent  739989dcd108c6dac61aa9c87be2a75feafb9871
libxl: ocaml: fix code intended to output comments before definitions

I'm not sure how useful these comments actually are but erred on the
side of fixing rather than removing.

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

diff -r 739989dcd108 -r be294b1cdd00 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -79,12 +79,14 @@ def gen_ocaml_ml(ty, interface, indent="
         s = ("""(* %s interface *)\n""" % ty.typename)
     else:
         s = ("""(* %s implementation *)\n""" % ty.typename)
+        
     if isinstance(ty, idl.Enumeration):
-        s = "type %s = \n" % ty.rawname
+        s += "type %s = \n" % ty.rawname
         for v in ty.values:
             s += "\t | %s\n" % v.rawname
     elif isinstance(ty, idl.Aggregate):
-        s = ""
+        s += ""
+        
         if ty.typename is None:
             raise NotImplementedError("%s has no typename" % type(ty))
         else:

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 05 of 15] libxl: ocaml: support for Arrays in bindings generator
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (3 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 04 of 15] libxl: ocaml: fix code intended to output comments before definitions Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 06 of 15] libxl/ocaml: avoid reserved words in type and field names Ian Campbell
                   ` (19 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID b7e2cd4a03f278c9abfec0812c88234f7e493646
# Parent  be294b1cdd00dac5d3a1b42faf06656902b99e5b
libxl: ocaml: support for Arrays in bindings generator.

No change in generated code because no arrays are currently generated.

Signed-off-by: Ian Campbell <ian.campbell@citria.xcom>

diff -r be294b1cdd00 -r b7e2cd4a03f2 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -143,7 +143,13 @@ def c_val(ty, c, o, indent="", parent = 
             raise NotImplementedError("No c_val fn for Builtin %s (%s)" % (ty.typename, type(ty)))
         s += "%s;" % (fn % { "o": o, "c": c })
     elif isinstance (ty,idl.Array):
-        raise("Cannot handle Array type\n")
+        s += "{\n"
+        s += "\tint i;\n"
+        s += "\t%s = Wosize_val(%s);\n" % (parent + ty.lenvar.name, o)
+        s += "\tfor(i=0; i<%s; i++) {\n" % (parent + ty.lenvar.name)
+        s += c_val(ty.elem_type, c+"[i]", "Field(%s, i)" % o, indent="\t\t", parent=parent) + "\n"
+        s += "\t}\n"
+        s += "}\n"
     elif isinstance(ty,idl.Enumeration) and (parent is None):
         n = 0
         s += "switch(Int_val(%s)) {\n" % o

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 06 of 15] libxl/ocaml: avoid reserved words in type and field names
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (4 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 05 of 15] libxl: ocaml: support for Arrays in bindings generator Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator Ian Campbell
                   ` (18 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID f618acdeea1bf60b3b68da4062de018d8162fe8c
# Parent  b7e2cd4a03f278c9abfec0812c88234f7e493646
libxl/ocaml: avoid reserved words in type and field names.

Current just s/type/ty/ and there are no such fields (yet) so no
change to generated code.

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

diff -r b7e2cd4a03f2 -r f618acdeea1b tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -70,8 +70,14 @@ def ocaml_type_of(ty):
     else:
         return ty.rawname
 
+def munge_name(name):
+    if name == "type":
+        return "ty"
+    else:
+        return name
+    
 def ocaml_instance_of(type, name):
-    return "%s : %s" % (name, ocaml_type_of(type))
+    return "%s : %s" % (munge_name(name), ocaml_type_of(type))
 
 def gen_ocaml_ml(ty, interface, indent=""):

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (5 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 06 of 15] libxl/ocaml: avoid reserved words in type and field names Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 08 of 15] libxl/ocaml: add some more builtin types Ian Campbell
                   ` (17 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 0cf342afa9e6b506fad68346cb3a1207030372eb
# Parent  f618acdeea1bf60b3b68da4062de018d8162fe8c
libxl: ocaml: support for KeyedUnion in the bindings generator.

A KeyedUnion consists of two fields in the containing struct. First an
enum field ("e") used as a descriminator and second a union ("u")
containing potentially anonymous structs associated with each enum
value.

We map the anonymous structs to structs named after the descriminator
field ("e") and the specific enum values. We then declare an ocaml
variant type name e__union mapping each enum value to its associated
struct.

So given IDL:

 foo = Enumeration("foo",
	(0, "BAR"),
	(1, "BAZ"),
 s = Struct("s", [
        ("u", KeyedUnion(none, foo, "blargle", [
		("bar", Struct(...xxx...)),
		("baz", Struct(...yyy...)),
	])),
 ])

We generate C:

 enum { FOO, BAR } foo;
 struct s {
 	enum foo blargle;
 	union {
 		struct { ...xxx... } bar;
 		struct { ...yyy... } baz;
 	} u;
 }

and map this to ocaml

 type foo = BAR | BAZ;

 module	s = Struct

 	type blargle_bar = ...xxx...;

 	type blargle_baz = ...yyy...;

 	type blargle__union = Bar of blargle_bar | Baz of blargle_baz;

 	type t =
 	{
 		blargle : blargle__union;
 	}

These type names are OK because they are already within the namespace
associated with the struct "s".

If the struct assiated with bar is empty then we don't bother iwht
blargle_bar of "of blargle_bar".

No actually change in the gnerated code since we don't generated any
KeyedUnions yet.

The actual implementation was inspired by
http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php#ref_constvrnt

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

diff -r f618acdeea1b -r 0cf342afa9e6 tools/libxl/idl.py
--- a/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
@@ -216,6 +216,9 @@ class Struct(Aggregate):
         kwargs.setdefault('passby', PASS_BY_REFERENCE)
         Aggregate.__init__(self, "struct", name, fields, **kwargs)
 
+    def has_fields(self):
+        return len(self.fields) != 0
+
 class Union(Aggregate):
     def __init__(self, name, fields, **kwargs):
         # Generally speaking some intelligence is required to free a
diff -r f618acdeea1b -r 0cf342afa9e6 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -65,6 +65,8 @@ def ocaml_type_of(ty):
         if not typename:
             raise NotImplementedError("No typename for Builtin %s (%s)" % (ty.typename, type(ty)))
         return typename
+    elif isinstance(ty,idl.KeyedUnion):
+        return ty.union_name
     elif isinstance(ty,idl.Aggregate):
         return ty.rawname.capitalize() + ".t"
     else:
@@ -76,8 +78,67 @@ def munge_name(name):
     else:
         return name
     
-def ocaml_instance_of(type, name):
-    return "%s : %s" % (munge_name(name), ocaml_type_of(type))
+def ocaml_instance_of_field(f):
+    if isinstance(f.type, idl.KeyedUnion):
+        name = f.type.keyvar.name
+    else:
+        name = f.name
+    return "%s : %s" % (munge_name(name), ocaml_type_of(f.type))
+
+def gen_struct(ty):
+    s = ""
+    for f in ty.fields:
+        if f.type.private:
+            continue
+        x = ocaml_instance_of_field(f)
+        x = x.replace("\n", "\n\t\t")
+        s += "\t\t" + x + ";\n"
+    return s
+
+def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
+    s = ""
+    
+    if ty.rawname is not None:
+        # Non-anonymous types need no special handling
+        pass
+    elif isinstance(ty, idl.KeyedUnion):
+        if parent is None:
+            nparent = ty.keyvar.name
+        else:
+            nparent = parent + "_" + ty.keyvar.name
+
+        for f in ty.fields:
+            if f.type is None: continue
+            if f.type.rawname is not None: continue
+            if isinstance(f.type, idl.Struct) and not f.type.has_fields(): continue
+            s += "\ntype %s_%s =\n" % (nparent,f.name)
+            s += "{\n"
+            s += gen_struct(f.type)
+            s += "}\n"
+
+        name = "%s__union" % ty.keyvar.name
+        s += "\n"
+        s += "type %s = " % name
+        u = []
+        for f in ty.fields:
+            if f.type is None:
+                u.append("%s" % (f.name.capitalize()))
+            elif isinstance(f.type, idl.Struct):
+                if f.type.rawname is not None:
+                    u.append("%s of %s" % (f.name.capitalize(), f.type.rawname.capitalize()))
+                elif f.type.has_fields():
+                    u.append("%s of %s_%s" % (f.name.capitalize(), nparent, f.name))
+                else:
+                    u.append("%s" % (f.name.capitalize()))
+            else:
+                raise NotImplementedError("Cannot handle KeyedUnion fields which are not Structs")
+            
+        s += " | ".join(u) + "\n"
+        ty.union_name = name
+
+    if s == "":
+        return None
+    return s.replace("\n", "\n%s" % indent)
 
 def gen_ocaml_ml(ty, interface, indent=""):
 
@@ -103,16 +164,17 @@ def gen_ocaml_ml(ty, interface, indent="
                 s += "module %s : sig\n" % module_name
             else:
                 s += "module %s = struct\n" % module_name
-            s += "\ttype t =\n"
-            s += "\t{\n"
-            
+                
+        # Handle KeyedUnions...
         for f in ty.fields:
-            if f.type.private:
-                continue
-            x = ocaml_instance_of(f.type, f.name)
-            x = x.replace("\n", "\n\t\t")
-            s += "\t\t" + x + ";\n"
+            ku = gen_ocaml_keyedunions(f.type, interface, "\t")
+            if ku is not None:
+                s += ku
+                s += "\n"
 
+        s += "\ttype t =\n"
+        s += "\t{\n"
+        s += gen_struct(ty)
         s += "\t}\n"
         
         if functions.has_key(ty.rawname):
@@ -164,12 +226,43 @@ def c_val(ty, c, o, indent="", parent = 
             n += 1
         s += "    default: failwith_xl(\"cannot convert value to %s\", lg); break;\n" % ty.typename
         s += "}"
-    elif isinstance(ty, idl.Aggregate) and (parent is None):
+    elif isinstance(ty, idl.KeyedUnion):
+        s += "{\n"
+        s += "\tif(Is_long(%s)) {\n" % o
+        n = 0
+        s += "\t\tswitch(Int_val(%s)) {\n" % o
+        for f in ty.fields:
+            if f.type is None or not f.type.has_fields():
+                s += "\t\t    case %d: %s = %s; break;\n" % (n,
+                                                    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}\n"
+        s += "\t} else {\n"
+        s += "\t\t/* Is block... */\n"
+        s += "\t\tswitch(Tag_val(%s)) {\n" % o
+        n = 0
+        for f in ty.fields:
+            if f.type is not None and f.type.has_fields():
+                if f.type.private:
+                    continue
+                s += "\t\t    case %d:\n" % (n)
+                s += "\t\t        %s = %s;\n" % (parent + ty.keyvar.name, f.enumname)
+                (nparent,fexpr) = ty.member(c, f, False)
+                s += "%s" % c_val(f.type, fexpr, 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}\n"
+        s += "\t}\n"
+        s += "}"
+    elif isinstance(ty, idl.Aggregate) and (parent is None or ty.rawname is None):
         n = 0
         for f in ty.fields:
             if f.type.private:
                 continue
-            (nparent,fexpr) = ty.member(c, f, parent is None)
+            (nparent,fexpr) = ty.member(c, f, ty.rawname is not None)
             s += "%s\n" % c_val(f.type, fexpr, "Field(%s, %d)" % (o,n), parent=nparent)
             n = n + 1
     else:
@@ -191,8 +284,8 @@ def gen_c_val(ty, indent=""):
     s += "}\n"
     
     return s.replace("\n", "\n%s" % indent)
-
-def ocaml_Val(ty, o, c, indent="", parent = None):
+    
+def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag = None):
     s = indent
     if isinstance(ty,idl.UInt):
         if ty.width in [8, 16]:
@@ -231,11 +324,39 @@ def ocaml_Val(ty, o, c, indent="", paren
             n += 1
         s += "    default: failwith_xl(\"cannot convert value from %s\", lg); break;\n" % ty.typename
         s += "}"
-    elif isinstance(ty,idl.Aggregate) and (parent is None):
+    elif isinstance(ty, idl.KeyedUnion):
+        n = 0
+        s += "switch(%s) {\n" % (parent + ty.keyvar.name)
+        for f in ty.fields:
+            s += "\t    case %s:\n" % f.enumname
+            if f.type is None:
+                s += "\t        /* %d: None */\n" % n
+                s += "\t        %s = Val_long(%d);\n" % (o,n)
+            elif not f.type.has_fields():
+                s += "\t        /* %d: Long */\n" % n
+                s += "\t        %s = Val_long(%d);\n" % (o,n)
+            else:
+                s += "\t        /* %d: Block */\n" % n
+                (nparent,fexpr) = ty.member(c, f, parent is None)
+                s += ocaml_Val(f.type, o, fexpr, struct_tag = n, indent="\t        ", parent=nparent)
+                s += "\n"
+                #s += "\t        %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n)
+            s += "\t        break;\n"
+            n += 1
+        s += "\t    default: failwith_xl(\"cannot convert value from %s\", lg); break;\n" % ty.typename
+        s += "\t}"
+    elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is None):
         s += "{\n"
-        s += "\tvalue %s_field;\n" % ty.rawname
+        if ty.rawname is None:
+            fn = "anon_field"
+        else:
+            fn = "%s_field" % ty.rawname
+        s += "\tvalue %s;\n" % fn
         s += "\n"
-        s += "\t%s = caml_alloc_tuple(%d);\n" % (o, len(ty.fields))
+        if struct_tag is not None:
+            s += "\t%s = caml_alloc(%d,%d);\n" % (o, len(ty.fields), struct_tag)
+        else:
+            s += "\t%s = caml_alloc_tuple(%d);\n" % (o, len(ty.fields))
         
         n = 0
         for f in ty.fields:
@@ -245,8 +366,8 @@ def ocaml_Val(ty, o, c, indent="", paren
             (nparent,fexpr) = ty.member(c, f, parent is None)
 
             s += "\n"
-            s += "\t%s\n" % ocaml_Val(f.type, "%s_field" % ty.rawname, ty.pass_arg(fexpr, c), parent=nparent)
-            s += "\tStore_field(%s, %d, %s);\n" % (o, n, "%s_field" % ty.rawname)
+            s += "\t%s\n" % ocaml_Val(f.type, fn, ty.pass_arg(fexpr, c), parent=nparent)
+            s += "\tStore_field(%s, %d, %s);\n" % (o, n, fn)
             n = n + 1
         s += "}"
     else:

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 08 of 15] libxl/ocaml: add some more builtin types
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (6 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 09 of 15] libxl/ocaml: add domain_build/create_info and events to the bindings Ian Campbell
                   ` (16 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 21c5e58956d09437903e1ee1b0588d61a7c28145
# Parent  0cf342afa9e6b506fad68346cb3a1207030372eb
libxl/ocaml: add some more builtin types.

  * bitmaps
  * string_list
  * cpuid_policy_list (actually opaque)
  * key_value_list

None of these are used yet, so no change to the generated code.

Bitmap_val requires a ctx, so leave it as an abort for now.

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

diff -r 0cf342afa9e6 -r 21c5e58956d0 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -13,9 +13,13 @@ builtins = {
     "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_key_value_list": ("(string * string) list", None,                                None),
+    "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_hwcap":          ("int32 array",            None,                                "Val_hwcap(&%(c)s)"),
+    # This is an opaque type
+    "libxl_cpuid_policy_list": ("Cpuid_policy.t",      "Cpuid_policy_list_val(gc, lg, &%(c)s, %(o)s)",   "Val_cpuid_policy_list(&%(c)s)"),    
     }
 
 DEVICE_FUNCTIONS = [ ("add",            ["t", "domid", "unit"]),
diff -r 0cf342afa9e6 -r 21c5e58956d0 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
@@ -18,6 +18,10 @@ exception Error of string
 type domid = int
 type devid = int
 
+module Cpuid_policy = struct
+	type t
+end
+
 (* @@LIBXL_TYPES@@ *)
 
 external send_trigger : domid -> trigger -> int -> unit = "stub_xl_send_trigger"
diff -r 0cf342afa9e6 -r 21c5e58956d0 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
@@ -27,6 +27,7 @@
 #include <string.h>
 
 #include <libxl.h>
+#include <libxl_utils.h>
 
 struct caml_logger {
 	struct xentoollog_logger logger;
@@ -96,7 +97,6 @@ static void failwith_xl(char *fname, str
 	caml_raise_with_string(*caml_named_value("xl.error"), s);
 }
 
-#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed then */
 static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
 {
 	void *ptr;
@@ -107,28 +107,62 @@ static void * gc_calloc(caml_gc *gc, siz
 	return ptr;
 }
 
-static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value v)
+static int list_len(value v)
+{
+	int len = 0;
+	while ( v != Val_emptylist ) {
+		len++;
+		v = Field(v, 1);
+	}
+	return len;
+}
+
+static int libxl_key_value_list_val(caml_gc *gc, struct caml_logger *lg,
+				    libxl_key_value_list *c_val,
+				    value v)
 {
 	CAMLparam1(v);
-	CAMLlocal1(a);
-	int i;
-	char **array;
+	CAMLlocal1(elem);
+	int nr, i;
+	libxl_key_value_list array;
 
-	for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) { i++; }
+	nr = list_len(v);
 
-	array = gc_calloc(gc, (i + 1) * 2, sizeof(char *));
+	array = gc_calloc(gc, (nr + 1) * 2, sizeof(char *));
 	if (!array)
-		return 1;
-	for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1), i++) {
-		value b = Field(a, 0);
-		array[i * 2] = dup_String_val(gc, Field(b, 0));
-		array[i * 2 + 1] = dup_String_val(gc, Field(b, 1));
+		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));
 	}
+
 	*c_val = array;
 	CAMLreturn(0);
 }
 
-#endif
+static int libxl_string_list_val(caml_gc *gc, struct caml_logger *lg,
+				 libxl_string_list *c_val,
+				 value v)
+{
+	CAMLparam1(v);
+	int nr, i;
+	libxl_key_value_list array;
+
+	nr = list_len(v);
+
+	array = gc_calloc(gc, (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));
+
+	*c_val = array;
+	CAMLreturn(0);
+}
 
 /* Option type support as per http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php */
 #define Val_none Val_int(0)
@@ -168,6 +202,45 @@ static int Mac_val(caml_gc *gc, struct c
 	CAMLreturn(0);
 }
 
+static value Val_bitmap (libxl_bitmap *c_val)
+{
+	CAMLparam0();
+	CAMLlocal1(v);
+	int i;
+
+	v = caml_alloc(8 * (c_val->size), 0);
+	libxl_for_each_bit(i, *c_val) {
+		if (libxl_bitmap_test(c_val, i))
+			Store_field(v, i, Val_true);
+		else
+			Store_field(v, i, Val_false);
+	}
+	CAMLreturn(v);
+}
+
+static int Bitmap_val(caml_gc *gc, struct caml_logger *lg,
+		      libxl_bitmap *c_val, value v)
+{
+	abort(); /* XXX */
+}
+
+static value Val_cpuid_policy_list(libxl_cpuid_policy_list *c_val)
+{
+	CAMLparam0();
+	/* An opaque pointer */
+	CAMLreturn((value)c_val);
+}
+
+static int Cpuid_policy_list_val(caml_gc *gc, struct caml_logger *lg,
+				 libxl_cpuid_policy_list **c_val, value v)
+{
+	CAMLparam1(v);
+
+	/* An opaque pointer */
+	*c_val = (libxl_cpuid_policy_list*)v;
+	CAMLreturn(0);
+}
+
 static value Val_uuid (libxl_uuid *c_val)
 {
 	CAMLparam0();

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 09 of 15] libxl/ocaml: add domain_build/create_info and events to the bindings
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (7 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 08 of 15] libxl/ocaml: add some more builtin types Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-29 17:20   ` Rob Hoes
  2012-11-20 17:23 ` [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only) Ian Campbell
                   ` (15 subsequent siblings)
  24 siblings, 1 reply; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 5173d29f64fa541f6ec0c48481c4957a03f0302c
# Parent  21c5e58956d09437903e1ee1b0588d61a7c28145
libxl/ocaml: add domain_build/create_info and events to the bindings.

We now have enoguh infrastructure in place to do this trivially.

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

diff -r 21c5e58956d0 -r 5173d29f64fa tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -19,7 +19,7 @@ builtins = {
     "libxl_mac":            ("int array",              "Mac_val(gc, lg, &%(c)s, %(o)s)",    "Val_mac(&%(c)s)"),
     "libxl_hwcap":          ("int32 array",            None,                                "Val_hwcap(&%(c)s)"),
     # This is an opaque type
-    "libxl_cpuid_policy_list": ("Cpuid_policy.t",      "Cpuid_policy_list_val(gc, lg, &%(c)s, %(o)s)",   "Val_cpuid_policy_list(&%(c)s)"),    
+    "libxl_cpuid_policy_list": ("Cpuid_policy.t",      "Cpuid_policy_list_val(gc, lg, &%(c)s, %(o)s)",   "Val_cpuid_policy_list(%(c)s)"),    
     }
 
 DEVICE_FUNCTIONS = [ ("add",            ["t", "domid", "unit"]),
@@ -420,11 +420,8 @@ if __name__ == '__main__':
     # Do not generate these yet.
     blacklist = [
         "cpupoolinfo",
-        "domain_create_info",
-        "domain_build_info",
         "domain_config",
         "vcpuinfo",
-        "event",
         ]
 
     for t in blacklist:
diff -r 21c5e58956d0 -r 5173d29f64fa 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
@@ -224,7 +224,7 @@ static int Bitmap_val(caml_gc *gc, struc
 	abort(); /* XXX */
 }
 
-static value Val_cpuid_policy_list(libxl_cpuid_policy_list *c_val)
+static value Val_cpuid_policy_list(libxl_cpuid_policy_list c_val)
 {
 	CAMLparam0();
 	/* An opaque pointer */
@@ -232,12 +232,13 @@ static value Val_cpuid_policy_list(libxl
 }
 
 static int Cpuid_policy_list_val(caml_gc *gc, struct caml_logger *lg,
-				 libxl_cpuid_policy_list **c_val, value v)
+				 libxl_cpuid_policy_list *c_val, value v)
 {
 	CAMLparam1(v);
 
 	/* An opaque pointer */
-	*c_val = (libxl_cpuid_policy_list*)v;
+	*c_val = (libxl_cpuid_policy_list)v;
+
 	CAMLreturn(0);
 }

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only)
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (8 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 09 of 15] libxl/ocaml: add domain_build/create_info and events to the bindings Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-29 17:41   ` Rob Hoes
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107B2@LONPMAILBOX01.citrite.net>
  2012-11-20 17:23 ` [PATCH 11 of 15] libxl: ocaml: allocate a long lived libxl context Ian Campbell
                   ` (14 subsequent siblings)
  24 siblings, 2 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 2b433b1523e4295bb1ed74a7b71e2a20e00f1802
# Parent  5173d29f64fa541f6ec0c48481c4957a03f0302c
libxc/ocaml: Add simple binding for xentoollog (output only).

These bindings allow ocaml code to receive log message via xentoollog
but do not support injecting messages into xentoollog from ocaml.
Receiving log messages from libx{c,l} and forwarding them to ocaml is
the use case which is needed by the following patches.

Add a simple noddy test case (tools/ocaml/test).

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

diff -r 5173d29f64fa -r 2b433b1523e4 .gitignore
--- a/.gitignore	Tue Nov 20 17:22:21 2012 +0000
+++ b/.gitignore	Tue Nov 20 17:22:21 2012 +0000
@@ -364,6 +364,7 @@ tools/ocaml/libs/xl/_libxl_types.mli.in
 tools/ocaml/libs/xl/xenlight.ml
 tools/ocaml/libs/xl/xenlight.mli
 tools/ocaml/xenstored/oxenstored
+tools/ocaml/test/xtl
 
 tools/debugger/kdd/kdd
 tools/firmware/etherboot/ipxe.tar.gz
diff -r 5173d29f64fa -r 2b433b1523e4 .hgignore
--- a/.hgignore	Tue Nov 20 17:22:21 2012 +0000
+++ b/.hgignore	Tue Nov 20 17:22:21 2012 +0000
@@ -305,6 +305,7 @@
 ^tools/ocaml/libs/xl/xenlight\.ml$
 ^tools/ocaml/libs/xl/xenlight\.mli$
 ^tools/ocaml/xenstored/oxenstored$
+^tools/ocaml/test/xtl$
 ^tools/autom4te\.cache$
 ^tools/config\.h$
 ^tools/config\.log$
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/Makefile
--- a/tools/ocaml/Makefile	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/Makefile	Tue Nov 20 17:22:21 2012 +0000
@@ -1,7 +1,7 @@
 XEN_ROOT = $(CURDIR)/../..
 include $(XEN_ROOT)/tools/Rules.mk
 
-SUBDIRS_PROGRAMS = xenstored
+SUBDIRS_PROGRAMS = xenstored test
 
 SUBDIRS = libs $(SUBDIRS_PROGRAMS)
 
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/Makefile.rules
--- a/tools/ocaml/Makefile.rules	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/Makefile.rules	Tue Nov 20 17:22:21 2012 +0000
@@ -24,7 +24,7 @@ ALL_OCAML_OBJS ?= $(OBJS)
 %.cmi: %.mli
 	$(call quiet-command, $(OCAMLC) $(OCAMLCFLAGS) -c -o $@ $<,MLI,$@)
 
-%.cmx: %.ml
+%.cmx %.o: %.ml
 	$(call quiet-command, $(OCAMLOPT) $(OCAMLOPTFLAGS) -c -o $@ $<,MLOPT,$@)
 
 %.ml: %.mll
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/libs/Makefile
--- a/tools/ocaml/libs/Makefile	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/Makefile	Tue Nov 20 17:22:21 2012 +0000
@@ -3,6 +3,7 @@ include $(XEN_ROOT)/tools/Rules.mk
 
 SUBDIRS= \
 	mmap \
+	xentoollog \
 	xc eventchn \
 	xb xs xl
 
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/libs/xentoollog/META.in
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xentoollog/META.in	Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "Xen Tools Logger Interface"
+archive(byte) = "xentoollog.cma"
+archive(native) = "xentoollog.cmxa"
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/libs/xentoollog/Makefile
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xentoollog/Makefile	Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,33 @@
+TOPLEVEL=$(CURDIR)/../..
+XEN_ROOT=$(TOPLEVEL)/../..
+include $(TOPLEVEL)/common.make
+
+CFLAGS += $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest)
+OCAMLINCLUDE +=
+
+OBJS = xentoollog
+INTF = xentoollog.cmi
+LIBS = xentoollog.cma xentoollog.cmxa
+
+LIBS_xentoollog = $(LDLIBS_libxenctrl)
+
+xentoollog_OBJS = $(OBJS)
+xentoollog_C_OBJS = xentoollog_stubs
+
+OCAML_LIBRARY = xentoollog
+
+all: $(INTF) $(LIBS)
+
+libs: $(LIBS)
+
+.PHONY: install
+install: $(LIBS) META
+	mkdir -p $(OCAMLDESTDIR)
+	ocamlfind remove -destdir $(OCAMLDESTDIR) xentoollog
+	ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xentoollog META $(INTF) $(LIBS) *.a *.so *.cmx
+
+.PHONY: uninstall
+uninstall:
+	ocamlfind remove -destdir $(OCAMLDESTDIR) xentoollog
+
+include $(TOPLEVEL)/Makefile.rules
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/libs/xentoollog/xentoollog.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xentoollog/xentoollog.ml	Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,101 @@
+(*
+ * Copyright (C) 2012      Citrix Ltd.
+ * Author Ian Campbell <ian.campbell@citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open Printf
+open Random
+open Callback
+
+type level = Debug
+	     | Verbose
+	     | Detail
+	     | Progress
+	     | Info
+	     | Notice
+	     | Warn
+	     | Error
+	     | Critical
+
+let level_to_string level =
+  match level with
+  | Debug -> "Debug"
+  | Verbose -> "Verbose"
+  | Detail -> "Detail"
+  | Progress -> "Progress"
+  | Info -> "Info"
+  | Notice -> "Notice"
+  | Warn -> "Warn"
+  | Error -> "Error"
+  | Critical -> "Critical"
+
+let level_to_prio level = 
+  match level with
+  | Debug -> 0
+  | Verbose -> 1
+  | Detail -> 2
+  | Progress -> 3
+  | Info -> 4
+  | Notice -> 5
+  | Warn -> 6
+  | Error -> 7
+  | Critical -> 8
+
+type handle
+
+type logger_cbs = {
+		  vmessage : level -> int option -> string option -> string -> unit;
+		  progress : string option -> string -> int -> int64 -> int64 -> unit;
+		  (*destroy : unit -> unit*) }
+
+external _create_logger: (string * string) -> handle = "stub_xtl_create_logger"
+external test: handle -> unit = "stub_xtl_test"
+
+let create name cbs : handle =
+  (* Callback names are supposed to be unique *)
+  let suffix = string_of_int (Random.int 1000000) in
+  let vmessage_name = sprintf "%s_vmessage_%s" name suffix in
+  let progress_name = sprintf "%s_progress_%s" name suffix in
+  (*let destroy_name = sprintf "%s_destroy" name in*)
+  begin
+    Callback.register vmessage_name cbs.vmessage;
+    Callback.register progress_name cbs.progress;
+    _create_logger (vmessage_name, progress_name)
+  end
+
+
+let stdio_vmessage min_level level errno ctx msg =
+  let level_int = level_to_prio level 
+  and level_str = level_to_string level
+  and errno_str = match errno with None -> "" | Some s -> sprintf ": errno=%d" s
+  and ctx_str = match ctx with None -> "" | Some s -> sprintf ": %s" s in
+  if min_level <= level_int then begin
+    printf "%s%s%s: %s\n" level_str ctx_str errno_str msg;
+    flush stdout;  
+  end;
+  ()
+
+let stdio_progress ctx what percent dne total =
+  let nl = if dne = total then "\n" else "" in
+  printf "\rProgress %s %d%% (%Ld/%Ld)%s" what percent dne total nl;
+  flush stdout;
+  ()
+    
+let create_stdio_logger ?(level=Info) () =
+  let level_int = level_to_prio level in
+  let cbs = {
+    vmessage = stdio_vmessage level_int;
+    progress = stdio_progress; } in
+  create "Xentoollog.stdio_logger" cbs
+
+external destroy: handle -> unit = "stub_xtl_destroy"
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/libs/xentoollog/xentoollog.mli
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xentoollog/xentoollog.mli	Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,52 @@
+(*
+ * Copyright (C) 2012      Citrix Ltd.
+ * Author Ian Campbell <ian.campbell@citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type level = Debug
+	     | Verbose
+	     | Detail
+	     | Progress (* also used for "progress" messages *)
+	     | Info
+	     | Notice
+	     | Warn
+	     | Error
+	     | Critical
+
+val level_to_string : level -> string
+
+type handle
+
+(** call back arguments. See xentoollog.h for more info.
+    vmessage:
+      level: level as above
+      errno: Some <errno> or None
+      context: Some <string> or None
+      message: The log message (already formatted)
+    progress:
+      context: Some <string> or None
+      doing_what: string
+      percent, done, total.
+*)
+type logger_cbs = {
+		  vmessage : level -> int option -> string option -> string -> unit;
+		  progress : string option -> string -> int -> int64 -> int64 -> unit;
+		  (*destroy : handle -> unit*) }
+
+external test: handle -> unit = "stub_xtl_test"
+
+val create : string -> logger_cbs -> handle
+
+val create_stdio_logger : ?level:level -> unit -> handle
+
+external destroy: handle -> unit = "stub_xtl_destroy"
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/libs/xentoollog/xentoollog_stubs.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c	Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,211 @@
+/*
+ * Copyright (C) 2012      Citrix Ltd.
+ * Author Ian Campbell <ian.campbell@citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#define _GNU_SOURCE
+#include <stdio.h>
+#include <string.h>
+#include <unistd.h>
+#include <errno.h>
+
+#define CAML_NAME_SPACE
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+
+
+#include <xentoollog.h>
+
+struct caml_xtl {
+	xentoollog_logger vtable;
+	char *vmessage_cb;
+	char *progress_cb;
+};
+
+#define HND ((struct caml_xtl*)handle)
+#define XTL ((xentoollog_logger *)HND)
+
+static char * dup_String_val(value s)
+{
+	int len;
+	char *c;
+	len = caml_string_length(s);
+	c = calloc(len + 1, sizeof(char));
+	if (!c)
+		caml_raise_out_of_memory();
+	memcpy(c, String_val(s), len);
+	return c;
+}
+
+static value Val_level(xentoollog_level c_level)
+{
+	/* Must correspond to order in .mli */
+	switch (c_level) {
+	case XTL_NONE: /* Not a real value */
+		caml_raise_sys_error(caml_copy_string("Val_level XTL_NONE"));
+		break;
+	case XTL_DEBUG:    return Val_int(0);
+	case XTL_VERBOSE:  return Val_int(1);
+	case XTL_DETAIL:   return Val_int(2);
+	case XTL_PROGRESS: return Val_int(3);
+	case XTL_INFO:     return Val_int(4);
+	case XTL_NOTICE:   return Val_int(5);
+	case XTL_WARN:     return Val_int(6);
+	case XTL_ERROR:    return Val_int(7);
+	case XTL_CRITICAL: return Val_int(8);
+	case XTL_NUM_LEVELS: /* Not a real value! */
+		caml_raise_sys_error(
+			caml_copy_string("Val_level XTL_NUM_LEVELS"));
+#if 0 /* Let the compiler catch this */
+	default:
+		caml_raise_sys_error(caml_copy_string("Val_level Unknown"));
+		break;
+#endif
+	}
+	abort();
+}
+
+/* Option type support as per http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php */
+#define Val_none Val_int(0)
+#define Some_val(v) Field(v,0)
+
+static value Val_some(value v)
+{
+	CAMLparam1(v);
+	CAMLlocal1(some);
+	some = caml_alloc(1, 0);
+	Store_field(some, 0, v);
+	CAMLreturn(some);
+}
+
+static value Val_errno(int errnoval)
+{
+	if (errnoval == -1)
+		return Val_none;
+	return Val_some(Val_int(errnoval));
+}
+
+static value Val_context(const char *context)
+{
+	if (context == NULL)
+		return Val_none;
+	return Val_some(caml_copy_string(context));
+}
+
+static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
+			       xentoollog_level level,
+			       int errnoval,
+			       const char *context,
+			       const char *format,
+			       va_list al)
+{
+	struct caml_xtl *xtl = (struct caml_xtl*)logger;
+	value *func = caml_named_value(xtl->vmessage_cb) ;
+	value args[4];
+	char *msg;
+
+	if (args == NULL)
+		caml_raise_out_of_memory();
+	if (func == NULL)
+		caml_raise_sys_error(caml_copy_string("Unable to find callback"));
+	if (vasprintf(&msg, format, al) < 0)
+		caml_raise_out_of_memory();
+
+	/* vmessage : level -> int option -> string option -> string -> unit; */
+	args[0] = Val_level(level);
+	args[1] = Val_errno(errnoval);
+	args[2] = Val_context(context);
+	args[3] = caml_copy_string(msg);
+
+	free(msg);
+
+	caml_callbackN(*func, 4, args);
+}
+
+static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
+				    const char *context,
+				    const char *doing_what /* no \r,\n */,
+				    int percent, unsigned long done, unsigned long total)
+{
+	struct caml_xtl *xtl = (struct caml_xtl*)logger;
+	value *func = caml_named_value(xtl->progress_cb) ;
+	value args[5];
+
+	if (args == NULL)
+		caml_raise_out_of_memory();
+	if (func == NULL)
+		caml_raise_sys_error(caml_copy_string("Unable to find callback"));
+
+	/* progress : string option -> string -> int -> int64 -> int64 -> unit; */
+	args[0] = Val_context(context);
+	args[1] = caml_copy_string(doing_what);
+	args[2] = Val_int(percent);
+	args[3] = caml_copy_int64(done);
+	args[4] = caml_copy_int64(total);
+
+	caml_callbackN(*func, 5, args);
+}
+
+static void xtl_destroy(struct xentoollog_logger *logger)
+{
+	struct caml_xtl *xtl = (struct caml_xtl*)logger;
+	free(xtl->vmessage_cb);
+	free(xtl->progress_cb);
+	free(xtl);
+}
+
+/* external _create_logger: (string * string) -> handle = "stub_xtl_create_logger" */
+CAMLprim value stub_xtl_create_logger(value cbs)
+{
+	CAMLparam1(cbs);
+	struct caml_xtl *xtl = malloc(sizeof(*xtl));
+	if (xtl == NULL)
+		caml_raise_out_of_memory();
+
+	memset(xtl, 0, sizeof(*xtl));
+
+	xtl->vtable.vmessage = &stub_xtl_ocaml_vmessage;
+	xtl->vtable.progress = &stub_xtl_ocaml_progress;
+	xtl->vtable.destroy = &xtl_destroy;
+
+	xtl->vmessage_cb = dup_String_val(Field(cbs, 0));
+	xtl->progress_cb = dup_String_val(Field(cbs, 1));
+	CAMLreturn((value)xtl);
+}
+
+/* external destroy: handle -> unit = "stub_xtl_destroy" */
+CAMLprim value stub_xtl_destroy(value handle)
+{
+	CAMLparam1(handle);
+	xtl_logger_destroy(XTL);
+	CAMLreturn(Val_unit);
+}
+
+/* external test: handle -> unit = "stub_xtl_test" */
+CAMLprim value stub_xtl_test(value handle)
+{
+	unsigned long l;
+	CAMLparam1(handle);
+	xtl_log(XTL, XTL_DEBUG, -1, "debug", "%s -- debug", __func__);
+	xtl_log(XTL, XTL_INFO, -1, "test", "%s -- test 1", __func__);
+	xtl_log(XTL, XTL_INFO, ENOSYS, "test errno", "%s -- test 2", __func__);
+	xtl_log(XTL, XTL_CRITICAL, -1, "critical", "%s -- critical", __func__);
+	for (l = 0UL; l<=100UL; l += 10UL) {
+		xtl_progress(XTL, "progress", "testing", l, 100UL);
+		usleep(10000);
+	}
+	CAMLreturn(Val_unit);
+}
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/test/Makefile
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/Makefile	Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,27 @@
+XEN_ROOT = $(CURDIR)/../../..
+OCAML_TOPLEVEL = $(CURDIR)/..
+include $(OCAML_TOPLEVEL)/common.make
+
+OCAMLINCLUDE += \
+	-I $(OCAML_TOPLEVEL)/libs/xentoollog
+
+OBJS = xtl
+
+PROGRAMS = xtl
+
+xtl_LIBS =  \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa
+
+xtl_OBJS = xtl
+
+OCAML_PROGRAM = xtl
+
+all: $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+install: all
+	$(INSTALL_DIR) $(DESTDIR)$(BINDIR)
+	$(INSTALL_PROG) $(PROGRAMS) $(DESTDIR)$(BINDIR)
+
+include $(OCAML_TOPLEVEL)/Makefile.rules
diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/test/xtl.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/xtl.ml	Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,20 @@
+open Arg
+open Xentoollog
+  
+let do_test level = 
+  let lgr = Xentoollog.create_stdio_logger ~level:level () in
+  begin
+    Xentoollog.test lgr;
+    Xentoollog.destroy lgr;
+  end
+
+let () =
+  let debug_level = ref Xentoollog.Info in
+  let speclist = [
+    ("-v", Arg.Unit (fun () -> debug_level := Xentoollog.Debug), "Verbose");
+    ("-q", Arg.Unit (fun () -> debug_level := Xentoollog.Critical), "Quiet");
+  ] in
+  let usage_msg = "usage: xtl [OPTIONS]" in
+  Arg.parse speclist (fun s -> ()) usage_msg;
+
+  do_test !debug_level

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 11 of 15] libxl: ocaml: allocate a long lived libxl context
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (9 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only) Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 12 of 15] libxl: ocaml: switch all functions over to take a context Ian Campbell
                   ` (13 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# 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

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 12 of 15] libxl: ocaml: switch all functions over to take a context
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (10 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 11 of 15] libxl: ocaml: allocate a long lived libxl context Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 13 of 15] libxl: ocaml: propagate the libxl return error code in exceptions Ian Campbell
                   ` (12 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID e4525795eac22c7d199ceae8714e95ed660a00c4
# Parent  bdd9c3e423d7f505f93edf413a92ad7b47ed9e39
libxl: ocaml: switch all functions over to take a context.

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>

diff -r bdd9c3e423d7 -r e4525795eac2 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -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)"),
     # This is an opaque type
-    "libxl_cpuid_policy_list": ("Cpuid_policy.t",      "Cpuid_policy_list_val(gc, lg, &%(c)s, %(o)s)",   "Val_cpuid_policy_list(%(c)s)"),    
+    "libxl_cpuid_policy_list": ("Cpuid_policy.t",      "Cpuid_policy_list_val(&%(c)s, %(o)s)",   "Val_cpuid_policy_list(%(c)s)"),    
     }
 
-DEVICE_FUNCTIONS = [ ("add",            ["t", "domid", "unit"]),
-                     ("remove",         ["t", "domid", "unit"]),
-                     ("destroy",        ["t", "domid", "unit"]),
+DEVICE_FUNCTIONS = [ ("add",            ["handle", "t", "domid", "unit"]),
+                     ("remove",         ["handle", "t", "domid", "unit"]),
+                     ("destroy",        ["handle", "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",            ["handle", "t"]),
                       ],
-    "cputopology":    [ ("get",            ["unit", "t array"]),
+    "cputopology":    [ ("get",            ["handle", "t array"]),
                       ],
     "domain_sched_params":
-                      [ ("get",            ["domid", "t"]),
-                        ("set",            ["domid", "t", "unit"]),
+                      [ ("get",            ["handle", "domid", "t"]),
+                        ("set",            ["handle", "domid", "t", "unit"]),
                       ],
 }
 def stub_fn_name(ty, name):
@@ -228,7 +228,7 @@ def c_val(ty, c, o, indent="", parent = 
         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"
@@ -241,7 +241,7 @@ def c_val(ty, c, o, indent="", parent = 
                                                     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"
@@ -257,7 +257,7 @@ def c_val(ty, c, o, indent="", parent = 
                 s += "%s" % c_val(f.type, fexpr, 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 += "}"
@@ -270,14 +270,14 @@ def c_val(ty, c, o, indent="", parent = 
             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"
@@ -326,7 +326,7 @@ def ocaml_Val(ty, o, c, indent="", paren
         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
@@ -347,7 +347,7 @@ def ocaml_Val(ty, o, c, indent="", paren
                 #s += "\t        %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n)
             s += "\t        break;\n"
             n += 1
-        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"
@@ -375,14 +375,14 @@ def ocaml_Val(ty, o, c, indent="", paren
             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(ctx, %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 (libxl_ctx *ctx, %s)\n" % (ty.rawname, ty.make_arg(ty.rawname+"_c"))
     s += "{\n"
     s += "\tCAMLparam0();\n"
     s += "\tCAMLlocal1(%s_ocaml);\n" % ty.rawname
diff -r bdd9c3e423d7 -r e4525795eac2 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
@@ -37,4 +37,4 @@ external send_trigger : domid -> trigger
 external send_sysrq : 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 -r bdd9c3e423d7 -r e4525795eac2 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
@@ -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
 	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)
@@ -111,7 +60,7 @@ CAMLprim value stub_libxl_ctx_alloc(valu
 	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);
+		failwith_xl("cannot init context");
 	caml_leave_blocking_section();
 	CAMLreturn((value)ctx);
 }
@@ -127,16 +76,6 @@ CAMLprim value stub_libxl_ctx_free(value
 	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;
@@ -147,8 +86,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);
@@ -158,24 +96,22 @@ static int libxl_key_value_list_val(caml
 
 	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;
@@ -183,12 +119,12 @@ static int libxl_string_list_val(caml_gc
 
 	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);
@@ -221,7 +157,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;
@@ -248,10 +184,20 @@ static value Val_bitmap (libxl_bitmap *c
 	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);
+
+	if (!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_cpuid_policy_list(libxl_cpuid_policy_list c_val)
@@ -261,8 +207,7 @@ static value Val_cpuid_policy_list(libxl
 	CAMLreturn((value)c_val);
 }
 
-static int Cpuid_policy_list_val(caml_gc *gc, struct caml_logger *lg,
-				 libxl_cpuid_policy_list *c_val, value v)
+static int Cpuid_policy_list_val(libxl_cpuid_policy_list *c_val, value v)
 {
 	CAMLparam1(v);
 
@@ -287,7 +232,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;
@@ -345,14 +290,12 @@ 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);
+		failwith_xl("list_domain");
 
 	cli = Val_emptylist;
 
@@ -360,7 +303,7 @@ value stub_libxl_list_domain(value ctx)
 		cons = caml_alloc(2, 0);
 
 		/* Head */
-		Store_field(cons, 0, Val_dominfo(&gc, NULL, &info[i]));
+		Store_field(cons, 0, Val_dominfo(CTX, &info[i]));
 		/* Tail */
 		Store_field(cons, 1, cli);
 
@@ -369,259 +312,77 @@ value stub_libxl_list_domain(value ctx)
 
 	libxl_dominfo_list_free(info, nr);
 
-	gc_free(&gc);
-
 	CAMLreturn(cli);
 }
 
-value stub_xl_device_disk_add(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_disk c_info;
-	int ret;
-	INIT_STRUCT();
+#define _STRINGIFY(x) #x
+#define STRINGIFY(x) _STRINGIFY(x)
 
-	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);
+#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);						\
 }
 
-value stub_xl_device_disk_del(value info, value domid)
+#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)
 {
-	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)
-{
-	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;
-	int ret;
-	INIT_STRUCT();
-
-	device_pci_val(&gc, &lg, &c_info, info);
-
-	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);
-}
-
-value stub_xl_device_pci_remove(value info, value domid)
-{
-	CAMLparam2(info, domid);
-	libxl_device_pci c_info;
-	int ret;
-	INIT_STRUCT();
-
-	device_pci_val(&gc, &lg, &c_info, info);
-
-	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);
+	CAMLparam1(ctx);
 	CAMLlocal1(physinfo);
 	libxl_physinfo c_physinfo;
 	int ret;
-	INIT_STRUCT();
 
-	INIT_CTX();
-	ret = libxl_get_physinfo(ctx, &c_physinfo);
+	ret = libxl_get_physinfo(CTX, &c_physinfo);
+
 	if (ret != 0)
-		failwith_xl("physinfo", &lg);
-	FREE_CTX();
+		failwith_xl("get_physinfo");
 
-	physinfo = Val_physinfo(&gc, &lg, &c_physinfo);
+	physinfo = Val_physinfo(CTX, &c_physinfo);
+
+	libxl_physinfo_dispose(&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(CTX, &c_topology[i]));
 		else
 			v = Val_none;
 		Store_field(topology, i, v);
@@ -629,74 +390,72 @@ 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(&gc, &lg, &c_scinfo);
+	scinfo = Val_domain_sched_params(CTX, &c_scinfo);
+
+	libxl_domain_sched_params_dispose(&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);
 
-	INIT_CTX();
-	ret = libxl_domain_sched_params_set(ctx, Int_val(domid), &c_scinfo);
+	ret = libxl_domain_sched_params_set(CTX, Int_val(domid), &c_scinfo);
+
+	libxl_domain_sched_params_dispose(&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);
 
-	INIT_CTX();
-	ret = libxl_send_trigger(ctx, Int_val(domid), c_trigger, Int_val(vcpuid));
+	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);
 }
 
@@ -706,11 +465,11 @@ value stub_xl_send_debug_keys(value ctx,
 	int ret;
 	char *c_keys;
 
-	c_keys = dup_String_val(NULL, keys);
+	c_keys = dup_String_val(keys);
 
 	ret = libxl_send_debug_keys(CTX, c_keys);
 	if (ret != 0)
-		failwith_xl("send_debug_keys", NULL);
+		failwith_xl("send_debug_keys");
 
 	free(c_keys);

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 13 of 15] libxl: ocaml: propagate the libxl return error code in exceptions
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (11 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 12 of 15] libxl: ocaml: switch all functions over to take a context Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-30 11:13   ` Rob Hoes
  2012-11-20 17:23 ` [PATCH 14 of 15] libxl: ocaml: generate libxl_domain_config bindings Ian Campbell
                   ` (11 subsequent siblings)
  24 siblings, 1 reply; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID c8d22bfef298ce525c98b5a3f0c394068ab01572
# Parent  e4525795eac22c7d199ceae8714e95ed660a00c4
libxl: ocaml: propagate the libxl return error code in exceptions

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

diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -228,7 +228,7 @@ def c_val(ty, c, o, indent="", parent = 
         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\"); break;\n" % ty.typename
+        s += "    default: failwith_xl(ERROR_FAIL, \"cannot convert value to %s\"); break;\n" % ty.typename
         s += "}"
     elif isinstance(ty, idl.KeyedUnion):
         s += "{\n"
@@ -241,7 +241,7 @@ def c_val(ty, c, o, indent="", parent = 
                                                     parent + ty.keyvar.name,
                                                     f.enumname)
             n += 1
-        s += "\t\t    default: failwith_xl(\"variant handling bug %s%s (long)\"); break;\n" % (parent, ty.keyvar.name)        
+        s += "\t\t    default: failwith_xl(ERROR_FAIL, \"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"
@@ -257,7 +257,7 @@ def c_val(ty, c, o, indent="", parent = 
                 s += "%s" % c_val(f.type, fexpr, o, indent=indent+"\t\t        ")
                 s += "break;\n"
             n += 1
-        s += "\t\t    default: failwith_xl(\"variant handling bug %s%s (block)\"); break;\n" % (parent, ty.keyvar.name)
+        s += "\t\t    default: failwith_xl(ERROR_FAIL, \"variant handling bug %s%s (block)\"); break;\n" % (parent, ty.keyvar.name)
         s += "\t\t}\n"
         s += "\t}\n"
         s += "}"
@@ -326,7 +326,7 @@ def ocaml_Val(ty, o, c, indent="", paren
         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\"); break;\n" % ty.typename
+        s += "    default: failwith_xl(ERROR_FAIL, \"cannot convert value from %s\"); break;\n" % ty.typename
         s += "}"
     elif isinstance(ty, idl.KeyedUnion):
         n = 0
@@ -347,7 +347,7 @@ def ocaml_Val(ty, o, c, indent="", paren
                 #s += "\t        %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n)
             s += "\t        break;\n"
             n += 1
-        s += "\t    default: failwith_xl(\"cannot convert value from %s\"); break;\n" % ty.typename
+        s += "\t    default: failwith_xl(ERROR_FAIL, \"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"
diff -r e4525795eac2 -r c8d22bfef298 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
@@ -15,7 +15,47 @@
 
 open Xentoollog
 
-exception Error of string
+type error = 
+    Nonspecific |
+    Version |
+    Fail |
+    Ni |
+    Nomem |
+    Inval |
+    Badfail |
+    Guest_Timedout |
+    Timedout |
+    Noparavirt |
+    Not_Ready |
+    Osevent_Reg_Fail |
+    Bufferfull |
+    Unknown_Child
+
+let string_of_error error =
+  match error with
+  | Nonspecific -> "Non specific"
+  | Version -> "Version"
+  | Fail -> "Fail"
+  | Ni -> "Ni"
+  | Nomem -> "Nomem"
+  | Inval -> "Inval"
+  | Badfail -> "Badfail"
+  | Guest_Timedout -> "Guest Timedout"
+  | Timedout -> "Timedout"
+  | Noparavirt -> "Noparavirt"
+  | Not_Ready -> "Not Ready"
+  | Osevent_Reg_Fail -> "Osevent Reg Fail"
+  | Bufferfull -> "Bufferfull"
+  | Unknown_Child -> "Unknown Child"
+
+exception Error of (error * string)
+
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
+
+external test_raise_exception: unit -> unit = "stub_raise_exception"
 
 type domid = int
 type devid = int
@@ -26,15 +66,10 @@ 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 : ctx -> string -> unit = "stub_xl_send_debug_keys"
 
-let _ = Callback.register_exception "Xenlight.Error" (Error(""))
+let _ = Callback.register_exception "Xenlight.Error" (Error(Fail, ""))
diff -r e4525795eac2 -r c8d22bfef298 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
@@ -15,7 +15,32 @@
 
 open Xentoollog
 
-exception Error of string
+type error = 
+    Nonspecific |
+    Version |
+    Fail |
+    Ni |
+    Nomem |
+    Inval |
+    Badfail |
+    Guest_Timedout |
+    Timedout |
+    Noparavirt |
+    Not_Ready |
+    Osevent_Reg_Fail |
+    Bufferfull |
+    Unknown_Child
+
+val string_of_error: error -> string
+
+exception Error of (error * string)
+
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
+
+external test_raise_exception: unit = "stub_raise_exception"
 
 type domid = int
 type devid = int
@@ -24,9 +49,6 @@ type devid = int
 
 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"
diff -r e4525795eac2 -r c8d22bfef298 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
@@ -43,12 +43,54 @@ static char * dup_String_val(value s)
 	return c;
 }
 
-static void failwith_xl(char *fname)
+static value Val_error(int error)
 {
+	switch (error) {
+	case ERROR_NONSPECIFIC: return Val_int(0);
+	case ERROR_VERSION:     return Val_int(1);
+	case ERROR_FAIL:        return Val_int(2);
+	case ERROR_NI:          return Val_int(3);
+	case ERROR_NOMEM:       return Val_int(4);
+	case ERROR_INVAL:       return Val_int(5);
+	case ERROR_BADFAIL:     return Val_int(6);
+	case ERROR_GUEST_TIMEDOUT: return Val_int(7);
+	case ERROR_TIMEDOUT:    return Val_int(8);
+	case ERROR_NOPARAVIRT:  return Val_int(9);
+	case ERROR_NOT_READY:   return Val_int(10);
+	case ERROR_OSEVENT_REG_FAIL: return Val_int(11);
+	case ERROR_BUFFERFULL:  return Val_int(12);
+	case ERROR_UNKNOWN_CHILD: return Val_int(13);
+#if 0 /* Let the compiler catch this */
+	default:
+		caml_raise_sys_error(caml_copy_string("Unknown libxl ERROR"));
+		break;
+#endif
+	}
+	/* Should not reach here */
+	abort();
+}
+
+static void failwith_xl(int error, char *fname)
+{
+	CAMLlocal1(arg);
 	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);
+
+	arg = caml_alloc_small(2, 0);
+
+	Field(arg, 0) = Val_error(error);
+	Field(arg, 1) = caml_copy_string(fname);
+
+	caml_raise_with_arg(*exc, arg);
+}
+
+CAMLprim value stub_raise_exception(value unit)
+{
+	CAMLparam1(unit);
+	failwith_xl(ERROR_FAIL, "test exception");
+	CAMLreturn(Val_unit);
 }
 
 CAMLprim value stub_libxl_ctx_alloc(value logger)
@@ -60,7 +102,7 @@ CAMLprim value stub_libxl_ctx_alloc(valu
 	caml_enter_blocking_section();
 	ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *) logger);
 	if (ret != 0) \
-		failwith_xl("cannot init context");
+		failwith_xl(ERROR_FAIL, "cannot init context");
 	caml_leave_blocking_section();
 	CAMLreturn((value)ctx);
 }
@@ -190,7 +232,7 @@ static int Bitmap_val(libxl_ctx *ctx, li
 	int i, len = Wosize_val(v);
 
 	if (!libxl_bitmap_alloc(ctx, c_val, len))
-		failwith_xl("cannot allocate bitmap");
+		failwith_xl(ERROR_NOMEM, "cannot allocate bitmap");
 	for (i=0; i<len; i++) {
 		if (Int_val(Field(v, i)))
 			libxl_bitmap_set(c_val, i);
@@ -295,7 +337,7 @@ value stub_libxl_list_domain(value ctx)
 
 	info = libxl_list_domain(CTX, &nr);
 	if (info == NULL)
-		failwith_xl("list_domain");
+		failwith_xl(ERROR_FAIL, "list_domain");
 
 	cli = Val_emptylist;
 
@@ -332,7 +374,7 @@ value stub_xl_device_##type##_##op(value
 	libxl_device_##type##_dispose(&c_info);				\
 									\
 	if (ret != 0)							\
-		failwith_xl(STRINGIFY(type) "_" STRINGIFY(op));		\
+		failwith_xl(ret, STRINGIFY(type) "_" STRINGIFY(op));	\
 									\
 	CAMLreturn(Val_unit);						\
 }
@@ -358,7 +400,7 @@ value stub_xl_physinfo_get(value ctx)
 	ret = libxl_get_physinfo(CTX, &c_physinfo);
 
 	if (ret != 0)
-		failwith_xl("get_physinfo");
+		failwith_xl(ret, "get_physinfo");
 
 	physinfo = Val_physinfo(CTX, &c_physinfo);
 
@@ -377,7 +419,7 @@ value stub_xl_cputopology_get(value ctx)
 	c_topology = libxl_get_cpu_topology(CTX, &nr);
 
 	if (!c_topology)
-		failwith_xl("topologyinfo");
+		failwith_xl(ERROR_FAIL, "get_cpu_topologyinfo");
 
 	topology = caml_alloc_tuple(nr);
 	for (i = 0; i < nr; i++) {
@@ -402,7 +444,7 @@ value stub_xl_domain_sched_params_get(va
 
 	ret = libxl_domain_sched_params_get(CTX, Int_val(domid), &c_scinfo);
 	if (ret != 0)
-		failwith_xl("domain_sched_params_get");
+		failwith_xl(ret, "domain_sched_params_get");
 
 	scinfo = Val_domain_sched_params(CTX, &c_scinfo);
 
@@ -424,7 +466,7 @@ value stub_xl_domain_sched_params_set(va
 	libxl_domain_sched_params_dispose(&c_scinfo);
 
 	if (ret != 0)
-		failwith_xl("domain_sched_params_set");
+		failwith_xl(ret, "domain_sched_params_set");
 
 	CAMLreturn(Val_unit);
 }
@@ -441,7 +483,7 @@ value stub_xl_send_trigger(value ctx, va
 				 c_trigger, Int_val(vcpuid));
 
 	if (ret != 0)
-		failwith_xl("send_trigger");
+		failwith_xl(ret, "send_trigger");
 
 	CAMLreturn(Val_unit);
 }
@@ -454,7 +496,7 @@ value stub_xl_send_sysrq(value ctx, valu
 	ret = libxl_send_sysrq(CTX, Int_val(domid), Int_val(sysrq));
 
 	if (ret != 0)
-		failwith_xl("send_sysrq");
+		failwith_xl(ret, "send_sysrq");
 
 	CAMLreturn(Val_unit);
 }
@@ -469,7 +511,7 @@ value stub_xl_send_debug_keys(value ctx,
 
 	ret = libxl_send_debug_keys(CTX, c_keys);
 	if (ret != 0)
-		failwith_xl("send_debug_keys");
+		failwith_xl(ret, "send_debug_keys");
 
 	free(c_keys);
 
diff -r e4525795eac2 -r c8d22bfef298 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
@@ -6,9 +6,9 @@ OCAMLINCLUDE += \
 	-I $(OCAML_TOPLEVEL)/libs/xentoollog \
 	-I $(OCAML_TOPLEVEL)/libs/xl
 
-OBJS = xtl send_debug_keys list_domains
+OBJS = xtl send_debug_keys list_domains raise_exception
 
-PROGRAMS = xtl send_debug_keys list_domains
+PROGRAMS = xtl send_debug_keys list_domains raise_exception
 
 xtl_LIBS =  \
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa
@@ -27,7 +27,13 @@ list_domains_LIBS =  \
 
 list_domains_OBJS = list_domains
 
-OCAML_PROGRAM = xtl send_debug_keys list_domains
+raise_exception_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
+
+raise_exception_OBJS = raise_exception
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
 
 all: $(PROGRAMS)
 
diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/list_domains.ml
--- a/tools/ocaml/test/list_domains.ml	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/test/list_domains.ml	Tue Nov 20 17:22:21 2012 +0000
@@ -19,8 +19,11 @@ let print_dominfo dominfo =
 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;
-
+  try
+    let domains = Xenlight.list_domain ctx in
+    List.iter (fun d -> print_dominfo d) domains;
+    Xenlight.ctx_free ctx;
+    Xentoollog.destroy logger;
+  with Xenlight.Error(err, fn) -> begin
+    printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn;
+  end
diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/raise_exception.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/raise_exception.ml	Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,15 @@
+open Printf
+open Xentoollog
+open Xenlight
+
+let _ = 
+  let logger = Xentoollog.create_stdio_logger (*~level:Xentoollog.Debug*) () in
+  let ctx = Xenlight.ctx_alloc logger in
+  try
+    Xenlight.test_raise_exception ()
+  with Xenlight.Error(err, fn) -> begin
+    printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn;
+  end;
+  Xenlight.ctx_free ctx;
+  Xentoollog.destroy logger;
+

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 14 of 15] libxl: ocaml: generate libxl_domain_config bindings
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (12 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 13 of 15] libxl: ocaml: propagate the libxl return error code in exceptions Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-20 17:23 ` [PATCH 15 of 15] libxl: ocaml: add bindings for libxl_domain_create_new Ian Campbell
                   ` (10 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 41f0137955f4a1a5a76ad34a5a6440e32d0090ef
# Parent  c8d22bfef298ce525c98b5a3f0c394068ab01572
libxl: ocaml: generate libxl_domain_config bindings

With the infrastructure we now have in place this is trivial.

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

diff -r c8d22bfef298 -r 41f0137955f4 tools/libxl/libxl_types.idl
--- a/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:21 2012 +0000
@@ -417,7 +417,7 @@ libxl_domain_config = Struct("domain_con
     ("on_reboot", libxl_action_on_shutdown),
     ("on_watchdog", libxl_action_on_shutdown),
     ("on_crash", libxl_action_on_shutdown),
-    ])
+    ], dir=DIR_IN)
 
 libxl_diskinfo = Struct("diskinfo", [
     ("backend", string),
diff -r c8d22bfef298 -r 41f0137955f4 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
@@ -420,7 +420,6 @@ if __name__ == '__main__':
     # Do not generate these yet.
     blacklist = [
         "cpupoolinfo",
-        "domain_config",
         "vcpuinfo",
         ]

^ permalink raw reply	[flat|nested] 39+ messages in thread

* [PATCH 15 of 15] libxl: ocaml: add bindings for libxl_domain_create_new
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (13 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 14 of 15] libxl: ocaml: generate libxl_domain_config bindings Ian Campbell
@ 2012-11-20 17:23 ` Ian Campbell
  2012-11-26 14:01 ` [PATCH 00 of 15] libxl: ocaml: improve the bindings Rob Hoes
                   ` (9 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-20 17:23 UTC (permalink / raw)
  To: xen-devel, xen-api

# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 72376896ba08bb7035ad4b7ed5a91c2c1b45b905
# Parent  41f0137955f4a1a5a76ad34a5a6440e32d0090ef
libxl: ocaml: add bindings for libxl_domain_create_new

** NOT TO BE APPLIED **

Add a simple stub thing which should build a domain. Except it is
incomplete and doesn't actually build. Hence RFC.

It's a bit tedious to have to give empty values for everything. This
suggests that a better API would be for anything in the libxl API
which has the concept of a default type should be a FOO option in the
ocaml binding. Or is that tedious on the ocaml side?

Or is there some way to declare only a partially initialised struct
in ocaml (in a way which can be sensibly marshalled to C).

diff -r 41f0137955f4 -r 72376896ba08 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
@@ -72,4 +72,6 @@ external send_trigger : domid -> trigger
 external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
 external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
 
+external domain_create_new : ctx -> Domain_config.t -> domid = "stub_xl_domain_create_new"
+
 let _ = Callback.register_exception "Xenlight.Error" (Error(Fail, ""))
diff -r 41f0137955f4 -r 72376896ba08 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
@@ -54,3 +54,6 @@ external list_domain: ctx -> Dominfo.t l
 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 : ctx -> string -> unit = "stub_xl_send_debug_keys"
+
+/* XXX: const libxl_asyncop_how *ao_how, const libxl_asyncprogress_how *aop_console_how */
+external domain_create_new :ctx -> Domain_config.t -> domid = "stub_xl_domain_create_new"
diff -r 41f0137955f4 -r 72376896ba08 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
@@ -518,6 +518,23 @@ value stub_xl_send_debug_keys(value ctx,
 	CAMLreturn(Val_unit);
 }
 
+value stub_xl_domain_create_new(value ctx, value domain_config)
+{
+	CAMLparam2(ctx, domain_config);
+	int ret;
+	libxl_domain_config c_dconfig;
+	uint32_t c_domid;
+
+	ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid,
+				      NULL, NULL);
+	if (ret != 0)
+		failwith_xl(ret, "domain_create_new");
+
+	libxl_domain_config_dispose(&c_dconfig);
+
+	CAMLreturn(Val_int(c_domid));
+}
+
 /*
  * Local variables:
  *  indent-tabs-mode: t
diff -r 41f0137955f4 -r 72376896ba08 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
@@ -6,9 +6,9 @@ OCAMLINCLUDE += \
 	-I $(OCAML_TOPLEVEL)/libs/xentoollog \
 	-I $(OCAML_TOPLEVEL)/libs/xl
 
-OBJS = xtl send_debug_keys list_domains raise_exception
+OBJS = xtl send_debug_keys list_domains raise_exception build_domain
 
-PROGRAMS = xtl send_debug_keys list_domains raise_exception
+PROGRAMS = xtl send_debug_keys list_domains raise_exception build_domain
 
 xtl_LIBS =  \
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa
@@ -33,7 +33,13 @@ raise_exception_LIBS =  \
 
 raise_exception_OBJS = raise_exception
 
-OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
+build_domain_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
+
+build_domain_OBJS = build_domain
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception build_domain
 
 all: $(PROGRAMS)
 
diff -r 41f0137955f4 -r 72376896ba08 tools/ocaml/test/build_domain.ml
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/build_domain.ml	Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,42 @@
+open Arg
+open Printf
+open Xentoollog
+open Xenlight
+
+let _ = 
+  let logger = Xentoollog.create_stdio_logger ~level:Xentoollog.Debug () in
+  let ctx = Xenlight.ctx_alloc logger in
+  let c_info = {
+    Xenlight.Domain_create_info.hap = None;
+    Xenlight.Domain_create_info.oos = None;
+    Xenlight.Domain_create_info.name = "Test;
+  }
+  and b_info = {
+    Xenlight.Domain_build_info.max_vcpus = 1;
+    Xenlight.Domain_build_info.avail_vcpus = [| |];
+    Xenlight.Domain_build_info.cpumap = [| |];
+    Xenlight.Domain_build_info.numa_placement = None;
+    Xenlight.Domain_build_info.tsc_mode = Xenlight.TSC_MODE_DEFAULT;
+    Xenlight.Domain_build_info.max_memkb = 1024L;
+    Xenlight.Domain_build_info.target_memkb = 1024L;
+    Xenlight.Domain_build_info.video_memkb = 0L;
+    Xenlight.Domain_build_info.shadow_memkb = 0L;
+    Xenlight.Domain_build_info.rtc_timeoffset = 0L;
+  } in
+  let d_info = {
+    Xenlight.Domain_config.b_info = b_info;
+    Xenlight.Domain_config.c_info = c_info;
+    Xenlight.Domain_config.disks = [| |];
+    Xenlight.Domain_config.nics = [| |];
+    Xenlight.Domain_config.vfbs = [| |];
+    Xenlight.Domain_config.vkbs = [| |];
+    Xenlight.Domain_config.pcidevs = [| |];
+    (*Xenlight.Domain_config.on_poweroff = Xenlight.Action_on_shutdown.dESTROY;*)
+  } in
+  try
+    Xenlight.domain_create_new ctx d_info;
+    Xenlight.ctx_free ctx;
+    Xentoollog.destroy logger;
+  with Xenlight.Error(err, fn) -> begin
+    printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn;
+  end

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 00 of 15] libxl: ocaml: improve the bindings
       [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
                   ` (14 preceding siblings ...)
  2012-11-20 17:23 ` [PATCH 15 of 15] libxl: ocaml: add bindings for libxl_domain_create_new Ian Campbell
@ 2012-11-26 14:01 ` Rob Hoes
       [not found] ` <0cf342afa9e6b506fad6.1353432207@cosworth.uk.xensource.com>
                   ` (8 subsequent siblings)
  24 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-26 14:01 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

Hi Ian,

> The following series makes the libxl ocaml bindings somewhat more useful
> (for some small value of useful).

Great timing: I am currently investigating how to port xenopsd/xapi to libxl (for XCP and XenServer), and have been playing with these bindings as well. I indeed noticed a few shortcomings and omissions.
 
> As well as defining some of the more useful types in the bindings they
> switch to a model of long lived libxl contexts rather than per-call ones. This
> is necessary to use the stuff like events, signal handling etc.

I think that is a good idea.

> I got half way through implementing a useful binding for building a domain
> before I got distracted by other things, hence posting what I have. Most of
> the early part of the series could go in, the last couple of patches probably
> need more work.
> 
> There are plenty of code paths here which have never been even slightly
> exercised. This is true of these bindings in general I think.

I'll use your patches as a base for my own improvements to the bindings. Thanks for releasing these.

Cheers,
Rob

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 02 of 15] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
       [not found] ` <8195cb0ebac691ae94e9.1353432202@cosworth.uk.xensource.com>
@ 2012-11-26 14:18   ` Rob Hoes
  2012-11-29 16:23   ` Rob Hoes
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107AB@LONPMAILBOX01.citrite.net>
  2 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-26 14:18 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> 8195cb0ebac691ae94e97939362f4d345891b4a7
> # Parent  601dc257a740d3a6047667731007283a4dcb9600
> libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
> 
> libxl_dominfo.shutdown_reason is valid iff (shutdown||dying). This is a bit
> annoying when generating language bindings since it needs all sorts of
> special casing. Just introduce an explicit value instead.

I have a patch in my queue that is almost identical to this one, for exactly this reason.
It is very handy for the ocaml binding to have all possible values of an enum explicitly
defined in this way.

Cheers,
Rob

> Signed-off-by: Ian Campbell <ian.cambell@citrix.com>
> 
> diff -r 601dc257a740 -r 8195cb0ebac6 tools/libxl/libxl.c
> --- a/tools/libxl/libxl.c	Tue Nov 20 17:22:16 2012 +0000
> +++ b/tools/libxl/libxl.c	Tue Nov 20 17:22:21 2012 +0000
> @@ -526,7 +526,7 @@ static void xcinfo2xlinfo(const xc_domai
>      if (xlinfo->shutdown || xlinfo->dying)
>          xlinfo->shutdown_reason = (xcinfo-
> >flags>>XEN_DOMINF_shutdownshift) & XEN_DOMINF_shutdownmask;
>      else
> -        xlinfo->shutdown_reason  = ~0;
> +        xlinfo->shutdown_reason = LIBXL_SHUTDOWN_REASON_UNKNOWN;
> 
>      xlinfo->current_memkb = PAGE_TO_MEMKB(xcinfo->tot_pages);
>      xlinfo->shared_memkb = PAGE_TO_MEMKB(xcinfo->shr_pages); diff -r
> 601dc257a740 -r 8195cb0ebac6 tools/libxl/libxl_types.idl
> --- a/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:16 2012 +0000
> +++ b/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:21 2012 +0000
> @@ -118,14 +118,15 @@ libxl_scheduler = Enumeration("scheduler
>      (7, "arinc653"),
>      ])
> 
> -# Consistent with SHUTDOWN_* in sched.h
> +# Consistent with SHUTDOWN_* in sched.h (apart from UNKNOWN)
>  libxl_shutdown_reason = Enumeration("shutdown_reason", [
> +    (-1, "unknown"),
>      (0, "poweroff"),
>      (1, "reboot"),
>      (2, "suspend"),
>      (3, "crash"),
>      (4, "watchdog"),
> -    ])
> +    ], init_val = "LIBXL_SHUTDOWN_REASON_UNKNOWN")
> 
>  libxl_vga_interface_type = Enumeration("vga_interface_type", [
>      (1, "CIRRUS"),
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator
       [not found] ` <0cf342afa9e6b506fad6.1353432207@cosworth.uk.xensource.com>
@ 2012-11-26 15:31   ` Rob Hoes
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107A4@LONPMAILBOX01.citrite.net>
  2012-11-29 16:54   ` Rob Hoes
  2 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-26 15:31 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> 0cf342afa9e6b506fad68346cb3a1207030372eb
> # Parent  f618acdeea1bf60b3b68da4062de018d8162fe8c
> libxl: ocaml: support for KeyedUnion in the bindings generator.
> 
> A KeyedUnion consists of two fields in the containing struct. First an enum
> field ("e") used as a descriminator and second a union ("u") containing
> potentially anonymous structs associated with each enum value.
> 
> We map the anonymous structs to structs named after the descriminator
> field ("e") and the specific enum values. We then declare an ocaml variant
> type name e__union mapping each enum value to its associated struct.
> 
> So given IDL:
> 
>  foo = Enumeration("foo",
> 	(0, "BAR"),
> 	(1, "BAZ"),
>  s = Struct("s", [
>         ("u", KeyedUnion(none, foo, "blargle", [
> 		("bar", Struct(...xxx...)),
> 		("baz", Struct(...yyy...)),
> 	])),
>  ])
> 
> We generate C:
> 
>  enum { FOO, BAR } foo;
>  struct s {
>  	enum foo blargle;
>  	union {
>  		struct { ...xxx... } bar;
>  		struct { ...yyy... } baz;
>  	} u;
>  }
> 
> and map this to ocaml
> 
>  type foo = BAR | BAZ;
> 
>  module	s = Struct
> 
>  	type blargle_bar = ...xxx...;
> 
>  	type blargle_baz = ...yyy...;
> 
>  	type blargle__union = Bar of blargle_bar | Baz of blargle_baz;
> 
>  	type t =
>  	{
>  		blargle : blargle__union;
>  	}
> 
> These type names are OK because they are already within the namespace
> associated with the struct "s".

I think this is a useful representation of KeyedUnion types in ocaml.
I'll play around a bit with this implementation.

Cheers,
Rob
 
> If the struct assiated with bar is empty then we don't bother iwht
> blargle_bar of "of blargle_bar".
> 
> No actually change in the gnerated code since we don't generated any
> KeyedUnions yet.
> 
> The actual implementation was inspired by http://www.linux-
> nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php#ref_constvrnt
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
> 
> diff -r f618acdeea1b -r 0cf342afa9e6 tools/libxl/idl.py
> --- a/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -216,6 +216,9 @@ class Struct(Aggregate):
>          kwargs.setdefault('passby', PASS_BY_REFERENCE)
>          Aggregate.__init__(self, "struct", name, fields, **kwargs)
> 
> +    def has_fields(self):
> +        return len(self.fields) != 0
> +
>  class Union(Aggregate):
>      def __init__(self, name, fields, **kwargs):
>          # Generally speaking some intelligence is required to free a diff -r
> f618acdeea1b -r 0cf342afa9e6 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -65,6 +65,8 @@ def ocaml_type_of(ty):
>          if not typename:
>              raise NotImplementedError("No typename for Builtin %s (%s)" %
> (ty.typename, type(ty)))
>          return typename
> +    elif isinstance(ty,idl.KeyedUnion):
> +        return ty.union_name
>      elif isinstance(ty,idl.Aggregate):
>          return ty.rawname.capitalize() + ".t"
>      else:
> @@ -76,8 +78,67 @@ def munge_name(name):
>      else:
>          return name
> 
> -def ocaml_instance_of(type, name):
> -    return "%s : %s" % (munge_name(name), ocaml_type_of(type))
> +def ocaml_instance_of_field(f):
> +    if isinstance(f.type, idl.KeyedUnion):
> +        name = f.type.keyvar.name
> +    else:
> +        name = f.name
> +    return "%s : %s" % (munge_name(name), ocaml_type_of(f.type))
> +
> +def gen_struct(ty):
> +    s = ""
> +    for f in ty.fields:
> +        if f.type.private:
> +            continue
> +        x = ocaml_instance_of_field(f)
> +        x = x.replace("\n", "\n\t\t")
> +        s += "\t\t" + x + ";\n"
> +    return s
> +
> +def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
> +    s = ""
> +
> +    if ty.rawname is not None:
> +        # Non-anonymous types need no special handling
> +        pass
> +    elif isinstance(ty, idl.KeyedUnion):
> +        if parent is None:
> +            nparent = ty.keyvar.name
> +        else:
> +            nparent = parent + "_" + ty.keyvar.name
> +
> +        for f in ty.fields:
> +            if f.type is None: continue
> +            if f.type.rawname is not None: continue
> +            if isinstance(f.type, idl.Struct) and not f.type.has_fields(): continue
> +            s += "\ntype %s_%s =\n" % (nparent,f.name)
> +            s += "{\n"
> +            s += gen_struct(f.type)
> +            s += "}\n"
> +
> +        name = "%s__union" % ty.keyvar.name
> +        s += "\n"
> +        s += "type %s = " % name
> +        u = []
> +        for f in ty.fields:
> +            if f.type is None:
> +                u.append("%s" % (f.name.capitalize()))
> +            elif isinstance(f.type, idl.Struct):
> +                if f.type.rawname is not None:
> +                    u.append("%s of %s" % (f.name.capitalize(),
> f.type.rawname.capitalize()))
> +                elif f.type.has_fields():
> +                    u.append("%s of %s_%s" % (f.name.capitalize(), nparent,
> f.name))
> +                else:
> +                    u.append("%s" % (f.name.capitalize()))
> +            else:
> +                raise NotImplementedError("Cannot handle KeyedUnion
> + fields which are not Structs")
> +
> +        s += " | ".join(u) + "\n"
> +        ty.union_name = name
> +
> +    if s == "":
> +        return None
> +    return s.replace("\n", "\n%s" % indent)
> 
>  def gen_ocaml_ml(ty, interface, indent=""):
> 
> @@ -103,16 +164,17 @@ def gen_ocaml_ml(ty, interface, indent="
>                  s += "module %s : sig\n" % module_name
>              else:
>                  s += "module %s = struct\n" % module_name
> -            s += "\ttype t =\n"
> -            s += "\t{\n"
> -
> +
> +        # Handle KeyedUnions...
>          for f in ty.fields:
> -            if f.type.private:
> -                continue
> -            x = ocaml_instance_of(f.type, f.name)
> -            x = x.replace("\n", "\n\t\t")
> -            s += "\t\t" + x + ";\n"
> +            ku = gen_ocaml_keyedunions(f.type, interface, "\t")
> +            if ku is not None:
> +                s += ku
> +                s += "\n"
> 
> +        s += "\ttype t =\n"
> +        s += "\t{\n"
> +        s += gen_struct(ty)
>          s += "\t}\n"
> 
>          if functions.has_key(ty.rawname):
> @@ -164,12 +226,43 @@ def c_val(ty, c, o, indent="", parent =
>              n += 1
>          s += "    default: failwith_xl(\"cannot convert value to %s\", lg);
> break;\n" % ty.typename
>          s += "}"
> -    elif isinstance(ty, idl.Aggregate) and (parent is None):
> +    elif isinstance(ty, idl.KeyedUnion):
> +        s += "{\n"
> +        s += "\tif(Is_long(%s)) {\n" % o
> +        n = 0
> +        s += "\t\tswitch(Int_val(%s)) {\n" % o
> +        for f in ty.fields:
> +            if f.type is None or not f.type.has_fields():
> +                s += "\t\t    case %d: %s = %s; break;\n" % (n,
> +                                                    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}\n"
> +        s += "\t} else {\n"
> +        s += "\t\t/* Is block... */\n"
> +        s += "\t\tswitch(Tag_val(%s)) {\n" % o
> +        n = 0
> +        for f in ty.fields:
> +            if f.type is not None and f.type.has_fields():
> +                if f.type.private:
> +                    continue
> +                s += "\t\t    case %d:\n" % (n)
> +                s += "\t\t        %s = %s;\n" % (parent + ty.keyvar.name, f.enumname)
> +                (nparent,fexpr) = ty.member(c, f, False)
> +                s += "%s" % c_val(f.type, fexpr, 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}\n"
> +        s += "\t}\n"
> +        s += "}"
> +    elif isinstance(ty, idl.Aggregate) and (parent is None or ty.rawname is
> None):
>          n = 0
>          for f in ty.fields:
>              if f.type.private:
>                  continue
> -            (nparent,fexpr) = ty.member(c, f, parent is None)
> +            (nparent,fexpr) = ty.member(c, f, ty.rawname is not None)
>              s += "%s\n" % c_val(f.type, fexpr, "Field(%s, %d)" % (o,n),
> parent=nparent)
>              n = n + 1
>      else:
> @@ -191,8 +284,8 @@ def gen_c_val(ty, indent=""):
>      s += "}\n"
> 
>      return s.replace("\n", "\n%s" % indent)
> -
> -def ocaml_Val(ty, o, c, indent="", parent = None):
> +
> +def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag = None):
>      s = indent
>      if isinstance(ty,idl.UInt):
>          if ty.width in [8, 16]:
> @@ -231,11 +324,39 @@ def ocaml_Val(ty, o, c, indent="", paren
>              n += 1
>          s += "    default: failwith_xl(\"cannot convert value from %s\", lg);
> break;\n" % ty.typename
>          s += "}"
> -    elif isinstance(ty,idl.Aggregate) and (parent is None):
> +    elif isinstance(ty, idl.KeyedUnion):
> +        n = 0
> +        s += "switch(%s) {\n" % (parent + ty.keyvar.name)
> +        for f in ty.fields:
> +            s += "\t    case %s:\n" % f.enumname
> +            if f.type is None:
> +                s += "\t        /* %d: None */\n" % n
> +                s += "\t        %s = Val_long(%d);\n" % (o,n)
> +            elif not f.type.has_fields():
> +                s += "\t        /* %d: Long */\n" % n
> +                s += "\t        %s = Val_long(%d);\n" % (o,n)
> +            else:
> +                s += "\t        /* %d: Block */\n" % n
> +                (nparent,fexpr) = ty.member(c, f, parent is None)
> +                s += ocaml_Val(f.type, o, fexpr, struct_tag = n, indent="\t        ",
> parent=nparent)
> +                s += "\n"
> +                #s += "\t        %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n)
> +            s += "\t        break;\n"
> +            n += 1
> +        s += "\t    default: failwith_xl(\"cannot convert value from %s\", lg);
> break;\n" % ty.typename
> +        s += "\t}"
> +    elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is
> None):
>          s += "{\n"
> -        s += "\tvalue %s_field;\n" % ty.rawname
> +        if ty.rawname is None:
> +            fn = "anon_field"
> +        else:
> +            fn = "%s_field" % ty.rawname
> +        s += "\tvalue %s;\n" % fn
>          s += "\n"
> -        s += "\t%s = caml_alloc_tuple(%d);\n" % (o, len(ty.fields))
> +        if struct_tag is not None:
> +            s += "\t%s = caml_alloc(%d,%d);\n" % (o, len(ty.fields), struct_tag)
> +        else:
> +            s += "\t%s = caml_alloc_tuple(%d);\n" % (o, len(ty.fields))
> 
>          n = 0
>          for f in ty.fields:
> @@ -245,8 +366,8 @@ def ocaml_Val(ty, o, c, indent="", paren
>              (nparent,fexpr) = ty.member(c, f, parent is None)
> 
>              s += "\n"
> -            s += "\t%s\n" % ocaml_Val(f.type, "%s_field" % ty.rawname,
> ty.pass_arg(fexpr, c), parent=nparent)
> -            s += "\tStore_field(%s, %d, %s);\n" % (o, n, "%s_field" % ty.rawname)
> +            s += "\t%s\n" % ocaml_Val(f.type, fn, ty.pass_arg(fexpr, c),
> parent=nparent)
> +            s += "\tStore_field(%s, %d, %s);\n" % (o, n, fn)
>              n = n + 1
>          s += "}"
>      else:
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 00 of 15] libxl: ocaml: improve the bindings
       [not found] ` <7EA643C653F17F4C80DE959E978F10EDFA101107A1@LONPMAILBOX01.citrite.net>
@ 2012-11-26 15:35   ` Ian Campbell
  2012-11-26 15:36   ` Ian Campbell
  1 sibling, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-26 15:35 UTC (permalink / raw)
  To: Rob Hoes; +Cc: xen-api@lists.xen.org, xen-devel@lists.xen.org

On Mon, 2012-11-26 at 14:01 +0000, Rob Hoes wrote:
> Hi Ian,
> 
> > The following series makes the libxl ocaml bindings somewhat more useful
> > (for some small value of useful).
> 
> Great timing: I am currently investigating how to port xenopsd/xapi to
> libxl (for XCP and XenServer),

Awesome!

>  and have been playing with these bindings as well. I indeed noticed a
> few shortcomings and omissions.

Hopefully they are somewhat fewer in number after this series ;-)

[...]
> I'll use your patches as a base for my own improvements to the bindings. Thanks for releasing these.

Cool, let me know if you have any trouble or I can do anything (the
binding generator is a bit of a beast for example).

Ian.

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107A4@LONPMAILBOX01.citrite.net>
@ 2012-11-26 15:35     ` Ian Campbell
  0 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-26 15:35 UTC (permalink / raw)
  To: Rob Hoes; +Cc: xen-api@lists.xen.org, xen-devel@lists.xen.org

On Mon, 2012-11-26 at 15:31 +0000, Rob Hoes wrote:
> I think this is a useful representation of KeyedUnion types in ocaml.
> I'll play around a bit with this implementation.

Thanks, one of the problem I have with these bindings is that although I
can clone and hack ocaml OK I'm not sure what constructs are expected by
proper ocaml programmers ;-)

Ian.

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 00 of 15] libxl: ocaml: improve the bindings
       [not found] ` <7EA643C653F17F4C80DE959E978F10EDFA101107A1@LONPMAILBOX01.citrite.net>
  2012-11-26 15:35   ` [PATCH 00 of 15] libxl: ocaml: improve the bindings Ian Campbell
@ 2012-11-26 15:36   ` Ian Campbell
  1 sibling, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-26 15:36 UTC (permalink / raw)
  To: Rob Hoes; +Cc: xen-api@lists.xen.org, xen-devel@lists.xen.org

On Mon, 2012-11-26 at 14:01 +0000, Rob Hoes wrote:
> I'll use your patches as a base for my own improvements to the bindings.

BTW, I'd happily commit any which you care to attach an "Acked-by" to.

Ian.

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 02 of 15] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
       [not found] ` <8195cb0ebac691ae94e9.1353432202@cosworth.uk.xensource.com>
  2012-11-26 14:18   ` [PATCH 02 of 15] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
@ 2012-11-29 16:23   ` Rob Hoes
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107AB@LONPMAILBOX01.citrite.net>
  2 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-29 16:23 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
> 
> libxl_dominfo.shutdown_reason is valid iff (shutdown||dying). This is a bit
> annoying when generating language bindings since it needs all sorts of
> special casing. Just introduce an explicit value instead.
> 
> Signed-off-by: Ian Campbell <ian.cambell@citrix.com>

This change is very useful from an ocaml-bindings point of view.

Acked-by: Rob Hoes <rob.hoes@citrix.com>
 
> diff -r 601dc257a740 -r 8195cb0ebac6 tools/libxl/libxl.c
> --- a/tools/libxl/libxl.c	Tue Nov 20 17:22:16 2012 +0000
> +++ b/tools/libxl/libxl.c	Tue Nov 20 17:22:21 2012 +0000
> @@ -526,7 +526,7 @@ static void xcinfo2xlinfo(const xc_domai
>      if (xlinfo->shutdown || xlinfo->dying)
>          xlinfo->shutdown_reason = (xcinfo-
> >flags>>XEN_DOMINF_shutdownshift) & XEN_DOMINF_shutdownmask;
>      else
> -        xlinfo->shutdown_reason  = ~0;
> +        xlinfo->shutdown_reason = LIBXL_SHUTDOWN_REASON_UNKNOWN;
> 
>      xlinfo->current_memkb = PAGE_TO_MEMKB(xcinfo->tot_pages);
>      xlinfo->shared_memkb = PAGE_TO_MEMKB(xcinfo->shr_pages); diff -r
> 601dc257a740 -r 8195cb0ebac6 tools/libxl/libxl_types.idl
> --- a/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:16 2012 +0000
> +++ b/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:21 2012 +0000
> @@ -118,14 +118,15 @@ libxl_scheduler = Enumeration("scheduler
>      (7, "arinc653"),
>      ])
> 
> -# Consistent with SHUTDOWN_* in sched.h
> +# Consistent with SHUTDOWN_* in sched.h (apart from UNKNOWN)
>  libxl_shutdown_reason = Enumeration("shutdown_reason", [
> +    (-1, "unknown"),
>      (0, "poweroff"),
>      (1, "reboot"),
>      (2, "suspend"),
>      (3, "crash"),
>      (4, "watchdog"),
> -    ])
> +    ], init_val = "LIBXL_SHUTDOWN_REASON_UNKNOWN")
> 
>  libxl_vga_interface_type = Enumeration("vga_interface_type", [
>      (1, "CIRRUS"),
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [Xen-API] [PATCH 04 of 15] libxl: ocaml: fix code intended to output comments before definitions
       [not found] ` <be294b1cdd00dac5d3a1.1353432204@cosworth.uk.xensource.com>
@ 2012-11-29 16:27   ` Rob Hoes
  0 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-29 16:27 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> be294b1cdd00dac5d3a1b42faf06656902b99e5b
> # Parent  739989dcd108c6dac61aa9c87be2a75feafb9871
> libxl: ocaml: fix code intended to output comments before definitions
> 
> I'm not sure how useful these comments actually are but erred on the side
> of fixing rather than removing.
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>

Acked-by: Rob Hoes <rob.hoes@citrix.com>

> diff -r 739989dcd108 -r be294b1cdd00 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -79,12 +79,14 @@ def gen_ocaml_ml(ty, interface, indent="
>          s = ("""(* %s interface *)\n""" % ty.typename)
>      else:
>          s = ("""(* %s implementation *)\n""" % ty.typename)
> +
>      if isinstance(ty, idl.Enumeration):
> -        s = "type %s = \n" % ty.rawname
> +        s += "type %s = \n" % ty.rawname
>          for v in ty.values:
>              s += "\t | %s\n" % v.rawname
>      elif isinstance(ty, idl.Aggregate):
> -        s = ""
> +        s += ""
> +
>          if ty.typename is None:
>              raise NotImplementedError("%s has no typename" % type(ty))
>          else:
> 
> _______________________________________________
> Xen-api mailing list
> Xen-api@lists.xen.org
> http://lists.xen.org/cgi-bin/mailman/listinfo/xen-api

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 05 of 15] libxl: ocaml: support for Arrays in bindings generator
       [not found] ` <b7e2cd4a03f278c9abfe.1353432205@cosworth.uk.xensource.com>
@ 2012-11-29 16:52   ` Rob Hoes
  0 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-29 16:52 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> b7e2cd4a03f278c9abfec0812c88234f7e493646
> # Parent  be294b1cdd00dac5d3a1b42faf06656902b99e5b
> libxl: ocaml: support for Arrays in bindings generator.
> 
> No change in generated code because no arrays are currently generated.
> 
> Signed-off-by: Ian Campbell <ian.campbell@citria.xcom>

I tried this on an example, and it looks like it is doing the right thing.

Acked-by: Rob Hoes <rob.hoes@citrix.com>

> diff -r be294b1cdd00 -r b7e2cd4a03f2 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -143,7 +143,13 @@ def c_val(ty, c, o, indent="", parent =
>              raise NotImplementedError("No c_val fn for Builtin %s (%s)" %
> (ty.typename, type(ty)))
>          s += "%s;" % (fn % { "o": o, "c": c })
>      elif isinstance (ty,idl.Array):
> -        raise("Cannot handle Array type\n")
> +        s += "{\n"
> +        s += "\tint i;\n"
> +        s += "\t%s = Wosize_val(%s);\n" % (parent + ty.lenvar.name, o)
> +        s += "\tfor(i=0; i<%s; i++) {\n" % (parent + ty.lenvar.name)
> +        s += c_val(ty.elem_type, c+"[i]", "Field(%s, i)" % o, indent="\t\t",
> parent=parent) + "\n"
> +        s += "\t}\n"
> +        s += "}\n"
>      elif isinstance(ty,idl.Enumeration) and (parent is None):
>          n = 0
>          s += "switch(Int_val(%s)) {\n" % o
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 06 of 15] libxl/ocaml: avoid reserved words in type and field names
       [not found] ` <f618acdeea1bf60b3b68.1353432206@cosworth.uk.xensource.com>
@ 2012-11-29 16:52   ` Rob Hoes
  0 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-29 16:52 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> f618acdeea1bf60b3b68da4062de018d8162fe8c
> # Parent  b7e2cd4a03f278c9abfec0812c88234f7e493646
> libxl/ocaml: avoid reserved words in type and field names.
> 
> Current just s/type/ty/ and there are no such fields (yet) so no change to
> generated code.
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>

Looks good to me.

Acked-by: Rob Hoes <rob.hoes@citrix.com>

> diff -r b7e2cd4a03f2 -r f618acdeea1b tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -70,8 +70,14 @@ def ocaml_type_of(ty):
>      else:
>          return ty.rawname
> 
> +def munge_name(name):
> +    if name == "type":
> +        return "ty"
> +    else:
> +        return name
> +
>  def ocaml_instance_of(type, name):
> -    return "%s : %s" % (name, ocaml_type_of(type))
> +    return "%s : %s" % (munge_name(name), ocaml_type_of(type))
> 
>  def gen_ocaml_ml(ty, interface, indent=""):
> 
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator
       [not found] ` <0cf342afa9e6b506fad6.1353432207@cosworth.uk.xensource.com>
  2012-11-26 15:31   ` [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107A4@LONPMAILBOX01.citrite.net>
@ 2012-11-29 16:54   ` Rob Hoes
  2 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-29 16:54 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> 0cf342afa9e6b506fad68346cb3a1207030372eb
> # Parent  f618acdeea1bf60b3b68da4062de018d8162fe8c
> libxl: ocaml: support for KeyedUnion in the bindings generator.
> 
> A KeyedUnion consists of two fields in the containing struct. First an enum
> field ("e") used as a descriminator and second a union ("u") containing
> potentially anonymous structs associated with each enum value.
> 
> We map the anonymous structs to structs named after the descriminator
> field ("e") and the specific enum values. We then declare an ocaml variant
> type name e__union mapping each enum value to its associated struct.
> 
> So given IDL:
> 
>  foo = Enumeration("foo",
> 	(0, "BAR"),
> 	(1, "BAZ"),
>  s = Struct("s", [
>         ("u", KeyedUnion(none, foo, "blargle", [
> 		("bar", Struct(...xxx...)),
> 		("baz", Struct(...yyy...)),
> 	])),
>  ])
> 
> We generate C:
> 
>  enum { FOO, BAR } foo;
>  struct s {
>  	enum foo blargle;
>  	union {
>  		struct { ...xxx... } bar;
>  		struct { ...yyy... } baz;
>  	} u;
>  }
> 
> and map this to ocaml
> 
>  type foo = BAR | BAZ;
> 
>  module	s = Struct
> 
>  	type blargle_bar = ...xxx...;
> 
>  	type blargle_baz = ...yyy...;
> 
>  	type blargle__union = Bar of blargle_bar | Baz of blargle_baz;
> 
>  	type t =
>  	{
>  		blargle : blargle__union;
>  	}
> 
> These type names are OK because they are already within the namespace
> associated with the struct "s".
> 
> If the struct assiated with bar is empty then we don't bother iwht
> blargle_bar of "of blargle_bar".
> 
> No actually change in the gnerated code since we don't generated any
> KeyedUnions yet.
> 
> The actual implementation was inspired by http://www.linux-
> nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php#ref_constvrnt
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>

This works for me.

Acked-by: Rob Hoes <rob.hoes@citrix.com>

> diff -r f618acdeea1b -r 0cf342afa9e6 tools/libxl/idl.py
> --- a/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/libxl/idl.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -216,6 +216,9 @@ class Struct(Aggregate):
>          kwargs.setdefault('passby', PASS_BY_REFERENCE)
>          Aggregate.__init__(self, "struct", name, fields, **kwargs)
> 
> +    def has_fields(self):
> +        return len(self.fields) != 0
> +
>  class Union(Aggregate):
>      def __init__(self, name, fields, **kwargs):
>          # Generally speaking some intelligence is required to free a diff -r
> f618acdeea1b -r 0cf342afa9e6 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -65,6 +65,8 @@ def ocaml_type_of(ty):
>          if not typename:
>              raise NotImplementedError("No typename for Builtin %s (%s)" %
> (ty.typename, type(ty)))
>          return typename
> +    elif isinstance(ty,idl.KeyedUnion):
> +        return ty.union_name
>      elif isinstance(ty,idl.Aggregate):
>          return ty.rawname.capitalize() + ".t"
>      else:
> @@ -76,8 +78,67 @@ def munge_name(name):
>      else:
>          return name
> 
> -def ocaml_instance_of(type, name):
> -    return "%s : %s" % (munge_name(name), ocaml_type_of(type))
> +def ocaml_instance_of_field(f):
> +    if isinstance(f.type, idl.KeyedUnion):
> +        name = f.type.keyvar.name
> +    else:
> +        name = f.name
> +    return "%s : %s" % (munge_name(name), ocaml_type_of(f.type))
> +
> +def gen_struct(ty):
> +    s = ""
> +    for f in ty.fields:
> +        if f.type.private:
> +            continue
> +        x = ocaml_instance_of_field(f)
> +        x = x.replace("\n", "\n\t\t")
> +        s += "\t\t" + x + ";\n"
> +    return s
> +
> +def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
> +    s = ""
> +
> +    if ty.rawname is not None:
> +        # Non-anonymous types need no special handling
> +        pass
> +    elif isinstance(ty, idl.KeyedUnion):
> +        if parent is None:
> +            nparent = ty.keyvar.name
> +        else:
> +            nparent = parent + "_" + ty.keyvar.name
> +
> +        for f in ty.fields:
> +            if f.type is None: continue
> +            if f.type.rawname is not None: continue
> +            if isinstance(f.type, idl.Struct) and not f.type.has_fields(): continue
> +            s += "\ntype %s_%s =\n" % (nparent,f.name)
> +            s += "{\n"
> +            s += gen_struct(f.type)
> +            s += "}\n"
> +
> +        name = "%s__union" % ty.keyvar.name
> +        s += "\n"
> +        s += "type %s = " % name
> +        u = []
> +        for f in ty.fields:
> +            if f.type is None:
> +                u.append("%s" % (f.name.capitalize()))
> +            elif isinstance(f.type, idl.Struct):
> +                if f.type.rawname is not None:
> +                    u.append("%s of %s" % (f.name.capitalize(),
> f.type.rawname.capitalize()))
> +                elif f.type.has_fields():
> +                    u.append("%s of %s_%s" % (f.name.capitalize(), nparent,
> f.name))
> +                else:
> +                    u.append("%s" % (f.name.capitalize()))
> +            else:
> +                raise NotImplementedError("Cannot handle KeyedUnion
> + fields which are not Structs")
> +
> +        s += " | ".join(u) + "\n"
> +        ty.union_name = name
> +
> +    if s == "":
> +        return None
> +    return s.replace("\n", "\n%s" % indent)
> 
>  def gen_ocaml_ml(ty, interface, indent=""):
> 
> @@ -103,16 +164,17 @@ def gen_ocaml_ml(ty, interface, indent="
>                  s += "module %s : sig\n" % module_name
>              else:
>                  s += "module %s = struct\n" % module_name
> -            s += "\ttype t =\n"
> -            s += "\t{\n"
> -
> +
> +        # Handle KeyedUnions...
>          for f in ty.fields:
> -            if f.type.private:
> -                continue
> -            x = ocaml_instance_of(f.type, f.name)
> -            x = x.replace("\n", "\n\t\t")
> -            s += "\t\t" + x + ";\n"
> +            ku = gen_ocaml_keyedunions(f.type, interface, "\t")
> +            if ku is not None:
> +                s += ku
> +                s += "\n"
> 
> +        s += "\ttype t =\n"
> +        s += "\t{\n"
> +        s += gen_struct(ty)
>          s += "\t}\n"
> 
>          if functions.has_key(ty.rawname):
> @@ -164,12 +226,43 @@ def c_val(ty, c, o, indent="", parent =
>              n += 1
>          s += "    default: failwith_xl(\"cannot convert value to %s\", lg);
> break;\n" % ty.typename
>          s += "}"
> -    elif isinstance(ty, idl.Aggregate) and (parent is None):
> +    elif isinstance(ty, idl.KeyedUnion):
> +        s += "{\n"
> +        s += "\tif(Is_long(%s)) {\n" % o
> +        n = 0
> +        s += "\t\tswitch(Int_val(%s)) {\n" % o
> +        for f in ty.fields:
> +            if f.type is None or not f.type.has_fields():
> +                s += "\t\t    case %d: %s = %s; break;\n" % (n,
> +                                                    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}\n"
> +        s += "\t} else {\n"
> +        s += "\t\t/* Is block... */\n"
> +        s += "\t\tswitch(Tag_val(%s)) {\n" % o
> +        n = 0
> +        for f in ty.fields:
> +            if f.type is not None and f.type.has_fields():
> +                if f.type.private:
> +                    continue
> +                s += "\t\t    case %d:\n" % (n)
> +                s += "\t\t        %s = %s;\n" % (parent + ty.keyvar.name, f.enumname)
> +                (nparent,fexpr) = ty.member(c, f, False)
> +                s += "%s" % c_val(f.type, fexpr, 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}\n"
> +        s += "\t}\n"
> +        s += "}"
> +    elif isinstance(ty, idl.Aggregate) and (parent is None or ty.rawname is
> None):
>          n = 0
>          for f in ty.fields:
>              if f.type.private:
>                  continue
> -            (nparent,fexpr) = ty.member(c, f, parent is None)
> +            (nparent,fexpr) = ty.member(c, f, ty.rawname is not None)
>              s += "%s\n" % c_val(f.type, fexpr, "Field(%s, %d)" % (o,n),
> parent=nparent)
>              n = n + 1
>      else:
> @@ -191,8 +284,8 @@ def gen_c_val(ty, indent=""):
>      s += "}\n"
> 
>      return s.replace("\n", "\n%s" % indent)
> -
> -def ocaml_Val(ty, o, c, indent="", parent = None):
> +
> +def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag = None):
>      s = indent
>      if isinstance(ty,idl.UInt):
>          if ty.width in [8, 16]:
> @@ -231,11 +324,39 @@ def ocaml_Val(ty, o, c, indent="", paren
>              n += 1
>          s += "    default: failwith_xl(\"cannot convert value from %s\", lg);
> break;\n" % ty.typename
>          s += "}"
> -    elif isinstance(ty,idl.Aggregate) and (parent is None):
> +    elif isinstance(ty, idl.KeyedUnion):
> +        n = 0
> +        s += "switch(%s) {\n" % (parent + ty.keyvar.name)
> +        for f in ty.fields:
> +            s += "\t    case %s:\n" % f.enumname
> +            if f.type is None:
> +                s += "\t        /* %d: None */\n" % n
> +                s += "\t        %s = Val_long(%d);\n" % (o,n)
> +            elif not f.type.has_fields():
> +                s += "\t        /* %d: Long */\n" % n
> +                s += "\t        %s = Val_long(%d);\n" % (o,n)
> +            else:
> +                s += "\t        /* %d: Block */\n" % n
> +                (nparent,fexpr) = ty.member(c, f, parent is None)
> +                s += ocaml_Val(f.type, o, fexpr, struct_tag = n, indent="\t        ",
> parent=nparent)
> +                s += "\n"
> +                #s += "\t        %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n)
> +            s += "\t        break;\n"
> +            n += 1
> +        s += "\t    default: failwith_xl(\"cannot convert value from %s\", lg);
> break;\n" % ty.typename
> +        s += "\t}"
> +    elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is
> None):
>          s += "{\n"
> -        s += "\tvalue %s_field;\n" % ty.rawname
> +        if ty.rawname is None:
> +            fn = "anon_field"
> +        else:
> +            fn = "%s_field" % ty.rawname
> +        s += "\tvalue %s;\n" % fn
>          s += "\n"
> -        s += "\t%s = caml_alloc_tuple(%d);\n" % (o, len(ty.fields))
> +        if struct_tag is not None:
> +            s += "\t%s = caml_alloc(%d,%d);\n" % (o, len(ty.fields), struct_tag)
> +        else:
> +            s += "\t%s = caml_alloc_tuple(%d);\n" % (o, len(ty.fields))
> 
>          n = 0
>          for f in ty.fields:
> @@ -245,8 +366,8 @@ def ocaml_Val(ty, o, c, indent="", paren
>              (nparent,fexpr) = ty.member(c, f, parent is None)
> 
>              s += "\n"
> -            s += "\t%s\n" % ocaml_Val(f.type, "%s_field" % ty.rawname,
> ty.pass_arg(fexpr, c), parent=nparent)
> -            s += "\tStore_field(%s, %d, %s);\n" % (o, n, "%s_field" % ty.rawname)
> +            s += "\t%s\n" % ocaml_Val(f.type, fn, ty.pass_arg(fexpr, c),
> parent=nparent)
> +            s += "\tStore_field(%s, %d, %s);\n" % (o, n, fn)
>              n = n + 1
>          s += "}"
>      else:
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 08 of 15] libxl/ocaml: add some more builtin types
       [not found] ` <21c5e58956d09437903e.1353432208@cosworth.uk.xensource.com>
@ 2012-11-29 17:19   ` Rob Hoes
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107B0@LONPMAILBOX01.citrite.net>
  1 sibling, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-29 17:19 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> 21c5e58956d09437903e1ee1b0588d61a7c28145
> # Parent  0cf342afa9e6b506fad68346cb3a1207030372eb
> libxl/ocaml: add some more builtin types.
> 
>   * bitmaps
>   * string_list
>   * cpuid_policy_list (actually opaque)
>   * key_value_list
> 
> None of these are used yet, so no change to the generated code.
> 
> Bitmap_val requires a ctx, so leave it as an abort for now.
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
> 
> diff -r 0cf342afa9e6 -r 21c5e58956d0 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -13,9 +13,13 @@ builtins = {
>      "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_key_value_list": ("(string * string) list", None,
> None),
> +    "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_hwcap":          ("int32 array",            None,
> "Val_hwcap(&%(c)s)"),
> +    # This is an opaque type
> +    "libxl_cpuid_policy_list": ("Cpuid_policy.t",      "Cpuid_policy_list_val(gc,
> lg, &%(c)s, %(o)s)",   "Val_cpuid_policy_list(&%(c)s)"),
>      }
> 
>  DEVICE_FUNCTIONS = [ ("add",            ["t", "domid", "unit"]),
> diff -r 0cf342afa9e6 -r 21c5e58956d0 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
> @@ -18,6 +18,10 @@ exception Error of string  type domid = int  type devid
> = int
> 
> +module Cpuid_policy = struct
> +	type t
> +end
> +

Do you expect this type to become more complicated, or non-opaque, in future? Or would it have functions associated with it like for the devices? If not, perhaps we can use a simpler type definition:

type cpuid_policy_list

>  (* @@LIBXL_TYPES@@ *)
> 
>  external send_trigger : domid -> trigger -> int -> unit =
> "stub_xl_send_trigger"
> diff -r 0cf342afa9e6 -r 21c5e58956d0 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
> @@ -27,6 +27,7 @@
>  #include <string.h>
> 
>  #include <libxl.h>
> +#include <libxl_utils.h>
> 
>  struct caml_logger {
>  	struct xentoollog_logger logger;
> @@ -96,7 +97,6 @@ static void failwith_xl(char *fname, str
>  	caml_raise_with_string(*caml_named_value("xl.error"), s);  }
> 
> -#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed
> then */  static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)  {
>  	void *ptr;
> @@ -107,28 +107,62 @@ static void * gc_calloc(caml_gc *gc, siz
>  	return ptr;
>  }
> 
> -static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value v)
> +static int list_len(value v)
> +{
> +	int len = 0;
> +	while ( v != Val_emptylist ) {
> +		len++;
> +		v = Field(v, 1);
> +	}
> +	return len;
> +}
> +

It is probably best to use CAMLparam1(v) and CAMLreturn(len) here, just in case.

> +static int libxl_key_value_list_val(caml_gc *gc, struct caml_logger *lg,
> +				    libxl_key_value_list *c_val,
> +				    value v)
>  {
>  	CAMLparam1(v);
> -	CAMLlocal1(a);
> -	int i;
> -	char **array;
> +	CAMLlocal1(elem);
> +	int nr, i;
> +	libxl_key_value_list array;
> 
> -	for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) { i++; }
> +	nr = list_len(v);
> 
> -	array = gc_calloc(gc, (i + 1) * 2, sizeof(char *));
> +	array = gc_calloc(gc, (nr + 1) * 2, sizeof(char *));
>  	if (!array)
> -		return 1;
> -	for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1), i++) {
> -		value b = Field(a, 0);
> -		array[i * 2] = dup_String_val(gc, Field(b, 0));
> -		array[i * 2 + 1] = dup_String_val(gc, Field(b, 1));
> +		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));
>  	}
> +
>  	*c_val = array;
>  	CAMLreturn(0);
>  }
> 
> -#endif
> +static int libxl_string_list_val(caml_gc *gc, struct caml_logger *lg,
> +				 libxl_string_list *c_val,
> +				 value v)
> +{
> +	CAMLparam1(v);
> +	int nr, i;
> +	libxl_key_value_list array;

This should probably be a libxl_string_list.

> +
> +	nr = list_len(v);
> +
> +	array = gc_calloc(gc, (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));
> +
> +	*c_val = array;
> +	CAMLreturn(0);
> +}
> 
>  /* Option type support as per http://www.linux-
> nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php */  #define Val_none
> Val_int(0) @@ -168,6 +202,45 @@ static int Mac_val(caml_gc *gc, struct c
>  	CAMLreturn(0);
>  }
> 
> +static value Val_bitmap (libxl_bitmap *c_val) {
> +	CAMLparam0();
> +	CAMLlocal1(v);
> +	int i;
> +
> +	v = caml_alloc(8 * (c_val->size), 0);
> +	libxl_for_each_bit(i, *c_val) {
> +		if (libxl_bitmap_test(c_val, i))
> +			Store_field(v, i, Val_true);
> +		else
> +			Store_field(v, i, Val_false);
> +	}
> +	CAMLreturn(v);
> +}
> +
> +static int Bitmap_val(caml_gc *gc, struct caml_logger *lg,
> +		      libxl_bitmap *c_val, value v)
> +{
> +	abort(); /* XXX */
> +}
> +
> +static value Val_cpuid_policy_list(libxl_cpuid_policy_list *c_val) {
> +	CAMLparam0();
> +	/* An opaque pointer */
> +	CAMLreturn((value)c_val);
> +}
> +
> +static int Cpuid_policy_list_val(caml_gc *gc, struct caml_logger *lg,
> +				 libxl_cpuid_policy_list **c_val, value v) {
> +	CAMLparam1(v);
> +
> +	/* An opaque pointer */
> +	*c_val = (libxl_cpuid_policy_list*)v;
> +	CAMLreturn(0);
> +}
> +
>  static value Val_uuid (libxl_uuid *c_val)  {
>  	CAMLparam0();

For the rest it looks good to me.

Cheers,
Rob

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 09 of 15] libxl/ocaml: add domain_build/create_info and events to the bindings
  2012-11-20 17:23 ` [PATCH 09 of 15] libxl/ocaml: add domain_build/create_info and events to the bindings Ian Campbell
@ 2012-11-29 17:20   ` Rob Hoes
  0 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-29 17:20 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> 5173d29f64fa541f6ec0c48481c4957a03f0302c
> # Parent  21c5e58956d09437903e1ee1b0588d61a7c28145
> libxl/ocaml: add domain_build/create_info and events to the bindings.
> 
> We now have enoguh infrastructure in place to do this trivially.
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>

Looks good.

Acked-by: Rob Hoes <rob.hoes@citrix.com>

> diff -r 21c5e58956d0 -r 5173d29f64fa tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -19,7 +19,7 @@ builtins = {
>      "libxl_mac":            ("int array",              "Mac_val(gc, lg, &%(c)s, %(o)s)",
> "Val_mac(&%(c)s)"),
>      "libxl_hwcap":          ("int32 array",            None,
> "Val_hwcap(&%(c)s)"),
>      # This is an opaque type
> -    "libxl_cpuid_policy_list": ("Cpuid_policy.t",      "Cpuid_policy_list_val(gc,
> lg, &%(c)s, %(o)s)",   "Val_cpuid_policy_list(&%(c)s)"),
> +    "libxl_cpuid_policy_list": ("Cpuid_policy.t",      "Cpuid_policy_list_val(gc,
> lg, &%(c)s, %(o)s)",   "Val_cpuid_policy_list(%(c)s)"),
>      }
> 
>  DEVICE_FUNCTIONS = [ ("add",            ["t", "domid", "unit"]),
> @@ -420,11 +420,8 @@ if __name__ == '__main__':
>      # Do not generate these yet.
>      blacklist = [
>          "cpupoolinfo",
> -        "domain_create_info",
> -        "domain_build_info",
>          "domain_config",
>          "vcpuinfo",
> -        "event",
>          ]
> 
>      for t in blacklist:
> diff -r 21c5e58956d0 -r 5173d29f64fa 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
> @@ -224,7 +224,7 @@ static int Bitmap_val(caml_gc *gc, struc
>  	abort(); /* XXX */
>  }
> 
> -static value Val_cpuid_policy_list(libxl_cpuid_policy_list *c_val)
> +static value Val_cpuid_policy_list(libxl_cpuid_policy_list c_val)
>  {
>  	CAMLparam0();
>  	/* An opaque pointer */
> @@ -232,12 +232,13 @@ static value Val_cpuid_policy_list(libxl  }
> 
>  static int Cpuid_policy_list_val(caml_gc *gc, struct caml_logger *lg,
> -				 libxl_cpuid_policy_list **c_val, value v)
> +				 libxl_cpuid_policy_list *c_val, value v)
>  {
>  	CAMLparam1(v);
> 
>  	/* An opaque pointer */
> -	*c_val = (libxl_cpuid_policy_list*)v;
> +	*c_val = (libxl_cpuid_policy_list)v;
> +
>  	CAMLreturn(0);
>  }
> 
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only)
  2012-11-20 17:23 ` [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only) Ian Campbell
@ 2012-11-29 17:41   ` Rob Hoes
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107B2@LONPMAILBOX01.citrite.net>
  1 sibling, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-29 17:41 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> 2b433b1523e4295bb1ed74a7b71e2a20e00f1802
> # Parent  5173d29f64fa541f6ec0c48481c4957a03f0302c
> libxc/ocaml: Add simple binding for xentoollog (output only).
> 
> These bindings allow ocaml code to receive log message via xentoollog but
> do not support injecting messages into xentoollog from ocaml.
> Receiving log messages from libx{c,l} and forwarding them to ocaml is the
> use case which is needed by the following patches.
> 
> Add a simple noddy test case (tools/ocaml/test).
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
> 

This is potentially very useful. However, I have a few concerns about the callbacks to OCaml.

The most important issue is that we'd like to wrap potentially blocking C code in caml_enter_blocking_section and caml_leave_blocking section calls, to make sure that this code won't block the entire OCaml program. Within such a block, it is not allowed to interact with the OCaml runtime in any way. This includes callbacks.

I have notice some weird segfaults happening when using this logging code, and they seemed to have gone away when I removed the blocking_section calls.

I can't think of a good solution yet, but to make this really useful, I think we may need to do it slightly differently.

I included some smaller comments below.

> diff -r 5173d29f64fa -r 2b433b1523e4 .gitignore
> --- a/.gitignore	Tue Nov 20 17:22:21 2012 +0000
> +++ b/.gitignore	Tue Nov 20 17:22:21 2012 +0000
> @@ -364,6 +364,7 @@ tools/ocaml/libs/xl/_libxl_types.mli.in

[.....]

> +static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
> +			       xentoollog_level level,
> +			       int errnoval,
> +			       const char *context,
> +			       const char *format,
> +			       va_list al)
> +{
> +	struct caml_xtl *xtl = (struct caml_xtl*)logger;
> +	value *func = caml_named_value(xtl->vmessage_cb) ;
> +	value args[4];

I think it is safer to use this instead:

       CAMLparam0();
       CAMLlocalN(args, 4);

> +	char *msg;
> +
> +	if (args == NULL)
> +		caml_raise_out_of_memory();
> +	if (func == NULL)
> +		caml_raise_sys_error(caml_copy_string("Unable to find
> callback"));
> +	if (vasprintf(&msg, format, al) < 0)
> +		caml_raise_out_of_memory();
> +
> +	/* vmessage : level -> int option -> string option -> string -> unit; */
> +	args[0] = Val_level(level);
> +	args[1] = Val_errno(errnoval);
> +	args[2] = Val_context(context);
> +	args[3] = caml_copy_string(msg);
> +
> +	free(msg);
> +
> +	caml_callbackN(*func, 4, args);

Because of the above, we should also add CAMLreturn0.

> +}
> +
> +static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
> +				    const char *context,
> +				    const char *doing_what /* no \r,\n */,
> +				    int percent, unsigned long done, unsigned
> long total) {
> +	struct caml_xtl *xtl = (struct caml_xtl*)logger;
> +	value *func = caml_named_value(xtl->progress_cb) ;
> +	value args[5];

Here as well:

       CAMLparam0();
       CAMLlocalN(args, 5);

> +
> +	if (args == NULL)
> +		caml_raise_out_of_memory();
> +	if (func == NULL)
> +		caml_raise_sys_error(caml_copy_string("Unable to find
> callback"));
> +
> +	/* progress : string option -> string -> int -> int64 -> int64 -> unit; */
> +	args[0] = Val_context(context);
> +	args[1] = caml_copy_string(doing_what);
> +	args[2] = Val_int(percent);
> +	args[3] = caml_copy_int64(done);
> +	args[4] = caml_copy_int64(total);
> +
> +	caml_callbackN(*func, 5, args);

And CAMLreturn0.

> +}
> +
> +static void xtl_destroy(struct xentoollog_logger *logger) {
> +	struct caml_xtl *xtl = (struct caml_xtl*)logger;
> +	free(xtl->vmessage_cb);
> +	free(xtl->progress_cb);
> +	free(xtl);
> +}
> +

[...]

> diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/test/Makefile
> --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
> +++ b/tools/ocaml/test/Makefile	Tue Nov 20 17:22:21 2012 +0000
> @@ -0,0 +1,27 @@
> +XEN_ROOT = $(CURDIR)/../../..
> +OCAML_TOPLEVEL = $(CURDIR)/..
> +include $(OCAML_TOPLEVEL)/common.make
> +
> +OCAMLINCLUDE += \
> +	-I $(OCAML_TOPLEVEL)/libs/xentoollog
> +
> +OBJS = xtl
> +
> +PROGRAMS = xtl
> +
> +xtl_LIBS =  \
> +	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog
> +$(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa

I had to add "-cclib -lxenctrl" here to get it to link properly.

> +
> +xtl_OBJS = xtl
> +
> +OCAML_PROGRAM = xtl
> +
> +all: $(PROGRAMS)
> +
> +bins: $(PROGRAMS)
> +
> +install: all
> +	$(INSTALL_DIR) $(DESTDIR)$(BINDIR)
> +	$(INSTALL_PROG) $(PROGRAMS) $(DESTDIR)$(BINDIR)
> +
> +include $(OCAML_TOPLEVEL)/Makefile.rules
> diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/test/xtl.ml
> --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
> +++ b/tools/ocaml/test/xtl.ml	Tue Nov 20 17:22:21 2012 +0000
> @@ -0,0 +1,20 @@
> +open Arg
> +open Xentoollog
> +
> +let do_test level =
> +  let lgr = Xentoollog.create_stdio_logger ~level:level () in
> +  begin
> +    Xentoollog.test lgr;
> +    Xentoollog.destroy lgr;
> +  end
> +
> +let () =
> +  let debug_level = ref Xentoollog.Info in
> +  let speclist = [
> +    ("-v", Arg.Unit (fun () -> debug_level := Xentoollog.Debug), "Verbose");
> +    ("-q", Arg.Unit (fun () -> debug_level := Xentoollog.Critical),
> +"Quiet");
> +  ] in
> +  let usage_msg = "usage: xtl [OPTIONS]" in
> +  Arg.parse speclist (fun s -> ()) usage_msg;
> +
> +  do_test !debug_level
> 

Cheers,
Rob

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 08 of 15] libxl/ocaml: add some more builtin types
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107B0@LONPMAILBOX01.citrite.net>
@ 2012-11-29 17:42     ` Ian Campbell
  0 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-29 17:42 UTC (permalink / raw)
  To: Rob Hoes; +Cc: xen-api@lists.xen.org, xen-devel@lists.xen.org

On Thu, 2012-11-29 at 17:19 +0000, Rob Hoes wrote:
> > # HG changeset patch
> > # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> > 21c5e58956d09437903e1ee1b0588d61a7c28145
> > # Parent  0cf342afa9e6b506fad68346cb3a1207030372eb
> > libxl/ocaml: add some more builtin types.
> > 
> >   * bitmaps
> >   * string_list
> >   * cpuid_policy_list (actually opaque)
> >   * key_value_list
> > 
> > None of these are used yet, so no change to the generated code.
> > 
> > Bitmap_val requires a ctx, so leave it as an abort for now.
> > 
> > Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
> > 
> > diff -r 0cf342afa9e6 -r 21c5e58956d0 tools/ocaml/libs/xl/genwrap.py
> > --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> > +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> > @@ -13,9 +13,13 @@ builtins = {
> >      "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_key_value_list": ("(string * string) list", None,
> > None),
> > +    "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_hwcap":          ("int32 array",            None,
> > "Val_hwcap(&%(c)s)"),
> > +    # This is an opaque type
> > +    "libxl_cpuid_policy_list": ("Cpuid_policy.t",      "Cpuid_policy_list_val(gc,
> > lg, &%(c)s, %(o)s)",   "Val_cpuid_policy_list(&%(c)s)"),
> >      }
> > 
> >  DEVICE_FUNCTIONS = [ ("add",            ["t", "domid", "unit"]),
> > diff -r 0cf342afa9e6 -r 21c5e58956d0 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
> > @@ -18,6 +18,10 @@ exception Error of string  type domid = int  type devid
> > = int
> > 
> > +module Cpuid_policy = struct
> > +	type t
> > +end
> > +
> 
> Do you expect this type to become more complicated, or non-opaque, in future?

IIRC it is opaque at the libxc layer too and I don't see this changing.
Mostly because its a total brain bender ;-)

>  Or would it have functions associated with it like for the devices?

I think it will eventually get functions to initialise the opaque thing,
corresponding to one or more of:

int libxl_cpuid_parse_config(libxl_cpuid_policy_list *cpuid, const char* str);
int libxl_cpuid_parse_config_xend(libxl_cpuid_policy_list *cpuid,
                                  const char* str);
void libxl_cpuid_apply_policy(libxl_ctx *ctx, uint32_t domid);
void libxl_cpuid_set(libxl_ctx *ctx, uint32_t domid,
                     libxl_cpuid_policy_list cpuid);

or some new accessor useful to you guys.

>  If not, perhaps we can use a simpler type definition:
> 
> type cpuid_policy_list
> 
> >  (* @@LIBXL_TYPES@@ *)
> > 
> >  external send_trigger : domid -> trigger -> int -> unit =
> > "stub_xl_send_trigger"
> > diff -r 0cf342afa9e6 -r 21c5e58956d0 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
> > @@ -27,6 +27,7 @@
> >  #include <string.h>
> > 
> >  #include <libxl.h>
> > +#include <libxl_utils.h>
> > 
> >  struct caml_logger {
> >  	struct xentoollog_logger logger;
> > @@ -96,7 +97,6 @@ static void failwith_xl(char *fname, str
> >  	caml_raise_with_string(*caml_named_value("xl.error"), s);  }
> > 
> > -#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed
> > then */  static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)  {
> >  	void *ptr;
> > @@ -107,28 +107,62 @@ static void * gc_calloc(caml_gc *gc, siz
> >  	return ptr;
> >  }
> > 
> > -static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value v)
> > +static int list_len(value v)
> > +{
> > +	int len = 0;
> > +	while ( v != Val_emptylist ) {
> > +		len++;
> > +		v = Field(v, 1);
> > +	}
> > +	return len;
> > +}
> > +
> 
> It is probably best to use CAMLparam1(v) and CAMLreturn(len) here, just in case.

Yes, thanks.

> 
> > +static int libxl_key_value_list_val(caml_gc *gc, struct caml_logger *lg,
> > +				    libxl_key_value_list *c_val,
> > +				    value v)
> >  {
> >  	CAMLparam1(v);
> > -	CAMLlocal1(a);
> > -	int i;
> > -	char **array;
> > +	CAMLlocal1(elem);
> > +	int nr, i;
> > +	libxl_key_value_list array;
> > 
> > -	for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) { i++; }
> > +	nr = list_len(v);
> > 
> > -	array = gc_calloc(gc, (i + 1) * 2, sizeof(char *));
> > +	array = gc_calloc(gc, (nr + 1) * 2, sizeof(char *));
> >  	if (!array)
> > -		return 1;
> > -	for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1), i++) {
> > -		value b = Field(a, 0);
> > -		array[i * 2] = dup_String_val(gc, Field(b, 0));
> > -		array[i * 2 + 1] = dup_String_val(gc, Field(b, 1));
> > +		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));
> >  	}
> > +
> >  	*c_val = array;
> >  	CAMLreturn(0);
> >  }
> > 
> > -#endif
> > +static int libxl_string_list_val(caml_gc *gc, struct caml_logger *lg,
> > +				 libxl_string_list *c_val,
> > +				 value v)
> > +{
> > +	CAMLparam1(v);
> > +	int nr, i;
> > +	libxl_key_value_list array;
> 
> This should probably be a libxl_string_list.

Yes!

(they are actually the same type under the hood, which is why gcc
doesn't complain)

> 
> > +
> > +	nr = list_len(v);
> > +
> > +	array = gc_calloc(gc, (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));
> > +
> > +	*c_val = array;
> > +	CAMLreturn(0);
> > +}
> > 
> >  /* Option type support as per http://www.linux-
> > nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php */  #define Val_none
> > Val_int(0) @@ -168,6 +202,45 @@ static int Mac_val(caml_gc *gc, struct c
> >  	CAMLreturn(0);
> >  }
> > 
> > +static value Val_bitmap (libxl_bitmap *c_val) {
> > +	CAMLparam0();
> > +	CAMLlocal1(v);
> > +	int i;
> > +
> > +	v = caml_alloc(8 * (c_val->size), 0);
> > +	libxl_for_each_bit(i, *c_val) {
> > +		if (libxl_bitmap_test(c_val, i))
> > +			Store_field(v, i, Val_true);
> > +		else
> > +			Store_field(v, i, Val_false);
> > +	}
> > +	CAMLreturn(v);
> > +}
> > +
> > +static int Bitmap_val(caml_gc *gc, struct caml_logger *lg,
> > +		      libxl_bitmap *c_val, value v)
> > +{
> > +	abort(); /* XXX */
> > +}
> > +
> > +static value Val_cpuid_policy_list(libxl_cpuid_policy_list *c_val) {
> > +	CAMLparam0();
> > +	/* An opaque pointer */
> > +	CAMLreturn((value)c_val);
> > +}
> > +
> > +static int Cpuid_policy_list_val(caml_gc *gc, struct caml_logger *lg,
> > +				 libxl_cpuid_policy_list **c_val, value v) {
> > +	CAMLparam1(v);
> > +
> > +	/* An opaque pointer */
> > +	*c_val = (libxl_cpuid_policy_list*)v;
> > +	CAMLreturn(0);
> > +}
> > +
> >  static value Val_uuid (libxl_uuid *c_val)  {
> >  	CAMLparam0();
> 
> For the rest it looks good to me.
> 
> Cheers,
> Rob
> 

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only)
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107B2@LONPMAILBOX01.citrite.net>
@ 2012-11-29 18:03     ` Ian Campbell
       [not found]     ` <1354212199.6269.67.camel@zakaz.uk.xensource.com>
  1 sibling, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-11-29 18:03 UTC (permalink / raw)
  To: Rob Hoes; +Cc: xen-api@lists.xen.org, xen-devel@lists.xen.org

On Thu, 2012-11-29 at 17:41 +0000, Rob Hoes wrote:
> > # HG changeset patch
> > # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> > 2b433b1523e4295bb1ed74a7b71e2a20e00f1802
> > # Parent  5173d29f64fa541f6ec0c48481c4957a03f0302c
> > libxc/ocaml: Add simple binding for xentoollog (output only).
> > 
> > These bindings allow ocaml code to receive log message via xentoollog but
> > do not support injecting messages into xentoollog from ocaml.
> > Receiving log messages from libx{c,l} and forwarding them to ocaml is the
> > use case which is needed by the following patches.
> > 
> > Add a simple noddy test case (tools/ocaml/test).
> > 
> > Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
> > 
> 
> This is potentially very useful. However, I have a few concerns about the callbacks to OCaml.
> 
> The most important issue is that we'd like to wrap potentially
> blocking C code in caml_enter_blocking_section and caml_leave_blocking
> section calls, to make sure that this code won't block the entire
> OCaml program. Within such a block, it is not allowed to interact with
> the OCaml runtime in any way. This includes callbacks.

> 
> I have notice some weird segfaults happening when using this logging
> code, and they seemed to have gone away when I removed the
> blocking_section calls.
> 
> I can't think of a good solution yet, but to make this really useful,
> I think we may need to do it slightly differently.

Can we call leave/enter from the C part of the callback before heading
back to ocaml, or does it not work like that? Would this require us to
*always* call enter/leave when calling into libxl, in case it generates
a callback (i.e. to balance things out correctly)?

Another idea might be to make the bindings use the async interfaces
wherever possible by default, by definition anything potentially
blocking has supports this and that would avoid the need for
enter/leave, but at the expense of making the ocaml callers ugly
perhaps? Or maybe this sort of thing ends up looking very natural in
ocaml? Depends on your application's event mechanism I suspect.

Last half witted idea: everything could be async but the bindings
include the loop to wait for the async event, i.e. effectively making
the call sync again. This sounds silly but it might allow better control
over the placement of enter/leave vs callbacks, since you would just
drop it over libxl_event_wait?

> I included some smaller comments below.
> 
> > diff -r 5173d29f64fa -r 2b433b1523e4 .gitignore
> > --- a/.gitignore	Tue Nov 20 17:22:21 2012 +0000
> > +++ b/.gitignore	Tue Nov 20 17:22:21 2012 +0000
> > @@ -364,6 +364,7 @@ tools/ocaml/libs/xl/_libxl_types.mli.in
> 
> [.....]
> 
> > +static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
> > +			       xentoollog_level level,
> > +			       int errnoval,
> > +			       const char *context,
> > +			       const char *format,
> > +			       va_list al)
> > +{
> > +	struct caml_xtl *xtl = (struct caml_xtl*)logger;
> > +	value *func = caml_named_value(xtl->vmessage_cb) ;
> > +	value args[4];
> 
> I think it is safer to use this instead:
> 
>        CAMLparam0();
>        CAMLlocalN(args, 4);
> 
> > +	char *msg;
> > +
> > +	if (args == NULL)
> > +		caml_raise_out_of_memory();
> > +	if (func == NULL)
> > +		caml_raise_sys_error(caml_copy_string("Unable to find
> > callback"));
> > +	if (vasprintf(&msg, format, al) < 0)
> > +		caml_raise_out_of_memory();
> > +
> > +	/* vmessage : level -> int option -> string option -> string -> unit; */
> > +	args[0] = Val_level(level);
> > +	args[1] = Val_errno(errnoval);
> > +	args[2] = Val_context(context);
> > +	args[3] = caml_copy_string(msg);
> > +
> > +	free(msg);
> > +
> > +	caml_callbackN(*func, 4, args);
> 
> Because of the above, we should also add CAMLreturn0.
> 
> > +}
> > +
> > +static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
> > +				    const char *context,
> > +				    const char *doing_what /* no \r,\n */,
> > +				    int percent, unsigned long done, unsigned
> > long total) {
> > +	struct caml_xtl *xtl = (struct caml_xtl*)logger;
> > +	value *func = caml_named_value(xtl->progress_cb) ;
> > +	value args[5];
> 
> Here as well:
> 
>        CAMLparam0();
>        CAMLlocalN(args, 5);
> 
> > +
> > +	if (args == NULL)
> > +		caml_raise_out_of_memory();
> > +	if (func == NULL)
> > +		caml_raise_sys_error(caml_copy_string("Unable to find
> > callback"));
> > +
> > +	/* progress : string option -> string -> int -> int64 -> int64 -> unit; */
> > +	args[0] = Val_context(context);
> > +	args[1] = caml_copy_string(doing_what);
> > +	args[2] = Val_int(percent);
> > +	args[3] = caml_copy_int64(done);
> > +	args[4] = caml_copy_int64(total);
> > +
> > +	caml_callbackN(*func, 5, args);
> 
> And CAMLreturn0.
> 
> > +}
> > +
> > +static void xtl_destroy(struct xentoollog_logger *logger) {
> > +	struct caml_xtl *xtl = (struct caml_xtl*)logger;
> > +	free(xtl->vmessage_cb);
> > +	free(xtl->progress_cb);
> > +	free(xtl);
> > +}
> > +
> 
> [...]
> 
> > diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/test/Makefile
> > --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
> > +++ b/tools/ocaml/test/Makefile	Tue Nov 20 17:22:21 2012 +0000
> > @@ -0,0 +1,27 @@
> > +XEN_ROOT = $(CURDIR)/../../..
> > +OCAML_TOPLEVEL = $(CURDIR)/..
> > +include $(OCAML_TOPLEVEL)/common.make
> > +
> > +OCAMLINCLUDE += \
> > +	-I $(OCAML_TOPLEVEL)/libs/xentoollog
> > +
> > +OBJS = xtl
> > +
> > +PROGRAMS = xtl
> > +
> > +xtl_LIBS =  \
> > +	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog
> > +$(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa
> 
> I had to add "-cclib -lxenctrl" here to get it to link properly.
> 
> > +
> > +xtl_OBJS = xtl
> > +
> > +OCAML_PROGRAM = xtl
> > +
> > +all: $(PROGRAMS)
> > +
> > +bins: $(PROGRAMS)
> > +
> > +install: all
> > +	$(INSTALL_DIR) $(DESTDIR)$(BINDIR)
> > +	$(INSTALL_PROG) $(PROGRAMS) $(DESTDIR)$(BINDIR)
> > +
> > +include $(OCAML_TOPLEVEL)/Makefile.rules
> > diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/test/xtl.ml
> > --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
> > +++ b/tools/ocaml/test/xtl.ml	Tue Nov 20 17:22:21 2012 +0000
> > @@ -0,0 +1,20 @@
> > +open Arg
> > +open Xentoollog
> > +
> > +let do_test level =
> > +  let lgr = Xentoollog.create_stdio_logger ~level:level () in
> > +  begin
> > +    Xentoollog.test lgr;
> > +    Xentoollog.destroy lgr;
> > +  end
> > +
> > +let () =
> > +  let debug_level = ref Xentoollog.Info in
> > +  let speclist = [
> > +    ("-v", Arg.Unit (fun () -> debug_level := Xentoollog.Debug), "Verbose");
> > +    ("-q", Arg.Unit (fun () -> debug_level := Xentoollog.Critical),
> > +"Quiet");
> > +  ] in
> > +  let usage_msg = "usage: xtl [OPTIONS]" in
> > +  Arg.parse speclist (fun s -> ()) usage_msg;
> > +
> > +  do_test !debug_level
> > 
> 
> Cheers,
> Rob

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [Xen-API] [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only)
       [not found]     ` <1354212199.6269.67.camel@zakaz.uk.xensource.com>
@ 2012-11-29 18:20       ` Anil Madhavapeddy
       [not found]       ` <5DC583C2-ED2D-4305-9AC5-74F8F57F300D@recoil.org>
  1 sibling, 0 replies; 39+ messages in thread
From: Anil Madhavapeddy @ 2012-11-29 18:20 UTC (permalink / raw)
  To: Ian Campbell; +Cc: xen-devel, Rob Hoes, David Scott, xen-api

On 29 Nov 2012, at 18:03, Ian Campbell <Ian.Campbell@citrix.com> wrote:
> 
> Another idea might be to make the bindings use the async interfaces
> wherever possible by default, by definition anything potentially
> blocking has supports this and that would avoid the need for
> enter/leave, but at the expense of making the ocaml callers ugly
> perhaps? Or maybe this sort of thing ends up looking very natural in
> ocaml? Depends on your application's event mechanism I suspect.
> 
> Last half witted idea: everything could be async but the bindings
> include the loop to wait for the async event, i.e. effectively making
> the call sync again. This sounds silly but it might allow better control
> over the placement of enter/leave vs callbacks, since you would just
> drop it over libxl_event_wait?

Making everything explicitly async and non-blocking is by far the
preferred solution in terms of stability, as it largely removes the
need to worry about the GC interface and thread interactions.

There are several libraries to wrap async interfaces in convenient
synchronous programming, most notably Lwt (http://ocsigen.org/lwt).
With this interface, all the OCaml callbacks are implemented in
OCaml, and it just needs a select/epoll or equivalent to wake up
sleeping threads when an IO event occurs.

Dave has already done some bindings to Lwt, so I've CCed him...

-anil

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [Xen-API] [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only)
       [not found]       ` <5DC583C2-ED2D-4305-9AC5-74F8F57F300D@recoil.org>
@ 2012-11-30  9:50         ` Ian Campbell
  2012-11-30 10:04           ` Rob Hoes
  0 siblings, 1 reply; 39+ messages in thread
From: Ian Campbell @ 2012-11-30  9:50 UTC (permalink / raw)
  To: Anil Madhavapeddy
  Cc: xen-devel@lists.xen.org, Rob Hoes, David Scott,
	xen-api@lists.xen.org

On Thu, 2012-11-29 at 18:20 +0000, Anil Madhavapeddy wrote:
> On 29 Nov 2012, at 18:03, Ian Campbell <Ian.Campbell@citrix.com> wrote:
> > 
> > Another idea might be to make the bindings use the async interfaces
> > wherever possible by default, by definition anything potentially
> > blocking has supports this and that would avoid the need for
> > enter/leave, but at the expense of making the ocaml callers ugly
> > perhaps? Or maybe this sort of thing ends up looking very natural in
> > ocaml? Depends on your application's event mechanism I suspect.
> > 
> > Last half witted idea: everything could be async but the bindings
> > include the loop to wait for the async event, i.e. effectively making
> > the call sync again. This sounds silly but it might allow better control
> > over the placement of enter/leave vs callbacks, since you would just
> > drop it over libxl_event_wait?
> 
> Making everything explicitly async and non-blocking is by far the
> preferred solution in terms of stability, as it largely removes the
> need to worry about the GC interface and thread interactions.
> 
> There are several libraries to wrap async interfaces in convenient
> synchronous programming, most notably Lwt (http://ocsigen.org/lwt).

I'll have to take your word for that ;-)

> With this interface, all the OCaml callbacks are implemented in
> OCaml, and it just needs a select/epoll or equivalent to wake up
> sleeping threads when an IO event occurs.

On the libxl side you'd want to be using the ao_how thing described in
libxl.h[0] and probably the event loop stuff in libxl_event.h[1]. My gut
feeling is that you'd want to go the libxl_osevent_register_hooks route
to integrate libxl into lwt's event loop rather than the
libxl_osevent_{before,after}poll option.

[0] http://xenbits.xen.org/hg/xen-unstable.hg/file/1c69c938f641/tools/libxl/libxl.h#l377
[1] http://xenbits.xen.org/hg/xen-unstable.hg/file/1c69c938f641/tools/libxl/libxl_event.h

Ian.

> 
> Dave has already done some bindings to Lwt, so I've CCed him...
> 
> -anil
> 

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [Xen-API] [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only)
  2012-11-30  9:50         ` Ian Campbell
@ 2012-11-30 10:04           ` Rob Hoes
  0 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-30 10:04 UTC (permalink / raw)
  To: Ian Campbell, Anil Madhavapeddy
  Cc: xen-devel@lists.xen.org, David Scott, xen-api@lists.xen.org

> > > Another idea might be to make the bindings use the async interfaces
> > > wherever possible by default, by definition anything potentially
> > > blocking has supports this and that would avoid the need for
> > > enter/leave, but at the expense of making the ocaml callers ugly
> > > perhaps? Or maybe this sort of thing ends up looking very natural in
> > > ocaml? Depends on your application's event mechanism I suspect.
> > >
> > > Last half witted idea: everything could be async but the bindings
> > > include the loop to wait for the async event, i.e. effectively
> > > making the call sync again. This sounds silly but it might allow
> > > better control over the placement of enter/leave vs callbacks, since
> > > you would just drop it over libxl_event_wait?
> >
> > Making everything explicitly async and non-blocking is by far the
> > preferred solution in terms of stability, as it largely removes the
> > need to worry about the GC interface and thread interactions.
> >
> > There are several libraries to wrap async interfaces in convenient
> > synchronous programming, most notably Lwt (http://ocsigen.org/lwt).
> 
> I'll have to take your word for that ;-)
> 
> > With this interface, all the OCaml callbacks are implemented in OCaml,
> > and it just needs a select/epoll or equivalent to wake up sleeping
> > threads when an IO event occurs.
> 
> On the libxl side you'd want to be using the ao_how thing described in
> libxl.h[0] and probably the event loop stuff in libxl_event.h[1]. My gut
> feeling is that you'd want to go the libxl_osevent_register_hooks route to
> integrate libxl into lwt's event loop rather than the
> libxl_osevent_{before,after}poll option.
> 
> [0] http://xenbits.xen.org/hg/xen-
> unstable.hg/file/1c69c938f641/tools/libxl/libxl.h#l377
> [1] http://xenbits.xen.org/hg/xen-
> unstable.hg/file/1c69c938f641/tools/libxl/libxl_event.h

Great, I completely forgot about the possibility of doing async calls to libxl. This sounds like an ideal solution, especially if we can avoid messing with the GC system this way (those segfaults are really hard to debug). It may be a nice excuse to get started with Lwt as well ;)

I'll do some investigation on how to integrate this.

Cheers,
Rob

> 
> Ian.
> 
> >
> > Dave has already done some bindings to Lwt, so I've CCed him...
> >
> > -anil
> >
> 

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 11 of 15] libxl: ocaml: allocate a long lived libxl context
       [not found] ` <bdd9c3e423d7f505f93e.1353432211@cosworth.uk.xensource.com>
@ 2012-11-30 10:55   ` Rob Hoes
  0 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-30 10:55 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # 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>

Looks good to me. I just included a few minor comments below. Otherwise:

Acked-by: Rob Hoes <rob.hoes@citrix.com>

Cheers,
Rob

> 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)

I had to also add 'requires = "xentoollog"' to tools/ocaml/libs/xl/META.in.

> 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"

I wrote a similar function to this one, but instead used the IDL thing. I added "dominfo" to the list of functions in genwrap.py, with "list" and "get" functions, so in OCaml you can do something like 'Dominfo.list ctx'.

> +
>  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
> +

You don't really need to open this here if you are using the "Xentoollog." prefix as done below. I think is generally better to not use "open" too much, and just prefix values/functions and type with the module name, so it is easier to see where they come from, and you avoid namespace issues (open != #include). I'd only use "open" if there are lots of them. There are few more of these in other parts of the code.

>  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();

I had to remove this to avoid segfaults, but that is probably due to the thing we discussed on the logger thread. If we are going completely async for all potentially blocking calls, we can remove this anyway.

> +	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

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 13 of 15] libxl: ocaml: propagate the libxl return error code in exceptions
  2012-11-20 17:23 ` [PATCH 13 of 15] libxl: ocaml: propagate the libxl return error code in exceptions Ian Campbell
@ 2012-11-30 11:13   ` Rob Hoes
  0 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-30 11:13 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> c8d22bfef298ce525c98b5a3f0c394068ab01572
> # Parent  e4525795eac22c7d199ceae8714e95ed660a00c4
> libxl: ocaml: propagate the libxl return error code in exceptions
>
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>

Acked-by: Rob Hoes <rob.hoes@citrix.com>

> diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py  Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py  Tue Nov 20 17:22:21 2012 +0000
> @@ -228,7 +228,7 @@ def c_val(ty, c, o, indent="", parent =
>          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\"); break;\n" %
> ty.typename
> +        s += "    default: failwith_xl(ERROR_FAIL, \"cannot convert value
> to %s\"); break;\n" % ty.typename
>          s += "}"
>      elif isinstance(ty, idl.KeyedUnion):
>          s += "{\n"
> @@ -241,7 +241,7 @@ def c_val(ty, c, o, indent="", parent =
>                                                      parent + ty.keyvar.name,
>                                                      f.enumname)
>              n += 1
> -        s += "\t\t    default: failwith_xl(\"variant handling bug %s%s (long)\");
> break;\n" % (parent, ty.keyvar.name)
> +        s += "\t\t    default: failwith_xl(ERROR_FAIL, \"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"
> @@ -257,7 +257,7 @@ def c_val(ty, c, o, indent="", parent =
>                  s += "%s" % c_val(f.type, fexpr, o, indent=indent+"\t\t        ")
>                  s += "break;\n"
>              n += 1
> -        s += "\t\t    default: failwith_xl(\"variant handling bug %s%s (block)\");
> break;\n" % (parent, ty.keyvar.name)
> +        s += "\t\t    default: failwith_xl(ERROR_FAIL, \"variant handling
> bug %s%s (block)\"); break;\n" % (parent, ty.keyvar.name)
>          s += "\t\t}\n"
>          s += "\t}\n"
>          s += "}"
> @@ -326,7 +326,7 @@ def ocaml_Val(ty, o, c, indent="", paren
>          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\");
> break;\n" % ty.typename
> +        s += "    default: failwith_xl(ERROR_FAIL, \"cannot convert value
> from %s\"); break;\n" % ty.typename
>          s += "}"
>      elif isinstance(ty, idl.KeyedUnion):
>          n = 0
> @@ -347,7 +347,7 @@ def ocaml_Val(ty, o, c, indent="", paren
>                  #s += "\t        %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n)
>              s += "\t        break;\n"
>              n += 1
> -        s += "\t    default: failwith_xl(\"cannot convert value from %s\");
> break;\n" % ty.typename
> +        s += "\t    default: failwith_xl(ERROR_FAIL, \"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"
> diff -r e4525795eac2 -r c8d22bfef298 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
> @@ -15,7 +15,47 @@
>
>  open Xentoollog
>
> -exception Error of string
> +type error =
> +    Nonspecific |
> +    Version |
> +    Fail |
> +    Ni |
> +    Nomem |
> +    Inval |
> +    Badfail |
> +    Guest_Timedout |
> +    Timedout |
> +    Noparavirt |
> +    Not_Ready |
> +    Osevent_Reg_Fail |
> +    Bufferfull |
> +    Unknown_Child
> +
> +let string_of_error error =
> +  match error with
> +  | Nonspecific -> "Non specific"
> +  | Version -> "Version"
> +  | Fail -> "Fail"
> +  | Ni -> "Ni"
> +  | Nomem -> "Nomem"
> +  | Inval -> "Inval"
> +  | Badfail -> "Badfail"
> +  | Guest_Timedout -> "Guest Timedout"
> +  | Timedout -> "Timedout"
> +  | Noparavirt -> "Noparavirt"
> +  | Not_Ready -> "Not Ready"
> +  | Osevent_Reg_Fail -> "Osevent Reg Fail"
> +  | Bufferfull -> "Bufferfull"
> +  | Unknown_Child -> "Unknown Child"
> +
> +exception Error of (error * string)
> +
> +type ctx
> +
> +external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
> +external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
> +
> +external test_raise_exception: unit -> unit = "stub_raise_exception"
>
>  type domid = int
>  type devid = int
> @@ -26,15 +66,10 @@ 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 : ctx -> string -> unit =
> "stub_xl_send_debug_keys"
>
> -let _ = Callback.register_exception "Xenlight.Error" (Error(""))
> +let _ = Callback.register_exception "Xenlight.Error" (Error(Fail, ""))
> diff -r e4525795eac2 -r c8d22bfef298 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
> @@ -15,7 +15,32 @@
>
>  open Xentoollog
>
> -exception Error of string
> +type error =
> +    Nonspecific |
> +    Version |
> +    Fail |
> +    Ni |
> +    Nomem |
> +    Inval |
> +    Badfail |
> +    Guest_Timedout |
> +    Timedout |
> +    Noparavirt |
> +    Not_Ready |
> +    Osevent_Reg_Fail |
> +    Bufferfull |
> +    Unknown_Child
> +
> +val string_of_error: error -> string
> +
> +exception Error of (error * string)
> +
> +type ctx
> +
> +external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
> +external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
> +
> +external test_raise_exception: unit = "stub_raise_exception"
>
>  type domid = int
>  type devid = int
> @@ -24,9 +49,6 @@ type devid = int
>
>  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"
> diff -r e4525795eac2 -r c8d22bfef298 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
> @@ -43,12 +43,54 @@ static char * dup_String_val(value s)
>       return c;
>  }
>
> -static void failwith_xl(char *fname)
> +static value Val_error(int error)
>  {
> +     switch (error) {
> +     case ERROR_NONSPECIFIC: return Val_int(0);
> +     case ERROR_VERSION:     return Val_int(1);
> +     case ERROR_FAIL:        return Val_int(2);
> +     case ERROR_NI:          return Val_int(3);
> +     case ERROR_NOMEM:       return Val_int(4);
> +     case ERROR_INVAL:       return Val_int(5);
> +     case ERROR_BADFAIL:     return Val_int(6);
> +     case ERROR_GUEST_TIMEDOUT: return Val_int(7);
> +     case ERROR_TIMEDOUT:    return Val_int(8);
> +     case ERROR_NOPARAVIRT:  return Val_int(9);
> +     case ERROR_NOT_READY:   return Val_int(10);
> +     case ERROR_OSEVENT_REG_FAIL: return Val_int(11);
> +     case ERROR_BUFFERFULL:  return Val_int(12);
> +     case ERROR_UNKNOWN_CHILD: return Val_int(13); #if 0 /* Let the
> +compiler catch this */
> +     default:
> +             caml_raise_sys_error(caml_copy_string("Unknown libxl
> ERROR"));
> +             break;
> +#endif
> +     }
> +     /* Should not reach here */
> +     abort();
> +}
> +
> +static void failwith_xl(int error, char *fname) {
> +     CAMLlocal1(arg);
>       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);
> +
> +     arg = caml_alloc_small(2, 0);
> +
> +     Field(arg, 0) = Val_error(error);
> +     Field(arg, 1) = caml_copy_string(fname);
> +
> +     caml_raise_with_arg(*exc, arg);
> +}
> +
> +CAMLprim value stub_raise_exception(value unit) {
> +     CAMLparam1(unit);
> +     failwith_xl(ERROR_FAIL, "test exception");
> +     CAMLreturn(Val_unit);
>  }
>
>  CAMLprim value stub_libxl_ctx_alloc(value logger) @@ -60,7 +102,7 @@
> CAMLprim value stub_libxl_ctx_alloc(valu
>       caml_enter_blocking_section();
>       ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct
> xentoollog_logger *) logger);
>       if (ret != 0) \
> -             failwith_xl("cannot init context");
> +             failwith_xl(ERROR_FAIL, "cannot init context");
>       caml_leave_blocking_section();
>       CAMLreturn((value)ctx);
>  }
> @@ -190,7 +232,7 @@ static int Bitmap_val(libxl_ctx *ctx, li
>       int i, len = Wosize_val(v);
>
>       if (!libxl_bitmap_alloc(ctx, c_val, len))
> -             failwith_xl("cannot allocate bitmap");
> +             failwith_xl(ERROR_NOMEM, "cannot allocate bitmap");
>       for (i=0; i<len; i++) {
>               if (Int_val(Field(v, i)))
>                       libxl_bitmap_set(c_val, i);
> @@ -295,7 +337,7 @@ value stub_libxl_list_domain(value ctx)
>
>       info = libxl_list_domain(CTX, &nr);
>       if (info == NULL)
> -             failwith_xl("list_domain");
> +             failwith_xl(ERROR_FAIL, "list_domain");
>
>       cli = Val_emptylist;
>
> @@ -332,7 +374,7 @@ value stub_xl_device_##type##_##op(value
>       libxl_device_##type##_dispose(&c_info);
>       \
>                                                                       \
>       if (ret != 0)                                                   \
> -             failwith_xl(STRINGIFY(type) "_" STRINGIFY(op));
>       \
> +             failwith_xl(ret, STRINGIFY(type) "_" STRINGIFY(op));    \
>                                                                       \
>       CAMLreturn(Val_unit);                                           \
>  }
> @@ -358,7 +400,7 @@ value stub_xl_physinfo_get(value ctx)
>       ret = libxl_get_physinfo(CTX, &c_physinfo);
>
>       if (ret != 0)
> -             failwith_xl("get_physinfo");
> +             failwith_xl(ret, "get_physinfo");
>
>       physinfo = Val_physinfo(CTX, &c_physinfo);
>
> @@ -377,7 +419,7 @@ value stub_xl_cputopology_get(value ctx)
>       c_topology = libxl_get_cpu_topology(CTX, &nr);
>
>       if (!c_topology)
> -             failwith_xl("topologyinfo");
> +             failwith_xl(ERROR_FAIL, "get_cpu_topologyinfo");
>
>       topology = caml_alloc_tuple(nr);
>       for (i = 0; i < nr; i++) {
> @@ -402,7 +444,7 @@ value stub_xl_domain_sched_params_get(va
>
>       ret = libxl_domain_sched_params_get(CTX, Int_val(domid),
> &c_scinfo);
>       if (ret != 0)
> -             failwith_xl("domain_sched_params_get");
> +             failwith_xl(ret, "domain_sched_params_get");
>
>       scinfo = Val_domain_sched_params(CTX, &c_scinfo);
>
> @@ -424,7 +466,7 @@ value stub_xl_domain_sched_params_set(va
>       libxl_domain_sched_params_dispose(&c_scinfo);
>
>       if (ret != 0)
> -             failwith_xl("domain_sched_params_set");
> +             failwith_xl(ret, "domain_sched_params_set");
>
>       CAMLreturn(Val_unit);
>  }
> @@ -441,7 +483,7 @@ value stub_xl_send_trigger(value ctx, va
>                                c_trigger, Int_val(vcpuid));
>
>       if (ret != 0)
> -             failwith_xl("send_trigger");
> +             failwith_xl(ret, "send_trigger");
>
>       CAMLreturn(Val_unit);
>  }
> @@ -454,7 +496,7 @@ value stub_xl_send_sysrq(value ctx, valu
>       ret = libxl_send_sysrq(CTX, Int_val(domid), Int_val(sysrq));
>
>       if (ret != 0)
> -             failwith_xl("send_sysrq");
> +             failwith_xl(ret, "send_sysrq");
>
>       CAMLreturn(Val_unit);
>  }
> @@ -469,7 +511,7 @@ value stub_xl_send_debug_keys(value ctx,
>
>       ret = libxl_send_debug_keys(CTX, c_keys);
>       if (ret != 0)
> -             failwith_xl("send_debug_keys");
> +             failwith_xl(ret, "send_debug_keys");
>
>       free(c_keys);
>
> diff -r e4525795eac2 -r c8d22bfef298 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
> @@ -6,9 +6,9 @@ OCAMLINCLUDE += \
>       -I $(OCAML_TOPLEVEL)/libs/xentoollog \
>       -I $(OCAML_TOPLEVEL)/libs/xl
>
> -OBJS = xtl send_debug_keys list_domains
> +OBJS = xtl send_debug_keys list_domains raise_exception
>
> -PROGRAMS = xtl send_debug_keys list_domains
> +PROGRAMS = xtl send_debug_keys list_domains raise_exception
>
>  xtl_LIBS =  \
>       -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog
> $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa
> @@ -27,7 +27,13 @@ list_domains_LIBS =  \
>
>  list_domains_OBJS = list_domains
>
> -OCAML_PROGRAM = xtl send_debug_keys list_domains
> +raise_exception_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
> +
> +raise_exception_OBJS = raise_exception
> +
> +OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
>
>  all: $(PROGRAMS)
>
> diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/list_domains.ml
> --- a/tools/ocaml/test/list_domains.ml        Tue Nov 20 17:22:21 2012
> +0000
> +++ b/tools/ocaml/test/list_domains.ml        Tue Nov 20 17:22:21 2012
> +0000
> @@ -19,8 +19,11 @@ let print_dominfo dominfo =  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;
> -
> +  try
> +    let domains = Xenlight.list_domain ctx in
> +    List.iter (fun d -> print_dominfo d) domains;
> +    Xenlight.ctx_free ctx;
> +    Xentoollog.destroy logger;
> +  with Xenlight.Error(err, fn) -> begin
> +    printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err)
> + fn;  end
> diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/raise_exception.ml
> --- /dev/null Thu Jan 01 00:00:00 1970 +0000
> +++ b/tools/ocaml/test/raise_exception.ml     Tue Nov 20 17:22:21 2012
> +0000
> @@ -0,0 +1,15 @@
> +open Printf
> +open Xentoollog
> +open Xenlight
> +
> +let _ =
> +  let logger = Xentoollog.create_stdio_logger
> +(*~level:Xentoollog.Debug*) () in
> +  let ctx = Xenlight.ctx_alloc logger in
> +  try
> +    Xenlight.test_raise_exception ()
> +  with Xenlight.Error(err, fn) -> begin
> +    printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err)
> +fn;
> +  end;
> +  Xenlight.ctx_free ctx;
> +  Xentoollog.destroy logger;
> +
>
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 14 of 15] libxl: ocaml: generate libxl_domain_config bindings
       [not found] ` <41f0137955f4a1a5a76a.1353432214@cosworth.uk.xensource.com>
@ 2012-11-30 11:14   ` Rob Hoes
  0 siblings, 0 replies; 39+ messages in thread
From: Rob Hoes @ 2012-11-30 11:14 UTC (permalink / raw)
  To: Ian Campbell, xen-devel@lists.xen.org, xen-api@lists.xen.org

> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID
> 41f0137955f4a1a5a76ad34a5a6440e32d0090ef
> # Parent  c8d22bfef298ce525c98b5a3f0c394068ab01572
> libxl: ocaml: generate libxl_domain_config bindings
> 
> With the infrastructure we now have in place this is trivial.
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>

Acked-by: Rob Hoes <rob.hoes@citrix.com>

> diff -r c8d22bfef298 -r 41f0137955f4 tools/libxl/libxl_types.idl
> --- a/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/libxl/libxl_types.idl	Tue Nov 20 17:22:21 2012 +0000
> @@ -417,7 +417,7 @@ libxl_domain_config = Struct("domain_con
>      ("on_reboot", libxl_action_on_shutdown),
>      ("on_watchdog", libxl_action_on_shutdown),
>      ("on_crash", libxl_action_on_shutdown),
> -    ])
> +    ], dir=DIR_IN)
> 
>  libxl_diskinfo = Struct("diskinfo", [
>      ("backend", string),
> diff -r c8d22bfef298 -r 41f0137955f4 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py	Tue Nov 20 17:22:21 2012 +0000
> @@ -420,7 +420,6 @@ if __name__ == '__main__':
>      # Do not generate these yet.
>      blacklist = [
>          "cpupoolinfo",
> -        "domain_config",
>          "vcpuinfo",
>          ]
> 
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 02 of 15] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
       [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107AB@LONPMAILBOX01.citrite.net>
@ 2012-12-19 13:57     ` Ian Campbell
  0 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-12-19 13:57 UTC (permalink / raw)
  To: Rob Hoes; +Cc: xen-api@lists.xen.org, xen-devel@lists.xen.org

On Thu, 2012-11-29 at 16:23 +0000, Rob Hoes wrote:
> > libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
> > 
> > libxl_dominfo.shutdown_reason is valid iff (shutdown||dying). This is a bit
> > annoying when generating language bindings since it needs all sorts of
> > special casing. Just introduce an explicit value instead.
> > 
> > Signed-off-by: Ian Campbell <ian.cambell@citrix.com>
> 
> This change is very useful from an ocaml-bindings point of view.
> 
> Acked-by: Rob Hoes <rob.hoes@citrix.com>

Thanks. I think I'm actually going to defer on applying this one until
we have a clearer idea what direction the bindings are taking.

In particular if we decide to implement the "default" state with
None/Some (see comment on patch 15/15) then that may be more appropriate
than this change.

Ian.

^ permalink raw reply	[flat|nested] 39+ messages in thread

* Re: [PATCH 01 of 15] libxl: move definition of libxl_domain_config into the IDL
  2012-11-20 17:23 ` [PATCH 01 of 15] libxl: move definition of libxl_domain_config into the IDL Ian Campbell
@ 2012-12-19 14:34   ` Ian Campbell
  0 siblings, 0 replies; 39+ messages in thread
From: Ian Campbell @ 2012-12-19 14:34 UTC (permalink / raw)
  To: xen-devel@lists.xen.org; +Cc: xen-api@lists.xen.org

On Tue, 2012-11-20 at 17:23 +0000, Ian Campbell wrote:
> # HG changeset patch
> # User Ian Campbell <ijc@hellion.org.uk>
> # Date 1353432136 0
> # Node ID 601dc257a740d3a6047667731007283a4dcb9600
> # Parent  c893596e2d4c7ddd62a3704ea5460be4e5be38df
> libxl: move definition of libxl_domain_config into the IDL
> 
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
> Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
> ---
> Posted during 4.2 freeze and deferred until 4.3...

And now, finally, committed.

> 
> diff -r c893596e2d4c -r 601dc257a740 tools/libxl/libxl.h
> --- a/tools/libxl/libxl.h       Tue Nov 20 17:22:10 2012 +0000
> +++ b/tools/libxl/libxl.h       Tue Nov 20 17:22:16 2012 +0000
> @@ -474,26 +474,6 @@ typedef struct {
> 
>  #define LIBXL_VERSION 0
> 
> -typedef struct {
> -    libxl_domain_create_info c_info;
> -    libxl_domain_build_info b_info;
> -
> -    int num_disks, num_nics, num_pcidevs, num_vfbs, num_vkbs, num_vtpms;
> -
> -    libxl_device_disk *disks;
> -    libxl_device_nic *nics;
> -    libxl_device_pci *pcidevs;
> -    libxl_device_vfb *vfbs;
> -    libxl_device_vkb *vkbs;
> -    libxl_device_vtpm *vtpms;
> -
> -    libxl_action_on_shutdown on_poweroff;
> -    libxl_action_on_shutdown on_reboot;
> -    libxl_action_on_shutdown on_watchdog;
> -    libxl_action_on_shutdown on_crash;
> -} libxl_domain_config;
> -char *libxl_domain_config_to_json(libxl_ctx *ctx, libxl_domain_config *p);
> -
>  /* context functions */
>  int libxl_ctx_alloc(libxl_ctx **pctx, int version,
>                      unsigned flags /* none currently defined */,
> diff -r c893596e2d4c -r 601dc257a740 tools/libxl/libxl_create.c
> --- a/tools/libxl/libxl_create.c        Tue Nov 20 17:22:10 2012 +0000
> +++ b/tools/libxl/libxl_create.c        Tue Nov 20 17:22:16 2012 +0000
> @@ -24,43 +24,6 @@
>  #include <xenguest.h>
>  #include <xen/hvm/hvm_info_table.h>
> 
> -void libxl_domain_config_init(libxl_domain_config *d_config)
> -{
> -    memset(d_config, 0, sizeof(*d_config));
> -    libxl_domain_create_info_init(&d_config->c_info);
> -    libxl_domain_build_info_init(&d_config->b_info);
> -}
> -
> -void libxl_domain_config_dispose(libxl_domain_config *d_config)
> -{
> -    int i;
> -
> -    for (i=0; i<d_config->num_disks; i++)
> -        libxl_device_disk_dispose(&d_config->disks[i]);
> -    free(d_config->disks);
> -
> -    for (i=0; i<d_config->num_nics; i++)
> -        libxl_device_nic_dispose(&d_config->nics[i]);
> -    free(d_config->nics);
> -
> -    for (i=0; i<d_config->num_pcidevs; i++)
> -        libxl_device_pci_dispose(&d_config->pcidevs[i]);
> -    free(d_config->pcidevs);
> -
> -    for (i=0; i<d_config->num_vfbs; i++)
> -        libxl_device_vfb_dispose(&d_config->vfbs[i]);
> -    free(d_config->vfbs);
> -
> -    for (i=0; i<d_config->num_vkbs; i++)
> -        libxl_device_vkb_dispose(&d_config->vkbs[i]);
> -    free(d_config->vkbs);
> -
> -    libxl_device_vtpm_list_free(d_config->vtpms, d_config->num_vtpms);
> -
> -    libxl_domain_create_info_dispose(&d_config->c_info);
> -    libxl_domain_build_info_dispose(&d_config->b_info);
> -}
> -
>  int libxl__domain_create_info_setdefault(libxl__gc *gc,
>                                           libxl_domain_create_info *c_info)
>  {
> diff -r c893596e2d4c -r 601dc257a740 tools/libxl/libxl_json.c
> --- a/tools/libxl/libxl_json.c  Tue Nov 20 17:22:10 2012 +0000
> +++ b/tools/libxl/libxl_json.c  Tue Nov 20 17:22:16 2012 +0000
> @@ -786,158 +786,6 @@ out:
>      return ret;
>  }
> 
> -yajl_gen_status libxl_domain_config_gen_json(yajl_gen hand,
> -                                             libxl_domain_config *p)
> -{
> -    yajl_gen_status s;
> -    int i;
> -
> -    s = yajl_gen_map_open(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"c_info",
> -                        sizeof("c_info")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = libxl_domain_create_info_gen_json(hand, &p->c_info);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"b_info",
> -                        sizeof("b_info")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = libxl_domain_build_info_gen_json(hand, &p->b_info);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"disks",
> -                        sizeof("disks")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = yajl_gen_array_open(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    for (i = 0; i < p->num_disks; i++) {
> -        s = libxl_device_disk_gen_json(hand, &p->disks[i]);
> -        if (s != yajl_gen_status_ok)
> -            goto out;
> -    }
> -    s = yajl_gen_array_close(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"nics",
> -                        sizeof("nics")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = yajl_gen_array_open(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    for (i = 0; i < p->num_nics; i++) {
> -        s = libxl_device_nic_gen_json(hand, &p->nics[i]);
> -        if (s != yajl_gen_status_ok)
> -            goto out;
> -    }
> -    s = yajl_gen_array_close(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"pcidevs",
> -                        sizeof("pcidevs")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = yajl_gen_array_open(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    for (i = 0; i < p->num_pcidevs; i++) {
> -        s = libxl_device_pci_gen_json(hand, &p->pcidevs[i]);
> -        if (s != yajl_gen_status_ok)
> -            goto out;
> -    }
> -    s = yajl_gen_array_close(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"vfbs",
> -                        sizeof("vfbs")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = yajl_gen_array_open(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    for (i = 0; i < p->num_vfbs; i++) {
> -        s = libxl_device_vfb_gen_json(hand, &p->vfbs[i]);
> -        if (s != yajl_gen_status_ok)
> -            goto out;
> -    }
> -    s = yajl_gen_array_close(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"vkbs",
> -                        sizeof("vkbs")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = yajl_gen_array_open(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    for (i = 0; i < p->num_vkbs; i++) {
> -        s = libxl_device_vkb_gen_json(hand, &p->vkbs[i]);
> -        if (s != yajl_gen_status_ok)
> -            goto out;
> -    }
> -    s = yajl_gen_array_close(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"on_poweroff",
> -                        sizeof("on_poweroff")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = libxl_action_on_shutdown_gen_json(hand, &p->on_poweroff);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"on_reboot",
> -                        sizeof("on_reboot")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = libxl_action_on_shutdown_gen_json(hand, &p->on_reboot);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"on_watchdog",
> -                        sizeof("on_watchdog")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = libxl_action_on_shutdown_gen_json(hand, &p->on_watchdog);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_string(hand, (const unsigned char *)"on_crash",
> -                        sizeof("on_crash")-1);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    s = libxl_action_on_shutdown_gen_json(hand, &p->on_crash);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -
> -    s = yajl_gen_map_close(hand);
> -    if (s != yajl_gen_status_ok)
> -        goto out;
> -    out:
> -    return s;
> -}
> -
> -char *libxl_domain_config_to_json(libxl_ctx *ctx, libxl_domain_config *p)
> -{
> -    return libxl__object_to_json(ctx, "libxl_domain_config",
> -                        (libxl__gen_json_callback)&libxl_domain_config_gen_json,
> -                        (void *)p);
> -}
> -
>  /*
>   * Local variables:
>   * mode: C
> diff -r c893596e2d4c -r 601dc257a740 tools/libxl/libxl_types.idl
> --- a/tools/libxl/libxl_types.idl       Tue Nov 20 17:22:10 2012 +0000
> +++ b/tools/libxl/libxl_types.idl       Tue Nov 20 17:22:16 2012 +0000
> @@ -401,6 +401,23 @@ libxl_device_vtpm = Struct("device_vtpm"
>      ("uuid",             libxl_uuid),
>  ])
> 
> +libxl_domain_config = Struct("domain_config", [
> +    ("c_info", libxl_domain_create_info),
> +    ("b_info", libxl_domain_build_info),
> +
> +    ("disks", Array(libxl_device_disk, "num_disks")),
> +    ("nics", Array(libxl_device_nic, "num_nics")),
> +    ("pcidevs", Array(libxl_device_pci, "num_pcidevs")),
> +    ("vfbs", Array(libxl_device_vfb, "num_vfbs")),
> +    ("vkbs", Array(libxl_device_vkb, "num_vkbs")),
> +    ("vtpms", Array(libxl_device_vtpm, "num_vtpms")),
> +
> +    ("on_poweroff", libxl_action_on_shutdown),
> +    ("on_reboot", libxl_action_on_shutdown),
> +    ("on_watchdog", libxl_action_on_shutdown),
> +    ("on_crash", libxl_action_on_shutdown),
> +    ])
> +
>  libxl_diskinfo = Struct("diskinfo", [
>      ("backend", string),
>      ("backend_id", uint32),
> diff -r c893596e2d4c -r 601dc257a740 tools/ocaml/libs/xl/genwrap.py
> --- a/tools/ocaml/libs/xl/genwrap.py    Tue Nov 20 17:22:10 2012 +0000
> +++ b/tools/ocaml/libs/xl/genwrap.py    Tue Nov 20 17:22:16 2012 +0000
> @@ -283,6 +283,7 @@ if __name__ == '__main__':
>          "cpupoolinfo",
>          "domain_create_info",
>          "domain_build_info",
> +        "domain_config",
>          "vcpuinfo",
>          "event",
>          ]
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

^ permalink raw reply	[flat|nested] 39+ messages in thread

end of thread, other threads:[~2012-12-19 14:34 UTC | newest]

Thread overview: 39+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
     [not found] <patchbomb.1353432200@cosworth.uk.xensource.com>
2012-11-20 17:23 ` [PATCH 01 of 15] libxl: move definition of libxl_domain_config into the IDL Ian Campbell
2012-12-19 14:34   ` Ian Campbell
2012-11-20 17:23 ` [PATCH 02 of 15] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Ian Campbell
2012-11-20 17:23 ` [PATCH 03 of 15] libxl: idl: Allow KeyedUnion members to be empty Ian Campbell
2012-11-20 17:23 ` [PATCH 04 of 15] libxl: ocaml: fix code intended to output comments before definitions Ian Campbell
2012-11-20 17:23 ` [PATCH 05 of 15] libxl: ocaml: support for Arrays in bindings generator Ian Campbell
2012-11-20 17:23 ` [PATCH 06 of 15] libxl/ocaml: avoid reserved words in type and field names Ian Campbell
2012-11-20 17:23 ` [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator Ian Campbell
2012-11-20 17:23 ` [PATCH 08 of 15] libxl/ocaml: add some more builtin types Ian Campbell
2012-11-20 17:23 ` [PATCH 09 of 15] libxl/ocaml: add domain_build/create_info and events to the bindings Ian Campbell
2012-11-29 17:20   ` Rob Hoes
2012-11-20 17:23 ` [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only) Ian Campbell
2012-11-29 17:41   ` Rob Hoes
     [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107B2@LONPMAILBOX01.citrite.net>
2012-11-29 18:03     ` Ian Campbell
     [not found]     ` <1354212199.6269.67.camel@zakaz.uk.xensource.com>
2012-11-29 18:20       ` [Xen-API] " Anil Madhavapeddy
     [not found]       ` <5DC583C2-ED2D-4305-9AC5-74F8F57F300D@recoil.org>
2012-11-30  9:50         ` Ian Campbell
2012-11-30 10:04           ` Rob Hoes
2012-11-20 17:23 ` [PATCH 11 of 15] libxl: ocaml: allocate a long lived libxl context Ian Campbell
2012-11-20 17:23 ` [PATCH 12 of 15] libxl: ocaml: switch all functions over to take a context Ian Campbell
2012-11-20 17:23 ` [PATCH 13 of 15] libxl: ocaml: propagate the libxl return error code in exceptions Ian Campbell
2012-11-30 11:13   ` Rob Hoes
2012-11-20 17:23 ` [PATCH 14 of 15] libxl: ocaml: generate libxl_domain_config bindings Ian Campbell
2012-11-20 17:23 ` [PATCH 15 of 15] libxl: ocaml: add bindings for libxl_domain_create_new Ian Campbell
2012-11-26 14:01 ` [PATCH 00 of 15] libxl: ocaml: improve the bindings Rob Hoes
     [not found] ` <0cf342afa9e6b506fad6.1353432207@cosworth.uk.xensource.com>
2012-11-26 15:31   ` [PATCH 07 of 15] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
     [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107A4@LONPMAILBOX01.citrite.net>
2012-11-26 15:35     ` Ian Campbell
2012-11-29 16:54   ` Rob Hoes
     [not found] ` <7EA643C653F17F4C80DE959E978F10EDFA101107A1@LONPMAILBOX01.citrite.net>
2012-11-26 15:35   ` [PATCH 00 of 15] libxl: ocaml: improve the bindings Ian Campbell
2012-11-26 15:36   ` Ian Campbell
     [not found] ` <8195cb0ebac691ae94e9.1353432202@cosworth.uk.xensource.com>
2012-11-26 14:18   ` [PATCH 02 of 15] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
2012-11-29 16:23   ` Rob Hoes
     [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107AB@LONPMAILBOX01.citrite.net>
2012-12-19 13:57     ` Ian Campbell
     [not found] ` <be294b1cdd00dac5d3a1.1353432204@cosworth.uk.xensource.com>
2012-11-29 16:27   ` [Xen-API] [PATCH 04 of 15] libxl: ocaml: fix code intended to output comments before definitions Rob Hoes
     [not found] ` <b7e2cd4a03f278c9abfe.1353432205@cosworth.uk.xensource.com>
2012-11-29 16:52   ` [PATCH 05 of 15] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
     [not found] ` <f618acdeea1bf60b3b68.1353432206@cosworth.uk.xensource.com>
2012-11-29 16:52   ` [PATCH 06 of 15] libxl/ocaml: avoid reserved words in type and field names Rob Hoes
     [not found] ` <21c5e58956d09437903e.1353432208@cosworth.uk.xensource.com>
2012-11-29 17:19   ` [PATCH 08 of 15] libxl/ocaml: add some more builtin types Rob Hoes
     [not found]   ` <7EA643C653F17F4C80DE959E978F10EDFA101107B0@LONPMAILBOX01.citrite.net>
2012-11-29 17:42     ` Ian Campbell
     [not found] ` <bdd9c3e423d7f505f93e.1353432211@cosworth.uk.xensource.com>
2012-11-30 10:55   ` [PATCH 11 of 15] libxl: ocaml: allocate a long lived libxl context Rob Hoes
     [not found] ` <41f0137955f4a1a5a76a.1353432214@cosworth.uk.xensource.com>
2012-11-30 11:14   ` [PATCH 14 of 15] libxl: ocaml: generate libxl_domain_config bindings Rob Hoes

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).