libxl: ocaml: add some more builtin types.

  * bitmaps
  * string_list
  * key_value_list
  * cpuid_policy_list (left "empty" for now)

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>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>

diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index f98d686dfda6aba44726d35309b8907cb9030735..1e956abb2e4cab21575279aea71358446ab1ec31 100644 (file)
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -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)", "Val_key_value_list(&%(c)s)"),
+    "libxl_string_list":    ("string list",            "libxl_string_list_val(gc, lg, &%(c)s, %(o)s)", "Val_string_list(&%(c)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)"),
+    # The following needs to be sorted out later
+    "libxl_cpuid_policy_list": ("unit",                "%(c)s = 0",                         "Val_unit"),
     }
 
 DEVICE_FUNCTIONS = [ ("add",            ["t", "domid", "unit"]),

diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 5f19a82c8b68b163a2c96289bdbc7f8fc059a4b7..a7bf6ba9105e2fbb5a60429b0de449f376fb54e8 100644 (file)
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -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, struct caml_logger *lg)
        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,103 @@ static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
        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 value Val_key_value_list(libxl_key_value_list *c_val)
+{
+       CAMLparam0();
+       CAMLlocal5(list, cons, key, val, kv);
+       int i;
+
+       list = Val_emptylist;
+       for (i = libxl_string_list_length((libxl_string_list *) c_val) - 1; i >= 0; i -= 2) {
+               val = caml_copy_string((char *) c_val[i]);
+               key = caml_copy_string((char *) c_val[i - 1]);
+               kv = caml_alloc_tuple(2);
+               Store_field(kv, 0, key);
+               Store_field(kv, 1, val);
+
+               cons = caml_alloc(2, 0);
+               Store_field(cons, 0, kv);   // head
+               Store_field(cons, 1, list);   // tail
+               list = cons;
+       }
+
+       CAMLreturn(list);
+}
+
+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_string_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);
+}
+
+static value Val_string_list(libxl_string_list *c_val)
+{
+       CAMLparam0();
+       CAMLlocal3(list, cons, string);
+       int i;
+
+       list = Val_emptylist;
+       for (i = libxl_string_list_length(c_val) - 1; i >= 0; i--) {
+               string = caml_copy_string((char *) c_val[i]);
+               cons = caml_alloc(2, 0);
+               Store_field(cons, 0, string);   // head
+               Store_field(cons, 1, list);     // tail
+               list = cons;
+       }
+
+       CAMLreturn(list);
+}
 
 /* Option type support as per http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php */
 #define Val_none Val_int(0)
@@ -168,6 +243,32 @@ static int Mac_val(caml_gc *gc, struct caml_logger *lg, libxl_mac *c_val, value
        CAMLreturn(0);
 }
 
+static value Val_bitmap (libxl_bitmap *c_val)
+{
+       CAMLparam0();
+       CAMLlocal1(v);
+       int i;
+
+       if (c_val->size == 0)
+               v = Atom(0);
+       else {
+           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_uuid (libxl_uuid *c_val)
 {
        CAMLparam0();