* [PATCH v2 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 02/30] libxl: idl: allow KeyedUnion members to be empty Rob Hoes
` (29 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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 ee1fa9c..b9ec689 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->outstanding_memkb = PAGE_TO_MEMKB(xcinfo->outstanding_pages);
xlinfo->current_memkb = PAGE_TO_MEMKB(xcinfo->tot_pages);
diff --git a/tools/libxl/libxl_types.idl b/tools/libxl/libxl_types.idl
index d218a2d..a22569f 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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 02/30] libxl: idl: allow KeyedUnion members to be empty
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
2013-06-13 15:24 ` [PATCH v2 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 03/30] libxl: idl: add domain_type field to libxl_dominfo struct Rob Hoes
` (28 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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 a22569f..81fb25a 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -344,7 +344,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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 03/30] libxl: idl: add domain_type field to libxl_dominfo struct
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
2013-06-13 15:24 ` [PATCH v2 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
2013-06-13 15:24 ` [PATCH v2 02/30] libxl: idl: allow KeyedUnion members to be empty Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 04/30] libxl: idl: complete some enums in the IDL with their defaults Rob Hoes
` (27 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
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 b9ec689..564b4c1 100644
--- a/tools/libxl/libxl.c
+++ b/tools/libxl/libxl.c
@@ -537,6 +537,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 81fb25a..1b8fd44 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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 04/30] libxl: idl: complete some enums in the IDL with their defaults
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (2 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 03/30] libxl: idl: add domain_type field to libxl_dominfo struct Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 05/30] libxl: ocaml: fix code intended to output comments before definitions Rob Hoes
` (26 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
There are several enums in the IDL that are initialised to 0, while
the value 0 is not part of the enum itself. This creates problems for
language bindings generated from the IDL, such as the OCaml ones.
Added an explicit (0, "UNKNOWN") enum value where appropriate, or used
init_val to default to a sensible value.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/libxl/libxl_types.idl | 11 ++++++++---
1 file changed, 8 insertions(+), 3 deletions(-)
diff --git a/tools/libxl/libxl_types.idl b/tools/libxl/libxl_types.idl
index 1b8fd44..daa8bb9 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -32,14 +32,16 @@ libxl_domain_type = Enumeration("domain_type", [
(-1, "INVALID"),
(1, "HVM"),
(2, "PV"),
- ])
+ ], init_val = -1)
libxl_device_model_version = Enumeration("device_model_version", [
+ (0, "UNKNOWN"),
(1, "QEMU_XEN_TRADITIONAL"), # Historical qemu-xen device model (qemu-dm)
(2, "QEMU_XEN"), # Upstream based qemu-xen device model
])
libxl_console_type = Enumeration("console_type", [
+ (0, "UNKNOWN"),
(1, "SERIAL"),
(2, "PV"),
])
@@ -61,6 +63,7 @@ libxl_disk_backend = Enumeration("disk_backend", [
])
libxl_nic_type = Enumeration("nic_type", [
+ (0, "UNKNOWN"),
(1, "VIF_IOEMU"),
(2, "VIF"),
])
@@ -75,7 +78,7 @@ libxl_action_on_shutdown = Enumeration("action_on_shutdown", [
(5, "COREDUMP_DESTROY"),
(6, "COREDUMP_RESTART"),
- ])
+ ], init_val = 1)
libxl_trigger = Enumeration("trigger", [
(0, "UNKNOWN"),
@@ -96,6 +99,7 @@ libxl_tsc_mode = Enumeration("tsc_mode", [
# Consistent with the values defined for HVM_PARAM_TIMER_MODE.
libxl_timer_mode = Enumeration("timer_mode", [
+ (-1, "unknown"),
(0, "delay_for_missed_ticks"),
(1, "no_delay_for_missed_ticks"),
(2, "no_missed_ticks_pending"),
@@ -103,6 +107,7 @@ libxl_timer_mode = Enumeration("timer_mode", [
], init_val = "LIBXL_TIMER_MODE_DEFAULT")
libxl_bios_type = Enumeration("bios_type", [
+ (0, "unknown"),
(1, "rombios"),
(2, "seabios"),
(3, "ovmf"),
@@ -131,7 +136,7 @@ libxl_shutdown_reason = Enumeration("shutdown_reason", [
libxl_vga_interface_type = Enumeration("vga_interface_type", [
(1, "CIRRUS"),
(2, "STD"),
- ], init_val = 0)
+ ], init_val = 1)
#
# Complex libxl types
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 05/30] libxl: ocaml: fix code intended to output comments before definitions
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (3 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 04/30] libxl: idl: complete some enums in the IDL with their defaults Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 06/30] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
` (25 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 06/30] libxl: ocaml: support for Arrays in bindings generator.
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (4 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 05/30] libxl: ocaml: fix code intended to output comments before definitions Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 07/30] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
` (24 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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 | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 5757218..1b68b6b 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
@@ -207,7 +214,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None):
s += "\t value array_elem;\n"
s += "\t %s = caml_alloc(%s,0);\n" % (o, parent + ty.lenvar.name)
s += "\t for(i=0; i<%s; i++) {\n" % (parent + ty.lenvar.name)
- s += "\t %s\n" % ocaml_Val(ty.elem_type, "array_elem", c + "[i]", "")
+ s += "\t %s\n" % ocaml_Val(ty.elem_type, "array_elem", c + "[i]", "", parent=parent)
s += "\t Store_field(%s, i, array_elem);\n" % o
s += "\t }\n"
s += "\t}"
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 07/30] libxl: ocaml: avoid reserved words in type and field names.
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (5 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 06/30] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
` (23 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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 1b68b6b..d76a007 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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator.
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (6 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 07/30] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 09/30] libxl: ocaml: add some more builtin types Rob Hoes
` (22 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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;
}
end
These type names are OK because they are already within the namespace
associated with the struct "s".
If the struct associated with bar is empty then we don't bother with
blargle_bar of "of blargle_bar".
No actually change in the generated code since we don't generate 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 | 160 +++++++++++++++++++++++++++++++++++-----
2 files changed, 146 insertions(+), 17 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 d76a007..0c80e3d 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,7 +285,7 @@ def gen_c_val(ty, indent=""):
s += "}\n"
return s.replace("\n", "\n%s" % indent)
-
+
def ocaml_Val(ty, o, c, indent="", parent = None):
s = indent
if isinstance(ty,idl.UInt):
@@ -232,9 +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 += "\t {\n"
+ s += "\t\t CAMLlocal1(tmp);\n"
+ s += "\t\t %s = caml_alloc(%d,%d);\n" % (o, 1, m)
+ s += ocaml_Val(f.type, 'tmp', fexpr, indent="\t\t ", parent=nparent)
+ s += "\n"
+ s += "\t\t Store_field(%s, 0, tmp);\n" % o
+ s += "\t }\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))
@@ -246,8 +372,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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 09/30] libxl: ocaml: add some more builtin types.
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (7 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 10/30] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
` (21 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
* bitmaps
* string_list
* key_value_list
* cpuid_policy_list (left "empty" for now)
None of these are used yet, so no change to the generated code.
Bitmap_val requires a ctx, so leave it as an abort for now.
Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 6 +-
tools/ocaml/libs/xl/xenlight_stubs.c | 127 ++++++++++++++++++++++++++++++----
2 files changed, 119 insertions(+), 14 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 0c80e3d..05c4582 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -13,9 +13,13 @@ builtins = {
"libxl_devid": ("devid", "%(c)s = Int_val(%(o)s)", "Val_int(%(c)s)" ),
"libxl_defbool": ("bool option", "%(c)s = Defbool_val(%(o)s)", "Val_defbool(%(c)s)" ),
"libxl_uuid": ("int array", "Uuid_val(gc, lg, &%(c)s, %(o)s)", "Val_uuid(&%(c)s)"),
- "libxl_key_value_list": ("(string * string) list", None, None),
+ "libxl_bitmap": ("bool array", "Bitmap_val(gc, lg, &%(c)s, %(o)s)", "Val_bitmap(&%(c)s)"),
+ "libxl_key_value_list": ("(string * string) list", "libxl_key_value_list_val(gc, lg, &%(c)s, %(o)s)", "Val_key_value_list(&%(c)s)"),
+ "libxl_string_list": ("string list", "libxl_string_list_val(gc, lg, &%(c)s, %(o)s)", "Val_string_list(&%(c)s)"),
"libxl_mac": ("int array", "Mac_val(gc, lg, &%(c)s, %(o)s)", "Val_mac(&%(c)s)"),
"libxl_hwcap": ("int32 array", None, "Val_hwcap(&%(c)s)"),
+ # The following needs to be sorted out later
+ "libxl_cpuid_policy_list": ("unit", "%(c)s = 0", "Val_unit"),
}
DEVICE_FUNCTIONS = [ ("add", ["t", "domid", "unit"]),
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 5f19a82..a7bf6ba 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -27,6 +27,7 @@
#include <string.h>
#include <libxl.h>
+#include <libxl_utils.h>
struct caml_logger {
struct xentoollog_logger logger;
@@ -96,7 +97,6 @@ static void failwith_xl(char *fname, struct caml_logger *lg)
caml_raise_with_string(*caml_named_value("xl.error"), s);
}
-#if 0 /* TODO: wrap libxl_domain_create(), these functions will be needed then */
static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
{
void *ptr;
@@ -107,28 +107,103 @@ static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
return ptr;
}
-static int string_string_tuple_array_val (caml_gc *gc, char ***c_val, value v)
+static int list_len(value v)
+{
+ int len = 0;
+ while ( v != Val_emptylist ) {
+ len++;
+ v = Field(v, 1);
+ }
+ return len;
+}
+
+static int libxl_key_value_list_val(caml_gc *gc, struct caml_logger *lg,
+ libxl_key_value_list *c_val,
+ value v)
{
CAMLparam1(v);
- CAMLlocal1(a);
- int i;
- char **array;
+ CAMLlocal1(elem);
+ int nr, i;
+ libxl_key_value_list array;
- for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) { i++; }
+ nr = list_len(v);
- array = gc_calloc(gc, (i + 1) * 2, sizeof(char *));
+ array = gc_calloc(gc, (nr + 1) * 2, sizeof(char *));
if (!array)
- return 1;
- for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1), i++) {
- value b = Field(a, 0);
- array[i * 2] = dup_String_val(gc, Field(b, 0));
- array[i * 2 + 1] = dup_String_val(gc, Field(b, 1));
+ caml_raise_out_of_memory();
+
+ for (i=0; v != Val_emptylist; i++, v = Field(v, 1) ) {
+ elem = Field(v, 0);
+
+ array[i * 2] = dup_String_val(gc, Field(elem, 0));
+ array[i * 2 + 1] = dup_String_val(gc, Field(elem, 1));
}
+
*c_val = array;
CAMLreturn(0);
}
-#endif
+static value Val_key_value_list(libxl_key_value_list *c_val)
+{
+ CAMLparam0();
+ CAMLlocal5(list, cons, key, val, kv);
+ int i;
+
+ list = Val_emptylist;
+ for (i = libxl_string_list_length((libxl_string_list *) c_val) - 1; i >= 0; i -= 2) {
+ val = caml_copy_string((char *) c_val[i]);
+ key = caml_copy_string((char *) c_val[i - 1]);
+ kv = caml_alloc_tuple(2);
+ Store_field(kv, 0, key);
+ Store_field(kv, 1, val);
+
+ cons = caml_alloc(2, 0);
+ Store_field(cons, 0, kv); // head
+ Store_field(cons, 1, list); // tail
+ list = cons;
+ }
+
+ CAMLreturn(list);
+}
+
+static int libxl_string_list_val(caml_gc *gc, struct caml_logger *lg,
+ libxl_string_list *c_val,
+ value v)
+{
+ CAMLparam1(v);
+ int nr, i;
+ libxl_string_list array;
+
+ nr = list_len(v);
+
+ array = gc_calloc(gc, (nr + 1), sizeof(char *));
+ if (!array)
+ caml_raise_out_of_memory();
+
+ for (i=0; v != Val_emptylist; i++, v = Field(v, 1) )
+ array[i] = dup_String_val(gc, Field(v, 0));
+
+ *c_val = array;
+ CAMLreturn(0);
+}
+
+static value Val_string_list(libxl_string_list *c_val)
+{
+ CAMLparam0();
+ CAMLlocal3(list, cons, string);
+ int i;
+
+ list = Val_emptylist;
+ for (i = libxl_string_list_length(c_val) - 1; i >= 0; i--) {
+ string = caml_copy_string((char *) c_val[i]);
+ cons = caml_alloc(2, 0);
+ Store_field(cons, 0, string); // head
+ Store_field(cons, 1, list); // tail
+ list = cons;
+ }
+
+ CAMLreturn(list);
+}
/* Option type support as per http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php */
#define Val_none Val_int(0)
@@ -168,6 +243,32 @@ static int Mac_val(caml_gc *gc, struct caml_logger *lg, libxl_mac *c_val, value
CAMLreturn(0);
}
+static value Val_bitmap (libxl_bitmap *c_val)
+{
+ CAMLparam0();
+ CAMLlocal1(v);
+ int i;
+
+ if (c_val->size == 0)
+ v = Atom(0);
+ else {
+ v = caml_alloc(8 * (c_val->size), 0);
+ libxl_for_each_bit(i, *c_val) {
+ if (libxl_bitmap_test(c_val, i))
+ Store_field(v, i, Val_true);
+ else
+ Store_field(v, i, Val_false);
+ }
+ }
+ CAMLreturn(v);
+}
+
+static int Bitmap_val(caml_gc *gc, struct caml_logger *lg,
+ libxl_bitmap *c_val, value v)
+{
+ abort(); /* XXX */
+}
+
static value Val_uuid (libxl_uuid *c_val)
{
CAMLparam0();
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 10/30] libxc: ocaml: add simple binding for xentoollog (output only).
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (8 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 09/30] libxl: ocaml: add some more builtin types Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 11/30] libxl: ocaml: allocate a long lived libxl context Rob Hoes
` (20 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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/caml_xentoollog.h | 24 +++
tools/ocaml/libs/xentoollog/xentoollog.ml | 98 +++++++++++
tools/ocaml/libs/xentoollog/xentoollog.mli | 53 ++++++
tools/ocaml/libs/xentoollog/xentoollog_stubs.c | 222 ++++++++++++++++++++++++
tools/ocaml/test/Makefile | 28 +++
tools/ocaml/test/xtl.ml | 19 ++
13 files changed, 486 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/caml_xentoollog.h
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 960c29e..5acebd0 100644
--- a/.gitignore
+++ b/.gitignore
@@ -401,6 +401,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 f3877a9..685a785 100644
--- a/.hgignore
+++ b/.hgignore
@@ -326,6 +326,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 5e6d81e..0745e83 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/caml_xentoollog.h b/tools/ocaml/libs/xentoollog/caml_xentoollog.h
new file mode 100644
index 0000000..0eb7618
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/caml_xentoollog.h
@@ -0,0 +1,24 @@
+/*
+ * Copyright (C) 2013 Citrix Ltd.
+ * Author Ian Campbell <ian.campbell@citrix.com>
+ * Author Rob Hoes <rob.hoes@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.
+ */
+
+struct caml_xtl {
+ xentoollog_logger vtable;
+ char *vmessage_cb;
+ char *progress_cb;
+};
+
+#define Xtl_val(x)(*((struct caml_xtl **) Data_custom_val(x)))
+
diff --git a/tools/ocaml/libs/xentoollog/xentoollog.ml b/tools/ocaml/libs/xentoollog/xentoollog.ml
new file mode 100644
index 0000000..0be736c
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog.ml
@@ -0,0 +1,98 @@
+(*
+ * 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*)
+ Callback.register vmessage_name cbs.vmessage;
+ Callback.register progress_name cbs.progress;
+ _create_logger (vmessage_name, progress_name)
+
+
+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
+
diff --git a/tools/ocaml/libs/xentoollog/xentoollog.mli b/tools/ocaml/libs/xentoollog/xentoollog.mli
new file mode 100644
index 0000000..c5c4f59
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog.mli
@@ -0,0 +1,53 @@
+(*
+ * 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
+
diff --git a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
new file mode 100644
index 0000000..c6430b1
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
@@ -0,0 +1,222 @@
+/*
+ * 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 <caml/custom.h>
+
+#include <xentoollog.h>
+
+#include "caml_xentoollog.h"
+
+#define XTL ((xentoollog_logger *) Xtl_val(handle))
+
+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);
+}
+
+void xtl_finalize(value handle)
+{
+ xtl_destroy(XTL);
+}
+
+static struct custom_operations xentoollogger_custom_operations = {
+ "xentoollogger_custom_operations",
+ xtl_finalize /* custom_finalize_default */,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+};
+
+/* external _create_logger: (string * string) -> handle = "stub_xtl_create_logger" */
+CAMLprim value stub_xtl_create_logger(value cbs)
+{
+ CAMLparam1(cbs);
+ CAMLlocal1(handle);
+ 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));
+
+ handle = caml_alloc_custom(&xentoollogger_custom_operations, sizeof(xtl), 0, 1);
+ Xtl_val(handle) = xtl;
+
+ CAMLreturn(handle);
+}
+
+/* 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..3a1df82
--- /dev/null
+++ b/tools/ocaml/test/xtl.ml
@@ -0,0 +1,19 @@
+open Arg
+open Xentoollog
+
+let do_test level =
+ let lgr = Xentoollog.create_stdio_logger ~level:level () in
+ begin
+ Xentoollog.test 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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 11/30] libxl: ocaml: allocate a long lived libxl context.
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (9 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 10/30] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 12/30] libxl: ocaml: switch all functions over to take a context Rob Hoes
` (19 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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 | 3 +++
tools/ocaml/libs/xl/xenlight.ml.in | 4 ++++
tools/ocaml/libs/xl/xenlight.mli.in | 4 ++++
tools/ocaml/libs/xl/xenlight_stubs.c | 42 +++++++++++++++++++++++++++++++++-
5 files changed, 53 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/META.in b/tools/ocaml/libs/xl/META.in
index fe2c60b..3f0c552 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) = "xenlight.cma"
archive(native) = "xenlight.cmxa"
diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile
index c9e5274..6917a20 100644
--- a/tools/ocaml/libs/xl/Makefile
+++ b/tools/ocaml/libs/xl/Makefile
@@ -5,11 +5,14 @@ include $(TOPLEVEL)/common.make
# ignore unused generated functions
CFLAGS += -Wno-unused
CFLAGS += $(CFLAGS_libxenlight)
+CFLAGS += -I ../xentoollog
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..3d663d8 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -20,6 +20,10 @@ type devid = int
(* @@LIBXL_TYPES@@ *)
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+
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..96d859c 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -20,6 +20,10 @@ type devid = int
(* @@LIBXL_TYPES@@ *)
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+
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 a7bf6ba..65e9a4a 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -21,6 +21,7 @@
#include <caml/signals.h>
#include <caml/fail.h>
#include <caml/callback.h>
+#include <caml/custom.h>
#include <sys/mman.h>
#include <stdint.h>
@@ -29,6 +30,11 @@
#include <libxl.h>
#include <libxl_utils.h>
+#include "caml_xentoollog.h"
+
+#define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x)))
+#define CTX ((libxl_ctx *) Ctx_val(ctx))
+
struct caml_logger {
struct xentoollog_logger logger;
int log_offset;
@@ -59,6 +65,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 +85,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 +102,41 @@ 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);
}
+void ctx_finalize(value ctx)
+{
+ libxl_ctx_free(CTX);
+}
+
+static struct custom_operations libxl_ctx_custom_operations = {
+ "libxl_ctx_custom_operations",
+ ctx_finalize /* custom_finalize_default */,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+};
+
+CAMLprim value stub_libxl_ctx_alloc(value logger)
+{
+ CAMLparam1(logger);
+ CAMLlocal1(handle);
+ libxl_ctx *ctx;
+ int ret;
+
+ ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (xentoollog_logger *) Xtl_val(logger));
+ if (ret != 0) \
+ failwith_xl("cannot init context", NULL);
+
+ handle = caml_alloc_custom(&libxl_ctx_custom_operations, sizeof(ctx), 0, 1);
+ Ctx_val(handle) = ctx;
+
+ CAMLreturn(handle);
+}
+
static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
{
void *ptr;
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 12/30] libxl: ocaml: switch all functions over to take a context.
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (10 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 11/30] libxl: ocaml: allocate a long lived libxl context Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 13/30] libxl: ocaml: propagate the libxl return error code in exceptions Rob Hoes
` (18 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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 | 11 +-
tools/ocaml/libs/xl/xenlight.mli.in | 9 +-
tools/ocaml/libs/xl/xenlight_stubs.c | 477 +++++++++-------------------------
4 files changed, 153 insertions(+), 388 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 05c4582..b617cb5 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)", "Val_key_value_list(&%(c)s)"),
- "libxl_string_list": ("string list", "libxl_string_list_val(gc, lg, &%(c)s, %(o)s)", "Val_string_list(&%(c)s)"),
- "libxl_mac": ("int array", "Mac_val(gc, lg, &%(c)s, %(o)s)", "Val_mac(&%(c)s)"),
+ "libxl_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)", "Val_key_value_list(&%(c)s)"),
+ "libxl_string_list": ("string list", "libxl_string_list_val(&%(c)s, %(o)s)", "Val_string_list(&%(c)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):
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
@@ -356,7 +356,7 @@ def ocaml_Val(ty, o, c, indent="", parent = 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"
@@ -381,14 +381,14 @@ def ocaml_Val(ty, o, c, indent="", parent = 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 3d663d8..dffba72 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -15,17 +15,16 @@
exception Error of string
+type ctx
type domid = int
type devid = int
(* @@LIBXL_TYPES@@ *)
-type ctx
-
external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
-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 96d859c..e2686bb 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -15,15 +15,14 @@
exception Error of string
+type ctx
type domid = int
type devid = int
(* @@LIBXL_TYPES@@ *)
-type ctx
-
external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
-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 65e9a4a..062f65b 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -35,49 +35,7 @@
#define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x)))
#define CTX ((libxl_ctx *) Ctx_val(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;
@@ -85,25 +43,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)
-{
- int i;
- for (i = 0; i < gc->offset; i++) {
- free(gc->ptrs[i]);
- }
-}
-
-static void failwith_xl(char *fname, struct caml_logger *lg)
+static void failwith_xl(char *fname)
{
- 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);
}
void ctx_finalize(value ctx)
@@ -129,7 +78,7 @@ CAMLprim value stub_libxl_ctx_alloc(value logger)
ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (xentoollog_logger *) Xtl_val(logger));
if (ret != 0) \
- failwith_xl("cannot init context", NULL);
+ failwith_xl("cannot init context");
handle = caml_alloc_custom(&libxl_ctx_custom_operations, sizeof(ctx), 0, 1);
Ctx_val(handle) = ctx;
@@ -137,16 +86,6 @@ CAMLprim value stub_libxl_ctx_alloc(value logger)
CAMLreturn(handle);
}
-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;
@@ -157,9 +96,8 @@ 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,
- value v)
+static int libxl_key_value_list_val(libxl_key_value_list *c_val,
+ value v)
{
CAMLparam1(v);
CAMLlocal1(elem);
@@ -168,15 +106,15 @@ 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;
@@ -206,9 +144,7 @@ static value Val_key_value_list(libxl_key_value_list *c_val)
CAMLreturn(list);
}
-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;
@@ -216,12 +152,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);
@@ -272,7 +208,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;
@@ -303,10 +239,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)
@@ -324,7 +271,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;
@@ -378,254 +325,76 @@ 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)
-{
- CAMLparam1(domid);
- libxl_device_vfb c_info;
- int ret;
- INIT_STRUCT();
-
- device_vfb_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_vfb_destroy(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("vfb_hard_shutdown", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_pci_add(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_pci c_info;
- int ret;
- INIT_STRUCT();
-
- device_pci_val(&gc, &lg, &c_info, info);
-
- INIT_CTX();
- ret = libxl_device_pci_add(ctx, Int_val(domid), &c_info, 0);
- if (ret != 0)
- failwith_xl("pci_add", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
-
-value stub_xl_device_pci_remove(value info, value domid)
-{
- CAMLparam2(info, domid);
- libxl_device_pci c_info;
+#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(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_remove(ctx, Int_val(domid), &c_info, 0);
if (ret != 0)
- failwith_xl("pci_remove", &lg);
- FREE_CTX();
-
- CAMLreturn(Val_unit);
-}
+ failwith_xl("get_physinfo");
-value stub_xl_physinfo_get(value unit)
-{
- CAMLparam1(unit);
- CAMLlocal1(physinfo);
- libxl_physinfo c_physinfo;
- int ret;
- INIT_STRUCT();
+ physinfo = Val_physinfo(&c_physinfo);
- INIT_CTX();
- ret = libxl_get_physinfo(ctx, &c_physinfo);
- if (ret != 0)
- failwith_xl("physinfo", &lg);
- FREE_CTX();
+ libxl_physinfo_dispose(&c_physinfo);
- 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);
- CAMLlocal2(topology, v);
+ CAMLparam1(ctx);
+ CAMLlocal3(topology, v, v0);
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]));
+ if (c_topology[i].core != LIBXL_CPUTOPOLOGY_INVALID_ENTRY) {
+ v0 = Val_cputopology(&c_topology[i]);
+ v = Val_some(v0);
+ }
else
v = Val_none;
Store_field(topology, i, v);
@@ -633,91 +402,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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 13/30] libxl: ocaml: propagate the libxl return error code in exceptions
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (11 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 12/30] libxl: ocaml: switch all functions over to take a context Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 14/30] libxl: ocaml: make Val_defbool GC-proof Rob Hoes
` (17 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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 | 43 ++++++++++++++++++--
tools/ocaml/libs/xl/xenlight.mli.in | 26 ++++++++++--
tools/ocaml/libs/xl/xenlight_stubs.c | 74 +++++++++++++++++++++++++++-------
4 files changed, 127 insertions(+), 26 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index b617cb5..15d513a 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):
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
@@ -356,7 +356,7 @@ def ocaml_Val(ty, o, c, indent="", parent = 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 dffba72..883df0c 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -13,18 +13,53 @@
* GNU Lesser General Public License for more details.
*)
-exception Error of string
-
type ctx
type domid = int
type devid = int
-(* @@LIBXL_TYPES@@ *)
+type error =
+ Nonspecific |
+ Version |
+ Fail |
+ Ni |
+ Nomem |
+ Inval |
+ Badfail |
+ Guest_Timedout |
+ Timedout |
+ Noparavirt |
+ Not_Ready |
+ Osevent_Reg_Fail |
+ Bufferfull |
+ Unknown_Child
+
+let string_of_error error =
+ match error with
+ | Nonspecific -> "Non specific"
+ | Version -> "Version"
+ | Fail -> "Fail"
+ | Ni -> "Ni"
+ | Nomem -> "Nomem"
+ | Inval -> "Inval"
+ | Badfail -> "Badfail"
+ | Guest_Timedout -> "Guest Timedout"
+ | Timedout -> "Timedout"
+ | Noparavirt -> "Noparavirt"
+ | Not_Ready -> "Not Ready"
+ | Osevent_Reg_Fail -> "Osevent Reg Fail"
+ | Bufferfull -> "Bufferfull"
+ | Unknown_Child -> "Unknown Child"
+
+exception Error of (error * string)
external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+external test_raise_exception: unit -> unit = "stub_raise_exception"
+
+(* @@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 e2686bb..34b1ce5 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -13,16 +13,36 @@
* GNU Lesser General Public License for more details.
*)
-exception Error of string
-
type ctx
type domid = int
type devid = int
-(* @@LIBXL_TYPES@@ *)
+type error =
+ Nonspecific |
+ Version |
+ Fail |
+ Ni |
+ Nomem |
+ Inval |
+ Badfail |
+ Guest_Timedout |
+ Timedout |
+ Noparavirt |
+ Not_Ready |
+ Osevent_Reg_Fail |
+ Bufferfull |
+ Unknown_Child
+
+val string_of_error: error -> string
+
+exception Error of (error * string)
external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+external test_raise_exception: unit -> unit = "stub_raise_exception"
+
+(* @@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 062f65b..53b9d4e 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -47,12 +47,58 @@ static char * dup_String_val(value s)
return c;
}
-static void failwith_xl(char *fname)
+static value Val_error(int error)
{
- value *exc = caml_named_value("Xenlight.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);
+ static value *exc = NULL;
+
+ /* First time around, lookup by name */
+ if (!exc)
+ 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);
+ caml_invalid_argument("Exception Xenlight.Error not initialized, please link xenlight.cma");
+
+ arg = caml_alloc(2, 0);
+
+ Store_field(arg, 0, Val_error(error));
+ Store_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);
}
void ctx_finalize(value ctx)
@@ -78,7 +124,7 @@ CAMLprim value stub_libxl_ctx_alloc(value logger)
ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (xentoollog_logger *) Xtl_val(logger));
if (ret != 0) \
- failwith_xl("cannot init context");
+ failwith_xl(ERROR_FAIL, "cannot init context");
handle = caml_alloc_custom(&libxl_ctx_custom_operations, sizeof(ctx), 0, 1);
Ctx_val(handle) = ctx;
@@ -246,7 +292,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);
@@ -342,7 +388,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); \
}
@@ -368,7 +414,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);
@@ -387,7 +433,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++) {
@@ -414,7 +460,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);
@@ -436,7 +482,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);
}
@@ -453,7 +499,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);
}
@@ -466,7 +512,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);
}
@@ -481,7 +527,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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 14/30] libxl: ocaml: make Val_defbool GC-proof
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (12 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 13/30] libxl: ocaml: propagate the libxl return error code in exceptions Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
` (16 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/xenlight_stubs.c | 12 +++++++-----
1 file changed, 7 insertions(+), 5 deletions(-)
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 53b9d4e..7b7d696 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -332,15 +332,17 @@ static int Uuid_val(libxl_uuid *c_val, value v)
static value Val_defbool(libxl_defbool c_val)
{
CAMLparam0();
- CAMLlocal1(v);
+ CAMLlocal2(v1, v2);
+ bool b;
if (libxl_defbool_is_default(c_val))
- v = Val_none;
+ v2 = Val_none;
else {
- bool b = libxl_defbool_val(c_val);
- v = Val_some(b ? Val_bool(true) : Val_bool(false));
+ b = libxl_defbool_val(c_val);
+ v1 = b ? Val_bool(true) : Val_bool(false);
+ v2 = Val_some(v1);
}
- CAMLreturn(v);
+ CAMLreturn(v2);
}
static libxl_defbool Defbool_val(value v)
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings.
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (13 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 14/30] libxl: ocaml: make Val_defbool GC-proof Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 16/30] libxl: ocaml: add META to list of generated files in Makefile Rob Hoes
` (15 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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 daa8bb9..58fd103 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -435,7 +435,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 15d513a..3f8bcbf 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -426,11 +426,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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 16/30] libxl: ocaml: add META to list of generated files in Makefile
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (14 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:24 ` [PATCH v2 17/30] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
` (14 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
tools/ocaml/libs/xl/Makefile | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile
index 6917a20..0408cc2 100644
--- a/tools/ocaml/libs/xl/Makefile
+++ b/tools/ocaml/libs/xl/Makefile
@@ -22,7 +22,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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 17/30] libxl: ocaml: fix the handling of enums in the bindings generator
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (15 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 16/30] libxl: ocaml: add META to list of generated files in Makefile Rob Hoes
@ 2013-06-13 15:24 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 18/30] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
` (13 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:24 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Campbell <ian.campbell@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 3f8bcbf..f0d4885 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):
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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 18/30] libxl: ocaml: use the "string option" type for IDL strings
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (16 preceding siblings ...)
2013-06-13 15:24 ` [PATCH v2 17/30] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:58 ` Andrew Cooper
2013-06-13 15:25 ` [PATCH v2 19/30] libxl: ocaml: add xen_console_read Rob Hoes
` (12 subsequent siblings)
30 siblings, 1 reply; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
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 | 21 +++++++++++++++++++++
2 files changed, 22 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index f0d4885..d967ee6 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 7b7d696..e801643 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -371,6 +371,27 @@ static value Val_hwcap(libxl_hwcap *c_val)
CAMLreturn(hwcap);
}
+static value Val_string_option(const char *c_val)
+{
+ CAMLparam0();
+ CAMLlocal2(tmp1, tmp2);
+ if (c_val) {
+ tmp1 = caml_copy_string(c_val);
+ tmp2 = Val_some(tmp1);
+ CAMLreturn(tmp2);
+ }
+ 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
^ permalink raw reply related [flat|nested] 34+ messages in thread* Re: [PATCH v2 18/30] libxl: ocaml: use the "string option" type for IDL strings
2013-06-13 15:25 ` [PATCH v2 18/30] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
@ 2013-06-13 15:58 ` Andrew Cooper
0 siblings, 0 replies; 34+ messages in thread
From: Andrew Cooper @ 2013-06-13 15:58 UTC (permalink / raw)
To: Rob Hoes; +Cc: xen-devel@lists.xen.org
On 13/06/13 16:25, Rob Hoes wrote:
> 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
"can be NULL" perhaps?
~Andrew
> 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 | 21 +++++++++++++++++++++
> 2 files changed, 22 insertions(+), 1 deletion(-)
>
> diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
> index f0d4885..d967ee6 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 7b7d696..e801643 100644
> --- a/tools/ocaml/libs/xl/xenlight_stubs.c
> +++ b/tools/ocaml/libs/xl/xenlight_stubs.c
> @@ -371,6 +371,27 @@ static value Val_hwcap(libxl_hwcap *c_val)
> CAMLreturn(hwcap);
> }
>
> +static value Val_string_option(const char *c_val)
> +{
> + CAMLparam0();
> + CAMLlocal2(tmp1, tmp2);
> + if (c_val) {
> + tmp1 = caml_copy_string(c_val);
> + tmp2 = Val_some(tmp1);
> + CAMLreturn(tmp2);
> + }
> + 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
^ permalink raw reply [flat|nested] 34+ messages in thread
* [PATCH v2 19/30] libxl: ocaml: add xen_console_read
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (17 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 18/30] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 20/30] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
` (11 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
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 883df0c..fd5c4ce 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -61,5 +61,6 @@ external test_raise_exception: unit -> unit = "stub_raise_exception"
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 34b1ce5..11ea43c 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -46,3 +46,4 @@ external test_raise_exception: unit -> unit = "stub_raise_exception"
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 e801643..cacaaca 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -557,6 +557,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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 20/30] libxl: ocaml: add dominfo_list and dominfo_get
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (18 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 19/30] libxl: ocaml: add xen_console_read Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 21/30] libxl: ocaml: implement some simple tests Rob Hoes
` (10 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
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 d967ee6..23de43a 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 cacaaca..4e15edb 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -474,6 +474,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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 21/30] libxl: ocaml: implement some simple tests
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (19 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 20/30] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 22/30] libxl: ocaml: event management Rob Hoes
` (9 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes, Ian Campbell
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 | 29 +++++++++++++++++++++++++++++
tools/ocaml/test/raise_exception.ml | 11 +++++++++++
tools/ocaml/test/send_debug_keys.ml | 16 ++++++++++++++++
6 files changed, 86 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 5acebd0..70cca17 100644
--- a/.gitignore
+++ b/.gitignore
@@ -402,7 +402,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 685a785..9de4f27 100644
--- a/.hgignore
+++ b/.hgignore
@@ -327,6 +327,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..e21dd71
--- /dev/null
+++ b/tools/ocaml/test/list_domains.ml
@@ -0,0 +1,29 @@
+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
+ 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..d4371f5
--- /dev/null
+++ b/tools/ocaml/test/raise_exception.ml
@@ -0,0 +1,11 @@
+open Printf
+open Xentoollog
+open Xenlight
+
+let _ =
+ try
+ Xenlight.test_raise_exception ()
+ 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/send_debug_keys.ml b/tools/ocaml/test/send_debug_keys.ml
new file mode 100644
index 0000000..6db89e8
--- /dev/null
+++ b/tools/ocaml/test/send_debug_keys.ml
@@ -0,0 +1,16 @@
+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>"
+
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 22/30] libxl: ocaml: event management
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (20 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 21/30] libxl: ocaml: implement some simple tests Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 23/30] libxl: ocaml: allow device operations to be called asynchronously Rob Hoes
` (8 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/xenlight.ml.in | 70 +++++++-
tools/ocaml/libs/xl/xenlight.mli.in | 48 +++++
tools/ocaml/libs/xl/xenlight_stubs.c | 325 ++++++++++++++++++++++++++++++++++
3 files changed, 442 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in
index fd5c4ce..06c9f52 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -56,6 +56,14 @@ external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
external test_raise_exception: unit -> unit = "stub_raise_exception"
+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"
@@ -63,4 +71,64 @@ 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, ""))
+module type EVENT_USERS =
+ sig
+ type osevent_user
+ type event_user
+ type async_user
+ end
+
+module Async = functor (S: EVENT_USERS) -> struct
+ type for_libxl
+ type event_hooks
+ type osevent_hooks
+
+ module OseventSet = Set.Make(struct type t = S.osevent_user;; let compare = Pervasives.compare end)
+ module EventSet = Set.Make(struct type t = S.event_user;; let compare = Pervasives.compare end)
+ module AsyncSet = Set.Make(struct type t = S.async_user;; let compare = Pervasives.compare end)
+
+ let osevent_users = ref OseventSet.empty
+ let event_users = ref EventSet.empty
+ let async_users = ref AsyncSet.empty
+ let async_callback_ref = ref None
+
+ external osevent_register_hooks' : ctx -> S.osevent_user -> osevent_hooks = "stub_libxl_osevent_register_hooks"
+ external osevent_occurred_fd : ctx -> for_libxl -> Unix.file_descr -> event list -> event list -> unit = "stub_libxl_osevent_occurred_fd"
+ external osevent_occurred_timeout : ctx -> for_libxl -> unit = "stub_libxl_osevent_occurred_timeout"
+
+ let osevent_register_hooks ctx ~user ~fd_register ~fd_modify ~fd_deregister ~timeout_register ~timeout_modify =
+ Callback.register "libxl_fd_register" fd_register;
+ Callback.register "libxl_fd_modify" fd_modify;
+ Callback.register "libxl_fd_deregister" fd_deregister;
+ Callback.register "libxl_timeout_register" timeout_register;
+ Callback.register "libxl_timeout_modify" timeout_modify;
+ osevent_users := OseventSet.add user !osevent_users;
+ osevent_register_hooks' ctx user
+
+ let async f user =
+ async_users := AsyncSet.add user !async_users;
+ f ?async:(Some user) ()
+
+ let async_callback' result user =
+ async_users := AsyncSet.remove user !async_users;
+ match !async_callback_ref with
+ | None -> ()
+ | Some f -> f ~result ~user
+
+ let async_register_callback ~async_callback =
+ async_callback_ref := Some async_callback;
+ Callback.register "libxl_async_callback" async_callback'
+
+ external evenable_domain_death : ctx -> domid -> int -> unit = "stub_libxl_evenable_domain_death"
+ external event_register_callbacks' : ctx -> S.event_user -> event_hooks = "stub_libxl_event_register_callbacks"
+
+ let event_register_callbacks ctx ~user ~event_occurs_callback ~event_disaster_callback =
+ Callback.register "libxl_event_occurs_callback" event_occurs_callback;
+ Callback.register "libxl_event_disaster_callback" event_disaster_callback;
+ event_users := EventSet.add user !event_users;
+ event_register_callbacks' ctx user
+end
+
+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 11ea43c..0b06712 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -41,9 +41,57 @@ external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
external test_raise_exception: unit -> unit = "stub_raise_exception"
+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"
+
+module type EVENT_USERS =
+ sig
+ type osevent_user
+ type event_user
+ type async_user
+ end
+
+module Async : functor (S: EVENT_USERS) -> sig
+ type for_libxl
+ type event_hooks
+ type osevent_hooks
+
+ val osevent_register_hooks : ctx ->
+ user:S.osevent_user ->
+ fd_register:(S.osevent_user -> Unix.file_descr -> event list -> for_libxl -> unit) ->
+ fd_modify:(S.osevent_user -> Unix.file_descr -> event list -> unit) ->
+ fd_deregister:(S.osevent_user -> Unix.file_descr -> unit) ->
+ timeout_register:(S.osevent_user -> int -> int -> for_libxl -> unit) ->
+ timeout_modify:(S.osevent_user -> unit) ->
+ osevent_hooks
+
+ external osevent_occurred_fd : ctx -> for_libxl -> Unix.file_descr -> event list -> event list -> unit = "stub_libxl_osevent_occurred_fd"
+ external osevent_occurred_timeout : ctx -> for_libxl -> unit = "stub_libxl_osevent_occurred_timeout"
+
+ val async : (?async:S.async_user -> unit -> 'a) -> S.async_user -> 'a
+
+ val async_register_callback :
+ async_callback:(result:error option -> user:S.async_user -> unit) ->
+ unit
+
+ external evenable_domain_death : ctx -> domid -> int -> unit = "stub_libxl_evenable_domain_death"
+
+ val event_register_callbacks : ctx ->
+ user:S.event_user ->
+ event_occurs_callback:(S.event_user -> Event.t -> unit) ->
+ event_disaster_callback:(S.event_user -> event_type -> string -> int -> unit) ->
+ event_hooks
+end
+
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 4e15edb..c98a660 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -30,6 +30,8 @@
#include <libxl.h>
#include <libxl_utils.h>
+#include <unistd.h>
+
#include "caml_xentoollog.h"
#define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x)))
@@ -394,6 +396,26 @@ static char *String_option_val(value v)
#include "_libxl_types.inc"
+void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
+{
+ CAMLparam0();
+ CAMLlocal1(error);
+ int *task = (int *) for_callback;
+ static value *func = NULL;
+
+ if (func == NULL) {
+ /* First time around, lookup by name */
+ func = caml_named_value("libxl_async_callback");
+ }
+
+ if (rc == 0)
+ error = Val_none;
+ else
+ error = Val_some(Val_error(rc));
+
+ caml_callback2(*func, error, (value) for_callback);
+}
+
#define _STRINGIFY(x) #x
#define STRINGIFY(x) _STRINGIFY(x)
@@ -625,6 +647,309 @@ value stub_xl_xen_console_read(value ctx)
CAMLreturn(list);
}
+
+/* Event handling */
+
+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;
+ default: failwith_xl(ERROR_FAIL, "cannot convert poll event value"); 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);
+}
+
+int fd_register(void *user, int fd, void **for_app_registration_out,
+ short events, void *for_libxl)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 4);
+ static value *func = NULL;
+
+ if (func == NULL) {
+ /* First time around, lookup by name */
+ func = caml_named_value("libxl_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);
+ static value *func = NULL;
+
+ if (func == NULL) {
+ /* First time around, lookup by name */
+ func = caml_named_value("libxl_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);
+ static value *func = NULL;
+
+ if (func == NULL) {
+ /* First time around, lookup by name */
+ func = caml_named_value("libxl_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)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 4);
+ static value *func = NULL;
+
+ if (func == NULL) {
+ /* First time around, lookup by name */
+ func = caml_named_value("libxl_timeout_register");
+ }
+
+ args[0] = (value) user;
+ args[1] = Val_int(abs.tv_sec);
+ args[2] = Val_int(abs.tv_usec);
+ args[3] = (value) for_libxl;
+
+ caml_callbackN(*func, 4, args);
+ CAMLreturn(0);
+}
+
+int timeout_modify(void *user, void **for_app_registration_update,
+ struct timeval abs)
+{
+ CAMLparam0();
+ static value *func = NULL;
+
+ if (func == NULL) {
+ /* First time around, lookup by name */
+ func = caml_named_value("libxl_timeout_modify");
+ }
+
+ caml_callback(*func, (value) user);
+ CAMLreturn(0);
+}
+
+void timeout_deregister(void *user, void *for_app_registration)
+{
+ failwith_xl(ERROR_FAIL, "timeout_deregister not yet implemented");
+ return;
+}
+
+value stub_libxl_osevent_register_hooks(value ctx, value user)
+{
+ CAMLparam2(ctx, user);
+ CAMLlocal1(result);
+ 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);
+ result = caml_alloc(1, Abstract_tag);
+ *((libxl_osevent_hooks **) result) = hooks;
+
+ CAMLreturn(result);
+}
+
+value stub_libxl_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_libxl_osevent_occurred_timeout(value ctx, value for_libxl)
+{
+ CAMLparam2(ctx, for_libxl);
+ libxl_osevent_occurred_timeout(CTX, (void *) for_libxl);
+ CAMLreturn(Val_unit);
+}
+
+struct user_with_ctx {
+ libxl_ctx *ctx;
+ void *user;
+};
+
+void event_occurs(void *user, libxl_event *event)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 2);
+ struct user_with_ctx *c_user = (struct user_with_ctx *) user;
+ static value *func = NULL;
+
+ if (func == NULL) {
+ /* First time around, lookup by name */
+ func = caml_named_value("libxl_event_occurs_callback");
+ }
+
+ args[0] = (value) c_user->user;
+ args[1] = Val_event(event);
+ libxl_event_free(c_user->ctx, event);
+
+ caml_callbackN(*func, 2, args);
+ CAMLreturn0;
+}
+
+void disaster(void *user, libxl_event_type type,
+ const char *msg, int errnoval)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 2);
+ struct user_with_ctx *c_user = (struct user_with_ctx *) user;
+ static value *func = NULL;
+
+ if (func == NULL) {
+ /* First time around, lookup by name */
+ func = caml_named_value("libxl_event_disaster_callback");
+ }
+
+ args[0] = (value) c_user->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_libxl_event_register_callbacks(value ctx, value user)
+{
+ CAMLparam2(ctx, user);
+ CAMLlocal1(result);
+ struct user_with_ctx *c_user = NULL;
+ libxl_event_hooks *hooks;
+
+ c_user = malloc(sizeof(*c_user));
+ c_user->user = (void *) user;
+ c_user->ctx = CTX;
+
+ hooks = malloc(sizeof(*hooks));
+ hooks->event_occurs_mask = LIBXL_EVENTMASK_ALL;
+ hooks->event_occurs = event_occurs;
+ hooks->disaster = disaster;
+
+ libxl_event_register_callbacks(CTX, hooks, (void *) c_user);
+ result = caml_alloc(1, Abstract_tag);
+ *((libxl_event_hooks **) result) = hooks;
+
+ CAMLreturn(result);
+}
+
+value stub_libxl_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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 23/30] libxl: ocaml: allow device operations to be called asynchronously
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (21 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 22/30] libxl: ocaml: event management Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 24/30] libxl: ocaml: add NIC helper functions Rob Hoes
` (7 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 6 +++---
tools/ocaml/libs/xl/xenlight_stubs.c | 14 +++++++++++---
2 files changed, 14 insertions(+), 6 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 23de43a..57ec143 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", "t", "domid", "?async:'a", "unit", "unit"]),
+ ("remove", ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
+ ("destroy", ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
]
functions = { # ( name , [type1,type2,....] )
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index c98a660..5ac8213 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -420,15 +420,23 @@ 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 info, value domid, \
+ value async, value unit) \
{ \
- CAMLparam3(ctx, info, domid); \
+ CAMLparam5(ctx, info, domid, async, unit); \
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.callback = async_callback; \
+ ao_how.u.for_callback = (void *) Some_val(async); \
+ } \
+ \
+ ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, \
+ async != Val_none ? &ao_how : NULL); \
\
libxl_device_##type##_dispose(&c_info); \
\
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 24/30] libxl: ocaml: add NIC helper functions
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (22 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 23/30] libxl: ocaml: allow device operations to be called asynchronously Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 25/30] libxl: ocaml: add PCI device " Rob Hoes
` (6 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
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 57ec143..c99326b 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 5ac8213..d833ba1 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -457,6 +457,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)
+ 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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 25/30] libxl: ocaml: add PCI device helper functions
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (23 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 24/30] libxl: ocaml: add NIC helper functions Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 26/30] libxl: ocaml: add disk and cdrom " Rob Hoes
` (5 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
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 c99326b..489ae9d 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 d833ba1..51ed855 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -493,6 +493,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)
+ 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)
+ 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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 26/30] libxl: ocaml: add disk and cdrom helper functions
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (24 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 25/30] libxl: ocaml: add PCI device " Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 27/30] libxl: ocaml: add VM lifecycle operations Rob Hoes
` (4 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 17 +++++++-----
tools/ocaml/libs/xl/xenlight_stubs.c | 47 ++++++++++++++++++++++++++++++----
2 files changed, 52 insertions(+), 12 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 489ae9d..92326e1 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -26,18 +26,21 @@ DEVICE_FUNCTIONS = [ ("add", ["ctx", "t", "domid", "?async:'a", "unit
("remove", ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
("destroy", ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
]
+DEVICE_LIST = [ ("list", ["ctx", "domid", "t list"]),
+ ]
functions = { # ( name , [type1,type2,....] )
"device_vfb": DEVICE_FUNCTIONS,
"device_vkb": DEVICE_FUNCTIONS,
- "device_disk": DEVICE_FUNCTIONS,
- "device_nic": DEVICE_FUNCTIONS +
- [ ("list", ["ctx", "domid", "t list"]),
- ("of_devid", ["ctx", "domid", "int", "t"]),
+ "device_disk": DEVICE_FUNCTIONS + DEVICE_LIST +
+ [ ("insert", ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
+ ("of_vdev", ["ctx", "domid", "string", "t"]),
+ ],
+ "device_nic": DEVICE_FUNCTIONS + DEVICE_LIST +
+ [ ("of_devid", ["ctx", "domid", "int", "t"]),
],
- "device_pci": DEVICE_FUNCTIONS +
- [ ("list", ["ctx", "domid", "t list"]),
- ("assignable_add", ["ctx", "t", "bool", "unit"]),
+ "device_pci": DEVICE_FUNCTIONS + DEVICE_LIST +
+ [ ("assignable_add", ["ctx", "t", "bool", "unit"]),
("assignable_remove", ["ctx", "t", "bool", "unit"]),
("assignable_list", ["ctx", "t list"]),
],
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 51ed855..0faa425 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -419,7 +419,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 info, value domid, \
value async, value unit) \
{ \
@@ -435,7 +435,7 @@ value stub_xl_device_##type##_##op(value ctx, value info, value domid, \
ao_how.u.for_callback = (void *) Some_val(async); \
} \
\
- ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, \
+ ret = libxl_##fn##_##op(CTX, Int_val(domid), &c_info, \
async != Val_none ? &ao_how : NULL); \
\
libxl_device_##type##_dispose(&c_info); \
@@ -447,15 +447,16 @@ value stub_xl_device_##type##_##op(value ctx, value info, value domid, \
}
#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)
{
@@ -493,6 +494,42 @@ value stub_xl_device_nic_list(value ctx, value domid)
CAMLreturn(list);
}
+value stub_xl_device_disk_list(value ctx, value domid)
+{
+ CAMLparam2(ctx, domid);
+ CAMLlocal2(list, temp);
+ libxl_device_disk *c_list;
+ int i, nb;
+ uint32_t c_domid;
+
+ c_domid = Int_val(domid);
+
+ c_list = libxl_device_disk_list(CTX, c_domid, &nb);
+ if (!c_list)
+ failwith_xl(ERROR_FAIL, "disk_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_disk(&c_list[i]));
+ libxl_device_disk_dispose(&c_list[i]);
+ }
+ free(c_list);
+
+ 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
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 27/30] libxl: ocaml: add VM lifecycle operations
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (25 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 26/30] libxl: ocaml: add disk and cdrom " Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 28/30] libxl: ocaml: in send_debug_keys, clean up before raising exception Rob Hoes
` (3 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
Also, reorganise toplevel OCaml functions into modules of Xenlight.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/xenlight.ml.in | 23 +++-
tools/ocaml/libs/xl/xenlight.mli.in | 23 +++-
tools/ocaml/libs/xl/xenlight_stubs.c | 198 ++++++++++++++++++++++++++++++++++
tools/ocaml/test/send_debug_keys.ml | 2 +-
4 files changed, 237 insertions(+), 9 deletions(-)
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in
index 06c9f52..4cfd085 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -66,10 +66,25 @@ type event =
(* @@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"
+module Domain = struct
+ external create_new : ctx -> Domain_config.t -> ?async:'a -> unit -> domid = "stub_libxl_domain_create_new"
+ external create_restore : ctx -> Domain_config.t -> Unix.file_descr -> ?async:'a -> unit -> domid = "stub_libxl_domain_create_restore"
+ external shutdown : ctx -> domid -> unit = "stub_libxl_domain_shutdown"
+ external wait_shutdown : ctx -> domid -> unit = "stub_libxl_domain_wait_shutdown"
+ external reboot : ctx -> domid -> unit = "stub_libxl_domain_reboot"
+ external destroy : ctx -> domid -> ?async:'a -> unit -> unit = "stub_libxl_domain_destroy"
+ external suspend : ctx -> domid -> Unix.file_descr -> ?async:'a -> unit -> unit = "stub_libxl_domain_suspend"
+ external pause : ctx -> domid -> unit = "stub_libxl_domain_pause"
+ external 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"
+end
+
+module Host = struct
+ external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
+ external xen_console_read : ctx -> string list = "stub_xl_xen_console_read"
+end
module type EVENT_USERS =
sig
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in
index 0b06712..d49edde 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -51,10 +51,25 @@ type event =
(* @@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"
+module Domain : sig
+ external create_new : ctx -> Domain_config.t -> ?async:'a -> unit -> domid = "stub_libxl_domain_create_new"
+ external create_restore : ctx -> Domain_config.t -> Unix.file_descr -> ?async:'a -> unit -> domid = "stub_libxl_domain_create_restore"
+ external shutdown : ctx -> domid -> unit = "stub_libxl_domain_shutdown"
+ external wait_shutdown : ctx -> domid -> unit = "stub_libxl_domain_wait_shutdown"
+ external reboot : ctx -> domid -> unit = "stub_libxl_domain_reboot"
+ external destroy : ctx -> domid -> ?async:'a -> unit -> unit = "stub_libxl_domain_destroy"
+ external suspend : ctx -> domid -> Unix.file_descr -> ?async:'a -> unit -> unit = "stub_libxl_domain_suspend"
+ external pause : ctx -> domid -> unit = "stub_libxl_domain_pause"
+ external 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"
+end
+
+module Host : sig
+ external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
+ external xen_console_read : ctx -> string list = "stub_xl_xen_console_read"
+end
module type EVENT_USERS =
sig
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 0faa425..aab3b21 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -416,6 +416,204 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
caml_callback2(*func, error, (value) for_callback);
}
+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) {
+ libxl_event_free(CTX, *event_r);
+ continue;
+ }
+ return ret;
+ }
+}
+
+value stub_libxl_domain_create_new(value ctx, value domain_config, value async, value unit)
+{
+ CAMLparam4(ctx, async, domain_config, unit);
+ int ret;
+ libxl_domain_config c_dconfig;
+ uint32_t c_domid;
+ libxl_asyncop_how ao_how;
+
+ if (async != Val_none) {
+ ao_how.callback = async_callback;
+ ao_how.u.for_callback = (void *) Some_val(async);
+ }
+
+ libxl_domain_config_init(&c_dconfig);
+ ret = domain_config_val(CTX, &c_dconfig, domain_config);
+ if (ret != 0) {
+ libxl_domain_config_dispose(&c_dconfig);
+ failwith_xl(ret, "domain_create_new");
+ }
+
+ ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid,
+ async != Val_none ? &ao_how : NULL, NULL);
+
+ libxl_domain_config_dispose(&c_dconfig);
+
+ if (ret != 0)
+ failwith_xl(ret, "domain_create_new");
+
+ CAMLreturn(Val_int(c_domid));
+}
+
+value stub_libxl_domain_create_restore(value ctx, value domain_config, value restore_fd, value async, value unit)
+{
+ CAMLparam5(ctx, domain_config, restore_fd, async, unit);
+ int ret;
+ libxl_domain_config c_dconfig;
+ uint32_t c_domid;
+ libxl_asyncop_how ao_how;
+
+ if (async != Val_none) {
+ ao_how.callback = async_callback;
+ ao_how.u.for_callback = (void *) Some_val(async);
+ }
+
+ libxl_domain_config_init(&c_dconfig);
+ ret = domain_config_val(CTX, &c_dconfig, domain_config);
+ if (ret != 0) {
+ libxl_domain_config_dispose(&c_dconfig);
+ failwith_xl(ret, "domain_create_restore");
+ }
+
+ ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, Int_val(restore_fd),
+ async != Val_none ? &ao_how : NULL, NULL);
+
+ libxl_domain_config_dispose(&c_dconfig);
+
+ if (ret != 0)
+ failwith_xl(ret, "domain_create_restore");
+
+ 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)
+ failwith_xl(ret, "domain_wait_shutdown");
+
+ for (;;) {
+ ret = domain_wait_event(CTX, Int_val(domid), &event);
+ if (ret) {
+ libxl_evdisable_domain_death(CTX, deathw);
+ failwith_xl(ret, "domain_wait_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, value async, value unit)
+{
+ CAMLparam4(ctx, domid, async, unit);
+ int ret;
+ libxl_asyncop_how ao_how;
+
+ if (async != Val_none) {
+ ao_how.callback = async_callback;
+ ao_how.u.for_callback = (void *) Some_val(async);
+ }
+
+ ret = libxl_domain_destroy(CTX, Int_val(domid),
+ async != Val_none ? &ao_how : NULL);
+ if (ret != 0)
+ failwith_xl(ret, "domain_destroy");
+
+ CAMLreturn(Val_unit);
+}
+
+value stub_libxl_domain_suspend(value ctx, value domid, value fd, value async, value unit)
+{
+ CAMLparam5(ctx, domid, fd, async, unit);
+ int ret;
+ libxl_asyncop_how ao_how;
+
+ if (async != Val_none) {
+ ao_how.callback = async_callback;
+ ao_how.u.for_callback = (void *) Some_val(async);
+ }
+
+ ret = libxl_domain_suspend(CTX, Int_val(domid), Int_val(fd), 0,
+ async != Val_none ? &ao_how : NULL);
+ 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);
+}
+
#define _STRINGIFY(x) #x
#define STRINGIFY(x) _STRINGIFY(x)
diff --git a/tools/ocaml/test/send_debug_keys.ml b/tools/ocaml/test/send_debug_keys.ml
index 6db89e8..6cf59ea 100644
--- a/tools/ocaml/test/send_debug_keys.ml
+++ b/tools/ocaml/test/send_debug_keys.ml
@@ -5,7 +5,7 @@ open Xenlight
let send_keys ctx s =
printf "Sending debug key %s\n" s;
- Xenlight.send_debug_keys ctx s;
+ Xenlight.Host.send_debug_keys ctx s;
()
let _ =
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 28/30] libxl: ocaml: in send_debug_keys, clean up before raising exception
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (26 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 27/30] libxl: ocaml: add VM lifecycle operations Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 29/30] libxl: ocaml: provide defaults for libxl types Rob Hoes
` (2 subsequent siblings)
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/xenlight_stubs.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index aab3b21..084961a 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -981,11 +981,11 @@ value stub_xl_send_debug_keys(value ctx, value keys)
c_keys = dup_String_val(keys);
ret = libxl_send_debug_keys(CTX, c_keys);
+ free(c_keys);
+
if (ret != 0)
failwith_xl(ret, "send_debug_keys");
- free(c_keys);
-
CAMLreturn(Val_unit);
}
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 29/30] libxl: ocaml: provide defaults for libxl types
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (27 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 28/30] libxl: ocaml: in send_debug_keys, clean up before raising exception Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-06-13 15:25 ` [PATCH v2 30/30] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code Rob Hoes
2013-08-22 10:21 ` libxl: ocaml: improve the bindings Rob Hoes
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
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.
The struct and keyed-union types in libxl have init functions, which
fill in the defaults for a given type. This commit provides an OCaml
interface to obtain records of defaults by calling the relevant init
function.
These default records 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:
Xenlight.Domain_create_info.({ default ctx () with
ty = Xenlight.DOMAIN_TYPE_PV;
name = Some vm_name;
uuid = vm_uuid;
})
For types with KeyedUnion fields, such as Domain_build_info, a record
with defaults is obtained by specifying the type key:
Xenlight.Domain_build_info.default ctx ~ty:Xenlight.DOMAIN_TYPE_HVM ()
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 61 +++++++++++++++++++++++++++++++++++-----
1 file changed, 54 insertions(+), 7 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 92326e1..7738b96 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -115,6 +115,7 @@ def gen_struct(ty):
def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
s = ""
+ union_type = ""
if ty.rawname is not None:
# Non-anonymous types need no special handling
@@ -154,9 +155,11 @@ def gen_ocaml_keyedunions(ty, interface, indent, parent = None):
s += " | ".join(u) + "\n"
ty.union_name = name
+ union_type = "?%s:%s" % (munge_name(nparent), ty.keyvar.type.rawname)
+
if s == "":
- return None
- return s.replace("\n", "\n%s" % indent)
+ return None, None
+ return s.replace("\n", "\n%s" % indent), union_type
def gen_ocaml_ml(ty, interface, indent=""):
@@ -184,17 +187,27 @@ def gen_ocaml_ml(ty, interface, indent=""):
s += "module %s = struct\n" % module_name
# Handle KeyedUnions...
+ union_types = []
for f in ty.fields:
- ku = gen_ocaml_keyedunions(f.type, interface, "\t")
+ ku, union_type = gen_ocaml_keyedunions(f.type, interface, "\t")
if ku is not None:
s += ku
s += "\n"
+ if union_type is not None:
+ union_types.append(union_type)
s += "\ttype t =\n"
s += "\t{\n"
s += gen_struct(ty)
s += "\t}\n"
-
+
+ if ty.init_fn is not None:
+ union_args = "".join([u + " -> " for u in union_types])
+ if interface:
+ s += "\tval default : ctx -> %sunit -> t\n" % union_args
+ else:
+ s += "\texternal default : ctx -> %sunit -> t = \"stub_libxl_%s_init\"\n" % (union_args, ty.rawname)
+
if functions.has_key(ty.rawname):
for name,args in functions[ty.rawname]:
s += "\texternal %s : " % name
@@ -422,6 +435,38 @@ def gen_c_stub_prototype(ty, fns):
s += ");\n"
return s
+def gen_c_default(ty):
+ s = "/* Get the defaults for %s */\n" % ty.rawname
+ # Handle KeyedUnions...
+ union_types = []
+ for f in ty.fields:
+ if isinstance(f.type, idl.KeyedUnion):
+ union_types.append(f.type.keyvar)
+
+ s += "value stub_libxl_%s_init(value ctx, %svalue unit)\n" % (ty.rawname,
+ "".join(["value " + u.name + ", " for u in union_types]))
+ s += "{\n"
+ s += "\tCAMLparam%d(ctx, %sunit);\n" % (len(union_types) + 2, "".join([u.name + ", " for u in union_types]))
+ s += "\tCAMLlocal1(val);\n"
+ s += "\tlibxl_%s c_val;\n" % ty.rawname
+ s += "\tlibxl_%s_init(&c_val);\n" % ty.rawname
+ for u in union_types:
+ s += "\tif (%s != Val_none) {\n" % u.name
+ s += "\t\t%s c = 0;\n" % u.type.typename
+ s += "\t\t%s_val(CTX, &c, Some_val(%s));\n" % (u.type.rawname, u.name)
+ s += "\t\tlibxl_%s_init_%s(&c_val, c);\n" % (ty.rawname, u.name)
+ s += "\t}\n"
+ s += "\tval = Val_%s(&c_val);\n" % ty.rawname
+ if ty.dispose_fn:
+ s += "\tlibxl_%s_dispose(&c_val);\n" % ty.rawname
+ s += "\tCAMLreturn(val);\n"
+ s += "}\n"
+ return s
+
+def gen_c_defaults(ty):
+ s = gen_c_default(ty)
+ return s
+
def autogen_header(open_comment, close_comment):
s = open_comment + " AUTO-GENERATED FILE DO NOT EDIT " + close_comment + "\n"
s += open_comment + " autogenerated by \n"
@@ -474,12 +519,14 @@ if __name__ == '__main__':
if ty.marshal_in():
cinc.write(gen_c_val(ty))
cinc.write("\n")
- if ty.marshal_out():
- cinc.write(gen_Val_ocaml(ty))
- cinc.write("\n")
+ cinc.write(gen_Val_ocaml(ty))
+ cinc.write("\n")
if functions.has_key(ty.rawname):
cinc.write(gen_c_stub_prototype(ty, functions[ty.rawname]))
cinc.write("\n")
+ if ty.init_fn is not None:
+ cinc.write(gen_c_defaults(ty))
+ cinc.write("\n")
#sys.stdout.write("\n")
ml.write("(* END OF AUTO-GENERATED CODE *)\n")
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* [PATCH v2 30/30] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (28 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 29/30] libxl: ocaml: provide defaults for libxl types Rob Hoes
@ 2013-06-13 15:25 ` Rob Hoes
2013-08-22 10:21 ` libxl: ocaml: improve the bindings Rob Hoes
30 siblings, 0 replies; 34+ messages in thread
From: Rob Hoes @ 2013-06-13 15:25 UTC (permalink / raw)
To: xen-devel; +Cc: Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 7738b96..e074f5e 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -341,7 +341,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None):
elif isinstance(ty, idl.Array):
s += "{\n"
s += "\t int i;\n"
- s += "\t value array_elem;\n"
+ s += "\t CAMLlocal1(array_elem);\n"
s += "\t %s = caml_alloc(%s,0);\n" % (o, parent + ty.lenvar.name)
s += "\t for(i=0; i<%s; i++) {\n" % (parent + ty.lenvar.name)
s += "\t %s\n" % ocaml_Val(ty.elem_type, "array_elem", c + "[i]", "", parent=parent)
@@ -391,7 +391,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None):
fn = "anon_field"
else:
fn = "%s_field" % ty.rawname
- s += "\tvalue %s;\n" % fn
+ s += "\tCAMLlocal1(%s);\n" % fn
s += "\n"
s += "\t%s = caml_alloc_tuple(%d);\n" % (o, len(ty.fields))
--
1.7.10.4
^ permalink raw reply related [flat|nested] 34+ messages in thread* Re: libxl: ocaml: improve the bindings
2013-06-13 15:24 libxl: ocaml: improve the bindings Rob Hoes
` (29 preceding siblings ...)
2013-06-13 15:25 ` [PATCH v2 30/30] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code Rob Hoes
@ 2013-08-22 10:21 ` Rob Hoes
2013-08-22 10:28 ` Ian Campbell
30 siblings, 1 reply; 34+ messages in thread
From: Rob Hoes @ 2013-08-22 10:21 UTC (permalink / raw)
To: xen-devel@lists.xen.org; +Cc: Ian Campbell
Hi,
I'd like to ask for the patches to the libxl OCaml bindings, which I submitted a while ago, to be considered for Xen 4.4.
I have rebased the series onto the current master branch, and there were no conflicts. The rebased version can be pulled using "git pull https://github.com/robhoes/xen.git hydrogen-upstream-v2-rebased".
Thanks,
Rob
> -----Original Message-----
> From: xen-devel-bounces@lists.xen.org [mailto:xen-devel-
> bounces@lists.xen.org] On Behalf Of Rob Hoes
> Sent: 13 June 2013 4:25 PM
> To: xen-devel@lists.xen.org
> Subject: [Xen-devel] libxl: ocaml: improve the bindings
>
> This is version 2 of this patch series to fix the OCaml binding to libxl.
>
> I believe I have addressed all the points raised by Dave Scott and Ian
> Campbell. Sorry for the delay in getting this new series out!
>
> The main changes are:
> * Several fixes to ensure the bindings play well with the OCaml GC. This
> includes properly using macros such as CAMLparam* and CAMLreturn* for
> _all_ OCaml values (even intermediate ones), and using "custom" blocks to
> encapsulate pointers to C code (including handy "finalize" functions for
> cleanup.
> * Fixes in the way KeyedUnions are handled.
> * Use the libxl init function to generate default records for libxl types.
> * Improve the functions that deal with event handling. We now have some
> higher-level functions to makes this easier as well as safer, and errors are
> translated properly.
>
> ---------
>
> 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-v2
>
> Cheers,
> Rob
>
>
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel
^ permalink raw reply [flat|nested] 34+ messages in thread