The following series of patches fill in most of the gaps in the OCaml bindings to libxl, to make them useful for clients such as xapi/xenopsd (from XCP). There are a number of bugfixes to the existing bindings as well. I have an experimental version of xenopsd that successfully uses the new bindings. An earlier version of the first half of the series was submitted to the last by Ian Campbell on 20 Nov 2012. With his permission, I have updated most of them to fix some issues (which were discussed on the mailing list at the time). I have left Ian''s signed-off-by line on those patches (please let me know if that is not appropriate). For convenience, the patches in this series may be pulled using: git pull git://github.com/robhoes/xen.git hydrogen-upstream Cheers, Rob
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>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/libxl/libxl.c | 2 +-
tools/libxl/libxl_types.idl | 5 +++--
2 files changed, 4 insertions(+), 3 deletions(-)
diff --git a/tools/libxl/libxl.c b/tools/libxl/libxl.c
index 572c2c6..9c7886a 100644
--- a/tools/libxl/libxl.c
+++ b/tools/libxl/libxl.c
@@ -526,7 +526,7 @@ static void xcinfo2xlinfo(const xc_domaininfo_t *xcinfo,
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 --git a/tools/libxl/libxl_types.idl b/tools/libxl/libxl_types.idl
index f3c212b..4552ca6 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -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"),
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 02/28] 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>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/libxl/gentest.py | 3 ++-
tools/libxl/gentypes.py | 11 ++++++++---
tools/libxl/libxl_types.idl | 2 +-
3 files changed, 11 insertions(+), 5 deletions(-)
diff --git a/tools/libxl/gentest.py b/tools/libxl/gentest.py
index 84b4fd7..6fab493 100644
--- a/tools/libxl/gentest.py
+++ b/tools/libxl/gentest.py
@@ -46,7 +46,8 @@ def gen_rand_init(ty, v, indent = " ", parent =
None):
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 --git a/tools/libxl/gentypes.py b/tools/libxl/gentypes.py
index 30f29ba..be06257 100644
--- a/tools/libxl/gentypes.py
+++ b/tools/libxl/gentypes.py
@@ -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 = " ",
parent = None):
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 = " ",
parent = None, subinit=False):
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 = " ",
parent = None):
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 --git a/tools/libxl/libxl_types.idl b/tools/libxl/libxl_types.idl
index 4552ca6..4749f68 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -342,7 +342,7 @@ libxl_domain_build_info =
Struct("domain_build_info",[
# 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
)
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 03/28] 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>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index ea978bf..5757218 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -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:
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 04/28] 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@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 9 ++++++++-
1 file changed, 8 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 5757218..7b29039 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -143,7 +143,14 @@ def c_val(ty, c, o, indent="", parent = None):
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 += "\t%s = (%s) calloc(%s, sizeof(*%s));\n" % (c,
ty.typename, parent + ty.lenvar.name, c)
+ 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
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 05/28] 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>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 8 +++++++-
1 file changed, 7 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 7b29039..9042c79 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -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=""):
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 06/28] 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>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/libxl/idl.py | 3 +
tools/ocaml/libs/xl/genwrap.py | 162 +++++++++++++++++++++++++++++++++++-----
2 files changed, 146 insertions(+), 19 deletions(-)
diff --git a/tools/libxl/idl.py b/tools/libxl/idl.py
index 7d95e3f..f4908dd 100644
--- a/tools/libxl/idl.py
+++ b/tools/libxl/idl.py
@@ -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 --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 9042c79..b3ba30e 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -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):
@@ -165,12 +227,43 @@ def c_val(ty, c, o, indent="", parent = None):
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, "Field(%s,
0)" % o, indent=indent+"\t\t ")
+ s += "break;\n"
+ n += 1
+ s += "\t\t default: failwith_xl(\"variant handling bug
%s%s (block)\", lg); break;\n" % (parent, ty.keyvar.name)
+ s += "\t\t}\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:
@@ -192,8 +285,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]:
@@ -232,11 +325,42 @@ def ocaml_Val(ty, o, c, indent="", parent =
None):
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
+ m = 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)
+ n += 1
+ elif not f.type.has_fields():
+ s += "\t /* %d: Long */\n" % n
+ s += "\t %s = Val_long(%d);\n" % (o,n)
+ n += 1
+ else:
+ s += "\t /* %d: Block */\n" % m
+ (nparent,fexpr) = ty.member(c, f, parent is None)
+ s += ocaml_Val(f.type, o, fexpr, struct_tag = m,
indent="\t ", parent=nparent)
+ s += "\n"
+ m += 1
+ #s += "\t %s = caml_alloc(%d,%d);\n" %
(o,len(f.type.fields),n)
+ s += "\t break;\n"
+ s += "\t default: failwith_xl(\"cannot convert value from
%s\", lg); break;\n" % ty.typename
+ s += "\t}"
+ 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:
@@ -246,8 +370,8 @@ def ocaml_Val(ty, o, c, indent="", parent = None):
(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:
--
1.7.10.4
* 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 | 82 ++++++++++++++++++++++++++++------
2 files changed, 74 insertions(+), 14 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index b3ba30e..aaa16a8 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)",
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)"),
+ # 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..8046238 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,62 @@ 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 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,28 @@ 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;
+
+ 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
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 08/28] 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>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
.gitignore | 1 +
.hgignore | 1 +
tools/ocaml/Makefile | 2 +-
tools/ocaml/Makefile.rules | 2 +-
tools/ocaml/libs/Makefile | 1 +
tools/ocaml/libs/xentoollog/META.in | 4 +
tools/ocaml/libs/xentoollog/Makefile | 33 ++++
tools/ocaml/libs/xentoollog/xentoollog.ml | 102 +++++++++++
tools/ocaml/libs/xentoollog/xentoollog.mli | 54 ++++++
tools/ocaml/libs/xentoollog/xentoollog_stubs.c | 215 ++++++++++++++++++++++++
tools/ocaml/test/Makefile | 28 +++
tools/ocaml/test/xtl.ml | 20 +++
12 files changed, 461 insertions(+), 2 deletions(-)
create mode 100644 tools/ocaml/libs/xentoollog/META.in
create mode 100644 tools/ocaml/libs/xentoollog/Makefile
create mode 100644 tools/ocaml/libs/xentoollog/xentoollog.ml
create mode 100644 tools/ocaml/libs/xentoollog/xentoollog.mli
create mode 100644 tools/ocaml/libs/xentoollog/xentoollog_stubs.c
create mode 100644 tools/ocaml/test/Makefile
create mode 100644 tools/ocaml/test/xtl.ml
diff --git a/.gitignore b/.gitignore
index fce8c89..05b9bb0 100644
--- a/.gitignore
+++ b/.gitignore
@@ -398,6 +398,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 --git a/.hgignore b/.hgignore
index 6b432f7..7d59535 100644
--- a/.hgignore
+++ b/.hgignore
@@ -325,6 +325,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 --git a/tools/ocaml/Makefile b/tools/ocaml/Makefile
index 6b22bbe..8e4ca36 100644
--- a/tools/ocaml/Makefile
+++ b/tools/ocaml/Makefile
@@ -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 --git a/tools/ocaml/Makefile.rules b/tools/ocaml/Makefile.rules
index ff19067..ed1dd76 100644
--- a/tools/ocaml/Makefile.rules
+++ b/tools/ocaml/Makefile.rules
@@ -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 --git a/tools/ocaml/libs/Makefile b/tools/ocaml/libs/Makefile
index bca0fa2..3afdc89 100644
--- a/tools/ocaml/libs/Makefile
+++ b/tools/ocaml/libs/Makefile
@@ -3,6 +3,7 @@ include $(XEN_ROOT)/tools/Rules.mk
SUBDIRS= \
mmap \
+ xentoollog \
xc eventchn \
xb xs xl
diff --git a/tools/ocaml/libs/xentoollog/META.in
b/tools/ocaml/libs/xentoollog/META.in
new file mode 100644
index 0000000..7b06683
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/META.in
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "Xen Tools Logger Interface"
+archive(byte) = "xentoollog.cma"
+archive(native) = "xentoollog.cmxa"
diff --git a/tools/ocaml/libs/xentoollog/Makefile
b/tools/ocaml/libs/xentoollog/Makefile
new file mode 100644
index 0000000..17dca95
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/Makefile
@@ -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 --git a/tools/ocaml/libs/xentoollog/xentoollog.ml
b/tools/ocaml/libs/xentoollog/xentoollog.ml
new file mode 100644
index 0000000..226722c
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog.ml
@@ -0,0 +1,102 @@
+(*
+ * 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
+
+let compare_level x y + compare (level_to_prio x) (level_to_prio y)
+
+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_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 compare min_level level <= 0 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 cbs = {
+ vmessage = stdio_vmessage level;
+ progress = stdio_progress; } in
+ create "Xentoollog.stdio_logger" cbs
+
+external destroy: handle -> unit = "stub_xtl_destroy"
diff --git a/tools/ocaml/libs/xentoollog/xentoollog.mli
b/tools/ocaml/libs/xentoollog/xentoollog.mli
new file mode 100644
index 0000000..ae417f5
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog.mli
@@ -0,0 +1,54 @@
+(*
+ * 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
+
+val compare_level : level -> level -> int
+
+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 --git a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
new file mode 100644
index 0000000..7c1b775
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
@@ -0,0 +1,215 @@
+/*
+ * 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)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 4);
+ struct caml_xtl *xtl = (struct caml_xtl*)logger;
+ value *func = caml_named_value(xtl->vmessage_cb) ;
+ 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);
+ 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)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 5);
+ struct caml_xtl *xtl = (struct caml_xtl*)logger;
+ value *func = caml_named_value(xtl->progress_cb) ;
+
+ 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);
+ 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);
+}
+
+/* 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 --git a/tools/ocaml/test/Makefile b/tools/ocaml/test/Makefile
new file mode 100644
index 0000000..980054c
--- /dev/null
+++ b/tools/ocaml/test/Makefile
@@ -0,0 +1,28 @@
+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 \
+ -cclib -lxenctrl
+
+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 --git a/tools/ocaml/test/xtl.ml b/tools/ocaml/test/xtl.ml
new file mode 100644
index 0000000..3afaa60
--- /dev/null
+++ b/tools/ocaml/test/xtl.ml
@@ -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
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 09/28] 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.
Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/META.in | 1 +
tools/ocaml/libs/xl/Makefile | 2 ++
tools/ocaml/libs/xl/xenlight.ml.in | 5 +++++
tools/ocaml/libs/xl/xenlight.mli.in | 5 +++++
tools/ocaml/libs/xl/xenlight_stubs.c | 26 +++++++++++++++++++++++++-
5 files changed, 38 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/META.in b/tools/ocaml/libs/xl/META.in
index 9c4405a..06efae6 100644
--- a/tools/ocaml/libs/xl/META.in
+++ b/tools/ocaml/libs/xl/META.in
@@ -1,4 +1,5 @@
version = "@VERSION@"
description = "Xen Toolstack Library"
+requires = "xentoollog"
archive(byte) = "xl.cma"
archive(native) = "xl.cmxa"
diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile
index c9e5274..79f07a5 100644
--- a/tools/ocaml/libs/xl/Makefile
+++ b/tools/ocaml/libs/xl/Makefile
@@ -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 --git a/tools/ocaml/libs/xl/xenlight.ml.in
b/tools/ocaml/libs/xl/xenlight.ml.in
index dcc1a38..22c647f 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -20,6 +20,11 @@ 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 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"
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in
b/tools/ocaml/libs/xl/xenlight.mli.in
index 3fd0165..fef8df5 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -20,6 +20,11 @@ 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 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"
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index 8046238..d495a6c 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -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 xentoollog_logger *logger)
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, value s)
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,29 @@ 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);
}
+CAMLprim value stub_libxl_ctx_alloc(value logger)
+{
+ CAMLparam1(logger);
+ libxl_ctx *ctx;
+ int ret;
+
+ ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *)
logger);
+ if (ret != 0) \
+ failwith_xl("cannot init context", NULL);
+ CAMLreturn((value)ctx);
+}
+
+CAMLprim value stub_libxl_ctx_free(value ctx)
+{
+ CAMLparam1(ctx);
+ libxl_ctx_free(CTX);
+ CAMLreturn(Val_unit);
+}
+
static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
{
void *ptr;
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 10/28] 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>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 44 ++--
tools/ocaml/libs/xl/xenlight.ml.in | 8 +-
tools/ocaml/libs/xl/xenlight.mli.in | 6 +-
tools/ocaml/libs/xl/xenlight_stubs.c | 467 +++++++++-------------------------
4 files changed, 145 insertions(+), 380 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index aaa16a8..b087817 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -8,23 +8,23 @@ import idl
builtins = {
"bool": ("bool",
"%(c)s = Bool_val(%(o)s)", "Val_bool(%(c)s)" ),
"int": ("int",
"%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)" ),
- "char *": ("string",
"%(c)s = dup_String_val(gc, %(o)s)",
"caml_copy_string(%(c)s)"),
+ "char *": ("string",
"%(c)s = dup_String_val(%(o)s)", "caml_copy_string(%(c)s)"),
"libxl_domid": ("domid",
"%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)" ),
"libxl_devid": ("devid",
"%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)" ),
"libxl_defbool": ("bool option",
"%(c)s = Defbool_val(%(o)s)", "Val_defbool(%(c)s)" ),
- "libxl_uuid": ("int array",
"Uuid_val(gc, lg, &%(c)s, %(o)s)",
"Val_uuid(&%(c)s)"),
- "libxl_bitmap": ("bool array",
"Bitmap_val(gc, lg, &%(c)s, %(o)s)",
"Val_bitmap(&%(c)s)"),
- "libxl_key_value_list": ("(string * string) list",
"libxl_key_value_list_val(gc, lg, &%(c)s, %(o)s)",
None),
- "libxl_string_list": ("string list",
"libxl_string_list_val(gc, lg, &%(c)s, %(o)s)",
"String_list_val(gc, lg, &%(c)s, %(o)s)"),
- "libxl_mac": ("int array",
"Mac_val(gc, lg, &%(c)s, %(o)s)",
"Val_mac(&%(c)s)"),
+ "libxl_uuid": ("int array",
"Uuid_val(&%(c)s, %(o)s)", "Val_uuid(&%(c)s)"),
+ "libxl_bitmap": ("bool array",
"Bitmap_val(ctx, &%(c)s, %(o)s)",
"Val_bitmap(&%(c)s)"),
+ "libxl_key_value_list": ("(string * string) list",
"libxl_key_value_list_val(&%(c)s, %(o)s)",
None),
+ "libxl_string_list": ("string list",
"libxl_string_list_val(&%(c)s, %(o)s)",
"String_list_val(&%(c)s, %(o)s)"),
+ "libxl_mac": ("int array",
"Mac_val(&%(c)s, %(o)s)", "Val_mac(&%(c)s)"),
"libxl_hwcap": ("int32 array",
None, "Val_hwcap(&%(c)s)"),
# The following needs to be sorted out later
"libxl_cpuid_policy_list": ("unit",
"%(c)s = 0", "Val_unit"),
}
-DEVICE_FUNCTIONS = [ ("add", ["t",
"domid", "unit"]),
- ("remove", ["t",
"domid", "unit"]),
- ("destroy", ["t",
"domid", "unit"]),
+DEVICE_FUNCTIONS = [ ("add", ["ctx",
"t", "domid", "unit"]),
+ ("remove", ["ctx",
"t", "domid", "unit"]),
+ ("destroy", ["ctx",
"t", "domid", "unit"]),
]
functions = { # ( name , [type1,type2,....] )
@@ -33,13 +33,13 @@ functions = { # ( name , [type1,type2,....] )
"device_disk": DEVICE_FUNCTIONS,
"device_nic": DEVICE_FUNCTIONS,
"device_pci": DEVICE_FUNCTIONS,
- "physinfo": [ ("get",
["unit", "t"]),
+ "physinfo": [ ("get",
["ctx", "t"]),
],
- "cputopology": [ ("get",
["unit", "t array"]),
+ "cputopology": [ ("get",
["ctx", "t array"]),
],
"domain_sched_params":
- [ ("get", ["domid",
"t"]),
- ("set", ["domid",
"t", "unit"]),
+ [ ("get", ["ctx",
"domid", "t"]),
+ ("set", ["ctx",
"domid", "t", "unit"]),
],
}
def stub_fn_name(ty, name):
@@ -229,7 +229,7 @@ def c_val(ty, c, o, indent="", parent = None):
for e in ty.values:
s += " case %d: *%s = %s; break;\n" % (n, c, e.name)
n += 1
- s += " default: failwith_xl(\"cannot convert value to
%s\", lg); break;\n" % ty.typename
+ s += " default: failwith_xl(\"cannot convert value to
%s\"); break;\n" % ty.typename
s += "}"
elif isinstance(ty, idl.KeyedUnion):
s += "{\n"
@@ -242,7 +242,7 @@ def c_val(ty, c, o, indent="", parent = None):
parent + ty.keyvar.name,
f.enumname)
n += 1
- s += "\t\t default: failwith_xl(\"variant handling bug
%s%s (long)\", lg); break;\n" % (parent, ty.keyvar.name)
+ s += "\t\t default: failwith_xl(\"variant handling bug
%s%s (long)\"); break;\n" % (parent, ty.keyvar.name)
s += "\t\t}\n"
s += "\t} else {\n"
s += "\t\t/* Is block... */\n"
@@ -258,7 +258,7 @@ def c_val(ty, c, o, indent="", parent = None):
s += "%s" % c_val(f.type, fexpr, "Field(%s,
0)" % o, indent=indent+"\t\t ")
s += "break;\n"
n += 1
- s += "\t\t default: failwith_xl(\"variant handling bug
%s%s (block)\", lg); break;\n" % (parent, ty.keyvar.name)
+ s += "\t\t default: failwith_xl(\"variant handling bug
%s%s (block)\"); break;\n" % (parent, ty.keyvar.name)
s += "\t\t}\n"
s += "\t}\n"
s += "}"
@@ -271,14 +271,14 @@ def c_val(ty, c, o, indent="", parent = None):
s += "%s\n" % c_val(f.type, fexpr, "Field(%s,
%d)" % (o,n), parent=nparent)
n = n + 1
else:
- s += "%s_val(gc, lg, %s, %s);" % (ty.rawname, ty.pass_arg(c,
parent is None, passby=idl.PASS_BY_REFERENCE), o)
+ s += "%s_val(ctx, %s, %s);" % (ty.rawname, ty.pass_arg(c,
parent is None, passby=idl.PASS_BY_REFERENCE), o)
return s.replace("\n", "\n%s" % indent)
def gen_c_val(ty, indent=""):
s = "/* Convert caml value to %s */\n" % ty.rawname
- s += "static int %s_val (caml_gc *gc, struct caml_logger *lg, %s,
value v)\n" % (ty.rawname, ty.make_arg("c_val",
passby=idl.PASS_BY_REFERENCE))
+ s += "static int %s_val (libxl_ctx *ctx, %s, value v)\n" %
(ty.rawname, ty.make_arg("c_val", passby=idl.PASS_BY_REFERENCE))
s += "{\n"
s += "\tCAMLparam1(v);\n"
s += "\n"
@@ -327,7 +327,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None,
struct_tag = None):
for e in ty.values:
s += " case %s: %s = Int_val(%d); break;\n" % (e.name,
o, n)
n += 1
- s += " default: failwith_xl(\"cannot convert value from
%s\", lg); break;\n" % ty.typename
+ s += " default: failwith_xl(\"cannot convert value from
%s\"); break;\n" % ty.typename
s += "}"
elif isinstance(ty, idl.KeyedUnion):
n = 0
@@ -351,7 +351,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None,
struct_tag = None):
m += 1
#s += "\t %s = caml_alloc(%d,%d);\n" %
(o,len(f.type.fields),n)
s += "\t break;\n"
- s += "\t default: failwith_xl(\"cannot convert value from
%s\", lg); break;\n" % ty.typename
+ s += "\t default: failwith_xl(\"cannot convert value from
%s\"); break;\n" % ty.typename
s += "\t}"
elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is
None):
s += "{\n"
@@ -379,14 +379,14 @@ def ocaml_Val(ty, o, c, indent="", parent =
None, struct_tag = None):
n = n + 1
s += "}"
else:
- s += "%s = Val_%s(gc, lg, %s);" % (o, ty.rawname,
ty.pass_arg(c, parent is None))
+ s += "%s = Val_%s(%s);" % (o, ty.rawname, ty.pass_arg(c,
parent is None))
return s.replace("\n", "\n%s" % indent).rstrip(indent)
def gen_Val_ocaml(ty, indent=""):
s = "/* Convert %s to a caml value */\n" % ty.rawname
- s += "static value Val_%s (caml_gc *gc, struct caml_logger *lg,
%s)\n" % (ty.rawname, ty.make_arg(ty.rawname+"_c"))
+ s += "static value Val_%s (%s)\n" % (ty.rawname,
ty.make_arg(ty.rawname+"_c"))
s += "{\n"
s += "\tCAMLparam0();\n"
s += "\tCAMLlocal1(%s_ocaml);\n" % ty.rawname
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in
b/tools/ocaml/libs/xl/xenlight.ml.in
index 22c647f..319c593 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -25,8 +25,8 @@ type ctx
external ctx_alloc: Xentoollog.handle -> ctx =
"stub_libxl_ctx_alloc"
external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
-external send_trigger : domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
-external send_sysrq : domid -> char -> unit =
"stub_xl_send_sysrq"
-external send_debug_keys : domid -> string -> unit =
"stub_xl_send_debug_keys"
+external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
+external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
+external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
-let _ = Callback.register_exception "xl.error" (Error
"register_callback")
+let _ = Callback.register_exception "Xenlight.Error"
(Error(""))
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in
b/tools/ocaml/libs/xl/xenlight.mli.in
index fef8df5..c797ceb 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -25,6 +25,6 @@ type ctx
external ctx_alloc: Xentoollog.handle -> ctx =
"stub_libxl_ctx_alloc"
external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
-external send_trigger : domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
-external send_sysrq : domid -> char -> unit =
"stub_xl_send_sysrq"
-external send_debug_keys : domid -> string -> unit =
"stub_xl_send_debug_keys"
+external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
+external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
+external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index d495a6c..c65d22d 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -31,49 +31,7 @@
#define CTX ((libxl_ctx *)ctx)
-struct caml_logger {
- struct xentoollog_logger logger;
- int log_offset;
- char log_buf[2048];
-};
-
-typedef struct caml_gc {
- int offset;
- void *ptrs[64];
-} caml_gc;
-
-static void log_vmessage(struct xentoollog_logger *logger, xentoollog_level
level,
- int errnoval, const char *context, const char *format,
va_list al)
-{
- struct caml_logger *ologger = (struct caml_logger *) logger;
-
- ologger->log_offset += vsnprintf(ologger->log_buf +
ologger->log_offset,
- 2048 - ologger->log_offset, format, al);
-}
-
-static void log_destroy(struct xentoollog_logger *logger)
-{
-}
-
-#define INIT_STRUCT() libxl_ctx *ctx; struct caml_logger lg; struct caml_gc gc;
gc.offset = 0;
-
-#define INIT_CTX() \
- lg.logger.vmessage = log_vmessage; \
- lg.logger.destroy = log_destroy; \
- lg.logger.progress = NULL; \
- lg.log_offset = 0; \
- memset(&lg.log_buf,0,sizeof(lg.log_buf)); \
- caml_enter_blocking_section(); \
- ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *)
&lg); \
- if (ret != 0) \
- failwith_xl("cannot init context", &lg);
-
-#define FREE_CTX() \
- gc_free(&gc); \
- caml_leave_blocking_section(); \
- libxl_ctx_free(ctx)
-
-static char * dup_String_val(caml_gc *gc, value s)
+static char * dup_String_val(value s)
{
int len;
char *c;
@@ -81,25 +39,16 @@ static char * dup_String_val(caml_gc *gc, value s)
c = calloc(len + 1, sizeof(char));
if (!c)
caml_raise_out_of_memory();
- if (gc) gc->ptrs[gc->offset++] = c;
memcpy(c, String_val(s), len);
return c;
}
-static void gc_free(caml_gc *gc)
+static void failwith_xl(char *fname)
{
- int i;
- for (i = 0; i < gc->offset; i++) {
- free(gc->ptrs[i]);
- }
-}
-
-static void failwith_xl(char *fname, struct caml_logger *lg)
-{
- char *s;
- s = (lg) ? lg->log_buf : fname;
- printf("Error: %s\n", fname);
- caml_raise_with_string(*caml_named_value("xl.error"), s);
+ value *exc = caml_named_value("Xenlight.Error");
+ if (!exc)
+ caml_invalid_argument("Exception Xenlight.Error not initialized, please
link xl.cma");
+ caml_raise_with_string(*exc, fname);
}
CAMLprim value stub_libxl_ctx_alloc(value logger)
@@ -110,7 +59,7 @@ CAMLprim value stub_libxl_ctx_alloc(value logger)
ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *)
logger);
if (ret != 0) \
- failwith_xl("cannot init context", NULL);
+ failwith_xl("cannot init context");
CAMLreturn((value)ctx);
}
@@ -121,16 +70,6 @@ CAMLprim value stub_libxl_ctx_free(value ctx)
CAMLreturn(Val_unit);
}
-static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
-{
- void *ptr;
- ptr = calloc(nmemb, size);
- if (!ptr)
- caml_raise_out_of_memory();
- gc->ptrs[gc->offset++] = ptr;
- return ptr;
-}
-
static int list_len(value v)
{
int len = 0;
@@ -141,8 +80,7 @@ static int list_len(value v)
return len;
}
-static int libxl_key_value_list_val(caml_gc *gc, struct caml_logger *lg,
- libxl_key_value_list *c_val,
+static int libxl_key_value_list_val(libxl_key_value_list *c_val,
value v)
{
CAMLparam1(v);
@@ -152,24 +90,22 @@ static int libxl_key_value_list_val(caml_gc *gc, struct
caml_logger *lg,
nr = list_len(v);
- array = gc_calloc(gc, (nr + 1) * 2, sizeof(char *));
+ array = calloc((nr + 1) * 2, sizeof(char *));
if (!array)
caml_raise_out_of_memory();
for (i=0; v != Val_emptylist; i++, v = Field(v, 1) ) {
elem = Field(v, 0);
- array[i * 2] = dup_String_val(gc, Field(elem, 0));
- array[i * 2 + 1] = dup_String_val(gc, Field(elem, 1));
+ array[i * 2] = dup_String_val(Field(elem, 0));
+ array[i * 2 + 1] = dup_String_val(Field(elem, 1));
}
*c_val = array;
CAMLreturn(0);
}
-static int libxl_string_list_val(caml_gc *gc, struct caml_logger *lg,
- libxl_string_list *c_val,
- value v)
+static int libxl_string_list_val(libxl_string_list *c_val, value v)
{
CAMLparam1(v);
int nr, i;
@@ -177,12 +113,12 @@ static int libxl_string_list_val(caml_gc *gc, struct
caml_logger *lg,
nr = list_len(v);
- array = gc_calloc(gc, (nr + 1), sizeof(char *));
+ array = calloc(nr + 1, sizeof(char *));
if (!array)
caml_raise_out_of_memory();
for (i=0; v != Val_emptylist; i++, v = Field(v, 1) )
- array[i] = dup_String_val(gc, Field(v, 0));
+ array[i] = dup_String_val(Field(v, 0));
*c_val = array;
CAMLreturn(0);
@@ -215,7 +151,7 @@ static value Val_mac (libxl_mac *c_val)
CAMLreturn(v);
}
-static int Mac_val(caml_gc *gc, struct caml_logger *lg, libxl_mac *c_val, value
v)
+static int Mac_val(libxl_mac *c_val, value v)
{
CAMLparam1(v);
int i;
@@ -242,10 +178,21 @@ static value Val_bitmap (libxl_bitmap *c_val)
CAMLreturn(v);
}
-static int Bitmap_val(caml_gc *gc, struct caml_logger *lg,
- libxl_bitmap *c_val, value v)
+static int Bitmap_val(libxl_ctx *ctx, libxl_bitmap *c_val, value v)
{
- abort(); /* XXX */
+ CAMLparam1(v);
+ int i, len = Wosize_val(v);
+
+ c_val->size = 0;
+ if (len > 0 && !libxl_bitmap_alloc(ctx, c_val, len))
+ failwith_xl("cannot allocate bitmap");
+ for (i=0; i<len; i++) {
+ if (Int_val(Field(v, i)))
+ libxl_bitmap_set(c_val, i);
+ else
+ libxl_bitmap_reset(c_val, i);
+ }
+ CAMLreturn(0);
}
static value Val_uuid (libxl_uuid *c_val)
@@ -263,7 +210,7 @@ static value Val_uuid (libxl_uuid *c_val)
CAMLreturn(v);
}
-static int Uuid_val(caml_gc *gc, struct caml_logger *lg, libxl_uuid *c_val,
value v)
+static int Uuid_val(libxl_uuid *c_val, value v)
{
CAMLparam1(v);
int i;
@@ -317,254 +264,74 @@ static value Val_hwcap(libxl_hwcap *c_val)
#include "_libxl_types.inc"
-value stub_xl_device_disk_add(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_disk c_info;
- int ret;
- INIT_STRUCT();
-
- device_disk_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_disk_add(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("disk_add", &lg);
- FREE_CTX();
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_disk_del(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_disk c_info;
- int ret;
- INIT_STRUCT();
-
- device_disk_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_disk_remove(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("disk_del", &lg);
- FREE_CTX();
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_nic_add(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_nic c_info;
- int ret;
- INIT_STRUCT();
-
- device_nic_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_nic_add(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("nic_add", &lg);
- FREE_CTX();
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_nic_del(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_nic c_info;
- int ret;
- INIT_STRUCT();
-
- device_nic_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_nic_remove(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("nic_del", &lg);
- FREE_CTX();
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vkb_add(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_vkb c_info;
- int ret;
- INIT_STRUCT();
-
- device_vkb_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_vkb_add(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("vkb_add", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vkb_remove(value info, value domid)
-{
- CAMLparam1(domid);
- libxl_device_vkb c_info;
- int ret;
- INIT_STRUCT();
-
- device_vkb_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_vkb_remove(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("vkb_clean_shutdown", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vkb_destroy(value info, value domid)
-{
- CAMLparam1(domid);
- libxl_device_vkb c_info;
- int ret;
- INIT_STRUCT();
-
- device_vkb_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_vkb_destroy(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("vkb_hard_shutdown", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vfb_add(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_vfb c_info;
- int ret;
- INIT_STRUCT();
-
- device_vfb_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_vfb_add(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("vfb_add", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vfb_remove(value info, value domid)
-{
- CAMLparam1(domid);
- libxl_device_vfb c_info;
- int ret;
- INIT_STRUCT();
-
- device_vfb_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_vfb_remove(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("vfb_clean_shutdown", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_vfb_destroy(value info, value domid)
+#define _STRINGIFY(x) #x
+#define STRINGIFY(x) _STRINGIFY(x)
+
+#define _DEVICE_ADDREMOVE(type,op) \
+value stub_xl_device_##type##_##op(value ctx, value info, value domid) \
+{ \
+ CAMLparam3(ctx, info, domid); \
+ libxl_device_##type c_info; \
+ int ret, marker_var; \
+ \
+ device_##type##_val(CTX, &c_info, info); \
+ \
+ ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, 0); \
+ \
+ libxl_device_##type##_dispose(&c_info); \
+ \
+ if (ret != 0) \
+ failwith_xl(STRINGIFY(type) "_" STRINGIFY(op)); \
+ \
+ CAMLreturn(Val_unit); \
+}
+
+#define DEVICE_ADDREMOVE(type) \
+ _DEVICE_ADDREMOVE(type, add) \
+ _DEVICE_ADDREMOVE(type, remove) \
+ _DEVICE_ADDREMOVE(type, destroy)
+
+DEVICE_ADDREMOVE(disk)
+DEVICE_ADDREMOVE(nic)
+DEVICE_ADDREMOVE(vfb)
+DEVICE_ADDREMOVE(vkb)
+DEVICE_ADDREMOVE(pci)
+
+value stub_xl_physinfo_get(value ctx)
{
- CAMLparam1(domid);
- libxl_device_vfb c_info;
- int ret;
- INIT_STRUCT();
-
- device_vfb_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_vfb_destroy(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("vfb_hard_shutdown", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_pci_add(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_pci c_info;
+ CAMLparam1(ctx);
+ CAMLlocal1(physinfo);
+ libxl_physinfo c_physinfo;
int ret;
- INIT_STRUCT();
- device_pci_val(&gc, &lg, &c_info, info);
+ ret = libxl_get_physinfo(CTX, &c_physinfo);
- INIT_CTX();
- ret = libxl_device_pci_add(ctx, Int_val(domid), &c_info, 0);
if (ret != 0)
- failwith_xl("pci_add", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
+ failwith_xl("get_physinfo");
-value stub_xl_device_pci_remove(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_pci c_info;
- int ret;
- INIT_STRUCT();
+ physinfo = Val_physinfo(&c_physinfo);
- device_pci_val(&gc, &lg, &c_info, info);
+ libxl_physinfo_dispose(&c_physinfo);
- INIT_CTX();
- ret = libxl_device_pci_remove(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("pci_remove", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_physinfo_get(value unit)
-{
- CAMLparam1(unit);
- CAMLlocal1(physinfo);
- libxl_physinfo c_physinfo;
- int ret;
- INIT_STRUCT();
-
- INIT_CTX();
- ret = libxl_get_physinfo(ctx, &c_physinfo);
- if (ret != 0)
- failwith_xl("physinfo", &lg);
- FREE_CTX();
-
- physinfo = Val_physinfo(&gc, &lg, &c_physinfo);
CAMLreturn(physinfo);
}
-value stub_xl_cputopology_get(value unit)
+value stub_xl_cputopology_get(value ctx)
{
- CAMLparam1(unit);
+ CAMLparam1(ctx);
CAMLlocal2(topology, v);
libxl_cputopology *c_topology;
- int i, nr, ret;
- INIT_STRUCT();
+ int i, nr;
- INIT_CTX();
+ c_topology = libxl_get_cpu_topology(CTX, &nr);
- c_topology = libxl_get_cpu_topology(ctx, &nr);
- if (ret != 0)
- failwith_xl("topologyinfo", &lg);
+ if (!c_topology)
+ failwith_xl("topologyinfo");
topology = caml_alloc_tuple(nr);
for (i = 0; i < nr; i++) {
if (c_topology[i].core != LIBXL_CPUTOPOLOGY_INVALID_ENTRY)
- v = Val_some(Val_cputopology(&gc, &lg, &c_topology[i]));
+ v = Val_some(Val_cputopology(&c_topology[i]));
else
v = Val_none;
Store_field(topology, i, v);
@@ -572,91 +339,89 @@ value stub_xl_cputopology_get(value unit)
libxl_cputopology_list_free(c_topology, nr);
- FREE_CTX();
CAMLreturn(topology);
}
-value stub_xl_domain_sched_params_get(value domid)
+value stub_xl_domain_sched_params_get(value ctx, value domid)
{
- CAMLparam1(domid);
+ CAMLparam2(ctx, domid);
CAMLlocal1(scinfo);
libxl_domain_sched_params c_scinfo;
int ret;
- INIT_STRUCT();
- INIT_CTX();
- ret = libxl_domain_sched_params_get(ctx, Int_val(domid), &c_scinfo);
+ ret = libxl_domain_sched_params_get(CTX, Int_val(domid), &c_scinfo);
if (ret != 0)
- failwith_xl("domain_sched_params_get", &lg);
- FREE_CTX();
+ failwith_xl("domain_sched_params_get");
+
+ scinfo = Val_domain_sched_params(&c_scinfo);
+
+ libxl_domain_sched_params_dispose(&c_scinfo);
- scinfo = Val_domain_sched_params(&gc, &lg, &c_scinfo);
CAMLreturn(scinfo);
}
-value stub_xl_domain_sched_params_set(value domid, value scinfo)
+value stub_xl_domain_sched_params_set(value ctx, value domid, value scinfo)
{
- CAMLparam2(domid, scinfo);
+ CAMLparam3(ctx, domid, scinfo);
libxl_domain_sched_params c_scinfo;
int ret;
- INIT_STRUCT();
- domain_sched_params_val(&gc, &lg, &c_scinfo, scinfo);
+ domain_sched_params_val(CTX, &c_scinfo, scinfo);
+
+ ret = libxl_domain_sched_params_set(CTX, Int_val(domid), &c_scinfo);
+
+ libxl_domain_sched_params_dispose(&c_scinfo);
- INIT_CTX();
- ret = libxl_domain_sched_params_set(ctx, Int_val(domid), &c_scinfo);
if (ret != 0)
- failwith_xl("domain_sched_params_set", &lg);
- FREE_CTX();
+ failwith_xl("domain_sched_params_set");
CAMLreturn(Val_unit);
}
-value stub_xl_send_trigger(value domid, value trigger, value vcpuid)
+value stub_xl_send_trigger(value ctx, value domid, value trigger, value vcpuid)
{
- CAMLparam3(domid, trigger, vcpuid);
+ CAMLparam4(ctx, domid, trigger, vcpuid);
int ret;
libxl_trigger c_trigger = LIBXL_TRIGGER_UNKNOWN;
- INIT_STRUCT();
- trigger_val(&gc, &lg, &c_trigger, trigger);
+ trigger_val(CTX, &c_trigger, trigger);
+
+ ret = libxl_send_trigger(CTX, Int_val(domid),
+ c_trigger, Int_val(vcpuid));
- INIT_CTX();
- ret = libxl_send_trigger(ctx, Int_val(domid), c_trigger, Int_val(vcpuid));
if (ret != 0)
- failwith_xl("send_trigger", &lg);
- FREE_CTX();
+ failwith_xl("send_trigger");
+
CAMLreturn(Val_unit);
}
-value stub_xl_send_sysrq(value domid, value sysrq)
+value stub_xl_send_sysrq(value ctx, value domid, value sysrq)
{
- CAMLparam2(domid, sysrq);
+ CAMLparam3(ctx, domid, sysrq);
int ret;
- INIT_STRUCT();
- INIT_CTX();
- ret = libxl_send_sysrq(ctx, Int_val(domid), Int_val(sysrq));
+ ret = libxl_send_sysrq(CTX, Int_val(domid), Int_val(sysrq));
+
if (ret != 0)
- failwith_xl("send_sysrq", &lg);
- FREE_CTX();
+ failwith_xl("send_sysrq");
+
CAMLreturn(Val_unit);
}
-value stub_xl_send_debug_keys(value keys)
+value stub_xl_send_debug_keys(value ctx, value keys)
{
- CAMLparam1(keys);
+ CAMLparam2(ctx, keys);
int ret;
char *c_keys;
- INIT_STRUCT();
- c_keys = dup_String_val(&gc, keys);
+ c_keys = dup_String_val(keys);
- INIT_CTX();
- ret = libxl_send_debug_keys(ctx, c_keys);
+ ret = libxl_send_debug_keys(CTX, c_keys);
if (ret != 0)
- failwith_xl("send_debug_keys", &lg);
- FREE_CTX();
+ failwith_xl("send_debug_keys");
+
+ free(c_keys);
+
CAMLreturn(Val_unit);
}
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 11/28] libxl: ocaml: propagate the libxl return error code in exceptions
Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 10 +++---
tools/ocaml/libs/xl/xenlight.ml.in | 45 ++++++++++++++++++++---
tools/ocaml/libs/xl/xenlight.mli.in | 28 ++++++++++++---
tools/ocaml/libs/xl/xenlight_stubs.c | 66 +++++++++++++++++++++++++++-------
4 files changed, 123 insertions(+), 26 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index b087817..9e440ae 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -229,7 +229,7 @@ def c_val(ty, c, o, indent="", parent = None):
for e in ty.values:
s += " case %d: *%s = %s; break;\n" % (n, c, e.name)
n += 1
- s += " default: failwith_xl(\"cannot convert value to
%s\"); 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"
@@ -242,7 +242,7 @@ def c_val(ty, c, o, indent="", parent = None):
parent + ty.keyvar.name,
f.enumname)
n += 1
- s += "\t\t default: failwith_xl(\"variant handling bug
%s%s (long)\"); 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"
@@ -258,7 +258,7 @@ def c_val(ty, c, o, indent="", parent = None):
s += "%s" % c_val(f.type, fexpr, "Field(%s,
0)" % o, indent=indent+"\t\t ")
s += "break;\n"
n += 1
- s += "\t\t default: failwith_xl(\"variant handling bug
%s%s (block)\"); 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 += "}"
@@ -327,7 +327,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None,
struct_tag = None):
for e in ty.values:
s += " case %s: %s = Int_val(%d); break;\n" % (e.name,
o, n)
n += 1
- s += " default: failwith_xl(\"cannot convert value from
%s\"); 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
@@ -351,7 +351,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None,
struct_tag = None):
m += 1
#s += "\t %s = caml_alloc(%d,%d);\n" %
(o,len(f.type.fields),n)
s += "\t break;\n"
- s += "\t default: failwith_xl(\"cannot convert value from
%s\"); 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 --git a/tools/ocaml/libs/xl/xenlight.ml.in
b/tools/ocaml/libs/xl/xenlight.ml.in
index 319c593..3e83355 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -13,20 +13,55 @@
* GNU Lesser General Public License for more details.
*)
-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
-type domid = int
-type devid = int
+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"
-(* @@LIBXL_TYPES@@ *)
+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
+
+(* @@LIBXL_TYPES@@ *)
+
external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
-let _ = Callback.register_exception "Xenlight.Error"
(Error(""))
+let _ = Callback.register_exception "Xenlight.Error" (Error(Fail,
""))
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in
b/tools/ocaml/libs/xl/xenlight.mli.in
index c797ceb..e562c4b 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -13,18 +13,38 @@
* GNU Lesser General Public License for more details.
*)
-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
-type domid = int
-type devid = int
+val string_of_error: error -> string
-(* @@LIBXL_TYPES@@ *)
+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
+
+(* @@LIBXL_TYPES@@ *)
+
external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index c65d22d..6c26a6a 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -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)
@@ -59,7 +101,7 @@ CAMLprim value stub_libxl_ctx_alloc(value logger)
ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *)
logger);
if (ret != 0) \
- failwith_xl("cannot init context");
+ failwith_xl(ERROR_FAIL, "cannot init context");
CAMLreturn((value)ctx);
}
@@ -185,7 +227,7 @@ static int Bitmap_val(libxl_ctx *ctx, libxl_bitmap *c_val,
value v)
c_val->size = 0;
if (len > 0 && !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);
@@ -281,7 +323,7 @@ value stub_xl_device_##type##_##op(value ctx, value info,
value domid) \
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); \
}
@@ -307,7 +349,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(&c_physinfo);
@@ -326,7 +368,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++) {
@@ -351,7 +393,7 @@ value stub_xl_domain_sched_params_get(value ctx, value
domid)
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(&c_scinfo);
@@ -373,7 +415,7 @@ value stub_xl_domain_sched_params_set(value ctx, value
domid, value scinfo)
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);
}
@@ -390,7 +432,7 @@ value stub_xl_send_trigger(value ctx, value domid, value
trigger, value vcpuid)
c_trigger, Int_val(vcpuid));
if (ret != 0)
- failwith_xl("send_trigger");
+ failwith_xl(ret, "send_trigger");
CAMLreturn(Val_unit);
}
@@ -403,7 +445,7 @@ value stub_xl_send_sysrq(value ctx, value domid, value
sysrq)
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);
}
@@ -418,7 +460,7 @@ value stub_xl_send_debug_keys(value ctx, value keys)
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);
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 12/28] libxl: ocaml: add domain_build/create_info/config 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>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/libxl/libxl_types.idl | 2 +-
tools/ocaml/libs/xl/genwrap.py | 4 ----
2 files changed, 1 insertion(+), 5 deletions(-)
diff --git a/tools/libxl/libxl_types.idl b/tools/libxl/libxl_types.idl
index 4749f68..3bc4213 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -422,7 +422,7 @@ libxl_domain_config = Struct("domain_config", [
("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 --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 9e440ae..964c4bf 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -424,11 +424,7 @@ if __name__ == ''__main__'':
# Do not generate these yet.
blacklist = [
"cpupoolinfo",
- "domain_create_info",
- "domain_build_info",
- "domain_config",
"vcpuinfo",
- "event",
]
for t in blacklist:
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 13/28] libxl: idl: add domain_type field to libxl_dominfo struct
This allows a toolstack to find out whether a VM has booted as PV or HVM.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/libxl/libxl.c | 2 ++
tools/libxl/libxl_types.idl | 1 +
2 files changed, 3 insertions(+)
diff --git a/tools/libxl/libxl.c b/tools/libxl/libxl.c
index 9c7886a..977f767 100644
--- a/tools/libxl/libxl.c
+++ b/tools/libxl/libxl.c
@@ -536,6 +536,8 @@ static void xcinfo2xlinfo(const xc_domaininfo_t *xcinfo,
xlinfo->vcpu_max_id = xcinfo->max_vcpu_id;
xlinfo->vcpu_online = xcinfo->nr_online_vcpus;
xlinfo->cpupool = xcinfo->cpupool;
+ xlinfo->domain_type = (xcinfo->flags & XEN_DOMINF_hvm_guest) ?
+ LIBXL_DOMAIN_TYPE_HVM : LIBXL_DOMAIN_TYPE_PV;
}
libxl_dominfo * libxl_list_domain(libxl_ctx *ctx, int *nb_domain_out)
diff --git a/tools/libxl/libxl_types.idl b/tools/libxl/libxl_types.idl
index 3bc4213..2f3e6d2 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -205,6 +205,7 @@ libxl_dominfo = Struct("dominfo",[
("vcpu_max_id", uint32),
("vcpu_online", uint32),
("cpupool", uint32),
+ ("domain_type", libxl_domain_type),
], dir=DIR_OUT)
libxl_cpupoolinfo = Struct("cpupoolinfo", [
--
1.7.10.4
The "xl" module was renamed to "xenlight" some time ago, but the META file was not updated. It also needed to be added to the list of generated files in the Makefile. Signed-off-by: Rob Hoes <rob.hoes@citrix.com> --- tools/ocaml/libs/xl/META.in | 4 ++-- tools/ocaml/libs/xl/Makefile | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/tools/ocaml/libs/xl/META.in b/tools/ocaml/libs/xl/META.in index 06efae6..3f0c552 100644 --- a/tools/ocaml/libs/xl/META.in +++ b/tools/ocaml/libs/xl/META.in @@ -1,5 +1,5 @@ version = "@VERSION@" description = "Xen Toolstack Library" requires = "xentoollog" -archive(byte) = "xl.cma" -archive(native) = "xl.cmxa" +archive(byte) = "xenlight.cma" +archive(native) = "xenlight.cmxa" diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile index 79f07a5..5a410d2 100644 --- a/tools/ocaml/libs/xl/Makefile +++ b/tools/ocaml/libs/xl/Makefile @@ -21,7 +21,7 @@ OCAML_LIBRARY = xenlight GENERATED_FILES += xenlight.ml xenlight.ml.tmp xenlight.mli xenlight.mli.tmp GENERATED_FILES += _libxl_types.ml.in _libxl_types.mli.in -GENERATED_FILES += _libxl_types.inc +GENERATED_FILES += _libxl_types.inc META all: $(INTF) $(LIBS) -- 1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 15/28] libxl: ocaml: fix the handling of enums in the bindings generator
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 964c4bf..b6bd80a 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -325,7 +325,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None,
struct_tag = None):
n = 0
s += "switch(%s) {\n" % c
for e in ty.values:
- s += " case %s: %s = Int_val(%d); break;\n" % (e.name,
o, n)
+ s += " case %s: %s = Val_int(%d); break;\n" % (e.name,
o, n)
n += 1
s += " default: failwith_xl(ERROR_FAIL, \"cannot convert
value from %s\"); break;\n" % ty.typename
s += "}"
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 16/28] libxl: ocaml: use the "string option" type for IDL strings
The libxl IDL is based on C type "char *", and therefore
"strings" can
by NULL, or be an actual string. In ocaml, it is common to encode such
things as option types.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 2 +-
tools/ocaml/libs/xl/xenlight_stubs.c | 17 +++++++++++++++++
2 files changed, 18 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index b6bd80a..40d18ee 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -8,7 +8,7 @@ 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(%(o)s)", "caml_copy_string(%(c)s)"),
+ "char *": ("string option",
"%(c)s = String_option_val(%(o)s)",
"Val_string_option(%(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)" ),
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index 6c26a6a..f4fa520 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -304,6 +304,23 @@ static value Val_hwcap(libxl_hwcap *c_val)
CAMLreturn(hwcap);
}
+static value Val_string_option(char *c_val)
+{
+ CAMLparam0();
+ if (c_val)
+ CAMLreturn(Val_some(caml_copy_string(c_val)));
+ else
+ CAMLreturn(Val_none);
+}
+
+static char *String_option_val(value v)
+{
+ char *s = NULL;
+ if (v != Val_none)
+ s = dup_String_val(Some_val(v));
+ return s;
+}
+
#include "_libxl_types.inc"
#define _STRINGIFY(x) #x
--
1.7.10.4
Signed-off-by: Rob Hoes <rob.hoes@citrix.com> --- tools/ocaml/libs/xl/xenlight.ml.in | 15 +++++++++++++++ tools/ocaml/libs/xl/xenlight.mli.in | 4 +++- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in index 3e83355..991b2bf 100644 --- a/tools/ocaml/libs/xl/xenlight.ml.in +++ b/tools/ocaml/libs/xl/xenlight.ml.in @@ -53,6 +53,21 @@ type ctx external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" external ctx_free: ctx -> unit = "stub_libxl_ctx_free" +let with_ctx ?logger f + let logger'' = match logger with + | None -> Xentoollog.create_stdio_logger (*~level:Xentoollog.Debug*) () + | Some l -> l + in + let ctx = ctx_alloc logger'' in + let res = try f ctx with exn -> + ctx_free ctx; + if logger = None then Xentoollog.destroy logger''; + raise exn + in + ctx_free ctx; + if logger = None then Xentoollog.destroy logger''; + res + external test_raise_exception: unit -> unit = "stub_raise_exception" type domid = int diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in index e562c4b..12568ca 100644 --- a/tools/ocaml/libs/xl/xenlight.mli.in +++ b/tools/ocaml/libs/xl/xenlight.mli.in @@ -38,7 +38,9 @@ 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" +val with_ctx : ?logger:Xentoollog.handle -> (ctx -> ''a) -> ''a + +external test_raise_exception: unit -> unit = "stub_raise_exception" type domid = int type devid = int -- 1.7.10.4
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/xenlight.ml.in | 1 +
tools/ocaml/libs/xl/xenlight.mli.in | 1 +
tools/ocaml/libs/xl/xenlight_stubs.c | 27 +++++++++++++++++++++++++++
3 files changed, 29 insertions(+)
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in
b/tools/ocaml/libs/xl/xenlight.ml.in
index 991b2bf..63b8bf8 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -78,5 +78,6 @@ type devid = int
external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
+external xen_console_read : ctx -> string list =
"stub_xl_xen_console_read"
let _ = Callback.register_exception "Xenlight.Error" (Error(Fail,
""))
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in
b/tools/ocaml/libs/xl/xenlight.mli.in
index 12568ca..24064fc 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -50,3 +50,4 @@ type devid = int
external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
+external xen_console_read : ctx -> string list =
"stub_xl_xen_console_read"
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index f4fa520..939e993 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -484,6 +484,33 @@ value stub_xl_send_debug_keys(value ctx, value keys)
CAMLreturn(Val_unit);
}
+value stub_xl_xen_console_read(value ctx)
+{
+ CAMLparam1(ctx);
+ CAMLlocal3(list, cons, ml_line);
+ int i = 0, ret;
+ char *console[32768], *line;
+ libxl_xen_console_reader *cr;
+
+ cr = libxl_xen_console_read_start(CTX, 0);
+ if (cr)
+ for (i = 0; libxl_xen_console_read_line(CTX, cr, &line) > 0; i++)
+ console[i] = strdup(line);
+ libxl_xen_console_read_finish(CTX, cr);
+
+ list = Val_emptylist;
+ for (; i > 0; i--) {
+ ml_line = caml_copy_string(console[i - 1]);
+ free(console[i - 1]);
+ cons = caml_alloc(2, 0);
+ Store_field(cons, 0, ml_line); // head
+ Store_field(cons, 1, list); // tail
+ list = cons;
+ }
+
+ CAMLreturn(list);
+}
+
/*
* Local variables:
* indent-tabs-mode: t
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 19/28] libxl: ocaml: add dominfo_list and dominfo_get
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 3 +++
tools/ocaml/libs/xl/xenlight_stubs.c | 41 ++++++++++++++++++++++++++++++++++
2 files changed, 44 insertions(+)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 40d18ee..10e6a74 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -33,6 +33,9 @@ functions = { # ( name , [type1,type2,....] )
"device_disk": DEVICE_FUNCTIONS,
"device_nic": DEVICE_FUNCTIONS,
"device_pci": DEVICE_FUNCTIONS,
+ "dominfo": [ ("list",
["ctx", "t list"]),
+ ("get", ["ctx",
"domid", "t"]),
+ ],
"physinfo": [ ("get",
["ctx", "t"]),
],
"cputopology": [ ("get",
["ctx", "t array"]),
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index 939e993..a8655ad 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -401,6 +401,47 @@ value stub_xl_cputopology_get(value ctx)
CAMLreturn(topology);
}
+value stub_xl_dominfo_list(value ctx)
+{
+ CAMLparam1(ctx);
+ CAMLlocal2(domlist, temp);
+ libxl_dominfo *c_domlist;
+ int i, nb;
+
+ c_domlist = libxl_list_domain(CTX, &nb);
+ if (!c_domlist)
+ failwith_xl(ERROR_FAIL, "dominfo_list");
+
+ domlist = temp = Val_emptylist;
+ for (i = nb - 1; i >= 0; i--) {
+ domlist = caml_alloc_small(2, Tag_cons);
+ Field(domlist, 0) = Val_int(0);
+ Field(domlist, 1) = temp;
+ temp = domlist;
+
+ Store_field(domlist, 0, Val_dominfo(&c_domlist[i]));
+ }
+
+ libxl_dominfo_list_free(c_domlist, nb);
+
+ CAMLreturn(domlist);
+}
+
+value stub_xl_dominfo_get(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ CAMLlocal1(dominfo);
+ libxl_dominfo c_dominfo;
+ int ret;
+
+ ret = libxl_domain_info(CTX, &c_dominfo, Int_val(domid));
+ if (ret != 0)
+ failwith_xl(ERROR_FAIL, "domain_info");
+ dominfo = Val_dominfo(&c_dominfo);
+
+ CAMLreturn(dominfo);
+}
+
value stub_xl_domain_sched_params_get(value ctx, value domid)
{
CAMLparam2(ctx, domid);
--
1.7.10.4
Signed-off-by: Ian Campbell <ian.campbell@citrix.com> Signed-off-by: Rob Hoes <rob.hoes@citrix.com> --- .gitignore | 3 ++- .hgignore | 2 ++ tools/ocaml/test/Makefile | 30 ++++++++++++++++++++++++++---- tools/ocaml/test/list_domains.ml | 31 +++++++++++++++++++++++++++++++ tools/ocaml/test/raise_exception.ml | 15 +++++++++++++++ tools/ocaml/test/send_debug_keys.ml | 17 +++++++++++++++++ 6 files changed, 93 insertions(+), 5 deletions(-) create mode 100644 tools/ocaml/test/list_domains.ml create mode 100644 tools/ocaml/test/raise_exception.ml create mode 100644 tools/ocaml/test/send_debug_keys.ml diff --git a/.gitignore b/.gitignore index 05b9bb0..59530e4 100644 --- a/.gitignore +++ b/.gitignore @@ -399,7 +399,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 --git a/.hgignore b/.hgignore index 7d59535..abee12e 100644 --- a/.hgignore +++ b/.hgignore @@ -326,6 +326,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 --git a/tools/ocaml/test/Makefile b/tools/ocaml/test/Makefile index 980054c..2c5fdd8 100644 --- a/tools/ocaml/test/Makefile +++ b/tools/ocaml/test/Makefile @@ -3,11 +3,12 @@ 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 raise_exception -PROGRAMS = xtl +PROGRAMS = xtl send_debug_keys list_domains raise_exception xtl_LIBS = \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \ @@ -15,7 +16,28 @@ xtl_LIBS = \ 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 \ + -cclib -lxenlight + +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 \ + -cclib -lxenlight + +list_domains_OBJS = 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 \ + -cclib -lxenlight + +raise_exception_OBJS = raise_exception + +OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception all: $(PROGRAMS) diff --git a/tools/ocaml/test/list_domains.ml b/tools/ocaml/test/list_domains.ml new file mode 100644 index 0000000..cf40533 --- /dev/null +++ b/tools/ocaml/test/list_domains.ml @@ -0,0 +1,31 @@ +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 + try + let domains = Xenlight.Dominfo.list 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 --git a/tools/ocaml/test/raise_exception.ml b/tools/ocaml/test/raise_exception.ml new file mode 100644 index 0000000..59d268b --- /dev/null +++ b/tools/ocaml/test/raise_exception.ml @@ -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; + diff --git a/tools/ocaml/test/send_debug_keys.ml b/tools/ocaml/test/send_debug_keys.ml new file mode 100644 index 0000000..34c65dc --- /dev/null +++ b/tools/ocaml/test/send_debug_keys.ml @@ -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 -- 1.7.10.4
We need this in order to wrap the event API of libxl.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/Makefile | 2 +-
tools/ocaml/libs/xl/poll_stubs.c | 128 ++++++++++++++++++++++++++++++++++++++
tools/ocaml/libs/xl/poll_stubs.h | 6 ++
3 files changed, 135 insertions(+), 1 deletion(-)
create mode 100644 tools/ocaml/libs/xl/poll_stubs.c
create mode 100644 tools/ocaml/libs/xl/poll_stubs.h
diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile
index 5a410d2..beca795 100644
--- a/tools/ocaml/libs/xl/Makefile
+++ b/tools/ocaml/libs/xl/Makefile
@@ -15,7 +15,7 @@ OCAMLINCLUDE += -I ../xentoollog
LIBS_xenlight = $(LDLIBS_libxenlight)
xenlight_OBJS = $(OBJS)
-xenlight_C_OBJS = xenlight_stubs
+xenlight_C_OBJS = xenlight_stubs poll_stubs
OCAML_LIBRARY = xenlight
diff --git a/tools/ocaml/libs/xl/poll_stubs.c b/tools/ocaml/libs/xl/poll_stubs.c
new file mode 100644
index 0000000..0cf54b9
--- /dev/null
+++ b/tools/ocaml/libs/xl/poll_stubs.c
@@ -0,0 +1,128 @@
+#include <poll.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/fail.h>
+
+static int list_len(value v)
+{
+ int len = 0;
+ while ( v != Val_emptylist ) {
+ len++;
+ v = Field(v, 1);
+ }
+ return len;
+}
+
+short Poll_val(value event)
+{
+ CAMLparam1(event);
+ short res = -1;
+
+ switch (Int_val(event)) {
+ case 0: res = POLLIN; break;
+ case 1: res = POLLPRI; break;
+ case 2: res = POLLOUT; break;
+ case 3: res = POLLERR; break;
+ case 4: res = POLLHUP; break;
+ case 5: res = POLLNVAL; break;
+ }
+
+ CAMLreturn(res);
+}
+
+short Poll_events_val(value event_list)
+{
+ CAMLparam1(event_list);
+ short events = 0;
+
+ while (event_list != Val_emptylist) {
+ events |= Poll_val(Field(event_list, 0));
+ event_list = Field(event_list, 1);
+ }
+
+ CAMLreturn(events);
+}
+
+value Val_poll(short event)
+{
+ CAMLparam0();
+ CAMLlocal1(res);
+
+ switch (event) {
+ case POLLIN: res = Val_int(0); break;
+ case POLLPRI: res = Val_int(1); break;
+ case POLLOUT: res = Val_int(2); break;
+ case POLLERR: res = Val_int(3); break;
+ case POLLHUP: res = Val_int(4); break;
+ case POLLNVAL: res = Val_int(5); break;
+ }
+
+ CAMLreturn(res);
+}
+
+value add_event(value event_list, short event)
+{
+ CAMLparam1(event_list);
+ CAMLlocal1(new_list);
+
+ new_list = caml_alloc(2, 0);
+ Store_field(new_list, 0, Val_poll(event));
+ Store_field(new_list, 1, event_list);
+
+ CAMLreturn(new_list);
+}
+
+value Val_poll_events(short events)
+{
+ CAMLparam0();
+ CAMLlocal1(event_list);
+
+ event_list = Val_emptylist;
+ if (events & POLLIN)
+ event_list = add_event(event_list, POLLIN);
+ if (events & POLLPRI)
+ event_list = add_event(event_list, POLLPRI);
+ if (events & POLLOUT)
+ event_list = add_event(event_list, POLLOUT);
+ if (events & POLLERR)
+ event_list = add_event(event_list, POLLERR);
+ if (events & POLLHUP)
+ event_list = add_event(event_list, POLLHUP);
+ if (events & POLLNVAL)
+ event_list = add_event(event_list, POLLNVAL);
+
+ CAMLreturn(event_list);
+}
+
+value stub_poll(value fds)
+{
+ CAMLparam1(fds);
+ CAMLlocal2(fd, tmp);
+ int rc, i;
+ const int c_nfds = list_len(fds);
+ struct pollfd c_fds[c_nfds];
+
+ for (i = 0; fds != Val_emptylist; i++) {
+ fd = Field(fds, 0);
+ c_fds[i].fd = Int_val(Field(fd, 0));
+ c_fds[i].events = Poll_events_val(Field(fd, 1));
+ fds = Field(fds, 1);
+ }
+
+ caml_enter_blocking_section();
+ rc = poll(c_fds, c_nfds, -1);
+ caml_leave_blocking_section();
+
+ if (rc > 0) {
+ for (i = c_nfds - 1; i >= 0; i--) {
+ tmp = caml_alloc(2, 0);
+ Store_field(tmp, 0, Val_poll_events(c_fds[i].revents));
+ Store_field(tmp, 1, fds);
+ fds = tmp;
+ }
+ }
+
+ CAMLreturn(fds);
+}
+
diff --git a/tools/ocaml/libs/xl/poll_stubs.h b/tools/ocaml/libs/xl/poll_stubs.h
new file mode 100644
index 0000000..0b2332d
--- /dev/null
+++ b/tools/ocaml/libs/xl/poll_stubs.h
@@ -0,0 +1,6 @@
+#include <caml/alloc.h>
+
+short Poll_events_val(value event_list);
+value Val_poll_events(short events);
+value stub_poll(value fds);
+
--
1.7.10.4
This patch add the facilities needed to interact with the event system
in libxl. This is useful, for instance, for getting a callback when a
domains dies, as well as to use the asyncronous versions of some of
libxl''s
calls.
The functions dealing with timeouts are still TBD.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/xenlight.ml.in | 42 +++++++++
tools/ocaml/libs/xl/xenlight.mli.in | 21 +++++
tools/ocaml/libs/xl/xenlight_stubs.c | 161 ++++++++++++++++++++++++++++++++++
3 files changed, 224 insertions(+)
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in
b/tools/ocaml/libs/xl/xenlight.ml.in
index 63b8bf8..96d6a38 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -73,6 +73,17 @@ external test_raise_exception: unit -> unit =
"stub_raise_exception"
type domid = int
type devid = int
+(* type for event callbacks *)
+type for_libxl
+
+type event + | POLLIN (* There is data to read *)
+ | POLLPRI (* There is urgent data to read *)
+ | POLLOUT (* Writing now will not block *)
+ | POLLERR (* Error condition (revents only) *)
+ | POLLHUP (* Device has been disconnected (revents only) *)
+ | POLLNVAL (* Invalid request: fd not open (revents only). *)
+
(* @@LIBXL_TYPES@@ *)
external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
@@ -80,4 +91,35 @@ external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
external xen_console_read : ctx -> string list =
"stub_xl_xen_console_read"
+(* Callbacks with the names as in the following must be registered before
calling
+ osevent_register_hooks:
+
+ Callback.register "fd_register" fd_register;
+ Callback.register "fd_modify" fd_modify;
+ Callback.register "fd_deregister" fd_deregister;
+*)
+
+external osevent_register_hooks : ctx -> ''a -> ''b =
"stub_xl_osevent_register_hooks"
+external osevent_occurred_fd : ctx -> for_libxl -> Unix.file_descr ->
event list -> event list -> unit = "stub_xl_osevent_occurred_fd"
+external osevent_occurred_timeout : ctx -> for_libxl -> unit =
"stub_xl_osevent_occurred_timeout"
+
+(* A callback with a name as in the following must be registered for async
calls
+ to libxl functions to work:
+
+ Callback.register "xl_async_callback" xl_async_callback;
+*)
+
+(* Callbacks with the names as in the following must be registered before
calling
+ event_register_callbacks:
+
+ Callback.register "xl_event_occurs_callback"
xl_event_occurs_callback;
+ Callback.register "xl_event_disaster_callback"
xl_event_disaster_callback;
+*)
+external evenable_domain_death : ctx -> domid -> int -> unit =
"stub_xl_evenable_domain_death"
+external event_register_callbacks : ctx -> ''a -> ''b =
"stub_xl_event_register_callbacks"
+
+(* event loop helper wrapping the poll syscall *)
+external poll : (Unix.file_descr * event list) list -> event list list =
"stub_poll"
+
let _ = Callback.register_exception "Xenlight.Error" (Error(Fail,
""))
+
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in
b/tools/ocaml/libs/xl/xenlight.mli.in
index 24064fc..d66f666 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -45,9 +45,30 @@ external test_raise_exception: unit -> unit =
"stub_raise_exception"
type domid = int
type devid = int
+(* type for event callbacks *)
+type for_libxl
+
+type event + | POLLIN (* There is data to read *)
+ | POLLPRI (* There is urgent data to read *)
+ | POLLOUT (* Writing now will not block *)
+ | POLLERR (* Error condition (revents only) *)
+ | POLLHUP (* Device has been disconnected (revents only) *)
+ | POLLNVAL (* Invalid request: fd not open (revents only). *)
+
(* @@LIBXL_TYPES@@ *)
external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
external xen_console_read : ctx -> string list =
"stub_xl_xen_console_read"
+
+external osevent_register_hooks : ctx -> ''a -> ''b =
"stub_xl_osevent_register_hooks"
+external osevent_occurred_fd : ctx -> for_libxl -> Unix.file_descr ->
event list -> event list -> unit = "stub_xl_osevent_occurred_fd"
+external osevent_occurred_timeout : ctx -> for_libxl -> unit =
"stub_xl_osevent_occurred_timeout"
+
+external evenable_domain_death : ctx -> domid -> int -> unit =
"stub_xl_evenable_domain_death"
+external event_register_callbacks : ctx -> ''a -> ''b =
"stub_xl_event_register_callbacks"
+
+external poll : (Unix.file_descr * event list) list -> event list list =
"stub_poll"
+
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index a8655ad..ae5317f 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -29,6 +29,10 @@
#include <libxl.h>
#include <libxl_utils.h>
+#include <unistd.h>
+
+#include "poll_stubs.h"
+
#define CTX ((libxl_ctx *)ctx)
static char * dup_String_val(value s)
@@ -323,6 +327,13 @@ static char *String_option_val(value v)
#include "_libxl_types.inc"
+void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
+{
+ int *task = (int *) for_callback;
+ value *func = caml_named_value("xl_async_callback");
+ caml_callback2(*func, (value) for_callback, Val_int(rc));
+}
+
#define _STRINGIFY(x) #x
#define STRINGIFY(x) _STRINGIFY(x)
@@ -552,6 +563,156 @@ value stub_xl_xen_console_read(value ctx)
CAMLreturn(list);
}
+int fd_register(void *user, int fd, void **for_app_registration_out,
+ short events, void *for_libxl)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 4);
+ value *func = caml_named_value("fd_register");
+
+ args[0] = (value) user;
+ args[1] = Val_int(fd);
+ args[2] = Val_poll_events(events);
+ args[3] = (value) for_libxl;
+
+ caml_callbackN(*func, 4, args);
+ CAMLreturn(0);
+}
+
+int fd_modify(void *user, int fd, void **for_app_registration_update,
+ short events)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 3);
+ value *func = caml_named_value("fd_modify");
+
+ args[0] = (value) user;
+ args[1] = Val_int(fd);
+ args[2] = Val_poll_events(events);
+
+ caml_callbackN(*func, 3, args);
+ CAMLreturn(0);
+}
+
+void fd_deregister(void *user, int fd, void *for_app_registration)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 2);
+ value *func = caml_named_value("fd_deregister");
+
+ args[0] = (value) user;
+ args[1] = Val_int(fd);
+
+ caml_callbackN(*func, 2, args);
+ CAMLreturn0;
+}
+
+int timeout_register(void *user, void **for_app_registration_out,
+ struct timeval abs, void *for_libxl)
+{
+ return 0;
+}
+
+int timeout_modify(void *user, void **for_app_registration_update,
+ struct timeval abs)
+{
+ return 0;
+}
+
+void timeout_deregister(void *user, void *for_app_registration)
+{
+ return;
+}
+
+value stub_xl_osevent_register_hooks(value ctx, value user)
+{
+ CAMLparam2(ctx, user);
+ libxl_osevent_hooks *hooks;
+ hooks = malloc(sizeof(*hooks));
+
+ hooks->fd_register = fd_register;
+ hooks->fd_modify = fd_modify;
+ hooks->fd_deregister = fd_deregister;
+ hooks->timeout_register = timeout_register;
+ hooks->timeout_modify = timeout_modify;
+ hooks->timeout_deregister = timeout_deregister;
+
+ libxl_osevent_register_hooks(CTX, hooks, (void *) user);
+
+ CAMLreturn((value) hooks);
+}
+
+value stub_xl_osevent_occurred_fd(value ctx, value for_libxl, value fd,
+ value events, value revents)
+{
+ CAMLparam5(ctx, for_libxl, fd, events, revents);
+ libxl_osevent_occurred_fd(CTX, (void *) for_libxl, Int_val(fd),
+ Poll_events_val(events), Poll_events_val(revents));
+ CAMLreturn(Val_unit);
+}
+
+value stub_xl_osevent_occurred_timeout(value ctx, value for_libxl)
+{
+ CAMLparam2(ctx, for_libxl);
+ libxl_osevent_occurred_timeout(CTX, (void *) for_libxl);
+ CAMLreturn(Val_unit);
+}
+
+void event_occurs(void *user, const libxl_event *event)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 2);
+ value *func = caml_named_value("xl_event_occurs_callback");
+
+ args[0] = (value) user;
+ args[1] = Val_event((libxl_event *) event);
+ //libxl_event_free(CTX, event); // no ctx here!
+
+ caml_callbackN(*func, 2, args);
+ CAMLreturn0;
+}
+
+void disaster(void *user, libxl_event_type type,
+ const char *msg, int errnoval)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 2);
+ value *func = caml_named_value("xl_event_disaster_callback");
+
+ args[0] = (value) user;
+ args[1] = Val_event_type(type);
+ args[2] = caml_copy_string(msg);
+ args[3] = Val_int(errnoval);
+
+ caml_callbackN(*func, 4, args);
+ CAMLreturn0;
+}
+
+value stub_xl_event_register_callbacks(value ctx, value user)
+{
+ CAMLparam2(ctx, user);
+ libxl_event_hooks *hooks;
+
+ hooks = malloc(sizeof(*hooks));
+ hooks->event_occurs_mask = LIBXL_EVENTMASK_ALL;
+ hooks->event_occurs = event_occurs;
+ hooks->disaster = disaster;
+
+ libxl_event_register_callbacks(CTX, (const libxl_event_hooks *) hooks, (void
*) user);
+
+ CAMLreturn((value) hooks);
+}
+
+value stub_xl_evenable_domain_death(value ctx, value domid, value user)
+{
+ CAMLparam3(ctx, domid, user);
+ libxl_evgen_domain_death *evgen_out;
+
+ libxl_evenable_domain_death(CTX, Int_val(domid), Int_val(user),
&evgen_out);
+
+ CAMLreturn(Val_unit);
+}
+
/*
* Local variables:
* indent-tabs-mode: t
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 23/28] libxl: ocaml: allow device operations to be called asynchronously
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 6 +++---
tools/ocaml/libs/xl/xenlight_stubs.c | 19 ++++++++++++++++---
2 files changed, 19 insertions(+), 6 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 10e6a74..9f7895a 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -22,9 +22,9 @@ builtins = {
"libxl_cpuid_policy_list": ("unit",
"%(c)s = 0", "Val_unit"),
}
-DEVICE_FUNCTIONS = [ ("add", ["ctx",
"t", "domid", "unit"]),
- ("remove", ["ctx",
"t", "domid", "unit"]),
- ("destroy", ["ctx",
"t", "domid", "unit"]),
+DEVICE_FUNCTIONS = [ ("add", ["ctx",
"?async:''a", "t", "domid",
"unit"]),
+ ("remove", ["ctx",
"?async:''a", "t", "domid",
"unit"]),
+ ("destroy", ["ctx",
"?async:''a", "t", "domid",
"unit"]),
]
functions = { # ( name , [type1,type2,....] )
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index ae5317f..c136db7 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -338,17 +338,30 @@ void async_callback(libxl_ctx *ctx, int rc, void
*for_callback)
#define STRINGIFY(x) _STRINGIFY(x)
#define _DEVICE_ADDREMOVE(type,op) \
-value stub_xl_device_##type##_##op(value ctx, value info, value domid) \
+value stub_xl_device_##type##_##op(value ctx, value async, value info, \
+ value domid) \
{ \
- CAMLparam3(ctx, info, domid); \
+ CAMLparam4(ctx, info, domid, async); \
libxl_device_##type c_info; \
int ret, marker_var; \
+ libxl_asyncop_how *ao_how; \
\
device_##type##_val(CTX, &c_info, info); \
\
- ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, 0); \
+ if (async != Val_none) { \
+ ao_how = malloc(sizeof(*ao_how)); \
+ ao_how->callback = async_callback; \
+ ao_how->u.for_callback = (void *) Some_val(async); \
+ } \
+ else \
+ ao_how = NULL; \
+ \
+ ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, \
+ ao_how); \
\
libxl_device_##type##_dispose(&c_info); \
+ if (ao_how) \
+ free(ao_how); \
\
if (ret != 0) \
failwith_xl(ret, STRINGIFY(type) "_" STRINGIFY(op)); \
--
1.7.10.4
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 5 ++++-
tools/ocaml/libs/xl/xenlight_stubs.c | 36 ++++++++++++++++++++++++++++++++++
2 files changed, 40 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 9f7895a..827fdb6 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -31,7 +31,10 @@ functions = { # ( name , [type1,type2,....] )
"device_vfb": DEVICE_FUNCTIONS,
"device_vkb": DEVICE_FUNCTIONS,
"device_disk": DEVICE_FUNCTIONS,
- "device_nic": DEVICE_FUNCTIONS,
+ "device_nic": DEVICE_FUNCTIONS +
+ [ ("list", ["ctx",
"domid", "t list"]),
+ ("of_devid", ["ctx",
"domid", "int", "t"]),
+ ],
"device_pci": DEVICE_FUNCTIONS,
"dominfo": [ ("list",
["ctx", "t list"]),
("get", ["ctx",
"domid", "t"]),
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index c136db7..ecc26ff 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -380,6 +380,42 @@ DEVICE_ADDREMOVE(vfb)
DEVICE_ADDREMOVE(vkb)
DEVICE_ADDREMOVE(pci)
+value stub_xl_device_nic_of_devid(value ctx, value domid, value devid)
+{
+ CAMLparam3(ctx, domid, devid);
+ libxl_device_nic nic;
+ libxl_devid_to_device_nic(CTX, Int_val(domid), Int_val(devid), &nic);
+ CAMLreturn(Val_device_nic(&nic));
+}
+
+value stub_xl_device_nic_list(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ CAMLlocal2(list, temp);
+ libxl_device_nic *c_list;
+ int i, nb;
+ uint32_t c_domid;
+
+ c_domid = Int_val(domid);
+
+ c_list = libxl_device_nic_list(CTX, c_domid, &nb);
+ if (!c_list && nb > 0)
+ failwith_xl(ERROR_FAIL, "nic_list");
+
+ list = temp = Val_emptylist;
+ for (i = 0; i < nb; i++) {
+ list = caml_alloc_small(2, Tag_cons);
+ Field(list, 0) = Val_int(0);
+ Field(list, 1) = temp;
+ temp = list;
+ Store_field(list, 0, Val_device_nic(&c_list[i]));
+ libxl_device_nic_dispose(&c_list[i]);
+ }
+ free(c_list);
+
+ CAMLreturn(list);
+}
+
value stub_xl_physinfo_get(value ctx)
{
CAMLparam1(ctx);
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 25/28] libxl: ocaml: add PCI device helper functions
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 7 ++-
tools/ocaml/libs/xl/xenlight_stubs.c | 90 ++++++++++++++++++++++++++++++++++
2 files changed, 96 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 827fdb6..becdef8 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -35,7 +35,12 @@ functions = { # ( name , [type1,type2,....] )
[ ("list", ["ctx",
"domid", "t list"]),
("of_devid", ["ctx",
"domid", "int", "t"]),
],
- "device_pci": DEVICE_FUNCTIONS,
+ "device_pci": DEVICE_FUNCTIONS +
+ [ ("list", ["ctx",
"domid", "t list"]),
+ ("assignable_add", ["ctx",
"t", "bool", "unit"]),
+ ("assignable_remove", ["ctx",
"t", "bool", "unit"]),
+ ("assignable_list", ["ctx",
"t list"]),
+ ],
"dominfo": [ ("list",
["ctx", "t list"]),
("get", ["ctx",
"domid", "t"]),
],
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index ecc26ff..7be5dd4 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -416,6 +416,96 @@ value stub_xl_device_nic_list(value ctx, value domid)
CAMLreturn(list);
}
+value stub_xl_device_pci_list(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ CAMLlocal2(list, temp);
+ libxl_device_pci *c_list;
+ int i, nb;
+ uint32_t c_domid;
+
+ c_domid = Int_val(domid);
+
+ c_list = libxl_device_pci_list(CTX, c_domid, &nb);
+ if (!c_list && nb > 0)
+ failwith_xl(ERROR_FAIL, "pci_list");
+
+ list = temp = Val_emptylist;
+ for (i = 0; i < nb; i++) {
+ list = caml_alloc_small(2, Tag_cons);
+ Field(list, 0) = Val_int(0);
+ Field(list, 1) = temp;
+ temp = list;
+ Store_field(list, 0, Val_device_pci(&c_list[i]));
+ libxl_device_pci_dispose(&c_list[i]);
+ }
+ free(c_list);
+
+ CAMLreturn(list);
+}
+
+value stub_xl_device_pci_assignable_add(value ctx, value info, value rebind)
+{
+ CAMLparam3(ctx, info, rebind);
+ libxl_device_pci c_info;
+ int ret, marker_var;
+
+ device_pci_val(CTX, &c_info, info);
+
+ ret = libxl_device_pci_assignable_add(CTX, &c_info, (int)
Bool_val(rebind));
+
+ libxl_device_pci_dispose(&c_info);
+
+ if (ret != 0)
+ failwith_xl(ret, "pci_assignable_add");
+
+ CAMLreturn(Val_unit);
+}
+
+value stub_xl_device_pci_assignable_remove(value ctx, value info, value rebind)
+{
+ CAMLparam3(ctx, info, rebind);
+ libxl_device_pci c_info;
+ int ret, marker_var;
+
+ device_pci_val(CTX, &c_info, info);
+
+ ret = libxl_device_pci_assignable_remove(CTX, &c_info, (int)
Bool_val(rebind));
+
+ libxl_device_pci_dispose(&c_info);
+
+ if (ret != 0)
+ failwith_xl(ret, "pci_assignable_remove");
+
+ CAMLreturn(Val_unit);
+}
+
+value stub_xl_device_pci_assignable_list(value ctx)
+{
+ CAMLparam1(ctx);
+ CAMLlocal2(list, temp);
+ libxl_device_pci *c_list;
+ int i, nb;
+ uint32_t c_domid;
+
+ c_list = libxl_device_pci_assignable_list(CTX, &nb);
+ if (!c_list && nb > 0)
+ failwith_xl(ERROR_FAIL, "pci_assignable_list");
+
+ list = temp = Val_emptylist;
+ for (i = 0; i < nb; i++) {
+ list = caml_alloc_small(2, Tag_cons);
+ Field(list, 0) = Val_int(0);
+ Field(list, 1) = temp;
+ temp = list;
+ Store_field(list, 0, Val_device_pci(&c_list[i]));
+ libxl_device_pci_dispose(&c_list[i]);
+ }
+ free(c_list);
+
+ CAMLreturn(list);
+}
+
value stub_xl_physinfo_get(value ctx)
{
CAMLparam1(ctx);
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 26/28] libxl: ocaml: add disk and cdrom helper functions
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 5 ++++-
tools/ocaml/libs/xl/xenlight_stubs.c | 19 ++++++++++++++-----
2 files changed, 18 insertions(+), 6 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index becdef8..5bc165d 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -30,7 +30,10 @@ DEVICE_FUNCTIONS = [ ("add",
["ctx", "?async:''a", "t",
"domid", "unit
functions = { # ( name , [type1,type2,....] )
"device_vfb": DEVICE_FUNCTIONS,
"device_vkb": DEVICE_FUNCTIONS,
- "device_disk": DEVICE_FUNCTIONS,
+ "device_disk": DEVICE_FUNCTIONS +
+ [ ("insert", ["ctx",
"?async:''a", "t", "domid",
"unit"]),
+ ("of_vdev", ["ctx",
"domid", "string", "t"]),
+ ],
"device_nic": DEVICE_FUNCTIONS +
[ ("list", ["ctx",
"domid", "t list"]),
("of_devid", ["ctx",
"domid", "int", "t"]),
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index 7be5dd4..f832f37 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -337,7 +337,7 @@ void async_callback(libxl_ctx *ctx, int rc, void
*for_callback)
#define _STRINGIFY(x) #x
#define STRINGIFY(x) _STRINGIFY(x)
-#define _DEVICE_ADDREMOVE(type,op) \
+#define _DEVICE_ADDREMOVE(type,fn,op) \
value stub_xl_device_##type##_##op(value ctx, value async, value info, \
value domid) \
{ \
@@ -356,7 +356,7 @@ value stub_xl_device_##type##_##op(value ctx, value async,
value info, \
else \
ao_how = NULL; \
\
- ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, \
+ ret = libxl_##fn##_##op(CTX, Int_val(domid), &c_info, \
ao_how); \
\
libxl_device_##type##_dispose(&c_info); \
@@ -370,15 +370,16 @@ value stub_xl_device_##type##_##op(value ctx, value async,
value info, \
}
#define DEVICE_ADDREMOVE(type) \
- _DEVICE_ADDREMOVE(type, add) \
- _DEVICE_ADDREMOVE(type, remove) \
- _DEVICE_ADDREMOVE(type, destroy)
+ _DEVICE_ADDREMOVE(type, device_##type, add) \
+ _DEVICE_ADDREMOVE(type, device_##type, remove) \
+ _DEVICE_ADDREMOVE(type, device_##type, destroy)
DEVICE_ADDREMOVE(disk)
DEVICE_ADDREMOVE(nic)
DEVICE_ADDREMOVE(vfb)
DEVICE_ADDREMOVE(vkb)
DEVICE_ADDREMOVE(pci)
+_DEVICE_ADDREMOVE(disk, cdrom, insert)
value stub_xl_device_nic_of_devid(value ctx, value domid, value devid)
{
@@ -416,6 +417,14 @@ value stub_xl_device_nic_list(value ctx, value domid)
CAMLreturn(list);
}
+value stub_xl_device_disk_of_vdev(value ctx, value domid, value vdev)
+{
+ CAMLparam3(ctx, domid, vdev);
+ libxl_device_disk disk;
+ libxl_vdev_to_device_disk(CTX, Int_val(domid), String_val(vdev), &disk);
+ CAMLreturn(Val_device_disk(&disk));
+}
+
value stub_xl_device_pci_list(value ctx, value domid)
{
CAMLparam2(ctx, domid);
--
1.7.10.4
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/xenlight.ml.in | 10 ++
tools/ocaml/libs/xl/xenlight.mli.in | 10 ++
tools/ocaml/libs/xl/xenlight_stubs.c | 171 ++++++++++++++++++++++++++++++++++
3 files changed, 191 insertions(+)
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in
b/tools/ocaml/libs/xl/xenlight.ml.in
index 96d6a38..5cd5204 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -86,6 +86,16 @@ type event
(* @@LIBXL_TYPES@@ *)
+external domain_create_new : ctx -> Domain_config.t -> domid =
"stub_xl_domain_create_new"
+external domain_create_restore : ctx -> Domain_config.t ->
Unix.file_descr -> domid = "stub_xl_domain_create_restore"
+external domain_shutdown : ctx -> domid -> unit =
"stub_libxl_domain_shutdown"
+external domain_wait_shutdown : ctx -> domid -> unit =
"stub_libxl_domain_wait_shutdown"
+external domain_reboot : ctx -> domid -> unit =
"stub_libxl_domain_reboot"
+external domain_destroy : ctx -> domid -> unit =
"stub_libxl_domain_destroy"
+external domain_suspend : ctx -> domid -> Unix.file_descr -> unit =
"stub_libxl_domain_suspend"
+external domain_pause : ctx -> domid -> unit =
"stub_libxl_domain_pause"
+external domain_unpause : ctx -> domid -> unit =
"stub_libxl_domain_unpause"
+
external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in
b/tools/ocaml/libs/xl/xenlight.mli.in
index d66f666..41713f3 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -58,6 +58,16 @@ type event
(* @@LIBXL_TYPES@@ *)
+external domain_create_new : ctx -> Domain_config.t -> domid =
"stub_xl_domain_create_new"
+external domain_create_restore : ctx -> Domain_config.t ->
Unix.file_descr -> domid = "stub_xl_domain_create_restore"
+external domain_shutdown : ctx -> domid -> unit =
"stub_libxl_domain_shutdown"
+external domain_wait_shutdown : ctx -> domid -> unit =
"stub_libxl_domain_wait_shutdown"
+external domain_reboot : ctx -> domid -> unit =
"stub_libxl_domain_reboot"
+external domain_destroy : ctx -> domid -> unit =
"stub_libxl_domain_destroy"
+external domain_suspend : ctx -> domid -> Unix.file_descr -> unit =
"stub_libxl_domain_suspend"
+external domain_pause : ctx -> domid -> unit =
"stub_libxl_domain_pause"
+external domain_unpause : ctx -> domid -> unit =
"stub_libxl_domain_unpause"
+
external send_trigger : ctx -> domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
external send_sysrq : ctx -> domid -> char -> unit =
"stub_xl_send_sysrq"
external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
b/tools/ocaml/libs/xl/xenlight_stubs.c
index f832f37..f3dd832 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -327,6 +327,177 @@ static char *String_option_val(value v)
#include "_libxl_types.inc"
+static int domain_wait_event(libxl_ctx *ctx, int domid, libxl_event **event_r)
+{
+ int ret;
+ for (;;) {
+ ret = libxl_event_wait(ctx, event_r, LIBXL_EVENTMASK_ALL, 0,0);
+ if (ret) {
+ return ret;
+ }
+ if ((*event_r)->domid != domid) {
+ char *evstr = libxl_event_to_json(CTX, *event_r);
+ free(evstr);
+ libxl_event_free(CTX, *event_r);
+ continue;
+ }
+ return ret;
+ }
+}
+
+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;
+
+ libxl_domain_config_init(&c_dconfig);
+ ret = domain_config_val(CTX, &c_dconfig, domain_config);
+ if (ret != 0)
+ failwith_xl(ret, "domain_create_new");
+
+ 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));
+}
+
+value stub_xl_domain_create_restore(value ctx, value domain_config, value
restore_fd)
+{
+ CAMLparam2(ctx, domain_config);
+ int ret;
+ libxl_domain_config c_dconfig;
+ uint32_t c_domid;
+
+ ret = domain_config_val(CTX, &c_dconfig, domain_config);
+ if (ret != 0)
+ failwith_xl(ret, "domain_create_restore");
+
+ ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid,
Int_val(restore_fd), NULL, NULL);
+ if (ret != 0)
+ failwith_xl(ret, "domain_create_restore");
+
+ libxl_domain_config_dispose(&c_dconfig);
+
+ CAMLreturn(Val_int(c_domid));
+}
+
+value stub_libxl_domain_wait_shutdown(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ int ret;
+ libxl_event *event;
+ libxl_evgen_domain_death *deathw;
+ ret = libxl_evenable_domain_death(CTX, Int_val(domid), 0, &deathw);
+ if (ret) {
+ fprintf(stderr,"wait for death failed (evgen, rc=%d)\n",ret);
+ exit(-1);
+ }
+
+ for (;;) {
+ ret = domain_wait_event(CTX, Int_val(domid), &event);
+ if (ret)
+ failwith_xl(ret, "domain_shutdown");
+
+ switch (event->type) {
+ case LIBXL_EVENT_TYPE_DOMAIN_DEATH:
+ goto done;
+ case LIBXL_EVENT_TYPE_DOMAIN_SHUTDOWN:
+ goto done;
+ default:
+ break;
+ }
+ libxl_event_free(CTX, event);
+ }
+done:
+ libxl_event_free(CTX, event);
+ libxl_evdisable_domain_death(CTX, deathw);
+
+ CAMLreturn(Val_unit);
+}
+
+value stub_libxl_domain_shutdown(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ int ret;
+
+ ret = libxl_domain_shutdown(CTX, Int_val(domid));
+
+ if (ret != 0)
+ failwith_xl(ret, "domain_shutdown");
+
+ CAMLreturn(Val_unit);
+}
+
+value stub_libxl_domain_reboot(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ int ret;
+
+ ret = libxl_domain_reboot(CTX, Int_val(domid));
+
+ if (ret != 0)
+ failwith_xl(ret, "domain_reboot");
+
+ CAMLreturn(Val_unit);
+}
+
+value stub_libxl_domain_destroy(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ int ret;
+
+ ret = libxl_domain_destroy(CTX, Int_val(domid), 0);
+
+ if (ret != 0)
+ failwith_xl(ret, "domain_destroy");
+
+ CAMLreturn(Val_unit);
+}
+
+value stub_libxl_domain_suspend(value ctx, value domid, value fd)
+{
+ CAMLparam3(ctx, domid, fd);
+ int ret;
+
+ ret = libxl_domain_suspend(CTX, Int_val(domid), Int_val(fd), 0, 0);
+
+ if (ret != 0)
+ failwith_xl(ret, "domain_suspend");
+
+ CAMLreturn(Val_unit);
+}
+
+value stub_libxl_domain_pause(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ int ret;
+
+ ret = libxl_domain_pause(CTX, Int_val(domid));
+
+ if (ret != 0)
+ failwith_xl(ret, "domain_pause");
+
+ CAMLreturn(Val_unit);
+}
+
+value stub_libxl_domain_unpause(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ int ret;
+
+ ret = libxl_domain_unpause(CTX, Int_val(domid));
+
+ if (ret != 0)
+ failwith_xl(ret, "domain_unpause");
+
+ CAMLreturn(Val_unit);
+}
+
void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
{
int *task = (int *) for_callback;
--
1.7.10.4
Rob Hoes
2013-Mar-25 14:45 UTC
[PATCH 28/28] libxl: ocaml: provide default records for libxl types
Libxl functions such as libxl_domain_create_new take large structs
of configuration parameters. Often, we would like to use the default
values for many of these parameters.
This commit makes OCaml records of defaults available for all libxl
struct and keyed-union types, which can be used as a base to construct
your own records, and to selectively override parameters where needed.
For example, a Domain_create_info record can now be created as follows:
let c_info = Xenlight.Domain_create_info.({ default with
ty = Xenlight.DOMAIN_TYPE_PV;
name = Some vm_name;
uuid = vm_uuid;
}) in
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 114 +++++++++++++++++++++++++++++++++-------
1 file changed, 96 insertions(+), 18 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 5bc165d..332a189 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -4,22 +4,22 @@ import sys,os
import idl
-# typename -> ( ocaml_type, c_from_ocaml, ocaml_from_c )
+# typename -> ( ocaml_type, c_from_ocaml, ocaml_from_c, ocaml_default )
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 option",
"%(c)s = String_option_val(%(o)s)",
"Val_string_option(%(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(&%(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)"),
+ "bool": ("bool",
"%(c)s = Bool_val(%(o)s)", "Val_bool(%(c)s)",
"false" ),
+ "int": ("int",
"%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)",
"0" ),
+ "char *": ("string option",
"%(c)s = String_option_val(%(o)s)",
"Val_string_option(%(c)s)", "None"),
+ "libxl_domid": ("domid",
"%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)",
"0" ),
+ "libxl_devid": ("devid",
"%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)",
"0" ),
+ "libxl_defbool": ("bool option",
"%(c)s = Defbool_val(%(o)s)", "Val_defbool(%(c)s)",
"None" ),
+ "libxl_uuid": ("int array",
"Uuid_val(&%(c)s, %(o)s)", "Val_uuid(&%(c)s)",
''[||]''),
+ "libxl_bitmap": ("bool array",
"Bitmap_val(ctx, &%(c)s, %(o)s)",
"Val_bitmap(&%(c)s)", "[||]"),
+ "libxl_key_value_list": ("(string * string) list",
"libxl_key_value_list_val(&%(c)s, %(o)s)", None,
"[]"),
+ "libxl_string_list": ("string list",
"libxl_string_list_val(&%(c)s, %(o)s)",
"String_list_val(&%(c)s, %(o)s)", "[]"),
+ "libxl_mac": ("int array",
"Mac_val(&%(c)s, %(o)s)", "Val_mac(&%(c)s)",
"[||]"),
+ "libxl_hwcap": ("int32 array",
None, "Val_hwcap(&%(c)s)",
"[||]"),
# The following needs to be sorted out later
- "libxl_cpuid_policy_list": ("unit",
"%(c)s = 0", "Val_unit"),
+ "libxl_cpuid_policy_list": ("unit",
"%(c)s = 0", "Val_unit",
"()"),
}
DEVICE_FUNCTIONS = [ ("add", ["ctx",
"?async:''a", "t", "domid",
"unit"]),
@@ -79,7 +79,7 @@ def ocaml_type_of(ty):
elif isinstance(ty,idl.Builtin):
if not builtins.has_key(ty.typename):
raise NotImplementedError("Unknown Builtin %s (%s)" %
(ty.typename, type(ty)))
- typename,_,_ = builtins[ty.typename]
+ typename,_,_,_ = builtins[ty.typename]
if not typename:
raise NotImplementedError("No typename for Builtin %s
(%s)" % (ty.typename, type(ty)))
return typename
@@ -90,6 +90,53 @@ def ocaml_type_of(ty):
else:
return ty.rawname
+def ocaml_default_of(ty):
+ if ty.rawname in ["domid","devid"]:
+ return "0"
+ elif isinstance(ty,idl.UInt):
+ if ty.width in [8, 16]:
+ # handle as ints
+ width = None
+ elif ty.width == 32:
+ width = "l"
+ elif ty.width == 64:
+ width = "L"
+ else:
+ raise NotImplementedError("Cannot handle %d-bit int" %
ty.width)
+ if width:
+ return "0" + width
+ else:
+ return "0"
+ elif isinstance(ty,idl.Array):
+ return "[||]"
+ elif isinstance(ty,idl.Builtin):
+ if not builtins.has_key(ty.typename):
+ raise NotImplementedError("Unknown Builtin %s (%s)" %
(ty.typename, type(ty)))
+ _,_,_,default = builtins[ty.typename]
+ if not default:
+ raise NotImplementedError("No default for Builtin %s
(%s)" % (ty.typename, type(ty)))
+ return default
+ elif isinstance(ty,idl.KeyedUnion):
+ if ty.keyvar.init_val:
+ s = " (* TODO: use keyvar init_val: " +
str(ty.keyvar.init_val) + "*)"
+ else:
+ s = ""
+ f = ty.fields[0]
+ if f.type == None:
+ return f.name.capitalize() + s
+ elif f.type.rawname is not None:
+ return "%s default_%s" % (f.name.capitalize(),
f.type.rawname.capitalize()) + s
+ elif f.type.has_fields():
+ return "%s default_%s" % (f.name.capitalize(), f.name) +
s
+ else:
+ return f.name.capitalize() + s
+ elif isinstance(ty,idl.Aggregate):
+ return ty.rawname.capitalize() + ".default"
+ elif isinstance(ty,idl.Enumeration):
+ return ty.values[0].rawname
+ else:
+ return ty.rawname
+
def munge_name(name):
if name == "type":
return "ty"
@@ -103,6 +150,13 @@ def ocaml_instance_of_field(f):
name = f.name
return "%s : %s" % (munge_name(name), ocaml_type_of(f.type))
+def ocaml_instance_of_field_default(f):
+ if isinstance(f.type, idl.KeyedUnion):
+ name = f.type.keyvar.name
+ else:
+ name = f.name
+ return "%s = %s" % (munge_name(name), ocaml_default_of(f.type))
+
def gen_struct(ty):
s = ""
for f in ty.fields:
@@ -113,9 +167,18 @@ def gen_struct(ty):
s += "\t\t" + x + ";\n"
return s
+def gen_struct_default(ty):
+ s = ""
+ for f in ty.fields:
+ if f.type.private:
+ continue
+ x = ocaml_instance_of_field_default(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
@@ -133,6 +196,13 @@ def gen_ocaml_keyedunions(ty, interface, indent, parent =
None):
s += "{\n"
s += gen_struct(f.type)
s += "}\n"
+ if interface:
+ s += "val default_%s : %s_%s\n" % (f.name,
nparent,f.name)
+ else:
+ s += "let default_%s =\n" % f.name
+ s += "{\n"
+ s += gen_struct_default(f.type)
+ s += "}\n"
name = "%s__union" % ty.keyvar.name
s += "\n"
@@ -195,6 +265,14 @@ def gen_ocaml_ml(ty, interface, indent=""):
s += gen_struct(ty)
s += "\t}\n"
+ if interface:
+ s += "\tval default : t\n"
+ else:
+ s += "\tlet default =\n"
+ s += "\t{\n"
+ s += gen_struct_default(ty)
+ s += "\t}\n"
+
if functions.has_key(ty.rawname):
for name,args in functions[ty.rawname]:
s += "\texternal %s : " % name
@@ -224,7 +302,7 @@ def c_val(ty, c, o, indent="", parent = None):
elif isinstance(ty,idl.Builtin):
if not builtins.has_key(ty.typename):
raise NotImplementedError("Unknown Builtin %s (%s)" %
(ty.typename, type(ty)))
- _,fn,_ = builtins[ty.typename]
+ _,fn,_,_ = builtins[ty.typename]
if not fn:
raise NotImplementedError("No c_val fn for Builtin %s
(%s)" % (ty.typename, type(ty)))
s += "%s;" % (fn % { "o": o, "c": c })
@@ -321,7 +399,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None,
struct_tag = None):
elif isinstance(ty,idl.Builtin):
if not builtins.has_key(ty.typename):
raise NotImplementedError("Unknown Builtin %s (%s)" %
(ty.typename, type(ty)))
- _,_,fn = builtins[ty.typename]
+ _,_,fn,_ = builtins[ty.typename]
if not fn:
raise NotImplementedError("No ocaml Val fn for Builtin %s
(%s)" % (ty.typename, type(ty)))
s += "%s = %s;" % (o, fn % { "c": c })
--
1.7.10.4
David Scott
2013-Mar-26 09:21 UTC
Re: [PATCH 06/28] libxl: ocaml: support for KeyedUnion in the bindings generator.
Minor quibble: On 25/03/13 14:45, Rob Hoes wrote: [snip]> So given IDL: > > foo = Enumeration("foo", > (0, "BAR"), > (1, "BAZ"), > s = Struct("s", [ > ("u", KeyedUnion(none, foo, "blargle", [ > ("bar", Struct(...xxx...)), > ("baz", Struct(...yyy...)), > ])), > ])[snip]> and map this to ocaml > > type foo = BAR | BAZ; > > module s = StructI presume you mean "module S = struct"? Cheers, Dave
David Scott
2013-Mar-26 11:14 UTC
Re: [PATCH 08/28] libxc: ocaml: add simple binding for xentoollog (output only).
On 25/03/13 14:45, Rob Hoes wrote: [snip]> +/* 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); > +}I think we should avoid returning "bare pointers" to the OCaml heap for two reasons: Firstly it makes us vulnerable to a sequence like the following: 1. malloc() something out of heap 2. return the "bare pointer" to the heap 3. GC runs, ignores the bare pointer because it points out of heap ... some time later ... 4. we call free() on the out of heap thing ... some time later ... 5. GC runs, ignores the bare pointer because it points out of heap ... some time and many heap allocations later ... 6. GC expands <-- the heap now includes the old address used by the bare pointer 7. GC runs, follows the bare pointer because it points inside the heap and segfaults Secondly it prevents some heap optimisations that are being experimented with by people at OCamlLabs, so we''d be storing up some incompatibility for the future. Instead of returning a "bare pointer" I think we should use a "Custom" value. This involves declaring a "struct custom_operations" like this: static struct custom_operations foo_custom_operations = { "foo_custom_operations", custom_finalize_default, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default }; And then wrapping and unwrapping "Custom" blocks using something like: #define Foo_val(x) (*((struct foo *)Data_custom_val(x))) static value Val_foo (struct foo *x) { CAMLparam0 (); CAMLlocal1 (result); result = caml_alloc_custom (&foo_custom_operations, sizeof (struct foo*), 0, 1); Foo_val (result) = x; CAMLreturn (result); } There''s more information here: http://caml.inria.fr/pub/docs/manual-ocaml-4.00/manual033.html#toc150 The ocaml-libvirt bindings are a good example of this pattern: http://git.annexia.org/?p=ocaml-libvirt.git;a=summary It''s also worth considering whether to use the finalizer support to automatically free the underlying C resource when the last reference to it from OCaml has been GCed. This would be safer than exposing a direct "free" function in the OCaml interface, since it would prevent use-after-free. Cheers, Dave
David Scott
2013-Mar-26 11:33 UTC
Re: [PATCH 11/28] libxl: ocaml: propagate the libxl return error code in exceptions
On 25/03/13 14:45, Rob Hoes wrote:> +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);I think this violates Rule 5 in the OCaml FFI manual[*]. In the low-level interface when you allocate a block with "caml_alloc_small" all the fields contain random values. The assignment: Field(arg, 1) = caml_copy_string(fname); will first call "caml_copy_string" which performs an allocation before setting the field to a valid value. Any function which performs an allocation can trigger a GC which will segfault if it sees the random data in field 1. I strongly recommend using the "simple interface" i.e. caml_alloc() caml_alloc_tuple() Store_field() If you look in the definition of "caml_alloc" [**] it does this: CAMLexport value caml_alloc (mlsize_t wosize, tag_t tag) { value result; mlsize_t i; Assert (tag < 256); Assert (tag != Infix_tag); if (wosize == 0){ result = Atom (tag); }else if (wosize <= Max_young_wosize){ Alloc_small (result, wosize, tag); if (tag < No_scan_tag){ for (i = 0; i < wosize; i++) Field (result, i) = 0; } ^^^^^ -- it sets the fields to 0 preventing the GC seeing a random value Whereas "caml_alloc_small" just does the "Alloc_small".> + > + caml_raise_with_arg(*exc, arg); > +}[*] http://caml.inria.fr/pub/docs/manual-ocaml-4.00/manual033.html [**] https://github.com/ocaml/ocaml/blob/trunk/byterun/alloc.c
David Scott
2013-Mar-26 11:43 UTC
Re: [PATCH 16/28] libxl: ocaml: use the "string option" type for IDL strings
On 25/03/13 14:45, Rob Hoes wrote: [ snip ]> +static value Val_string_option(char *c_val) > +{ > + CAMLparam0(); > + if (c_val) > + CAMLreturn(Val_some(caml_copy_string(c_val)));A bad sequence is: 1. caml_copy_string() allocates a string successfully 2. Val_some() calls the allocator to allocate a block but the minor heap is full so it triggers a GC 3. the GC deletes the string from (1) since it can''t find any references to it Personally I always force myself to write very basic code with lots of explicit temporaries, just to be totally safe. It feels strange because it''s the complete opposite of good functional style (particularly if you believe in point-free programming!). So I would write: CAMLparam0() CAMLlocal2(tmp1, tmp2) if (c_val) { tmp1 = caml_copy_string(c_val); tmp2 = Val_some(tmp1); CAMLreturn(tmp2) } ... It''s almost embarrassing to write code like that, but at least it''s safe! :-)> + else > + CAMLreturn(Val_none); > +} > + > +static char *String_option_val(value v) > +{ > + char *s = NULL; > + if (v != Val_none) > + s = dup_String_val(Some_val(v)); > + return s; > +} > + > #include "_libxl_types.inc" > > #define _STRINGIFY(x) #x >
On 25/03/13 14:45, Rob Hoes wrote:> Signed-off-by: Rob Hoes <rob.hoes@citrix.com> > --- > tools/ocaml/libs/xl/xenlight.ml.in | 1 + > tools/ocaml/libs/xl/xenlight.mli.in | 1 + > tools/ocaml/libs/xl/xenlight_stubs.c | 27 +++++++++++++++++++++++++++ > 3 files changed, 29 insertions(+) > > diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in > index 991b2bf..63b8bf8 100644 > --- a/tools/ocaml/libs/xl/xenlight.ml.in > +++ b/tools/ocaml/libs/xl/xenlight.ml.in > @@ -78,5 +78,6 @@ type devid = int > external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" > external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" > external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" > +external xen_console_read : ctx -> string list = "stub_xl_xen_console_read" > > let _ = Callback.register_exception "Xenlight.Error" (Error(Fail, "")) > diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in > index 12568ca..24064fc 100644 > --- a/tools/ocaml/libs/xl/xenlight.mli.in > +++ b/tools/ocaml/libs/xl/xenlight.mli.in > @@ -50,3 +50,4 @@ type devid = int > external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" > external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" > external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" > +external xen_console_read : ctx -> string list = "stub_xl_xen_console_read" > diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c > index f4fa520..939e993 100644 > --- a/tools/ocaml/libs/xl/xenlight_stubs.c > +++ b/tools/ocaml/libs/xl/xenlight_stubs.c > @@ -484,6 +484,33 @@ value stub_xl_send_debug_keys(value ctx, value keys) > CAMLreturn(Val_unit); > } > > +value stub_xl_xen_console_read(value ctx) > +{ > + CAMLparam1(ctx); > + CAMLlocal3(list, cons, ml_line); > + int i = 0, ret; > + char *console[32768], *line; > + libxl_xen_console_reader *cr; > + > + cr = libxl_xen_console_read_start(CTX, 0); > + if (cr) > + for (i = 0; libxl_xen_console_read_line(CTX, cr, &line) > 0; i++)> + console[i] = strdup(line); Is it obvious why i is always < 32768? Or is 32768 "too big to fail"? (Sorry, couldn''t resist)> + libxl_xen_console_read_finish(CTX, cr); > + > + list = Val_emptylist; > + for (; i > 0; i--) { > + ml_line = caml_copy_string(console[i - 1]); > + free(console[i - 1]); > + cons = caml_alloc(2, 0); > + Store_field(cons, 0, ml_line); // head > + Store_field(cons, 1, list); // tail > + list = cons; > + } > + > + CAMLreturn(list); > +} > + > /* > * Local variables: > * indent-tabs-mode: t >
On 25/03/13 14:45, Rob Hoes wrote:> +value Val_poll(short event) > +{ > + CAMLparam0(); > + CAMLlocal1(res); > + > + switch (event) { > + case POLLIN: res = Val_int(0); break; > + case POLLPRI: res = Val_int(1); break; > + case POLLOUT: res = Val_int(2); break; > + case POLLERR: res = Val_int(3); break; > + case POLLHUP: res = Val_int(4); break; > + case POLLNVAL: res = Val_int(5); break; > + } > + > + CAMLreturn(res); > +}Is it possible for none of the cases to match? If so, what would you like to happen-- it''s worth being more explicit.
On 25/03/13 14:45, Rob Hoes wrote:> +(* Callbacks with the names as in the following must be registered before calling > + osevent_register_hooks: > + > + Callback.register "fd_register" fd_register; > + Callback.register "fd_modify" fd_modify; > + Callback.register "fd_deregister" fd_deregister; > +*)Could you add a prefix to these names to prevent possible clashes with other libraries?
On 25/03/13 14:45, Rob Hoes wrote:> +void fd_deregister(void *user, int fd, void *for_app_registration) > +{ > + CAMLparam0(); > + CAMLlocalN(args, 2); > + value *func = caml_named_value("fd_deregister"); > + > + args[0] = (value) user; > + args[1] = Val_int(fd); > + > + caml_callbackN(*func, 2, args); > + CAMLreturn0; > +}The OCaml manual[*] (S19.7.2) hints that the name lookup is a bit slow: "The pointer returned by caml_named_value is constant and can safely be cached in a C variable to avoid repeated name lookups. On the other hand, the value pointed to can change during garbage collection and must always be recomputed at the point of use." The manual suggests caching the value * in a static like this: void fd_deregister(void *user, int fd, void *for_app_registration) { CAMLparam0(); CAMLlocalN(args, 2); static value * func = NULL; if (func == NULL) { /* First time around, look up by name */ func = caml_named_value("fd_deregister"); } ... [*] http://caml.inria.fr/pub/docs/manual-ocaml-4.00/manual033.html
On 26/03/2013 11:48, David Scott wrote:> On 25/03/13 14:45, Rob Hoes wrote: >> Signed-off-by: Rob Hoes <rob.hoes@citrix.com> >> --- >> tools/ocaml/libs/xl/xenlight.ml.in | 1 + >> tools/ocaml/libs/xl/xenlight.mli.in | 1 + >> tools/ocaml/libs/xl/xenlight_stubs.c | 27 +++++++++++++++++++++++++++ >> 3 files changed, 29 insertions(+) >> >> diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in >> index 991b2bf..63b8bf8 100644 >> --- a/tools/ocaml/libs/xl/xenlight.ml.in >> +++ b/tools/ocaml/libs/xl/xenlight.ml.in >> @@ -78,5 +78,6 @@ type devid = int >> external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" >> external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" >> external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" >> +external xen_console_read : ctx -> string list = "stub_xl_xen_console_read" >> >> let _ = Callback.register_exception "Xenlight.Error" (Error(Fail, "")) >> diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in >> index 12568ca..24064fc 100644 >> --- a/tools/ocaml/libs/xl/xenlight.mli.in >> +++ b/tools/ocaml/libs/xl/xenlight.mli.in >> @@ -50,3 +50,4 @@ type devid = int >> external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger" >> external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq" >> external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" >> +external xen_console_read : ctx -> string list = "stub_xl_xen_console_read" >> diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c >> index f4fa520..939e993 100644 >> --- a/tools/ocaml/libs/xl/xenlight_stubs.c >> +++ b/tools/ocaml/libs/xl/xenlight_stubs.c >> @@ -484,6 +484,33 @@ value stub_xl_send_debug_keys(value ctx, value keys) >> CAMLreturn(Val_unit); >> } >> >> +value stub_xl_xen_console_read(value ctx) >> +{ >> + CAMLparam1(ctx); >> + CAMLlocal3(list, cons, ml_line); >> + int i = 0, ret; >> + char *console[32768], *line; >> + libxl_xen_console_reader *cr; >> + >> + cr = libxl_xen_console_read_start(CTX, 0); >> + if (cr) >> + for (i = 0; libxl_xen_console_read_line(CTX, cr, &line) > 0; i++) > > + console[i] = strdup(line); > > Is it obvious why i is always < 32768? Or is 32768 "too big to fail"? > (Sorry, couldn''t resist)This is 32K entries of 4 or 8 bytes (for 32/64bit system), meaning 128K or 256K of data on the stack. I am surprised that this didn''t segfault instantly, but this does seem an unreasonably large amount of data, especially for some library bindings. If you want to end up with a list of lines, I would suggest using my patch series to grab the entire console ring at once, counting the number of ''\n''s present and working with that. ~Andrew> >> + libxl_xen_console_read_finish(CTX, cr); >> + >> + list = Val_emptylist; >> + for (; i > 0; i--) { >> + ml_line = caml_copy_string(console[i - 1]); >> + free(console[i - 1]); >> + cons = caml_alloc(2, 0); >> + Store_field(cons, 0, ml_line); // head >> + Store_field(cons, 1, list); // tail >> + list = cons; >> + } >> + >> + CAMLreturn(list); >> +} >> + >> /* >> * Local variables: >> * indent-tabs-mode: t >> > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xen.org > http://lists.xen.org/xen-devel
Rob Hoes
2013-Apr-05 13:37 UTC
Re: [PATCH 06/28] libxl: ocaml: support for KeyedUnion in the bindings generator.
Hi Dave, Thanks for reviewing my patches, and sorry for the late reply. I am going through your feedback now and will update the patches.> Minor quibble: > (...) > I presume you mean "module S = struct"?Indeed! Cheers, Rob
Rob Hoes
2013-Apr-05 14:04 UTC
Re: [PATCH 08/28] libxc: ocaml: add simple binding for xentoollog (output only).
> I think we should avoid returning "bare pointers" to the OCaml heap for two > reasons:[...] I see, thanks for pointing that out.> Instead of returning a "bare pointer" I think we should use a "Custom" > value. This involves declaring a "struct custom_operations" like this: > > static struct custom_operations foo_custom_operations = { > "foo_custom_operations", > custom_finalize_default, > custom_compare_default, > custom_hash_default, > custom_serialize_default, > custom_deserialize_default > }; > > And then wrapping and unwrapping "Custom" blocks using something like: > > #define Foo_val(x) (*((struct foo *)Data_custom_val(x))) > > static value > Val_foo (struct foo *x) > { > CAMLparam0 (); > CAMLlocal1 (result); > result = caml_alloc_custom (&foo_custom_operations, > sizeof (struct foo*), 0, 1); > Foo_val (result) = x; > CAMLreturn (result); > }I''ll update all occurrences of this pattern. The same think happens for the libxl context as well. [...]> It''s also worth considering whether to use the finalizer support to > automatically free the underlying C resource when the last reference to it > from OCaml has been GCed. This would be safer than exposing a direct > "free" function in the OCaml interface, since it would prevent use-after- > free.Agreed. I''ll try this. Cheers, Rob
Rob Hoes
2013-Apr-05 14:15 UTC
Re: [PATCH 11/28] libxl: ocaml: propagate the libxl return error code in exceptions
[...]> > + arg = caml_alloc_small(2, 0); > > + > > + Field(arg, 0) = Val_error(error); > > + Field(arg, 1) = caml_copy_string(fname); > > I think this violates Rule 5 in the OCaml FFI manual[*]. In the low-level > interface when you allocate a block with "caml_alloc_small" > all the fields contain random values. The assignment: > > Field(arg, 1) = caml_copy_string(fname); > > will first call "caml_copy_string" which performs an allocation before setting > the field to a valid value. Any function which performs an allocation can > trigger a GC which will segfault if it sees the random data in field 1. > > I strongly recommend using the "simple interface" i.e. > > caml_alloc() > caml_alloc_tuple() > Store_field()[...] Damn, this stuff is trickier than it seems! :) I''ll make sure that only the "simple interface" is used in all bindings, just to be sure. Cheers, Rob
Rob Hoes
2013-Apr-05 14:17 UTC
Re: [PATCH 16/28] libxl: ocaml: use the "string option" type for IDL strings
[...]> > + CAMLreturn(Val_some(caml_copy_string(c_val))); > > A bad sequence is: > > 1. caml_copy_string() allocates a string successfully > 2. Val_some() calls the allocator to allocate a block but the minor heap is > full so it triggers a GC > 3. the GC deletes the string from (1) since it can''t find any references to it > > Personally I always force myself to write very basic code with lots of explicit > temporaries, just to be totally safe. It feels strange because it''s the > complete opposite of good functional style (particularly if you believe in > point-free programming!). > > So I would write: > > CAMLparam0() > CAMLlocal2(tmp1, tmp2) > if (c_val) { > tmp1 = caml_copy_string(c_val); > tmp2 = Val_some(tmp1); > CAMLreturn(tmp2) > } > ... > > It''s almost embarrassing to write code like that, but at least it''s safe! :-)[...] Agreed! Cheers, Rob
> On 25/03/13 14:45, Rob Hoes wrote: > > +value Val_poll(short event) > > +{ > > + CAMLparam0(); > > + CAMLlocal1(res); > > + > > + switch (event) { > > + case POLLIN: res = Val_int(0); break; > > + case POLLPRI: res = Val_int(1); break; > > + case POLLOUT: res = Val_int(2); break; > > + case POLLERR: res = Val_int(3); break; > > + case POLLHUP: res = Val_int(4); break; > > + case POLLNVAL: res = Val_int(5); break; > > + } > > + > > + CAMLreturn(res); > > +} > > Is it possible for none of the cases to match? If so, what would you like to > happen-- it''s worth being more explicit.I''ll probably add some sort of exception handling, or an "unknown" error state. Cheers, Rob
[...]> The OCaml manual[*] (S19.7.2) hints that the name lookup is a bit slow: > > "The pointer returned by caml_named_value is constant and can safely be > cached in a C variable to avoid repeated name lookups. On the other hand, > the value pointed to can change during garbage collection and must always > be recomputed at the point of use." > > > The manual suggests caching the value * in a static like this: > > void fd_deregister(void *user, int fd, void *for_app_registration) > { > CAMLparam0(); > CAMLlocalN(args, 2); > static value * func = NULL; > if (func == NULL) { > /* First time around, look up by name */ > func = caml_named_value("fd_deregister"); > } > ... > > > [*] http://caml.inria.fr/pub/docs/manual-ocaml-4.00/manual033.htmlCool, I''ll change that. Cheers, Rob
[...]> >> +value stub_xl_xen_console_read(value ctx) { > >> + CAMLparam1(ctx); > >> + CAMLlocal3(list, cons, ml_line); > >> + int i = 0, ret; > >> + char *console[32768], *line; > >> + libxl_xen_console_reader *cr; > >> + > >> + cr = libxl_xen_console_read_start(CTX, 0); > >> + if (cr) > >> + for (i = 0; libxl_xen_console_read_line(CTX, cr, &line) > 0; > i++) > > > + console[i] = strdup(line); > > > > Is it obvious why i is always < 32768? Or is 32768 "too big to fail"? > > (Sorry, couldn''t resist) > > This is 32K entries of 4 or 8 bytes (for 32/64bit system), meaning 128K or > 256K of data on the stack. > > I am surprised that this didn''t segfault instantly, but this does seem an > unreasonably large amount of data, especially for some library bindings.I basically copied the value from the libxc bindings without thinking too much about it (although a static variable is used there)...: #define RING_SIZE 32768 static char ring[RING_SIZE]; CAMLprim value stub_xc_readconsolering(value xch) { unsigned int size = RING_SIZE - 1; char *ring_ptr = ring; int retval; CAMLparam1(xch); caml_enter_blocking_section(); retval = xc_readconsolering(_H(xch), ring_ptr, &size, 0, 0, NULL); caml_leave_blocking_section(); if (retval) failwith_xc(_H(xch)); ring[size] = ''\0''; CAMLreturn(caml_copy_string(ring)); }> If you want to end up with a list of lines, I would suggest using my patch > series to grab the entire console ring at once, counting the number of ''\n''s > present and working with that.I am happy enough to just get the entire ring, which is what the old xc binding did. Is there a libxl function that does this, or is this something new in your patch? Cheers, Rob
Ian Campbell
2013-Apr-11 11:19 UTC
Re: [PATCH 17/28] libxl: ocaml: add with_ctx helper function
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> +let with_ctx ?logger fDoes this imply that xenopsd et al intend to use short lived contexts rather than one or more long lived ones?
Ian Campbell
2013-Apr-11 11:19 UTC
Re: [PATCH 13/28] libxl: idl: add domain_type field to libxl_dominfo struct
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> This allows a toolstack to find out whether a VM has booted as PV or > HVM.OOI why do you need to know? I''m wondering if there might be a better higher level question to ask rather than PV vs HVM. Ian.
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> The "xl" module was renamed to "xenlight" some time ago, but the > META file was not updated. > > It also needed to be added to the list of generated files in the > Makefile. > > Signed-off-by: Rob Hoes <rob.hoes@citrix.com>Acked-by: Ian Campbell <ian.campbell@citrix.com>
Ian Campbell
2013-Apr-11 11:20 UTC
Re: [PATCH 15/28] libxl: ocaml: fix the handling of enums in the bindings generator
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>Acked-by: Ian Campbell <ian.campbell@citrix.com>
Ian Campbell
2013-Apr-11 11:23 UTC
Re: [PATCH 19/28] libxl: ocaml: add dominfo_list and dominfo_get
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> +value stub_xl_dominfo_list(value ctx) > +{ > + CAMLparam1(ctx); > + CAMLlocal2(domlist, temp); > + libxl_dominfo *c_domlist; > + int i, nb; > + > + c_domlist = libxl_list_domain(CTX, &nb); > + if (!c_domlist) > + failwith_xl(ERROR_FAIL, "dominfo_list"); > + > + domlist = temp = Val_emptylist; > + for (i = nb - 1; i >= 0; i--) { > + domlist = caml_alloc_small(2, Tag_cons); > + Field(domlist, 0) = Val_int(0); > + Field(domlist, 1) = temp; > + temp = domlist; > + > + Store_field(domlist, 0, Val_dominfo(&c_domlist[i]));Is the preceding "Field(domlist, 0) = Val_int(0);" storing to the same place and therefore redundant?> + } > + > + libxl_dominfo_list_free(c_domlist, nb); > + > + CAMLreturn(domlist); > +}
Ian Campbell
2013-Apr-11 11:31 UTC
Re: [PATCH 08/28] libxc: ocaml: add simple binding for xentoollog (output only).
On Fri, 2013-04-05 at 15:04 +0100, Rob Hoes wrote:> > I think we should avoid returning "bare pointers" to the OCaml heap for two > > reasons:malloc is the "C" runtime heap, is that the same as the ocaml heap? (From your description I understand the distinction isn''t relevant in this context, but I''m curious).> [...] > > I see, thanks for pointing that out. > > > Instead of returning a "bare pointer" I think we should use a "Custom" > > value. This involves declaring a "struct custom_operations" like this: > > > > static struct custom_operations foo_custom_operations = { > > "foo_custom_operations", > > custom_finalize_default, > > custom_compare_default, > > custom_hash_default, > > custom_serialize_default, > > custom_deserialize_default > > }; > > > > And then wrapping and unwrapping "Custom" blocks using something like: > > > > #define Foo_val(x) (*((struct foo *)Data_custom_val(x))) > > > > static value > > Val_foo (struct foo *x) > > { > > CAMLparam0 (); > > CAMLlocal1 (result); > > result = caml_alloc_custom (&foo_custom_operations, > > sizeof (struct foo*), 0, 1); > > Foo_val (result) = x; > > CAMLreturn (result); > > } > > I''ll update all occurrences of this pattern. The same think happens > for the libxl context as well.And probably the libxc context too in that set of bindings? There''s also a malloc in stub_xc_domain_get_pfn_list but that is free''d in the same C function, which I guess is not subject to this issue? BTW when looking I found the mmap library uses: result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag); Is that valid? If so then it avoids all the custom operations stuff, although if you want the finalizer callback then this is worthwhile anyway. Also in the same bit of the mmap library the mmap(2) result is stored as a bare pointer inside that "result" from above, is that visible to the GC and therefore also dangerous? Ian.
Ian Campbell
2013-Apr-11 11:33 UTC
Re: [PATCH 11/28] libxl: ocaml: propagate the libxl return error code in exceptions
On Tue, 2013-03-26 at 11:33 +0000, Dave Scott wrote:> On 25/03/13 14:45, Rob Hoes wrote: > > +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); > > I think this violates Rule 5 in the OCaml FFI manual[*]. In the > low-level interface when you allocate a block with "caml_alloc_small" > all the fields contain random values. The assignment: > > Field(arg, 1) = caml_copy_string(fname); > > will first call "caml_copy_string" which performs an allocation before > setting the field to a valid value. Any function which performs an > allocation can trigger a GC which will segfault if it sees the random > data in field 1.I think this answers my earlier query on another patch about the redundant looking store to Field ... Ian.
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> We need this in order to wrap the event API of libxl.Other than Dave''s comment it looks good to me. But how does the event model work in your callers today? The intention with the libxl event interface is that by implementing the right hooks to register/deregister fds you can just continue to use your existing event loop (presuming it can take events on fds). Ian.> > Signed-off-by: Rob Hoes <rob.hoes@citrix.com> > --- > tools/ocaml/libs/xl/Makefile | 2 +- > tools/ocaml/libs/xl/poll_stubs.c | 128 ++++++++++++++++++++++++++++++++++++++ > tools/ocaml/libs/xl/poll_stubs.h | 6 ++ > 3 files changed, 135 insertions(+), 1 deletion(-) > create mode 100644 tools/ocaml/libs/xl/poll_stubs.c > create mode 100644 tools/ocaml/libs/xl/poll_stubs.h > > diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile > index 5a410d2..beca795 100644 > --- a/tools/ocaml/libs/xl/Makefile > +++ b/tools/ocaml/libs/xl/Makefile > @@ -15,7 +15,7 @@ OCAMLINCLUDE += -I ../xentoollog > LIBS_xenlight = $(LDLIBS_libxenlight) > > xenlight_OBJS = $(OBJS) > -xenlight_C_OBJS = xenlight_stubs > +xenlight_C_OBJS = xenlight_stubs poll_stubs > > OCAML_LIBRARY = xenlight > > diff --git a/tools/ocaml/libs/xl/poll_stubs.c b/tools/ocaml/libs/xl/poll_stubs.c > new file mode 100644 > index 0000000..0cf54b9 > --- /dev/null > +++ b/tools/ocaml/libs/xl/poll_stubs.c > @@ -0,0 +1,128 @@ > +#include <poll.h> > +#include <caml/alloc.h> > +#include <caml/memory.h> > +#include <caml/signals.h> > +#include <caml/fail.h> > + > +static int list_len(value v) > +{ > + int len = 0; > + while ( v != Val_emptylist ) { > + len++; > + v = Field(v, 1); > + } > + return len; > +} > + > +short Poll_val(value event) > +{ > + CAMLparam1(event); > + short res = -1; > + > + switch (Int_val(event)) { > + case 0: res = POLLIN; break; > + case 1: res = POLLPRI; break; > + case 2: res = POLLOUT; break; > + case 3: res = POLLERR; break; > + case 4: res = POLLHUP; break; > + case 5: res = POLLNVAL; break; > + } > + > + CAMLreturn(res); > +} > + > +short Poll_events_val(value event_list) > +{ > + CAMLparam1(event_list); > + short events = 0; > + > + while (event_list != Val_emptylist) { > + events |= Poll_val(Field(event_list, 0)); > + event_list = Field(event_list, 1); > + } > + > + CAMLreturn(events); > +} > + > +value Val_poll(short event) > +{ > + CAMLparam0(); > + CAMLlocal1(res); > + > + switch (event) { > + case POLLIN: res = Val_int(0); break; > + case POLLPRI: res = Val_int(1); break; > + case POLLOUT: res = Val_int(2); break; > + case POLLERR: res = Val_int(3); break; > + case POLLHUP: res = Val_int(4); break; > + case POLLNVAL: res = Val_int(5); break; > + } > + > + CAMLreturn(res); > +} > + > +value add_event(value event_list, short event) > +{ > + CAMLparam1(event_list); > + CAMLlocal1(new_list); > + > + new_list = caml_alloc(2, 0); > + Store_field(new_list, 0, Val_poll(event)); > + Store_field(new_list, 1, event_list); > + > + CAMLreturn(new_list); > +} > + > +value Val_poll_events(short events) > +{ > + CAMLparam0(); > + CAMLlocal1(event_list); > + > + event_list = Val_emptylist; > + if (events & POLLIN) > + event_list = add_event(event_list, POLLIN); > + if (events & POLLPRI) > + event_list = add_event(event_list, POLLPRI); > + if (events & POLLOUT) > + event_list = add_event(event_list, POLLOUT); > + if (events & POLLERR) > + event_list = add_event(event_list, POLLERR); > + if (events & POLLHUP) > + event_list = add_event(event_list, POLLHUP); > + if (events & POLLNVAL) > + event_list = add_event(event_list, POLLNVAL); > + > + CAMLreturn(event_list); > +} > + > +value stub_poll(value fds) > +{ > + CAMLparam1(fds); > + CAMLlocal2(fd, tmp); > + int rc, i; > + const int c_nfds = list_len(fds); > + struct pollfd c_fds[c_nfds]; > + > + for (i = 0; fds != Val_emptylist; i++) { > + fd = Field(fds, 0); > + c_fds[i].fd = Int_val(Field(fd, 0)); > + c_fds[i].events = Poll_events_val(Field(fd, 1)); > + fds = Field(fds, 1); > + } > + > + caml_enter_blocking_section(); > + rc = poll(c_fds, c_nfds, -1); > + caml_leave_blocking_section(); > + > + if (rc > 0) { > + for (i = c_nfds - 1; i >= 0; i--) { > + tmp = caml_alloc(2, 0); > + Store_field(tmp, 0, Val_poll_events(c_fds[i].revents)); > + Store_field(tmp, 1, fds); > + fds = tmp; > + } > + } > + > + CAMLreturn(fds); > +} > + > diff --git a/tools/ocaml/libs/xl/poll_stubs.h b/tools/ocaml/libs/xl/poll_stubs.h > new file mode 100644 > index 0000000..0b2332d > --- /dev/null > +++ b/tools/ocaml/libs/xl/poll_stubs.h > @@ -0,0 +1,6 @@ > +#include <caml/alloc.h> > + > +short Poll_events_val(value event_list); > +value Val_poll_events(short events); > +value stub_poll(value fds); > +
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> This patch add the facilities needed to interact with the event system > in libxl. This is useful, for instance, for getting a callback when a > domains dies, as well as to use the asyncronous versions of some of libxl''s > calls. > > The functions dealing with timeouts are still TBD. > > Signed-off-by: Rob Hoes <rob.hoes@citrix.com> > --- > tools/ocaml/libs/xl/xenlight.ml.in | 42 +++++++++ > tools/ocaml/libs/xl/xenlight.mli.in | 21 +++++ > tools/ocaml/libs/xl/xenlight_stubs.c | 161 ++++++++++++++++++++++++++++++++++ > 3 files changed, 224 insertions(+) > > diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in > index 63b8bf8..96d6a38 100644 > --- a/tools/ocaml/libs/xl/xenlight.ml.in > +++ b/tools/ocaml/libs/xl/xenlight.ml.in > @@ -73,6 +73,17 @@ external test_raise_exception: unit -> unit = "stub_raise_exception" > type domid = int > type devid = int > > +(* type for event callbacks *) > +type for_libxl > + > +type event > + | POLLIN (* There is data to read *) > + | POLLPRI (* There is urgent data to read *) > + | POLLOUT (* Writing now will not block *) > + | POLLERR (* Error condition (revents only) *) > + | POLLHUP (* Device has been disconnected (revents only) *) > + | POLLNVAL (* Invalid request: fd not open (revents only). *)Can you reuse these from your poll library in the previous patch?> +int timeout_register(void *user, void **for_app_registration_out, > + struct timeval abs, void *for_libxl) > +{ > + return 0; > +} > + > +int timeout_modify(void *user, void **for_app_registration_update, > + struct timeval abs) > +{ > + return 0; > +} > + > +void timeout_deregister(void *user, void *for_app_registration) > +{ > + return; > +}Worth failing noisily until these are implemented?> + > +value stub_xl_osevent_register_hooks(value ctx, value user) > +{ > + CAMLparam2(ctx, user); > + libxl_osevent_hooks *hooks; > + hooks = malloc(sizeof(*hooks)); > + > + hooks->fd_register = fd_register; > + hooks->fd_modify = fd_modify; > + hooks->fd_deregister = fd_deregister; > + hooks->timeout_register = timeout_register; > + hooks->timeout_modify = timeout_modify; > + hooks->timeout_deregister = timeout_deregister; > + > + libxl_osevent_register_hooks(CTX, hooks, (void *) user);This user thing will be retained by libxl -- is that safe from an ocaml gc point of view?> + CAMLreturn((value) hooks);Another instance of the problematic heap allocation pattern Dave pointed out?> +void event_occurs(void *user, const libxl_event *event) > +{ > + CAMLparam0(); > + CAMLlocalN(args, 2); > + value *func = caml_named_value("xl_event_occurs_callback"); > + > + args[0] = (value) user; > + args[1] = Val_event((libxl_event *) event); > + //libxl_event_free(CTX, event); // no ctx here!Is it leaked or do you free it somewhere else? I suppose "func" must do it? (which makes sense actually) [...]> +value stub_xl_event_register_callbacks(value ctx, value user) > +{ > + CAMLparam2(ctx, user); > + libxl_event_hooks *hooks; > + > + hooks = malloc(sizeof(*hooks));Another heap alloc? Ian.
Ian Campbell
2013-Apr-11 12:51 UTC
Re: [PATCH 23/28] libxl: ocaml: allow device operations to be called asynchronously
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> Signed-off-by: Rob Hoes <rob.hoes@citrix.com> > --- > tools/ocaml/libs/xl/genwrap.py | 6 +++--- > tools/ocaml/libs/xl/xenlight_stubs.c | 19 ++++++++++++++++--- > 2 files changed, 19 insertions(+), 6 deletions(-) > > diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py > index 10e6a74..9f7895a 100644 > --- a/tools/ocaml/libs/xl/genwrap.py > +++ b/tools/ocaml/libs/xl/genwrap.py > @@ -22,9 +22,9 @@ builtins = { > "libxl_cpuid_policy_list": ("unit", "%(c)s = 0", "Val_unit"), > } > > -DEVICE_FUNCTIONS = [ ("add", ["ctx", "t", "domid", "unit"]), > - ("remove", ["ctx", "t", "domid", "unit"]), > - ("destroy", ["ctx", "t", "domid", "unit"]), > +DEVICE_FUNCTIONS = [ ("add", ["ctx", "?async:''a", "t", "domid", "unit"]), > + ("remove", ["ctx", "?async:''a", "t", "domid", "unit"]), > + ("destroy", ["ctx", "?async:''a", "t", "domid", "unit"]), > ] > > functions = { # ( name , [type1,type2,....] ) > diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c > index ae5317f..c136db7 100644 > --- a/tools/ocaml/libs/xl/xenlight_stubs.c > +++ b/tools/ocaml/libs/xl/xenlight_stubs.c > @@ -338,17 +338,30 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback) > #define STRINGIFY(x) _STRINGIFY(x) > > #define _DEVICE_ADDREMOVE(type,op) \ > -value stub_xl_device_##type##_##op(value ctx, value info, value domid) \ > +value stub_xl_device_##type##_##op(value ctx, value async, value info, \ > + value domid) \ > { \ > - CAMLparam3(ctx, info, domid); \ > + CAMLparam4(ctx, info, domid, async); \ > libxl_device_##type c_info; \ > int ret, marker_var; \ > + libxl_asyncop_how *ao_how; \ > \ > device_##type##_val(CTX, &c_info, info); \ > \ > - ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, 0); \ > + if (async != Val_none) { \ > + ao_how = malloc(sizeof(*ao_how)); \libxl.h says: * *ao_how does not need to remain valid after the initiating function * returns. All other parameters must remain valid for the lifetime of * the asynchronous operation, unless otherwise specified. So the ao_how can just be a normal stack variable if you like. If you want to use NULL/non-NULL-ness to indicate Some/None then: struct ao_how aoh_struct, *aoh = NULL; if (async != Val_none) aoh = &aoh_struct works I think or just struct ao_how aoh = { .callback = async_callback, ... }; ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, \ async != Val_none ? &aoh : NULL would do.> + ao_how->callback = async_callback; \ > + ao_how->u.for_callback = (void *) Some_val(async); \ > + } \ > + else \ > + ao_how = NULL; \ > + \ > + ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, \ > + ao_how); \ > \ > libxl_device_##type##_dispose(&c_info); \ > + if (ao_how) \ > + free(ao_how); \ > \ > if (ret != 0) \ > failwith_xl(ret, STRINGIFY(type) "_" STRINGIFY(op)); \
Ian Campbell
2013-Apr-11 12:56 UTC
Re: [PATCH 24/28] libxl: ocaml: add NIC helper functions
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> Signed-off-by: Rob Hoes <rob.hoes@citrix.com> > --- > tools/ocaml/libs/xl/genwrap.py | 5 ++++- > tools/ocaml/libs/xl/xenlight_stubs.c | 36 ++++++++++++++++++++++++++++++++++ > 2 files changed, 40 insertions(+), 1 deletion(-) > > diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py > index 9f7895a..827fdb6 100644 > --- a/tools/ocaml/libs/xl/genwrap.py > +++ b/tools/ocaml/libs/xl/genwrap.py > @@ -31,7 +31,10 @@ functions = { # ( name , [type1,type2,....] ) > "device_vfb": DEVICE_FUNCTIONS, > "device_vkb": DEVICE_FUNCTIONS, > "device_disk": DEVICE_FUNCTIONS, > - "device_nic": DEVICE_FUNCTIONS, > + "device_nic": DEVICE_FUNCTIONS + > + [ ("list", ["ctx", "domid", "t list"]), > + ("of_devid", ["ctx", "domid", "int", "t"]), > + ], > "device_pci": DEVICE_FUNCTIONS, > "dominfo": [ ("list", ["ctx", "t list"]), > ("get", ["ctx", "domid", "t"]), > diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c > index c136db7..ecc26ff 100644 > --- a/tools/ocaml/libs/xl/xenlight_stubs.c > +++ b/tools/ocaml/libs/xl/xenlight_stubs.c > @@ -380,6 +380,42 @@ DEVICE_ADDREMOVE(vfb) > DEVICE_ADDREMOVE(vkb) > DEVICE_ADDREMOVE(pci) > > +value stub_xl_device_nic_of_devid(value ctx, value domid, value devid) > +{ > + CAMLparam3(ctx, domid, devid); > + libxl_device_nic nic; > + libxl_devid_to_device_nic(CTX, Int_val(domid), Int_val(devid), &nic); > + CAMLreturn(Val_device_nic(&nic)); > +} > + > +value stub_xl_device_nic_list(value ctx, value domid) > +{ > + CAMLparam2(ctx, domid); > + CAMLlocal2(list, temp); > + libxl_device_nic *c_list; > + int i, nb; > + uint32_t c_domid; > + > + c_domid = Int_val(domid); > + > + c_list = libxl_device_nic_list(CTX, c_domid, &nb); > + if (!c_list && nb > 0)I don''t think && nb > 0 can ever occur, the error handling in libxl_device_nic_lsit does: out_err: LIBXL__LOG(ctx, LIBXL__LOG_ERROR, "Unable to list nics"); while (*num) { (*num)--; libxl_device_nic_dispose(&nics[*num]); } free(nics); return NULL; i.e. it counts *num back down to zero. I''d say you shouldn''t/mustn''t make any assumptions about nb if the function call failed.> + failwith_xl(ERROR_FAIL, "nic_list"); > + > + list = temp = Val_emptylist; > + for (i = 0; i < nb; i++) { > + list = caml_alloc_small(2, Tag_cons); > + Field(list, 0) = Val_int(0); > + Field(list, 1) = temp; > + temp = list;This reverses the list, if you care. I don''t suppose you do and libxl probably doesn''t actually guarantee anything abort the order. I wouldn''t have noticed except I saw you doing the counting backwards in an earlier patch and it took me a second to work out why...> + Store_field(list, 0, Val_device_nic(&c_list[i])); > + libxl_device_nic_dispose(&c_list[i]); > + } > + free(c_list); > + > + CAMLreturn(list); > +} > + > value stub_xl_physinfo_get(value ctx) > { > CAMLparam1(ctx);
Ian Campbell
2013-Apr-11 12:56 UTC
Re: [PATCH 25/28] libxl: ocaml: add PCI device helper functions
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote: Same comments here as on the previous patch I think, and I imagine the next one too...> Signed-off-by: Rob Hoes <rob.hoes@citrix.com> > --- > tools/ocaml/libs/xl/genwrap.py | 7 ++- > tools/ocaml/libs/xl/xenlight_stubs.c | 90 ++++++++++++++++++++++++++++++++++ > 2 files changed, 96 insertions(+), 1 deletion(-) > > diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py > index 827fdb6..becdef8 100644 > --- a/tools/ocaml/libs/xl/genwrap.py > +++ b/tools/ocaml/libs/xl/genwrap.py > @@ -35,7 +35,12 @@ functions = { # ( name , [type1,type2,....] ) > [ ("list", ["ctx", "domid", "t list"]), > ("of_devid", ["ctx", "domid", "int", "t"]), > ], > - "device_pci": DEVICE_FUNCTIONS, > + "device_pci": DEVICE_FUNCTIONS + > + [ ("list", ["ctx", "domid", "t list"]), > + ("assignable_add", ["ctx", "t", "bool", "unit"]), > + ("assignable_remove", ["ctx", "t", "bool", "unit"]), > + ("assignable_list", ["ctx", "t list"]), > + ], > "dominfo": [ ("list", ["ctx", "t list"]), > ("get", ["ctx", "domid", "t"]), > ], > diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c > index ecc26ff..7be5dd4 100644 > --- a/tools/ocaml/libs/xl/xenlight_stubs.c > +++ b/tools/ocaml/libs/xl/xenlight_stubs.c > @@ -416,6 +416,96 @@ value stub_xl_device_nic_list(value ctx, value domid) > CAMLreturn(list); > } > > +value stub_xl_device_pci_list(value ctx, value domid) > +{ > + CAMLparam2(ctx, domid); > + CAMLlocal2(list, temp); > + libxl_device_pci *c_list; > + int i, nb; > + uint32_t c_domid; > + > + c_domid = Int_val(domid); > + > + c_list = libxl_device_pci_list(CTX, c_domid, &nb); > + if (!c_list && nb > 0) > + failwith_xl(ERROR_FAIL, "pci_list"); > + > + list = temp = Val_emptylist; > + for (i = 0; i < nb; i++) { > + list = caml_alloc_small(2, Tag_cons); > + Field(list, 0) = Val_int(0); > + Field(list, 1) = temp; > + temp = list; > + Store_field(list, 0, Val_device_pci(&c_list[i])); > + libxl_device_pci_dispose(&c_list[i]); > + } > + free(c_list); > + > + CAMLreturn(list); > +} > + > +value stub_xl_device_pci_assignable_add(value ctx, value info, value rebind) > +{ > + CAMLparam3(ctx, info, rebind); > + libxl_device_pci c_info; > + int ret, marker_var; > + > + device_pci_val(CTX, &c_info, info); > + > + ret = libxl_device_pci_assignable_add(CTX, &c_info, (int) Bool_val(rebind)); > + > + libxl_device_pci_dispose(&c_info); > + > + if (ret != 0) > + failwith_xl(ret, "pci_assignable_add"); > + > + CAMLreturn(Val_unit); > +} > + > +value stub_xl_device_pci_assignable_remove(value ctx, value info, value rebind) > +{ > + CAMLparam3(ctx, info, rebind); > + libxl_device_pci c_info; > + int ret, marker_var; > + > + device_pci_val(CTX, &c_info, info); > + > + ret = libxl_device_pci_assignable_remove(CTX, &c_info, (int) Bool_val(rebind)); > + > + libxl_device_pci_dispose(&c_info); > + > + if (ret != 0) > + failwith_xl(ret, "pci_assignable_remove"); > + > + CAMLreturn(Val_unit); > +} > + > +value stub_xl_device_pci_assignable_list(value ctx) > +{ > + CAMLparam1(ctx); > + CAMLlocal2(list, temp); > + libxl_device_pci *c_list; > + int i, nb; > + uint32_t c_domid; > + > + c_list = libxl_device_pci_assignable_list(CTX, &nb); > + if (!c_list && nb > 0) > + failwith_xl(ERROR_FAIL, "pci_assignable_list"); > + > + list = temp = Val_emptylist; > + for (i = 0; i < nb; i++) { > + list = caml_alloc_small(2, Tag_cons); > + Field(list, 0) = Val_int(0); > + Field(list, 1) = temp; > + temp = list; > + Store_field(list, 0, Val_device_pci(&c_list[i])); > + libxl_device_pci_dispose(&c_list[i]); > + } > + free(c_list); > + > + CAMLreturn(list); > +} > + > value stub_xl_physinfo_get(value ctx) > { > CAMLparam1(ctx);
Ian Campbell
2013-Apr-11 12:58 UTC
Re: [PATCH 26/28] libxl: ocaml: add disk and cdrom helper functions
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> Signed-off-by: Rob Hoes <rob.hoes@citrix.com> > --- > tools/ocaml/libs/xl/genwrap.py | 5 ++++- > tools/ocaml/libs/xl/xenlight_stubs.c | 19 ++++++++++++++----- > 2 files changed, 18 insertions(+), 6 deletions(-) > > diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py > index becdef8..5bc165d 100644 > --- a/tools/ocaml/libs/xl/genwrap.py > +++ b/tools/ocaml/libs/xl/genwrap.py > @@ -30,7 +30,10 @@ DEVICE_FUNCTIONS = [ ("add", ["ctx", "?async:''a", "t", "domid", "unit > functions = { # ( name , [type1,type2,....] ) > "device_vfb": DEVICE_FUNCTIONS, > "device_vkb": DEVICE_FUNCTIONS, > - "device_disk": DEVICE_FUNCTIONS, > + "device_disk": DEVICE_FUNCTIONS + > + [ ("insert", ["ctx", "?async:''a", "t", "domid", "unit"]), > + ("of_vdev", ["ctx", "domid", "string", "t"]),No list?
Ian Campbell
2013-Apr-11 13:03 UTC
Re: [PATCH 27/28] libxl: ocaml: add VM lifecycle operations
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> +static int domain_wait_event(libxl_ctx *ctx, int domid, libxl_event **event_r) > +{ > + int ret; > + for (;;) { > + ret = libxl_event_wait(ctx, event_r, LIBXL_EVENTMASK_ALL, 0,0); > + if (ret) { > + return ret; > + } > + if ((*event_r)->domid != domid) { > + char *evstr = libxl_event_to_json(CTX, *event_r); > + free(evstr);Create/allocate the json and immediately free it? (left over debug perhaps?)> + libxl_event_free(CTX, *event_r); > + continue; > + } > + return ret; > + } > +}[...]> +value stub_xl_domain_create_restore(value ctx, value domain_config, value restore_fd) > +{ > + CAMLparam2(ctx, domain_config); > + int ret; > + libxl_domain_config c_dconfig; > + uint32_t c_domid; > + > + ret = domain_config_val(CTX, &c_dconfig, domain_config); > + if (ret != 0) > + failwith_xl(ret, "domain_create_restore"); > + > + ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, Int_val(restore_fd), NULL, NULL); > + if (ret != 0) > + failwith_xl(ret, "domain_create_restore"); > + > + libxl_domain_config_dispose(&c_dconfig); > + > + CAMLreturn(Val_int(c_domid)); > +} > + > +value stub_libxl_domain_wait_shutdown(value ctx, value domid) > +{ > + CAMLparam2(ctx, domid); > + int ret; > + libxl_event *event; > + libxl_evgen_domain_death *deathw; > + ret = libxl_evenable_domain_death(CTX, Int_val(domid), 0, &deathw); > + if (ret) { > + fprintf(stderr,"wait for death failed (evgen, rc=%d)\n",ret); > + exit(-1); > + } > + > + for (;;) { > + ret = domain_wait_event(CTX, Int_val(domid), &event); > + if (ret) > + failwith_xl(ret, "domain_shutdown");This exits asynchronously, which leaves the domain death event enabled. Depending on what your exception handler does this may not be what you want? This case has only just occurred to me, so there may be other instances in earlier patches...> + > + switch (event->type) { > + case LIBXL_EVENT_TYPE_DOMAIN_DEATH: > + goto done; > + case LIBXL_EVENT_TYPE_DOMAIN_SHUTDOWN: > + goto done; > + default: > + break; > + } > + libxl_event_free(CTX, event); > + } > +done: > + libxl_event_free(CTX, event); > + libxl_evdisable_domain_death(CTX, deathw); > + > + CAMLreturn(Val_unit); > +} > + > +value stub_libxl_domain_shutdown(value ctx, value domid) > +{ > + CAMLparam2(ctx, domid); > + int ret; > + > + ret = libxl_domain_shutdown(CTX, Int_val(domid)); > + > + if (ret != 0) > + failwith_xl(ret, "domain_shutdown"); > + > + CAMLreturn(Val_unit); > +}This and the rest look pretty mechanical, I just skimmed it... Ian.
Ian Campbell
2013-Apr-11 13:08 UTC
Re: [PATCH 28/28] libxl: ocaml: provide default records for libxl types
On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote:> Libxl functions such as libxl_domain_create_new take large structs > of configuration parameters. Often, we would like to use the default > values for many of these parameters. > > This commit makes OCaml records of defaults available for all libxl > struct and keyed-union types, which can be used as a base to construct > your own records, and to selectively override parameters where needed. > > For example, a Domain_create_info record can now be created as follows: > > let c_info = Xenlight.Domain_create_info.({ default with > ty = Xenlight.DOMAIN_TYPE_PV; > name = Some vm_name; > uuid = vm_uuid; > }) inThis is a clever approach (and I expect good idiomatic ocaml?) but you need to handle the init_val IDL field for all types since not everything should be set to zero (e.g. some of the UInt subtypes don''t default to 0, see MemKB for one). I wonder if a better alternative might be to use a C binding to call libxl_TYPE_init() and convert that to an ocaml value? This would mean one less place to change in the future as well. Ian.
David Scott
2013-Apr-15 09:39 UTC
Re: [PATCH 08/28] libxc: ocaml: add simple binding for xentoollog (output only).
On 11/04/13 12:31, Ian Campbell wrote:> On Fri, 2013-04-05 at 15:04 +0100, Rob Hoes wrote: >>> I think we should avoid returning "bare pointers" to the OCaml heap for two >>> reasons: > > malloc is the "C" runtime heap, is that the same as the ocaml heap? > (From your description I understand the distinction isn''t relevant in > this context, but I''m curious).The OCaml heap is a set of blocks acquired via malloc(), so you could say that the OCaml heap is a subset of the C heap :-) I guess in a long-running program you''d end up with some interleaving of <ocaml heap block>; <normal C data> throughout application memory. To make the GC work, the OCaml heap has to have enough structure for pointers to other OCaml values to be found. The current OCaml convention is that a "value" is a pointer if its least significant bit = 0 (the Val_int macro sets the bit to 1 to mark a value as a plain integer) and the pointer must point to somewhere within a previously-allocated OCaml heap block. This last check is what makes it possible to stuff the normal result of malloc() directly into an OCaml value and have it be ignored by the GC... for a while :-) It''s also worth knowing that every heap block has a tag and the tags are divided into two groups: one for blocks which should be introspected and assumed to contain arrays of OCaml values (tuples, records, arrays etc), and one group for blocks which should be ignored (and which are safe for us to stick our stuff in). For example an OCaml string is a block with a ''String_tag'' and won''t be examined further by the GC. in ocaml/byterun/mlvalues.h: /* The lowest tag for blocks containing no value. */ #define No_scan_tag 251 /* Strings. */ #define String_tag 252 /* Arrays of floating-point numbers. */ #define Double_array_tag 254 ...> >> [...] >> >> I see, thanks for pointing that out. >> >>> Instead of returning a "bare pointer" I think we should use a "Custom" >>> value. This involves declaring a "struct custom_operations" like this: >>> >>> static struct custom_operations foo_custom_operations = { >>> "foo_custom_operations", >>> custom_finalize_default, >>> custom_compare_default, >>> custom_hash_default, >>> custom_serialize_default, >>> custom_deserialize_default >>> }; >>> >>> And then wrapping and unwrapping "Custom" blocks using something like: >>> >>> #define Foo_val(x) (*((struct foo *)Data_custom_val(x))) >>> >>> static value >>> Val_foo (struct foo *x) >>> { >>> CAMLparam0 (); >>> CAMLlocal1 (result); >>> result = caml_alloc_custom (&foo_custom_operations, >>> sizeof (struct foo*), 0, 1); >>> Foo_val (result) = x; >>> CAMLreturn (result); >>> } >> >> I''ll update all occurrences of this pattern. The same think happens >> for the libxl context as well. > > And probably the libxc context too in that set of bindings? > > There''s also a malloc in stub_xc_domain_get_pfn_list but that is free''d > in the same C function, which I guess is not subject to this issue?It looks ok to me -- the result of the malloc is not being stored in an OCaml "value". The OCaml values look like they''re being created properly (caml_copy_nativeint) and stored in a place the GC can see (CAMLlocal2 and Store_field): CAMLlocal2(array, v); ... c_array = malloc(sizeof(uint64_t) * c_nr_pfns); ... array = caml_alloc(ret, 0); for (i = 0; i < ret; i++) { v = caml_copy_nativeint(c_array[i]); Store_field(array, i, v); } free(c_array);> > BTW when looking I found the mmap library uses: > result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag); > > Is that valid? If so then it avoids all the custom operations stuff, > although if you want the finalizer callback then this is worthwhile > anyway.I think so... Looking in in ocaml/byterun/mlvalues.h: /* Abstract things. Their contents is not traced by the GC; therefore they must not contain any [value]. */ #define Abstract_tag 251 /* Custom blocks. They contain a pointer to a "method suite" of functions (for finalization, comparison, hashing, etc) followed by raw data. The contents of custom blocks is not traced by the GC; therefore, they must not contain any [value]. See [custom.h] for operations on method suites. */ #define Custom_tag 255 So it looks like both Abstract_tag and Custom_tag shield the data within from the GC. So it should be safe to store anything which isn''t an OCaml "value", including the raw result of a malloc(). If we stored an OCaml "value" in there it would be hidden from the GC and probably prematurely deallocated. As for which option we should pick, as you say I think it just depends whether we want the finalizer.> > Also in the same bit of the mmap library the mmap(2) result is stored as > a bare pointer inside that "result" from above, is that visible to the > GC and therefore also dangerous?I think it''s ok because result = caml_alloc(sizeof(struct mmap_interface), Abstract_tag); -- this creates a block on the OCaml heap where the contents will be ignored by the GC ("not traced by the GC" above). If we created a different type of block then it would probably be an immediate disaster since the GC would look inside and see something different to what it expects: it expects a simple array of "value"s and we''ve stuck a custom struct in there. Does that make sense? Cheers, Dave
Ian Campbell
2013-Apr-15 09:47 UTC
Re: [PATCH 08/28] libxc: ocaml: add simple binding for xentoollog (output only).
On Mon, 2013-04-15 at 10:39 +0100, Dave Scott wrote:> > Does that make sense?I think so, but more importantly you''re telling me its all OK ;-) Ian.
Rob Hoes
2013-Apr-23 13:03 UTC
Re: [PATCH 17/28] libxl: ocaml: add with_ctx helper function
> On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote: > > +let with_ctx ?logger f > > Does this imply that xenopsd et al intend to use short lived contexts rather > than one or more long lived ones?No, it was just a little more convenient, because the with_ctx function also cleaned up the context and logger after use, so you won''t be able to forget this. I have now taken Dave''s advise and wrapped the ctx and logger pointers in custom block with "finalize" (GC) functions, so this became less useful. I have remove this patch in my v2 series. Cheers, Rob
Rob Hoes
2013-Apr-23 13:10 UTC
Re: [PATCH 13/28] libxl: idl: add domain_type field to libxl_dominfo struct
> On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote: > > This allows a toolstack to find out whether a VM has booted as PV or > > HVM. > > OOI why do you need to know? I''m wondering if there might be a better > higher level question to ask rather than PV vs HVM.One reason is simply to report to the user what kind of VMs they have running. Xenopsd also uses this information internally in some places, e.g. when inserting a CD, it uses libxl_cdrom_insert for HVMs, and does a normal VBD hotplug for PV. Cheers, Rob
Rob Hoes
2013-Apr-23 13:18 UTC
Re: [PATCH 19/28] libxl: ocaml: add dominfo_list and dominfo_get
[...]> > + domlist = temp = Val_emptylist; > > + for (i = nb - 1; i >= 0; i--) { > > + domlist = caml_alloc_small(2, Tag_cons); > > + Field(domlist, 0) = Val_int(0); > > + Field(domlist, 1) = temp; > > + temp = domlist; > > + > > + Store_field(domlist, 0, Val_dominfo(&c_domlist[i])); > > Is the preceding "Field(domlist, 0) = Val_int(0);" storing to the same place > and therefore redundant?I think the main reason to do this here is that caml_alloc_small (a low-level function) does not initialise the fields (as Dave pointed out earlier), and it is necessary to initialise the fields before doing any subsequent allocation on the OCaml heap (e.g. in Val_dominfo). If you don''t do that, the GC may try to evaluate the uninitialised value. Cheers, Rob
Ian Campbell
2013-Apr-23 13:21 UTC
Re: [PATCH 13/28] libxl: idl: add domain_type field to libxl_dominfo struct
On Tue, 2013-04-23 at 14:10 +0100, Rob Hoes wrote:> > On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote: > > > This allows a toolstack to find out whether a VM has booted as PV or > > > HVM. > > > > OOI why do you need to know? I''m wondering if there might be a better > > higher level question to ask rather than PV vs HVM. > > One reason is simply to report to the user what kind of VMs they have > running.Does xapi/xenopsd not already track this in the DB?> Xenopsd also uses this information internally in some places, e.g. > when inserting a CD, it uses libxl_cdrom_insert for HVMs, and does a > normal VBD hotplug for PV.xenopsd doesn''t already know which to use? I wonder if it is/was a mistake to not have libxl_cdrom_insert do the obvious PV thing for PV guests. Ian.
Rob Hoes
2013-Apr-23 13:27 UTC
Re: [PATCH 13/28] libxl: idl: add domain_type field to libxl_dominfo struct
> > One reason is simply to report to the user what kind of VMs they have > > running. > > Does xapi/xenopsd not already track this in the DB? > > > Xenopsd also uses this information internally in some places, e.g. > > when inserting a CD, it uses libxl_cdrom_insert for HVMs, and does a > > normal VBD hotplug for PV. > > xenopsd doesn''t already know which to use?It is probably not strictly necessary, because xenopsd would remember whether it has started a VM as PV or HVM. But I think that it is in general just a little safer to ask Xen what the state of the system is rather than relying on internal state in the daemon. Rob> I wonder if it is/was a mistake to not have libxl_cdrom_insert do the > obvious PV thing for PV guests. > > Ian.
Rob Hoes
2013-Apr-23 13:28 UTC
Re: [PATCH 11/28] libxl: ocaml: propagate the libxl return error code in exceptions
> > will first call "caml_copy_string" which performs an allocation before > > setting the field to a valid value. Any function which performs an > > allocation can trigger a GC which will segfault if it sees the random > > data in field 1. > > I think this answers my earlier query on another patch about the redundant > looking store to Field ...Indeed :) Rob
> Other than Dave''s comment it looks good to me. > > But how does the event model work in your callers today? The intention > with the libxl event interface is that by implementing the right hooks to > register/deregister fds you can just continue to use your existing event loop > (presuming it can take events on fds).I have been experimenting with two different ways of doing this. Xenopsd does not yet have an fd polling loop that we can easily use for libxl events. For this reason I just wrapped the poll function myself and ran it separately. The other option is to use a library such as Lwt (http://ocsigen.org/lwt/), which does have an event loop we can easily integrate with, and I got the libxl fd registration stuff working with this in a test program. The problem with the latter approach is that it requires quite a rather big rewrite of xenopsd in order to use Lwt (or a something similar), and we did not have time for that yet (we probably will at some point). Cheers, Rob
On Tue, 2013-04-23 at 14:37 +0100, Rob Hoes wrote:> > Other than Dave''s comment it looks good to me. > > > > But how does the event model work in your callers today? The intention > > with the libxl event interface is that by implementing the right hooks to > > register/deregister fds you can just continue to use your existing event loop > > (presuming it can take events on fds). > > I have been experimenting with two different ways of doing this. > > Xenopsd does not yet have an fd polling loop that we can easily use > for libxl events. For this reason I just wrapped the poll function > myself and ran it separately. The other option is to use a library > such as Lwt (http://ocsigen.org/lwt/), which does have an event loop > we can easily integrate with, and I got the libxl fd registration > stuff working with this in a test program. > > The problem with the latter approach is that it requires quite a > rather big rewrite of xenopsd in order to use Lwt (or a something > similar), and we did not have time for that yet (we probably will at > some point).Ah, so the use of poll is really just a short term pragmatic one until you get around to implementing Lwt support? That sounds reasonable. I seem to recall hearing that Lwt was on the roadmap for many of the xen-api ocaml bits (e.g. oxenstored) too. I think I''d be happier if this poll interface was part of xenopsd itself rather than part of the libxl ocaml bindings, where it runs the risk of becoming a stable & supported interface of the Xen project. Or if you cannot include it in xenopsd perhaps it fits better in some other dependency? I thought ocaml had a posix functionality library? (unix or stdext or something). Failing all that I suppose we could live with tools/ocaml/libs/poll in the Xen tree. (aside: I''d really love it if tools/ocaml/libs/mmap could find a non-Xen home too ;-)) Ian.
On 23/04/13 14:43, Ian Campbell wrote:> (aside: I''d really love it if tools/ocaml/libs/mmap could find a non-Xen > home too ;-))I think I can arrange that. In the mirage code we''ve settled on using OCaml ''bigarrays'' [1] (wrappers around C arrays) to pass around buffers, represent memory pages etc. The OCaml standard library has the ability to mmap() stuff and return a bigarray but there was an unfortunate bug where it assumed the thing being mmap()ed also supported lseek() [2]. The bug was fixed in OCaml 4.00.0 so if we''re happy to depend on that then we''re ready to roll. Cheers, Dave [1] http://caml.inria.fr/pub/docs/manual-ocaml/libref/Bigarray.html [2] http://caml.inria.fr/mantis/print_bug_page.php?bug_id=5543
On Tue, 2013-04-23 at 14:56 +0100, Dave Scott wrote:> On 23/04/13 14:43, Ian Campbell wrote: > > (aside: I''d really love it if tools/ocaml/libs/mmap could find a non-Xen > > home too ;-)) > > I think I can arrange that. > > In the mirage code we''ve settled on using OCaml ''bigarrays'' [1] > (wrappers around C arrays) to pass around buffers, represent memory > pages etc. The OCaml standard library has the ability to mmap() stuff > and return a bigarray but thereCool!> was an unfortunate bug where it assumed > the thing being mmap()ed also supported lseek() [2].Not Cool!> The bug was fixed in OCaml 4.00.0 so if we''re happy to depend on that > then we''re ready to roll.4.00.0 might be a bit bleeding edge to rely on outright. Ubuntu Raring still only has 3.12.1. Debian has 4.00.1 in experimental but the next stable release will have 3.12.x. Would it be possible to turn the existing mmap thing into a compat wrapper around the bigarrays for the case where the underlying ocaml is buggy in this way? Perhaps that is a lot of work and we should just shelve this conversation for a couple of distro release cycles and reconsider making this change then. Ian.
> > +type event > > + | POLLIN (* There is data to read *) > > + | POLLPRI (* There is urgent data to read *) > > + | POLLOUT (* Writing now will not block *) > > + | POLLERR (* Error condition (revents only) *) > > + | POLLHUP (* Device has been disconnected (revents only) *) > > + | POLLNVAL (* Invalid request: fd not open (revents only). *) > > Can you reuse these from your poll library in the previous patch?The previous patch only introduced them in C, this one adds the OCaml stuff.> > > +int timeout_register(void *user, void **for_app_registration_out, > > + struct timeval abs, void *for_libxl) { > > + return 0; > > +} > > + > > +int timeout_modify(void *user, void **for_app_registration_update, > > + struct timeval abs) { > > + return 0; > > +} > > + > > +void timeout_deregister(void *user, void *for_app_registration) { > > + return; > > +} > > Worth failing noisily until these are implemented?Yes, I''ll raise some exceptions.> > + > > +value stub_xl_osevent_register_hooks(value ctx, value user) { > > + CAMLparam2(ctx, user); > > + libxl_osevent_hooks *hooks; > > + hooks = malloc(sizeof(*hooks)); > > + > > + hooks->fd_register = fd_register; > > + hooks->fd_modify = fd_modify; > > + hooks->fd_deregister = fd_deregister; > > + hooks->timeout_register = timeout_register; > > + hooks->timeout_modify = timeout_modify; > > + hooks->timeout_deregister = timeout_deregister; > > + > > + libxl_osevent_register_hooks(CTX, hooks, (void *) user); > > This user thing will be retained by libxl -- is that safe from an ocaml gc point > of view?Good point. The original value may go out of scope in the OCaml program and will then be GC''ed. We should copy the value to avoid trouble. To do that, though, we need to know the type of the thing, which is currently polymorphic. I''ll just go ahead and make it a string instead, because that seems to be the most useful. Are these hooks and associated data every cleaned up by libxl? Or is the assumption that libxl_osevent_register_hooks is just called once at the beginning of the program, and everything starts till the end?> > + CAMLreturn((value) hooks); > > Another instance of the problematic heap allocation pattern Dave pointed > out?Yes, we should turn this into a custom or abstract block as well.> > +void event_occurs(void *user, const libxl_event *event) { > > + CAMLparam0(); > > + CAMLlocalN(args, 2); > > + value *func = caml_named_value("xl_event_occurs_callback"); > > + > > + args[0] = (value) user; > > + args[1] = Val_event((libxl_event *) event); > > + //libxl_event_free(CTX, event); // no ctx here! > > Is it leaked or do you free it somewhere else? I suppose "func" must do it? > (which makes sense actually)Hmm... This is awkward. The thing we are giving to "func" is the event translated into an Ocaml type, and not the C libxl_event*. And even if we give the libxl_event* to "func" as well, it still needs to know the ctx in order to free it (which it probably would, but won''t make things easier to use). Is there no way to ask libxl to which ctx the event belongs?> [...] > > +value stub_xl_event_register_callbacks(value ctx, value user) { > > + CAMLparam2(ctx, user); > > + libxl_event_hooks *hooks; > > + > > + hooks = malloc(sizeof(*hooks)); > > Another heap alloc?Yes... another abstract block. Cheers, Rob
The eventy ones I''ll mostly need to defer to IanJ, although I''ll try and speculate. On Tue, 2013-04-23 at 16:33 +0100, Rob Hoes wrote:> > > + > > > +value stub_xl_osevent_register_hooks(value ctx, value user) { > > > + CAMLparam2(ctx, user); > > > + libxl_osevent_hooks *hooks; > > > + hooks = malloc(sizeof(*hooks)); > > > + > > > + hooks->fd_register = fd_register; > > > + hooks->fd_modify = fd_modify; > > > + hooks->fd_deregister = fd_deregister; > > > + hooks->timeout_register = timeout_register; > > > + hooks->timeout_modify = timeout_modify; > > > + hooks->timeout_deregister = timeout_deregister; > > > + > > > + libxl_osevent_register_hooks(CTX, hooks, (void *) user); > > > > This user thing will be retained by libxl -- is that safe from an ocaml gc point > > of view? > > Good point. The original value may go out of scope in the OCaml > program and will then be GC''ed. We should copy the value to avoid > trouble. To do that, though, we need to know the type of the thing, > which is currently polymorphic. I''ll just go ahead and make it a > string instead, because that seems to be the most useful.Is there not a way to take a GC reference on a value or to otherwise make it possible for the GC to know you''ve kept hold of it?> Are these hooks and associated data every cleaned up by libxl? Or is > the assumption that libxl_osevent_register_hooks is just called once > at the beginning of the program, and everything starts till the end?This one is more of an IanJ thing but I notice that the comment says you can call it repeatedly, but it''s not clear if passing hooks == NULL is a valid way to unregister things. libxl itself doesn''t ever clean up the hooks, AFAICT. Specifically libxl_ctx_free() doesn''t free them or anything like that. [...]> > > +void event_occurs(void *user, const libxl_event *event) { > > > + CAMLparam0(); > > > + CAMLlocalN(args, 2); > > > + value *func = caml_named_value("xl_event_occurs_callback"); > > > + > > > + args[0] = (value) user; > > > + args[1] = Val_event((libxl_event *) event); > > > + //libxl_event_free(CTX, event); // no ctx here! > > > > Is it leaked or do you free it somewhere else? I suppose "func" must do it? > > (which makes sense actually) > > Hmm... This is awkward. The thing we are giving to "func" is the event > translated into an Ocaml type, and not the C libxl_event*. And even if > we give the libxl_event* to "func" as well, it still needs to know the > ctx in order to free it (which it probably would, but won''t make > things easier to use). Is there no way to ask libxl to which ctx the > event belongs?Apparently not. I expect the intention was that the void *user would contain reference to it. There''s nothing to stop you from wrapping the applications user value in a stub struct which you pass to libxl on register and then unpack here though. Likewise the application could bundle the CTX into the ocaml user value and extract it again to use it. The bigger issue is the const which actually stops you freeing it, without a horrible cast. <1365684384.8036.104.camel@zakaz.uk.xensource.com> has more details on that one. Ian.
Rob Hoes
2013-Apr-23 15:59 UTC
Re: [PATCH 23/28] libxl: ocaml: allow device operations to be called asynchronously
> libxl.h says: > * *ao_how does not need to remain valid after the initiating function > * returns. All other parameters must remain valid for the lifetime of > * the asynchronous operation, unless otherwise specified. > > So the ao_how can just be a normal stack variable if you like. If you want to > use NULL/non-NULL-ness to indicate Some/None then: > struct ao_how aoh_struct, *aoh = NULL; > if (async != Val_none) > aoh = &aoh_struct > works I think or just > struct ao_how aoh = { .callback = async_callback, ... }; > > ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, > \ > async != Val_none ? &aoh : NULL would do. >Ok, that makes sense. I have changed it to the second option. Cheers, Rob
> > > +value stub_xl_osevent_register_hooks(value ctx, value user) { > > > + CAMLparam2(ctx, user); > > > + libxl_osevent_hooks *hooks; > > > + hooks = malloc(sizeof(*hooks)); > > > + > > > + hooks->fd_register = fd_register; > > > + hooks->fd_modify = fd_modify; > > > + hooks->fd_deregister = fd_deregister; > > > + hooks->timeout_register = timeout_register; > > > + hooks->timeout_modify = timeout_modify; > > > + hooks->timeout_deregister = timeout_deregister; > > > + > > > + libxl_osevent_register_hooks(CTX, hooks, (void *) user); > > > > This user thing will be retained by libxl -- is that safe from an ocaml gc point > > of view? > > Good point. The original value may go out of scope in the OCaml program and will then be GC''ed. We should copy the value to avoid trouble. To do that, though, we need to know the type of the thing, which is currently polymorphic. I''ll just go ahead and make it a string instead, because that seems to be the most useful. > > Are these hooks and associated data every cleaned up by libxl? Or is the assumption that libxl_osevent_register_hooks is just called once at the beginning of the program, and everything starts till the end?From the doc comment (libxl_event.h line 353): * osevent_register_hooks may be called only once for each libxl_ctx. So you are not allowed to call it with NULL to deregister or change the hooks. The "user" should normally be a pointer whatever structure you have that contains the libxl_ctx*.> > > +void event_occurs(void *user, const libxl_event *event) { > > > + CAMLparam0(); > > > + CAMLlocalN(args, 2); > > > + value *func = caml_named_value("xl_event_occurs_callback"); > > > + > > > + args[0] = (value) user; > > > + args[1] = Val_event((libxl_event *) event); > > > + //libxl_event_free(CTX, event); // no ctx here! > > > > Is it leaked or do you free it somewhere else? I suppose "func" must do it? > > (which makes sense actually) > > Hmm... This is awkward. The thing we are giving to "func" is the event translated into an Ocaml type, and not the C libxl_event*. And even if we give the libxl_event* to "func" as well, it still needs to know the ctx in order to free it (which it probably would, but won''t make things easier to use). Is there no way to ask libxl to which ctx the event belongs?No, there isn''t such a way. Indeed it''s not recorded. I think part of the problem here is that you may be trying to map the C functions to ocaml too directly. Your ocaml system already has an event loop, doesn''t it ? You should provide plumbing to glue it to that. Ian.
> > Good point. The original value may go out of scope in the OCaml > > program and will then be GC''ed. We should copy the value to avoid > > trouble. To do that, though, we need to know the type of the thing, > > which is currently polymorphic. I''ll just go ahead and make it a > > string instead, because that seems to be the most useful. > > Is there not a way to take a GC reference on a value or to otherwise make it > possible for the GC to know you''ve kept hold of it?You can keep the value alive in the "main" function or toplevel. But you''d then have to rely on the user of the bindings library to do this properly at the cost of a crashing program. Or perhaps add some higher-level code to these bindings, but at this point I thought it was better to keep things simple...> Apparently not. I expect the intention was that the void *user would > contain reference to it. > > There''s nothing to stop you from wrapping the applications user value in a > stub struct which you pass to libxl on register and then unpack here though. > Likewise the application could bundle the CTX into the ocaml user value and > extract it again to use it.Cool, that sounds like a good solution.> > The bigger issue is the const which actually stops you freeing it, without a > horrible cast. > <1365684384.8036.104.camel@zakaz.uk.xensource.com> has more details on > that one.Interesting... But I guess there is no other option than use the cast at the moment? Rob
On Tue, 2013-04-23 at 17:30 +0100, Rob Hoes wrote:> > > Good point. The original value may go out of scope in the OCaml > > > program and will then be GC''ed. We should copy the value to avoid > > > trouble. To do that, though, we need to know the type of the thing, > > > which is currently polymorphic. I''ll just go ahead and make it a > > > string instead, because that seems to be the most useful. > > > > Is there not a way to take a GC reference on a value or to otherwise make it > > possible for the GC to know you''ve kept hold of it? > > You can keep the value alive in the "main" function or toplevel.I meant can the C bindings not take a reference to record their taking of the value and stashing it somewhere?> > The bigger issue is the const which actually stops you freeing it, without a > > horrible cast. > > <1365684384.8036.104.camel@zakaz.uk.xensource.com> has more details on > > that one. > > Interesting... But I guess there is no other option than use the cast at the moment?Right. Ian.
Ian Campbell writes ("Re: [PATCH 22/28] libxl: ocaml: event
management"):> On Tue, 2013-04-23 at 17:30 +0100, Rob Hoes wrote:
> > You can keep the value alive in the "main" function or
toplevel.
>
> I meant can the C bindings not take a reference to record their taking
> of the value and stashing it somewhere?
This is probably not the best way to deal with this. It will result
in the whole libxl context never being disposed of even when it''s no
longer needed.
Instead, the right approach would be to put the libxl_ctx* in some
kind of gc thunk thingy (most languages have one of these) with a
C-level freeing hook.
When the gc tells you the thing is no longer needed, you tear it all
down.
There is an awkward race here to do with events in flight, which the
libvirt guys encountered. I''m not clearheaded enough to explain it
properly.
The void *user is just there to let your callback functions find their
context, so can point straight to your libxl context wrapper struct.
Ian.
[...]> > + if (!c_list && nb > 0) > > I don''t think && nb > 0 can ever occur, the error handling in > libxl_device_nic_lsit does: > out_err: > LIBXL__LOG(ctx, LIBXL__LOG_ERROR, "Unable to list nics"); > while (*num) { > (*num)--; > libxl_device_nic_dispose(&nics[*num]); > } > free(nics); > return NULL; > i.e. it counts *num back down to zero. I''d say you shouldn''t/mustn''t make > any assumptions about nb if the function call failed.Right, I''ll fix that. I''m not sure why I had it that way.> > + failwith_xl(ERROR_FAIL, "nic_list"); > > + > > + list = temp = Val_emptylist; > > + for (i = 0; i < nb; i++) { > > + list = caml_alloc_small(2, Tag_cons); > > + Field(list, 0) = Val_int(0); > > + Field(list, 1) = temp; > > + temp = list; > > This reverses the list, if you care. I don''t suppose you do and libxl probably > doesn''t actually guarantee anything abort the order.Yeah, I don''t think the order really matters. Cheers, Rob> I wouldn''t have noticed except I saw you doing the counting backwards in an > earlier patch and it took me a second to work out why... > > > + Store_field(list, 0, Val_device_nic(&c_list[i])); > > + libxl_device_nic_dispose(&c_list[i]); > > + } > > + free(c_list); > > + > > + CAMLreturn(list); > > +} > > + > > value stub_xl_physinfo_get(value ctx) { > > CAMLparam1(ctx); >
On Tue, 2013-04-23 at 17:50 +0100, Ian Jackson wrote:> Ian Campbell writes ("Re: [PATCH 22/28] libxl: ocaml: event management"): > > On Tue, 2013-04-23 at 17:30 +0100, Rob Hoes wrote: > > > You can keep the value alive in the "main" function or toplevel. > > > > I meant can the C bindings not take a reference to record their taking > > of the value and stashing it somewhere? > > This is probably not the best way to deal with this. It will result > in the whole libxl context never being disposed of even when it''s no > longer needed.I was referring to taking a reference on the ocaml value used as the user pointer, not to taking a reference to the libxl context. Ian.
> > > I meant can the C bindings not take a reference to record their > > > taking of the value and stashing it somewhere? > > > > This is probably not the best way to deal with this. It will result > > in the whole libxl context never being disposed of even when it''s no > > longer needed. > > I was referring to taking a reference on the ocaml value used as the user > pointer, not to taking a reference to the libxl context.Ok, I am experimenting with a few higher-level functions in the bindings. I think we can maintain a list of "user" values for the event system inside the Xenlight module. I''ll send an update soon. Cheers, Rob
[...]> I think I''d be happier if this poll interface was part of xenopsd itself rather > than part of the libxl ocaml bindings, where it runs the risk of becoming a > stable & supported interface of the Xen project.Indeed, that is probably better. I''ll move it out. Cheers, Rob> Or if you cannot include it in xenopsd perhaps it fits better in some other > dependency? I thought ocaml had a posix functionality library? > (unix or stdext or something). > > Failing all that I suppose we could live with tools/ocaml/libs/poll in the Xen > tree. > > (aside: I''d really love it if tools/ocaml/libs/mmap could find a non-Xen > home too ;-)) > > Ian.
Rob Hoes
2013-Apr-29 11:41 UTC
Re: [PATCH 26/28] libxl: ocaml: add disk and cdrom helper functions
> > Signed-off-by: Rob Hoes <rob.hoes@citrix.com> > > --- > > tools/ocaml/libs/xl/genwrap.py | 5 ++++- > > tools/ocaml/libs/xl/xenlight_stubs.c | 19 ++++++++++++++----- > > 2 files changed, 18 insertions(+), 6 deletions(-) > > > > diff --git a/tools/ocaml/libs/xl/genwrap.py > > b/tools/ocaml/libs/xl/genwrap.py index becdef8..5bc165d 100644 > > --- a/tools/ocaml/libs/xl/genwrap.py > > +++ b/tools/ocaml/libs/xl/genwrap.py > > @@ -30,7 +30,10 @@ DEVICE_FUNCTIONS = [ ("add", ["ctx", > "?async:''a", "t", "domid", "unit > > functions = { # ( name , [type1,type2,....] ) > > "device_vfb": DEVICE_FUNCTIONS, > > "device_vkb": DEVICE_FUNCTIONS, > > - "device_disk": DEVICE_FUNCTIONS, > > + "device_disk": DEVICE_FUNCTIONS + > > + [ ("insert", ["ctx", "?async:''a", "t", "domid", "unit"]), > > + ("of_vdev", ["ctx", "domid", "string", "t"]), > > No list? >Yeah, why not... I''ll add it :) Cheers, Rob
Rob Hoes
2013-Apr-29 14:01 UTC
Re: [PATCH 27/28] libxl: ocaml: add VM lifecycle operations
> > +static int domain_wait_event(libxl_ctx *ctx, int domid, libxl_event > > +**event_r) { > > + int ret; > > + for (;;) { > > + ret = libxl_event_wait(ctx, event_r, LIBXL_EVENTMASK_ALL, > 0,0); > > + if (ret) { > > + return ret; > > + } > > + if ((*event_r)->domid != domid) { > > + char *evstr = libxl_event_to_json(CTX, *event_r); > > + free(evstr); > > Create/allocate the json and immediately free it? (left over debug > perhaps?)Yes :( I will remove it.> > + libxl_event_free(CTX, *event_r); > > + continue; > > + } > > + return ret; > > + } > > +} > [...] > > +value stub_xl_domain_create_restore(value ctx, value domain_config, > > +value restore_fd) { > > + CAMLparam2(ctx, domain_config); > > + int ret; > > + libxl_domain_config c_dconfig; > > + uint32_t c_domid; > > + > > + ret = domain_config_val(CTX, &c_dconfig, domain_config); > > + if (ret != 0) > > + failwith_xl(ret, "domain_create_restore"); > > + > > + ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, > Int_val(restore_fd), NULL, NULL); > > + if (ret != 0) > > + failwith_xl(ret, "domain_create_restore"); > > + > > + libxl_domain_config_dispose(&c_dconfig); > > + > > + CAMLreturn(Val_int(c_domid)); > > +} > > + > > +value stub_libxl_domain_wait_shutdown(value ctx, value domid) { > > + CAMLparam2(ctx, domid); > > + int ret; > > + libxl_event *event; > > + libxl_evgen_domain_death *deathw; > > + ret = libxl_evenable_domain_death(CTX, Int_val(domid), 0, > &deathw); > > + if (ret) { > > + fprintf(stderr,"wait for death failed (evgen, rc=%d)\n",ret); > > + exit(-1); > > + } > > + > > + for (;;) { > > + ret = domain_wait_event(CTX, Int_val(domid), &event); > > + if (ret) > > + failwith_xl(ret, "domain_shutdown"); > > This exits asynchronously, which leaves the domain death event enabled. > Depending on what your exception handler does this may not be what you > want?I think it is best to cleanup here itself. I''ll fix that.> This case has only just occurred to me, so there may be other instances in > earlier patches...I have looked through the code and indeed found a few more instances where cleanup is needed before raising an exception. Cheers, Rob> > + > > + switch (event->type) { > > + case LIBXL_EVENT_TYPE_DOMAIN_DEATH: > > + goto done; > > + case LIBXL_EVENT_TYPE_DOMAIN_SHUTDOWN: > > + goto done; > > + default: > > + break; > > + } > > + libxl_event_free(CTX, event); > > + } > > +done: > > + libxl_event_free(CTX, event); > > + libxl_evdisable_domain_death(CTX, deathw); > > + > > + CAMLreturn(Val_unit); > > +} > > + > > +value stub_libxl_domain_shutdown(value ctx, value domid) { > > + CAMLparam2(ctx, domid); > > + int ret; > > + > > + ret = libxl_domain_shutdown(CTX, Int_val(domid)); > > + > > + if (ret != 0) > > + failwith_xl(ret, "domain_shutdown"); > > + > > + CAMLreturn(Val_unit); > > +} > > This and the rest look pretty mechanical, I just skimmed it... > > Ian.
Rob Hoes
2013-Apr-29 14:13 UTC
Re: [PATCH 28/28] libxl: ocaml: provide default records for libxl types
> On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote: > > Libxl functions such as libxl_domain_create_new take large structs of > > configuration parameters. Often, we would like to use the default > > values for many of these parameters. > > > > This commit makes OCaml records of defaults available for all libxl > > struct and keyed-union types, which can be used as a base to construct > > your own records, and to selectively override parameters where needed. > > > > For example, a Domain_create_info record can now be created as follows: > > > > let c_info = Xenlight.Domain_create_info.({ default with > > ty = Xenlight.DOMAIN_TYPE_PV; > > name = Some vm_name; > > uuid = vm_uuid; > > }) in > > This is a clever approach (and I expect good idiomatic ocaml?) but you need > to handle the init_val IDL field for all types since not everything should be > set to zero (e.g. some of the UInt subtypes don''t default to 0, see MemKB > for one). > > I wonder if a better alternative might be to use a C binding to call > libxl_TYPE_init() and convert that to an ocaml value? This would mean one > less place to change in the future as well.I see. In that case, it indeed seems better to turn "default" into a function that calls a libxl *_init() function and converts it to an ocaml value, rather than having static defaults. With that, the only thing that changes in the example above is that "()" is added after "default". Cheers, Rob
Ian Campbell
2013-Apr-29 14:19 UTC
Re: [PATCH 28/28] libxl: ocaml: provide default records for libxl types
On Mon, 2013-04-29 at 15:13 +0100, Rob Hoes wrote:> > On Mon, 2013-03-25 at 14:45 +0000, Rob Hoes wrote: > > > Libxl functions such as libxl_domain_create_new take large structs of > > > configuration parameters. Often, we would like to use the default > > > values for many of these parameters. > > > > > > This commit makes OCaml records of defaults available for all libxl > > > struct and keyed-union types, which can be used as a base to construct > > > your own records, and to selectively override parameters where needed. > > > > > > For example, a Domain_create_info record can now be created as follows: > > > > > > let c_info = Xenlight.Domain_create_info.({ default with > > > ty = Xenlight.DOMAIN_TYPE_PV; > > > name = Some vm_name; > > > uuid = vm_uuid; > > > }) in > > > > This is a clever approach (and I expect good idiomatic ocaml?) but you need > > to handle the init_val IDL field for all types since not everything should be > > set to zero (e.g. some of the UInt subtypes don''t default to 0, see MemKB > > for one). > > > > I wonder if a better alternative might be to use a C binding to call > > libxl_TYPE_init() and convert that to an ocaml value? This would mean one > > less place to change in the future as well. > > I see. In that case, it indeed seems better to turn "default" into a > function that calls a libxl *_init() function and converts it to an > ocaml value, rather than having static defaults. With that, the only > thing that changes in the example above is that "()" is added after > "default".I''m fine with that if you are. Ian.