[PATCH v2 09/30] libxl: ocaml: add some more builtin types.

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

  * 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>
---
 tools/ocaml/libs/xl/genwrap.py       |    6 +-
 tools/ocaml/libs/xl/xenlight_stubs.c |  127 ++++++++++++++++++++++++++++++----
 2 files changed, 119 insertions(+), 14 deletions(-)

diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 0c80e3d..05c4582 100644
--- 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 5f19a82..a7bf6ba 100644
--- 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();
-- 
1.7.10.4