* [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
` (30 more replies)
0 siblings, 31 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell
This is a repost of 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-rebased
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 14:54 ` Ian Jackson
[not found] ` <12f36dbf-3fdc-45e8-b3c1-5194ea356197@FTLPEX01CL02.citrite.net>
2013-08-22 10:50 ` [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty Rob Hoes
` (29 subsequent siblings)
30 siblings, 2 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Ian Campbell, Rob Hoes
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 81785df..7fba2ee 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 85341a0..0b0a3eb 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] 146+ messages in thread
* [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 14:53 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct Rob Hoes
` (28 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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 0b0a3eb..027d066 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -349,7 +349,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] 146+ messages in thread
* [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 14:55 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults Rob Hoes
` (27 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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 7fba2ee..1bce4bb 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 027d066..c780a2d 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -209,6 +209,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] 146+ messages in thread
* [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (2 preceding siblings ...)
2013-08-22 10:50 ` [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 14:56 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 05/30] libxl: ocaml: fix code intended to output comments before definitions Rob Hoes
` (26 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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 c780a2d..47c925a 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)
libxl_vendor_device = Enumeration("vendor_device", [
(0, "NONE"),
--
1.7.10.4
^ permalink raw reply related [flat|nested] 146+ messages in thread
* [PATCH v2-resend 05/30] libxl: ocaml: fix code intended to output comments before definitions
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (3 preceding siblings ...)
2013-08-22 10:50 ` [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 14:57 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
` (25 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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] 146+ messages in thread
* [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator.
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (4 preceding siblings ...)
2013-08-22 10:50 ` [PATCH v2-resend 05/30] libxl: ocaml: fix code intended to output comments before definitions Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 14:59 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 07/30] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
` (24 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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] 146+ messages in thread
* [PATCH v2-resend 07/30] libxl: ocaml: avoid reserved words in type and field names.
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (5 preceding siblings ...)
2013-08-22 10:50 ` [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 15:01 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
` (23 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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] 146+ messages in thread
* [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator.
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (6 preceding siblings ...)
2013-08-22 10:50 ` [PATCH v2-resend 07/30] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 15:09 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 09/30] libxl: ocaml: add some more builtin types Rob Hoes
` (22 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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] 146+ messages in thread
* [PATCH v2-resend 09/30] libxl: ocaml: add some more builtin types.
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (7 preceding siblings ...)
2013-08-22 10:50 ` [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 15:21 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
` (21 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
* 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] 146+ messages in thread
* [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only).
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (8 preceding siblings ...)
2013-08-22 10:50 ` [PATCH v2-resend 09/30] libxl: ocaml: add some more builtin types Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 15:33 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 11/30] libxl: ocaml: allocate a long lived libxl context Rob Hoes
` (20 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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 c82a372..61a27c6 100644
--- a/.gitignore
+++ b/.gitignore
@@ -382,6 +382,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 05cb0de..bb1b67d 100644
--- a/.hgignore
+++ b/.hgignore
@@ -308,6 +308,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] 146+ messages in thread
* [PATCH v2-resend 11/30] libxl: ocaml: allocate a long lived libxl context.
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (9 preceding siblings ...)
2013-08-22 10:50 ` [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
@ 2013-08-22 10:50 ` Rob Hoes
2013-08-27 15:38 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 12/30] libxl: ocaml: switch all functions over to take a context Rob Hoes
` (19 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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] 146+ messages in thread
* [PATCH v2-resend 12/30] libxl: ocaml: switch all functions over to take a context.
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (10 preceding siblings ...)
2013-08-22 10:50 ` [PATCH v2-resend 11/30] libxl: ocaml: allocate a long lived libxl context Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 15:41 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 13/30] libxl: ocaml: propagate the libxl return error code in exceptions Rob Hoes
` (18 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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] 146+ messages in thread
* [PATCH v2-resend 13/30] libxl: ocaml: propagate the libxl return error code in exceptions
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (11 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 12/30] libxl: ocaml: switch all functions over to take a context Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 15:43 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 14/30] libxl: ocaml: make Val_defbool GC-proof Rob Hoes
` (17 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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] 146+ messages in thread
* [PATCH v2-resend 14/30] libxl: ocaml: make Val_defbool GC-proof
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (12 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 13/30] libxl: ocaml: propagate the libxl return error code in exceptions Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 15:48 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
` (16 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings.
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (13 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 14/30] libxl: ocaml: make Val_defbool GC-proof Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 15:50 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 16/30] libxl: ocaml: add META to list of generated files in Makefile Rob Hoes
` (15 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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 47c925a..4e99365 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -440,7 +440,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] 146+ messages in thread
* [PATCH v2-resend 16/30] libxl: ocaml: add META to list of generated files in Makefile
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (14 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 17:49 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 17/30] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
` (14 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 17/30] libxl: ocaml: fix the handling of enums in the bindings generator
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (15 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 16/30] libxl: ocaml: add META to list of generated files in Makefile Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 17:41 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
` (13 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (16 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 17/30] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 17:44 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 19/30] libxl: ocaml: add xen_console_read Rob Hoes
` (12 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 19/30] libxl: ocaml: add xen_console_read
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (17 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 17:46 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 20/30] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
` (11 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 20/30] libxl: ocaml: add dominfo_list and dominfo_get
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (18 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 19/30] libxl: ocaml: add xen_console_read Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 17:51 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 21/30] libxl: ocaml: implement some simple tests Rob Hoes
` (10 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 21/30] libxl: ocaml: implement some simple tests
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (19 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 20/30] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 17:52 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 22/30] libxl: ocaml: event management Rob Hoes
` (9 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, Rob Hoes
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 61a27c6..a30ff64 100644
--- a/.gitignore
+++ b/.gitignore
@@ -383,7 +383,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 bb1b67d..ee5c084 100644
--- a/.hgignore
+++ b/.hgignore
@@ -309,6 +309,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] 146+ messages in thread
* [PATCH v2-resend 22/30] libxl: ocaml: event management
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (20 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 21/30] libxl: ocaml: implement some simple tests Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-27 17:56 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 23/30] libxl: ocaml: allow device operations to be called asynchronously Rob Hoes
` (8 subsequent siblings)
30 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 23/30] libxl: ocaml: allow device operations to be called asynchronously
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (21 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 22/30] libxl: ocaml: event management Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 24/30] libxl: ocaml: add NIC helper functions Rob Hoes
` (7 subsequent siblings)
30 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 24/30] libxl: ocaml: add NIC helper functions
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (22 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 23/30] libxl: ocaml: allow device operations to be called asynchronously Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 25/30] libxl: ocaml: add PCI device " Rob Hoes
` (6 subsequent siblings)
30 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 25/30] libxl: ocaml: add PCI device helper functions
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (23 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 24/30] libxl: ocaml: add NIC helper functions Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 26/30] libxl: ocaml: add disk and cdrom " Rob Hoes
` (5 subsequent siblings)
30 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 26/30] libxl: ocaml: add disk and cdrom helper functions
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (24 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 25/30] libxl: ocaml: add PCI device " Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 27/30] libxl: ocaml: add VM lifecycle operations Rob Hoes
` (4 subsequent siblings)
30 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 27/30] libxl: ocaml: add VM lifecycle operations
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (25 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 26/30] libxl: ocaml: add disk and cdrom " Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 28/30] libxl: ocaml: in send_debug_keys, clean up before raising exception Rob Hoes
` (3 subsequent siblings)
30 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 28/30] libxl: ocaml: in send_debug_keys, clean up before raising exception
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (26 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 27/30] libxl: ocaml: add VM lifecycle operations Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 29/30] libxl: ocaml: provide defaults for libxl types Rob Hoes
` (2 subsequent siblings)
30 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 29/30] libxl: ocaml: provide defaults for libxl types
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (27 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 28/30] libxl: ocaml: in send_debug_keys, clean up before raising exception Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 30/30] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code Rob Hoes
2013-09-10 10:58 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Ian Campbell
30 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* [PATCH v2-resend 30/30] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (28 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 29/30] libxl: ocaml: provide defaults for libxl types Rob Hoes
@ 2013-08-22 10:51 ` Rob Hoes
2013-09-10 10:58 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Ian Campbell
30 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-22 10:51 UTC (permalink / raw)
To: xen-devel; +Cc: ian.campbell, 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] 146+ messages in thread
* Re: [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty
2013-08-22 10:50 ` [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty Rob Hoes
@ 2013-08-27 14:53 ` Ian Jackson
2013-08-27 14:56 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 14:53 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty"):
> This is useful when the key enum has an "invalid" option and avoids
> the need to declare a dummy struct. Use this for domain_build_info
> resulting in the generated API changing like so:
> --- tools/libxl/_libxl_BACKUP_types.h
> +++ tools/libxl/_libxl_types.h
> @@ -377,8 +377,6 @@ typedef struct libxl_domain_build_info {
> const char * features;
> libxl_defbool e820_host;
> } pv;
> - struct {
> - } invalid;
> } u;
I assume that the problem here is that the compiler rejects the empty
struct.
> - ("invalid", Struct(None, [])),
> + ("invalid", None),
Is it really necessary to do this with a special-cased new "None" type
rather than just fixing the empty structs by putting a dummy member in
them ?
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
2013-08-22 10:50 ` [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
@ 2013-08-27 14:54 ` Ian Jackson
[not found] ` <12f36dbf-3fdc-45e8-b3c1-5194ea356197@FTLPEX01CL02.citrite.net>
1 sibling, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 14:54 UTC (permalink / raw)
To: Rob Hoes; +Cc: Ian Campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN"):
> libxl_dominfo.shutdown_reason is valid iff (shutdown||dying). This is a bit
> annoying when generating language bindings since it needs all sorts of special
> casing. Just introduce an explicit value instead.
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct
2013-08-22 10:50 ` [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct Rob Hoes
@ 2013-08-27 14:55 ` Ian Jackson
2013-09-10 10:56 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 14:55 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct"):
> This allows a toolstack to find out whether a VM has booted as PV or HVM.
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults
2013-08-22 10:50 ` [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults Rob Hoes
@ 2013-08-27 14:56 ` Ian Jackson
2013-09-10 10:57 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 14:56 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults"):
> 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.
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
(I haven't double checked each of these changes against the context,
but the principle is sound.)
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty
2013-08-27 14:53 ` Ian Jackson
@ 2013-08-27 14:56 ` Ian Campbell
2013-08-27 14:59 ` Ian Jackson
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-08-27 14:56 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-08-27 at 15:53 +0100, Ian Jackson wrote:
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty"):
> > This is useful when the key enum has an "invalid" option and avoids
> > the need to declare a dummy struct. Use this for domain_build_info
> > resulting in the generated API changing like so:
> > --- tools/libxl/_libxl_BACKUP_types.h
> > +++ tools/libxl/_libxl_types.h
> > @@ -377,8 +377,6 @@ typedef struct libxl_domain_build_info {
> > const char * features;
> > libxl_defbool e820_host;
> > } pv;
> > - struct {
> > - } invalid;
> > } u;
>
> I assume that the problem here is that the compiler rejects the empty
> struct.
I don't recall exactly, but I think so.
>
> > - ("invalid", Struct(None, [])),
> > + ("invalid", None),
>
> Is it really necessary to do this with a special-cased new "None" type
> rather than just fixing the empty structs by putting a dummy member in
> them ?
I'd rather a bit of skaniness in the idl compiler than in the end user
facing eventual API.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 05/30] libxl: ocaml: fix code intended to output comments before definitions
2013-08-22 10:50 ` [PATCH v2-resend 05/30] libxl: ocaml: fix code intended to output comments before definitions Rob Hoes
@ 2013-08-27 14:57 ` Ian Jackson
2013-09-10 10:57 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 14:57 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 05/30] libxl: ocaml: fix code intended to output comments before definitions"):
> I'm not sure how useful these comments actually are but erred on the
> side of fixing rather than removing.
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty
2013-08-27 14:56 ` Ian Campbell
@ 2013-08-27 14:59 ` Ian Jackson
2013-08-27 15:04 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 14:59 UTC (permalink / raw)
To: Ian Campbell; +Cc: Rob Hoes, xen-devel
Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty"):
> On Tue, 2013-08-27 at 15:53 +0100, Ian Jackson wrote:
> > I assume that the problem here is that the compiler rejects the empty
> > struct.
>
> I don't recall exactly, but I think so.
GCC even permits them as an extension.
> > Is it really necessary to do this with a special-cased new "None" type
> > rather than just fixing the empty structs by putting a dummy member in
> > them ?
>
> I'd rather a bit of skaniness in the idl compiler than in the end user
> facing eventual API.
You are introducing skankiness not in the IDL compiler, but in the IDL
itself. I think it is better to have skankiness in some particular
language's output than in the IDL input.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator.
2013-08-22 10:50 ` [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
@ 2013-08-27 14:59 ` Ian Jackson
2013-08-27 15:06 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 14:59 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator."):
> No change in generated code because no arrays are currently generated.
This patch doesn't seem to have code for initialising, freeing, etc.,
arrays. Shouldn't it ?
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 07/30] libxl: ocaml: avoid reserved words in type and field names.
2013-08-22 10:50 ` [PATCH v2-resend 07/30] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
@ 2013-08-27 15:01 ` Ian Jackson
2013-08-29 10:29 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:01 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 07/30] libxl: ocaml: avoid reserved words in type and field names."):
> Current just s/type/ty/ and there are no such fields (yet) so no
> change to generated code.
I think this should be done in a systematic way, and one which is an
injection[1]. What if someone later introduces a field called "ty" in
the same struct as one called "type" ?
I don't know what a good convention would be in ocaml, but for example
you could prefix everything with "idl_" (including names starting "idl_").
[1] http://en.wikipedia.org/wiki/Injection_%28mathematics%29
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty
2013-08-27 14:59 ` Ian Jackson
@ 2013-08-27 15:04 ` Ian Campbell
2013-08-27 16:27 ` Ian Jackson
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-08-27 15:04 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-08-27 at 15:59 +0100, Ian Jackson wrote:
> Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty"):
> > On Tue, 2013-08-27 at 15:53 +0100, Ian Jackson wrote:
> > > I assume that the problem here is that the compiler rejects the empty
> > > struct.
> >
> > I don't recall exactly, but I think so.
>
> GCC even permits them as an extension.
I thought you meant the ocaml compiler, but of course we aren't at that
part of the series yet.
>
> > > Is it really necessary to do this with a special-cased new "None" type
> > > rather than just fixing the empty structs by putting a dummy member in
> > > them ?
> >
> > I'd rather a bit of skaniness in the idl compiler than in the end user
> > facing eventual API.
>
> You are introducing skankiness not in the IDL compiler, but in the IDL
> itself. I think it is better to have skankiness in some particular
> language's output than in the IDL input.
I think:
- ("invalid", Struct(None, [])),
+ ("invalid", None),
is reducing the amount of skank in the IDL, None has a good match with
"nothing here", while "Strict(None, [])" is just random placeholder goo,
which would be even worse if we were to artificially add a member
In hindsight I might even have gone one further and made it:
- ("invalid", Struct(None, [])),
+ ("invalid"),
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator.
2013-08-27 14:59 ` Ian Jackson
@ 2013-08-27 15:06 ` Ian Campbell
2013-08-27 15:12 ` Ian Jackson
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-08-27 15:06 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-08-27 at 15:59 +0100, Ian Jackson wrote:
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator."):
> > No change in generated code because no arrays are currently generated.
>
> This patch doesn't seem to have code for initialising, freeing, etc.,
> arrays. Shouldn't it ?
There's a calloc in there, and each element is initialised with a call
to c_val (which will already incorporate a libxl_foo_init as necessry),
the free is in the call to libxl_foo_dispose which comes from existing
bits of the bindings generator.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator.
2013-08-22 10:50 ` [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
@ 2013-08-27 15:09 ` Ian Jackson
2013-08-27 15:13 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:09 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator."):
> A KeyedUnion consists of two fields in the containing struct. First an
> enum field ("e") used as a descriminator and second a union ("u")
> containing potentially anonymous structs associated with each enum
> value.
...
> foo = Enumeration("foo", [
> (0, "BAR"),
> (1, "BAZ"),
> ])
> s = Struct("s", [
> ("u", KeyedUnion(none, foo, "blargle", [
> ("bar", Struct(...xxx...)),
> ("baz", Struct(...yyy...)),
I think you have some confusion betwwen bar,baz and foo,bar ? At
least, I hope so, as otherwise I haven't understood at all.
> 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
Is this indirection (through S.t) really needed ? It seems a bit
ugly. But I'm no expert on ocaml syntax or style.
> 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".
I'm not sure I follow this observation.
I don't intend to review the actual generator and will instead take on
trust that it does what you say :-).
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator.
2013-08-27 15:06 ` Ian Campbell
@ 2013-08-27 15:12 ` Ian Jackson
2013-08-28 14:37 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:12 UTC (permalink / raw)
To: Ian Campbell; +Cc: Rob Hoes, xen-devel
Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator."):
> On Tue, 2013-08-27 at 15:59 +0100, Ian Jackson wrote:
> > Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator."):
> > > No change in generated code because no arrays are currently generated.
> >
> > This patch doesn't seem to have code for initialising, freeing, etc.,
> > arrays. Shouldn't it ?
>
> There's a calloc in there, and each element is initialised with a call
> to c_val (which will already incorporate a libxl_foo_init as necessry),
> the free is in the call to libxl_foo_dispose which comes from existing
> bits of the bindings generator.
Oh, I see, we're just adding support for arrays in ocaml - and half of
it is already there, but unused, for some reason. How confusing.
Looking at the existing code am I right in thinking that we're just
adding support here for converting arrays from ocaml to C ?
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator.
2013-08-27 15:09 ` Ian Jackson
@ 2013-08-27 15:13 ` Ian Campbell
2013-08-27 15:20 ` Ian Jackson
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-08-27 15:13 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-08-27 at 16:09 +0100, Ian Jackson wrote:
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator."):
> > A KeyedUnion consists of two fields in the containing struct. First an
> > enum field ("e") used as a descriminator and second a union ("u")
> > containing potentially anonymous structs associated with each enum
> > value.
> ...
> > foo = Enumeration("foo", [
> > (0, "BAR"),
> > (1, "BAZ"),
> > ])
> > s = Struct("s", [
> > ("u", KeyedUnion(none, foo, "blargle", [
> > ("bar", Struct(...xxx...)),
> > ("baz", Struct(...yyy...)),
>
> I think you have some confusion betwwen bar,baz and foo,bar ? At
> least, I hope so, as otherwise I haven't understood at all.
I don't think so, foo is an enumeration with possible values of "bar"
and "baz".
The keyed union has a discriminator (called blargle in this example)
which is of type "enum foo". There is then an anonymous union with two
members, "bar" and "baz" corresponding to the possible values of
blargle.
>
> > 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
>
> Is this indirection (through S.t) really needed ? It seems a bit
> ugly. But I'm no expert on ocaml syntax or style.
It's the common idiom in ocaml, for a reason I cannot remember.
>
> > 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".
>
> I'm not sure I follow this observation.
In the type blargle__union we don't bother with the "of blargle_bar"
case of the corresponding struct is empty.
> I don't intend to review the actual generator and will instead take on
> trust that it does what you say :-).
Ack!
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator.
2013-08-27 15:13 ` Ian Campbell
@ 2013-08-27 15:20 ` Ian Jackson
2013-08-27 15:28 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:20 UTC (permalink / raw)
To: Ian Campbell; +Cc: Rob Hoes, xen-devel
Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator."):
> On Tue, 2013-08-27 at 16:09 +0100, Ian Jackson wrote:
> > I think you have some confusion betwwen bar,baz and foo,bar ? At
> > least, I hope so, as otherwise I haven't understood at all.
>
> I don't think so, foo is an enumeration with possible values of "bar"
> and "baz".
>
> The keyed union has a discriminator (called blargle in this example)
> which is of type "enum foo". There is then an anonymous union with two
> members, "bar" and "baz" corresponding to the possible values of
> blargle.
That's what I thought. So this part is wrong then ?
] We generate C:
]
] enum { FOO, BAR } foo;
] struct s {
> > Is this indirection (through S.t) really needed ? It seems a bit
> > ugly. But I'm no expert on ocaml syntax or style.
>
> It's the common idiom in ocaml, for a reason I cannot remember.
Fair enough.
> > > 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".
> >
> > I'm not sure I follow this observation.
>
> In the type blargle__union we don't bother with the "of blargle_bar"
> case of the corresponding struct is empty.
So we generate
type blargle__union = Bar of blargle_bar | Baz;
? If this is legal ocaml syntax, then fine, I guess. (I can't
remember what "of" does here.)
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 09/30] libxl: ocaml: add some more builtin types.
2013-08-22 10:50 ` [PATCH v2-resend 09/30] libxl: ocaml: add some more builtin types Rob Hoes
@ 2013-08-27 15:21 ` Ian Jackson
2013-08-28 14:52 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:21 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 09/30] libxl: ocaml: add some more builtin types."):
> Bitmap_val requires a ctx, so leave it as an abort for now.
I'm not qualified to review this patch because I'm not familiar with
the ocaml FFI, but I don't think that's a blocker for it going in.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator.
2013-08-27 15:20 ` Ian Jackson
@ 2013-08-27 15:28 ` Ian Campbell
2013-08-28 14:47 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-08-27 15:28 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-08-27 at 16:20 +0100, Ian Jackson wrote:
> Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator."):
> > On Tue, 2013-08-27 at 16:09 +0100, Ian Jackson wrote:
> > > I think you have some confusion betwwen bar,baz and foo,bar ? At
> > > least, I hope so, as otherwise I haven't understood at all.
> >
> > I don't think so, foo is an enumeration with possible values of "bar"
> > and "baz".
> >
> > The keyed union has a discriminator (called blargle in this example)
> > which is of type "enum foo". There is then an anonymous union with two
> > members, "bar" and "baz" corresponding to the possible values of
> > blargle.
>
> That's what I thought. So this part is wrong then ?
You didn't quote this part ;-)
> ] We generate C:
> ]
> ] enum { FOO, BAR } foo;
I meant "enum foo { BAR, BAZ };" here.
> > > > 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".
> > >
> > > I'm not sure I follow this observation.
> >
> > In the type blargle__union we don't bother with the "of blargle_bar"
> > case of the corresponding struct is empty.
>
> So we generate
> type blargle__union = Bar of blargle_bar | Baz;
> ? If this is legal ocaml syntax, then fine, I guess.
Not just legal but idiomatic too, I think.
> (I can't remember what "of" does here.)
I'm not sure what the proper name would be (a KeyedUnion maybe ;-)) it
means you can unpick it with:
match a_blargle with
| Bar of thing -> do stuff with the content of thing
| Baz -> do other stuff, not with thing
(modulo me not remembering the real syntax, but it's close)
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only).
2013-08-22 10:50 ` [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
@ 2013-08-27 15:33 ` Ian Jackson
2013-08-29 12:54 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:33 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only)."):
> These bindings allow ocaml code to receive log message via xentoollog
> but do not support injecting messages into xentoollog from ocaml.
> Receiving log messages from libx{c,l} and forwarding them to ocaml is
> the use case which is needed by the following patches.
...
> +type level = Debug
> + | Verbose
> + | Detail
> + | Progress
> + | Info
> + | Notice
> + | Warn
> + | Error
> + | Critical
This (and the next two stanzas too) needs to be autogenerated somehow
from the list in xentoollog.h. Otherwise people will add levels in
xentoollog.h and the ocaml code will go wrong.
> +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
Surely this can't be a good way to go about it.
(Won't this fail at least one time in 1E6 ?)
> +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
Why are you reimplementing in ocaml the stdio logging support from
xenttoollog ? Surely you'd want to simply call
xtl_createlogger_stdiostream ?
(Also, "vfoobar" is a convention used by C programmers to indicate
that a function takes a stdarg.h va_list. You probably want to call
this function "message".)
> diff --git a/tools/ocaml/libs/xentoollog/xentoollog.mli b/tools/ocaml/libs/xentoollog/xentoollog.mli
> new file mode 100644
...
> +type level =
> + | Debug
> + | Verbose
> + | Detail
> + | Progress (* also used for "progress" messages *)
> + | Info
> + | Notice
> + | Warn
> + | Error
> + | Critical
What, another copy of this ?
> 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 @@
...
> + 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! */
_Another_ copy of this!
Thanks,
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 11/30] libxl: ocaml: allocate a long lived libxl context.
2013-08-22 10:50 ` [PATCH v2-resend 11/30] libxl: ocaml: allocate a long lived libxl context Rob Hoes
@ 2013-08-27 15:38 ` Ian Jackson
2013-08-28 15:55 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:38 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 11/30] libxl: ocaml: allocate a long lived libxl context."):
> Rather than allocating a new context for every libxl call begin to
> switch to a model where a context is allocated by the caller and may
> then be used for multiple calls down into the library.
...
> @@ -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)); \
Is this in the wrong patch ?
@@ -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;
I don't understand this at all. Is it going to become local to call
this without a gc and if so what is its function in that case ?
> @@ -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);
> }
I don't understand why this hunk is in this patch, either.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 12/30] libxl: ocaml: switch all functions over to take a context.
2013-08-22 10:51 ` [PATCH v2-resend 12/30] libxl: ocaml: switch all functions over to take a context Rob Hoes
@ 2013-08-27 15:41 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:41 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 12/30] libxl: ocaml: switch all functions over to take a context."):
> Since the context has a logger we can get rid of the logger built into these
> bindings and use the xentoollog bindings instead.
This seems plausible.
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 13/30] libxl: ocaml: propagate the libxl return error code in exceptions
2013-08-22 10:51 ` [PATCH v2-resend 13/30] libxl: ocaml: propagate the libxl return error code in exceptions Rob Hoes
@ 2013-08-27 15:43 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:43 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 13/30] libxl: ocaml: propagate the libxl return error code in exceptions"):
> -(* @@LIBXL_TYPES@@ *)
> +type error =
> + Nonspecific |
> + Version |
> + Fail |
> + Ni |
> + Nomem |
> + Inval |
> + Badfail |
> + Guest_Timedout |
> + Timedout |
> + Noparavirt |
> + Not_Ready |
> + Osevent_Reg_Fail |
> + Bufferfull |
> + Unknown_Child
I'm afraid that you'll have to make the libxl error type an enum,
first, to avoid duplicating (pentuplicating(!)) all this. Otherwise
it's fine...
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 14/30] libxl: ocaml: make Val_defbool GC-proof
2013-08-22 10:51 ` [PATCH v2-resend 14/30] libxl: ocaml: make Val_defbool GC-proof Rob Hoes
@ 2013-08-27 15:48 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:48 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 14/30] libxl: ocaml: make Val_defbool GC-proof"):
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
I'm afraid I don't understand this at all. How does this make a
difference ?
(Also, these changes...
> + bool b;
> - bool b = libxl_defbool_val(c_val);
> + b = libxl_defbool_val(c_val);
... definitely don't have any purpose.)
So, the remaining key change is this:
bool b = libxl_defbool_val(c_val);
> - v = Val_some(b ? Val_bool(true) : Val_bool(false));
> + v1 = b ? Val_bool(true) : Val_bool(false);
> + v2 = Val_some(v1);
Assuming that Val_some is a function, I think this has no semantic
difference. Can you explain what the difference is ?
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings.
2013-08-22 10:51 ` [PATCH v2-resend 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
@ 2013-08-27 15:50 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 15:50 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings."):
> We now have enoguh infrastructure in place to do this trivially.
^^^^^^
This is OK (when the prerequisite patches are in). But you should fix
the typo :-).
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty
2013-08-27 15:04 ` Ian Campbell
@ 2013-08-27 16:27 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 16:27 UTC (permalink / raw)
To: Ian Campbell; +Cc: Rob Hoes, xen-devel
Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty"):
> On Tue, 2013-08-27 at 15:59 +0100, Ian Jackson wrote:
> > You are introducing skankiness not in the IDL compiler, but in the IDL
> > itself. I think it is better to have skankiness in some particular
> > language's output than in the IDL input.
>
> I think:
> - ("invalid", Struct(None, [])),
> + ("invalid", None),
>
> is reducing the amount of skank in the IDL, None has a good match with
> "nothing here", while "Strict(None, [])" is just random placeholder goo,
> which would be even worse if we were to artificially add a member
Well, I think we should keep the number of primitive types down to the
minimum possible. But I think this discussion has gone on long
enough and it's not that important:
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 17/30] libxl: ocaml: fix the handling of enums in the bindings generator
2013-08-22 10:51 ` [PATCH v2-resend 17/30] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
@ 2013-08-27 17:41 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 17:41 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 17/30] libxl: ocaml: fix the handling of enums in the bindings generator"):
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings
2013-08-22 10:51 ` [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
@ 2013-08-27 17:44 ` Ian Jackson
2013-08-28 8:30 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 17:44 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings"):
> The libxl IDL is based on C type "char *", and therefore "strings" can
> by NULL, or be an actual string. In ocaml, it is common to encode such
> things as option types.
Can you point me to the existing code this replaces ? I was looking
for "Val_string" and "String_val" but couldn't find them. I think if
that code is missing it deserves a note in the commit message at least
(and then surely this new code is currently unused?)
Thanks,
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 19/30] libxl: ocaml: add xen_console_read
2013-08-22 10:51 ` [PATCH v2-resend 19/30] libxl: ocaml: add xen_console_read Rob Hoes
@ 2013-08-27 17:46 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 17:46 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 19/30] libxl: ocaml: add xen_console_read"):
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Thanks. This code takes the console output and stores it in memory.
Is there anything here which would check that the amount of memory to
be used is reasonable ?
Do we need to worry about the lifetime of this data ? In a
garbage-collected language it might hang about.
Thanks,
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 16/30] libxl: ocaml: add META to list of generated files in Makefile
2013-08-22 10:51 ` [PATCH v2-resend 16/30] libxl: ocaml: add META to list of generated files in Makefile Rob Hoes
@ 2013-08-27 17:49 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 17:49 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 16/30] libxl: ocaml: add META to list of generated files in Makefile"):
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
> Acked-by: Ian Campbell <ian.campbell@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 20/30] libxl: ocaml: add dominfo_list and dominfo_get
2013-08-22 10:51 ` [PATCH v2-resend 20/30] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
@ 2013-08-27 17:51 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 17:51 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 20/30] libxl: ocaml: add dominfo_list and dominfo_get"):
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 21/30] libxl: ocaml: implement some simple tests
2013-08-22 10:51 ` [PATCH v2-resend 21/30] libxl: ocaml: implement some simple tests Rob Hoes
@ 2013-08-27 17:52 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 17:52 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 21/30] libxl: ocaml: implement some simple tests"):
> Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management
2013-08-22 10:51 ` [PATCH v2-resend 22/30] libxl: ocaml: event management Rob Hoes
@ 2013-08-27 17:56 ` Ian Jackson
2013-11-11 14:42 ` [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages] Ian Jackson
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-27 17:56 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml: event management"):
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Can you explain in a bit more detail how you expect to use this ?
I'm very surprised that apparently the right interface to provide is
one which exposes the poll-based event loop machinery to ocaml.
Surely it would be better to plumb that in at a lower level.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings
2013-08-27 17:44 ` Ian Jackson
@ 2013-08-28 8:30 ` Ian Campbell
2013-08-28 10:33 ` Ian Jackson
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-08-28 8:30 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-08-27 at 18:44 +0100, Ian Jackson wrote:
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings"):
> > The libxl IDL is based on C type "char *", and therefore "strings" can
> > by NULL, or be an actual string. In ocaml, it is common to encode such
> > things as option types.
>
> Can you point me to the existing code this replaces ? I was looking
> for "Val_string" and "String_val" but couldn't find them. I think if
> that code is missing it deserves a note in the commit message at least
> (and then surely this new code is currently unused?)
- "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)"),
So it is replacing uses of dup_String_val (existing function in
tools/ocaml/libs/xl/xenlight_stubs.c) and caml_copy_string (which is an
ocaml provided primitive) with newly defined String_option_val and
Val_string_option which wrap those original function with the Some/None
semantics.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings
2013-08-28 8:30 ` Ian Campbell
@ 2013-08-28 10:33 ` Ian Jackson
2013-08-28 10:41 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-08-28 10:33 UTC (permalink / raw)
To: Ian Campbell; +Cc: Rob Hoes, xen-devel
Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings"):
> On Tue, 2013-08-27 at 18:44 +0100, Ian Jackson wrote:
> > Can you point me to the existing code this replaces ? I was looking
> > for "Val_string" and "String_val" but couldn't find them. I think if
> > that code is missing it deserves a note in the commit message at least
> > (and then surely this new code is currently unused?)
>
> - "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)"),
>
> So it is replacing uses of dup_String_val (existing function in
> tools/ocaml/libs/xl/xenlight_stubs.c) and caml_copy_string (which is an
> ocaml provided primitive) with newly defined String_option_val and
> Val_string_option which wrap those original function with the Some/None
> semantics.
I was looking for "String_val", for example. Am I wrote to be looking
for that ?
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings
2013-08-28 10:33 ` Ian Jackson
@ 2013-08-28 10:41 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-08-28 10:41 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Wed, 2013-08-28 at 11:33 +0100, Ian Jackson wrote:
> Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings"):
> > On Tue, 2013-08-27 at 18:44 +0100, Ian Jackson wrote:
> > > Can you point me to the existing code this replaces ? I was looking
> > > for "Val_string" and "String_val" but couldn't find them. I think if
> > > that code is missing it deserves a note in the commit message at least
> > > (and then surely this new code is currently unused?)
> >
> > - "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)"),
> >
> > So it is replacing uses of dup_String_val (existing function in
> > tools/ocaml/libs/xl/xenlight_stubs.c) and caml_copy_string (which is an
> > ocaml provided primitive) with newly defined String_option_val and
> > Val_string_option which wrap those original function with the Some/None
> > semantics.
>
> I was looking for "String_val", for example. Am I wrote to be looking
> for that ?
The diff snippet I quoted uses dup_String_val not String_val, so yes I
think so.
The second and third elements of the tuple are the marshal/unmarshal
code for the type.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator.
2013-08-27 15:12 ` Ian Jackson
@ 2013-08-28 14:37 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-28 14:37 UTC (permalink / raw)
To: Ian Jackson, Ian Campbell; +Cc: xen-devel
> Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 06/30] libxl: ocaml:
> support for Arrays in bindings generator."):
> > On Tue, 2013-08-27 at 15:59 +0100, Ian Jackson wrote:
> > > Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 06/30] libxl: ocaml:
> support for Arrays in bindings generator."):
> > > > No change in generated code because no arrays are currently
> generated.
> > >
> > > This patch doesn't seem to have code for initialising, freeing,
> > > etc., arrays. Shouldn't it ?
> >
> > There's a calloc in there, and each element is initialised with a call
> > to c_val (which will already incorporate a libxl_foo_init as
> > necessry), the free is in the call to libxl_foo_dispose which comes
> > from existing bits of the bindings generator.
>
> Oh, I see, we're just adding support for arrays in ocaml - and half of it is
> already there, but unused, for some reason. How confusing.
>
> Looking at the existing code am I right in thinking that we're just adding
> support here for converting arrays from ocaml to C ?
That's right: the C -> OCaml conversion for arrays was already there (in the ocaml_Val function).
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator.
2013-08-27 15:28 ` Ian Campbell
@ 2013-08-28 14:47 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-28 14:47 UTC (permalink / raw)
To: Ian Campbell, Ian Jackson; +Cc: xen-devel
> You didn't quote this part ;-)
>
> > ] We generate C:
> > ]
> > ] enum { FOO, BAR } foo;
>
> I meant "enum foo { BAR, BAZ };" here.
I'll update the commit message.
> > So we generate
> > type blargle__union = Bar of blargle_bar | Baz; ? If this is
> > legal ocaml syntax, then fine, I guess.
>
> Not just legal but idiomatic too, I think.
>
> > (I can't remember what "of" does here.)
>
> I'm not sure what the proper name would be (a KeyedUnion maybe ;-)) it
> means you can unpick it with:
>
> match a_blargle with
> | Bar of thing -> do stuff with the content of thing | Baz -> do other stuff,
> not with thing
That's right. It is called a "variant type" in OCaml, and it is typically unpacked by pattern matching.
See http://caml.inria.fr/pub/docs/manual-ocaml/manual003.html#s:tut-recvariants.
Cheers,
Rob
> (modulo me not remembering the real syntax, but it's close)
>
> Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 09/30] libxl: ocaml: add some more builtin types.
2013-08-27 15:21 ` Ian Jackson
@ 2013-08-28 14:52 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-28 14:52 UTC (permalink / raw)
To: Ian Jackson; +Cc: Ian Campbell, xen-devel
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 09/30] libxl: ocaml: add
> some more builtin types."):
> > Bitmap_val requires a ctx, so leave it as an abort for now.
>
> I'm not qualified to review this patch because I'm not familiar with the
> ocaml FFI, but I don't think that's a blocker for it going in.
The Bitmap_val function is actually completed in patch 12 of this series, where the libxl context is made available.
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 11/30] libxl: ocaml: allocate a long lived libxl context.
2013-08-27 15:38 ` Ian Jackson
@ 2013-08-28 15:55 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-28 15:55 UTC (permalink / raw)
To: Ian Jackson; +Cc: Ian Campbell, xen-devel
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 11/30] libxl: ocaml:
> allocate a long lived libxl context."):
> > Rather than allocating a new context for every libxl call begin to
> > switch to a model where a context is allocated by the caller and may
> > then be used for multiple calls down into the library.
> ...
> > @@ -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)); \
>
> Is this in the wrong patch ?
>
> @@ -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;
>
> I don't understand this at all. Is it going to become local to call this without a
> gc and if so what is its function in that case ?
>
> > @@ -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); }
>
> I don't understand why this hunk is in this patch, either.
None of these hunks should be there. Both the logger and gc bits are removed entirely in the following patch, and that printf is a debugging line I forgot to remove.
I probably made some mistakes while reorganising and squashing some patches. I'll remove those hunks.
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 07/30] libxl: ocaml: avoid reserved words in type and field names.
2013-08-27 15:01 ` Ian Jackson
@ 2013-08-29 10:29 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-29 10:29 UTC (permalink / raw)
To: Ian Jackson; +Cc: Ian Campbell, xen-devel
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 07/30] libxl: ocaml: avoid
> reserved words in type and field names."):
> > Current just s/type/ty/ and there are no such fields (yet) so no
> > change to generated code.
>
> I think this should be done in a systematic way, and one which is an
> injection[1]. What if someone later introduces a field called "ty" in the
> same struct as one called "type" ?
>
> I don't know what a good convention would be in ocaml, but for example
> you could prefix everything with "idl_" (including names starting "idl_").
>
> [1] http://en.wikipedia.org/wiki/Injection_%28mathematics%29
Yes, I see what you mean. I don't really like to prefix everything, but that is mostly for aesthetic reasons. Although even an injective transformation such as prefixing isn't always safe: what if we prefix "type" to become "xl_type", and someone adds a keyword "xl_type" to OCaml?
I am not sure what the best solution would be in OCaml, but I'll ask around a bit.
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only).
2013-08-27 15:33 ` Ian Jackson
@ 2013-08-29 12:54 ` Rob Hoes
2013-08-29 13:12 ` Ian Campbell
2013-08-29 15:05 ` Ian Jackson
0 siblings, 2 replies; 146+ messages in thread
From: Rob Hoes @ 2013-08-29 12:54 UTC (permalink / raw)
To: Ian Jackson; +Cc: Ian Campbell, xen-devel
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 10/30] libxc: ocaml: add
> simple binding for xentoollog (output only)."):
> > These bindings allow ocaml code to receive log message via xentoollog
> > but do not support injecting messages into xentoollog from ocaml.
> > Receiving log messages from libx{c,l} and forwarding them to ocaml is
> > the use case which is needed by the following patches.
> ...
> > +type level = Debug
> > + | Verbose
> > + | Detail
> > + | Progress
> > + | Info
> > + | Notice
> > + | Warn
> > + | Error
> > + | Critical
>
> This (and the next two stanzas too) needs to be autogenerated somehow
> from the list in xentoollog.h. Otherwise people will add levels in
> xentoollog.h and the ocaml code will go wrong.
This would have been quite easy if the debug levels were part of the libxl IDL. Unfortunately they aren't, because xentoollog is part of libxc. So what options do we have? Adding some sort of IDL to libxc would be one. Or indeed parsing xentoollog.h to derive the log levels, but I think the risk of that going wrong due to changes in xentoollog.h may defeat its purpose.
Any update to the OCaml level type would likely require the application that uses the bindings to be modified, so some work will still be needed. Perhaps we could map any new log levels to a well-defined "unknown" value, so that the higher level OCaml code can mark them as such, signalling a need to update the bindings? At least nothing would break horribly in this way.
> > +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
>
> Surely this can't be a good way to go about it.
> (Won't this fail at least one time in 1E6 ?)
Most likely this function would be called just once, or at most a few times, in the lifetime of the application, so it won't be that bad. But it would probably be better to just use a counter instead of a random value, and raise a proper exception when we hit 1e6 (or some other larger number).
> > +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
>
> Why are you reimplementing in ocaml the stdio logging support from
> xenttoollog ? Surely you'd want to simply call
> xtl_createlogger_stdiostream ?
I suppose we could do that indeed.
> (Also, "vfoobar" is a convention used by C programmers to indicate that a
> function takes a stdarg.h va_list. You probably want to call this function
> "message".)
OK.
Rob
> > diff --git a/tools/ocaml/libs/xentoollog/xentoollog.mli
> > b/tools/ocaml/libs/xentoollog/xentoollog.mli
> > new file mode 100644
> ...
> > +type level =
> > + | Debug
> > + | Verbose
> > + | Detail
> > + | Progress (* also used for "progress" messages *)
> > + | Info
> > + | Notice
> > + | Warn
> > + | Error
> > + | Critical
>
> What, another copy of this ?
>
> > 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 @@
> ...
> > + 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! */
>
> _Another_ copy of this!
>
> Thanks,
> Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only).
2013-08-29 12:54 ` Rob Hoes
@ 2013-08-29 13:12 ` Ian Campbell
2013-08-29 15:07 ` Ian Jackson
2013-08-29 15:05 ` Ian Jackson
1 sibling, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-08-29 13:12 UTC (permalink / raw)
To: Rob Hoes; +Cc: Ian Jackson, xen-devel
On Thu, 2013-08-29 at 13:54 +0100, Rob Hoes wrote:
> > Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 10/30] libxc: ocaml: add
> > simple binding for xentoollog (output only)."):
> > > These bindings allow ocaml code to receive log message via xentoollog
> > > but do not support injecting messages into xentoollog from ocaml.
> > > Receiving log messages from libx{c,l} and forwarding them to ocaml is
> > > the use case which is needed by the following patches.
> > ...
> > > +type level = Debug
> > > + | Verbose
> > > + | Detail
> > > + | Progress
> > > + | Info
> > > + | Notice
> > > + | Warn
> > > + | Error
> > > + | Critical
> >
> > This (and the next two stanzas too) needs to be autogenerated somehow
> > from the list in xentoollog.h. Otherwise people will add levels in
> > xentoollog.h and the ocaml code will go wrong.
>
> This would have been quite easy if the debug levels were part of the
> libxl IDL. Unfortunately they aren't, because xentoollog is part of
> libxc. So what options do we have? Adding some sort of IDL to libxc
> would be one. Or indeed parsing xentoollog.h to derive the log levels,
> but I think the risk of that going wrong due to changes in
> xentoollog.h may defeat its purpose.
I think with a sufficiently large comment in the vicinity of the enum
xentoollog_level we might be able to get away with this. Realistically
that header hasn't changed since 2010 (in fact it only changed once
meaningfully since it was added!)
> Any update to the OCaml level type would likely require the
> application that uses the bindings to be modified, so some work will
> still be needed. Perhaps we could map any new log levels to a
> well-defined "unknown" value, so that the higher level OCaml code can
> mark them as such, signalling a need to update the bindings? At least
> nothing would break horribly in this way.
This sounds like a good belt and braces thing to do regardless.
> > > +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
> >
> > Surely this can't be a good way to go about it.
> > (Won't this fail at least one time in 1E6 ?)
>
> Most likely this function would be called just once, or at most a few
> times, in the lifetime of the application, so it won't be that bad.
> But it would probably be better to just use a counter instead of a
> random value, and raise a proper exception when we hit 1e6 (or some
> other larger number).
I can't imagine what I was thinking here! Perhaps I couldn't figure out
how to do the ocaml equivalent of "static int counter" so I bodged it
and forgot to come back...
I think a counter would be fine. Either that or push it onto the caller
to provide something it knows is unique, but that sucks...
> > > +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
> >
> > Why are you reimplementing in ocaml the stdio logging support from
> > xenttoollog ? Surely you'd want to simply call
> > xtl_createlogger_stdiostream ?
It was supposed to serve as a proof of concept for writing an output
module in ocaml rather than C, i.e. that the callbacks all worked right
etc. It would probably be best moved to the test app.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only).
2013-08-29 12:54 ` Rob Hoes
2013-08-29 13:12 ` Ian Campbell
@ 2013-08-29 15:05 ` Ian Jackson
1 sibling, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-29 15:05 UTC (permalink / raw)
To: Rob Hoes; +Cc: Ian Campbell, xen-devel
Rob Hoes writes ("RE: [Xen-devel] [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only)."):
> [Ian Jackson:]
> > Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 10/30] libxc: ocaml: add
> > This (and the next two stanzas too) needs to be autogenerated somehow
> > from the list in xentoollog.h. Otherwise people will add levels in
> > xentoollog.h and the ocaml code will go wrong.
>
> This would have been quite easy if the debug levels were part of the libxl IDL. Unfortunately they aren't, because xentoollog is part of libxc. So what options do we have? Adding some sort of IDL to libxc would be one. Or indeed parsing xentoollog.h to derive the log levels, but I think the risk of that going wrong due to changes in xentoollog.h may defeat its purpose.
I think we can promise not to break the syntax too badly. Please do
parse the information out of xentoollog.h.
> > > +let create name cbs : handle =
> > > + (* Callback names are supposed to be unique *)
> > > + let suffix = string_of_int (Random.int 1000000) in
> >
> > Surely this can't be a good way to go about it.
> > (Won't this fail at least one time in 1E6 ?)
>
> Most likely this function would be called just once, or at most a few times, in the lifetime of the application, so it won't be that bad. But it would probably be better to just use a counter instead of a random value, and raise a proper exception when we hit 1e6 (or some other larger number).
Yes. Or one 64-bit counter.
> > Why are you reimplementing in ocaml the stdio logging support from
> > xenttoollog ? Surely you'd want to simply call
> > xtl_createlogger_stdiostream ?
>
> I suppose we could do that indeed.
Yes :-). Unless there's some reason not to do that, that I'm missing.
Thanks,
Ia.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only).
2013-08-29 13:12 ` Ian Campbell
@ 2013-08-29 15:07 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-08-29 15:07 UTC (permalink / raw)
To: Ian Campbell; +Cc: Rob Hoes, xen-devel
Ian Campbell writes ("Re: [Xen-devel] [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only)."):
> > [Ian Jackson:]
> > > Why are you reimplementing in ocaml the stdio logging support from
> > > xenttoollog ? Surely you'd want to simply call
> > > xtl_createlogger_stdiostream ?
>
> It was supposed to serve as a proof of concept for writing an output
> module in ocaml rather than C, i.e. that the callbacks all worked right
> etc. It would probably be best moved to the test app.
That makes sense.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
[not found] ` <12f36dbf-3fdc-45e8-b3c1-5194ea356197@FTLPEX01CL02.citrite.net>
@ 2013-09-10 10:55 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-09-10 10:55 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, Ian Campbell, xen-devel
On Tue, 2013-08-27 at 10:54 -0400, Ian Jackson wrote:
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN"):
> > libxl_dominfo.shutdown_reason is valid iff (shutdown||dying). This is a bit
> > annoying when generating language bindings since it needs all sorts of special
> > casing. Just introduce an explicit value instead.
>
> Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Applied, thanks.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct
2013-08-27 14:55 ` Ian Jackson
@ 2013-09-10 10:56 ` Ian Campbell
2013-09-10 11:00 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-09-10 10:56 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-08-27 at 15:55 +0100, Ian Jackson wrote:
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct"):
> > This allows a toolstack to find out whether a VM has booted as PV or HVM.
>
> Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Applied.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults
2013-08-27 14:56 ` Ian Jackson
@ 2013-09-10 10:57 ` Ian Campbell
2013-09-10 11:02 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-09-10 10:57 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-08-27 at 15:56 +0100, Ian Jackson wrote:
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults"):
> > 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.
>
> Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Applied.
>
> (I haven't double checked each of these changes against the context,
> but the principle is sound.)
>
> Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 05/30] libxl: ocaml: fix code intended to output comments before definitions
2013-08-27 14:57 ` Ian Jackson
@ 2013-09-10 10:57 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-09-10 10:57 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-08-27 at 15:57 +0100, Ian Jackson wrote:
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 05/30] libxl: ocaml: fix code intended to output comments before definitions"):
> > I'm not sure how useful these comments actually are but erred on the
> > side of fixing rather than removing.
>
> Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Applied.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
` (29 preceding siblings ...)
2013-08-22 10:51 ` [PATCH v2-resend 30/30] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code Rob Hoes
@ 2013-09-10 10:58 ` Ian Campbell
2013-09-10 11:02 ` Rob Hoes
30 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-09-10 10:58 UTC (permalink / raw)
To: Rob Hoes; +Cc: xen-devel
On Thu, 2013-08-22 at 11:50 +0100, Rob Hoes wrote:
> This is a repost of version 2 of this patch series to fix the OCaml binding to libxl.
I picked a few acked patches off the front of this series before I got
into unacked territory and stopped. I did:
a65b5d3 libxl: ocaml: fix code intended to output comments before definitions
0b157d9 libxl: idl: complete some enums in the IDL with their defaults
60dd846 libxl: idl: add domain_type field to libxl_dominfo struct
8bf5d27 libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
Which I think were #1, and #3-#5. #2 was unacked.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct
2013-09-10 10:56 ` Ian Campbell
@ 2013-09-10 11:00 ` Ian Campbell
2013-09-10 11:03 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-09-10 11:00 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-09-10 at 11:56 +0100, Ian Campbell wrote:
> On Tue, 2013-08-27 at 15:55 +0100, Ian Jackson wrote:
> > Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct"):
> > > This allows a toolstack to find out whether a VM has booted as PV or HVM.
> >
> > Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
>
> Applied.
Although in hindsight this needed a #define LIBXL_HAVE_FOO in libxl.h.
#define LIBXL_DOMINFO_HAVE_DOMAINTYPE.
Could you follow up with a suitable patch, or add it to the head of the
next posting of the series? See libxl.h for some existing examples.
Thanks,
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults
2013-09-10 10:57 ` Ian Campbell
@ 2013-09-10 11:02 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-09-10 11:02 UTC (permalink / raw)
To: Ian Jackson; +Cc: Rob Hoes, xen-devel
On Tue, 2013-09-10 at 11:57 +0100, Ian Campbell wrote:
> On Tue, 2013-08-27 at 15:56 +0100, Ian Jackson wrote:
> > Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults"):
> > > 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.
> >
> > Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
>
> Applied.
I think we don't need a raft of LIBXL_HAVE defines in this case, the
addition is really for the benefit of autogenerated language bindings,
anyone using C who cares about supporting older APIs would just use 0
and not do:
#ifdef LIBXL_HAVE_A_THING
enum thing foo = LIBXL_HAVE_A_THING
#else
num thing foo = 0;
#endif
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings
2013-09-10 10:58 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Ian Campbell
@ 2013-09-10 11:02 ` Rob Hoes
2013-09-10 12:57 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-09-10 11:02 UTC (permalink / raw)
To: Ian Campbell; +Cc: xen-devel
Thanks! I think IanJ also acked #2 after some discussion on 27 Aug.
I'll process the remaining issues that came up soon.
Cheers,
Rob
> -----Original Message-----
> From: Ian Campbell
> Sent: 10 September 2013 11:58 AM
> To: Rob Hoes
> Cc: xen-devel@lists.xen.org
> Subject: Re: [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings
>
> On Thu, 2013-08-22 at 11:50 +0100, Rob Hoes wrote:
> > This is a repost of version 2 of this patch series to fix the OCaml binding to
> libxl.
>
> I picked a few acked patches off the front of this series before I got into
> unacked territory and stopped. I did:
>
> a65b5d3 libxl: ocaml: fix code intended to output comments before
> definitions
> 0b157d9 libxl: idl: complete some enums in the IDL with their defaults
> 60dd846 libxl: idl: add domain_type field to libxl_dominfo struct
> 8bf5d27 libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN
>
> Which I think were #1, and #3-#5. #2 was unacked.
>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct
2013-09-10 11:00 ` Ian Campbell
@ 2013-09-10 11:03 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-09-10 11:03 UTC (permalink / raw)
To: Ian Campbell, Ian Jackson; +Cc: xen-devel
> > Applied.
>
> Although in hindsight this needed a #define LIBXL_HAVE_FOO in libxl.h.
> #define LIBXL_DOMINFO_HAVE_DOMAINTYPE.
>
> Could you follow up with a suitable patch, or add it to the head of the next
> posting of the series? See libxl.h for some existing examples.
Sure, I'll do that.
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings
2013-09-10 11:02 ` Rob Hoes
@ 2013-09-10 12:57 ` Ian Campbell
2013-09-10 13:06 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-09-10 12:57 UTC (permalink / raw)
To: Rob Hoes; +Cc: xen-devel
On Tue, 2013-09-10 at 12:02 +0100, Rob Hoes wrote:
> Thanks! I think IanJ also acked #2 after some discussion on 27 Aug.
So he did. I'll try and remember that when I do another pas through my
queue.
> I'll process the remaining issues that came up soon.
Thanks! There are some important dates in
http://article.gmane.org/gmane.comp.emulators.xen.devel/168132 wrt code
freezes etc. Do you think we can hit 4.4 with this stuff?
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings
2013-09-10 12:57 ` Ian Campbell
@ 2013-09-10 13:06 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-09-10 13:06 UTC (permalink / raw)
To: Ian Campbell; +Cc: xen-devel
> Thanks! There are some important dates in
> http://article.gmane.org/gmane.comp.emulators.xen.devel/168132 wrt
> code freezes etc. Do you think we can hit 4.4 with this stuff?
Yep. I think it would be quite bad if we won't...
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* [PATCH v4 00/27] libxl: ocaml: improve the bindings
@ 2013-11-06 17:49 Rob Hoes
2013-11-06 17:49 ` [PATCH v4 01/27] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
` (27 more replies)
0 siblings, 28 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell
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
XenServer). 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.
This is version 4 of this patch series to fix the OCaml binding to libxl. See
the individual patches for detailed changes with respect to v3.
For convenience, the patches in this series may be pulled using:
git pull git://github.com/robhoes/xen.git hydrogen-upstream-v4
^ permalink raw reply [flat|nested] 146+ messages in thread
* [PATCH v4 01/27] libxl: ocaml: support for Arrays in bindings generator.
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 02/27] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
` (26 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
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>
Acked-by: David Scott <dave.scott@eu.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] 146+ messages in thread
* [PATCH v4 02/27] libxl: ocaml: avoid reserved words in type and field names.
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
2013-11-06 17:49 ` [PATCH v4 01/27] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-11 14:17 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 03/27] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
` (25 subsequent siblings)
27 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Do this by adding a "xl_" prefix to all names that are OCaml keywords.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
v4: Prefix only OCaml keywords.
---
tools/ocaml/libs/xl/genwrap.py | 15 ++++++++++++++-
1 file changed, 14 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 1b68b6b..bdac6e9 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -70,8 +70,21 @@ def ocaml_type_of(ty):
else:
return ty.rawname
+ocaml_keywords = ['and', 'as', 'assert', 'begin', 'end', 'class', 'constraint',
+ 'do', 'done', 'downto', 'else', 'if', 'end', 'exception', 'external', 'false',
+ 'for', 'fun', 'function', 'functor', 'if', 'in', 'include', 'inherit',
+ 'initializer', 'lazy', 'let', 'match', 'method', 'module', 'mutable', 'new',
+ 'object', 'of', 'open', 'or', 'private', 'rec', 'sig', 'struct', 'then', 'to',
+ 'true', 'try', 'type', 'val', 'virtual', 'when', 'while', 'with']
+
+def munge_name(name):
+ if name in ocaml_keywords:
+ return "xl_" + name
+ 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] 146+ messages in thread
* [PATCH v4 03/27] libxl: ocaml: support for KeyedUnion in the bindings generator.
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
2013-11-06 17:49 ` [PATCH v4 01/27] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
2013-11-06 17:49 ` [PATCH v4 02/27] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 04/27] libxl: ocaml: add some more builtin types Rob Hoes
` (24 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
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, BAZ };
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>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
tools/libxl/idl.py | 3 +
tools/ocaml/libs/xl/genwrap.py | 162 +++++++++++++++++++++++++++++++++++-----
2 files changed, 147 insertions(+), 18 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 bdac6e9..f98d686 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:
@@ -83,8 +85,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=""):
@@ -110,16 +171,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):
@@ -172,12 +234,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:
@@ -199,7 +292,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):
@@ -239,9 +332,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))
@@ -253,8 +379,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] 146+ messages in thread
* [PATCH v4 04/27] libxl: ocaml: add some more builtin types.
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (2 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 03/27] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 05/27] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
` (23 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
* bitmaps
* string_list
* key_value_list
* cpuid_policy_list (left "empty" for now)
None of these are used yet, so no change to the generated code.
Bitmap_val requires a ctx, so leave it as an abort for now.
Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
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 f98d686..1e956ab 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] 146+ messages in thread
* [PATCH v4 05/27] libxc: ocaml: add simple binding for xentoollog (output only).
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (3 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 04/27] libxl: ocaml: add some more builtin types Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-11 15:30 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 06/27] libxl: ocaml: allocate a long lived libxl context Rob Hoes
` (22 subsequent siblings)
27 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
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>
Acked-by: David Scott <dave.scott@eu.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 | 61 ++++++++
tools/ocaml/libs/xentoollog/caml_xentoollog.h | 24 +++
tools/ocaml/libs/xentoollog/genlevels.py | 127 +++++++++++++++
tools/ocaml/libs/xentoollog/xentoollog.ml.in | 48 ++++++
tools/ocaml/libs/xentoollog/xentoollog.mli.in | 43 ++++++
tools/ocaml/libs/xentoollog/xentoollog_stubs.c | 196 ++++++++++++++++++++++++
tools/ocaml/test/Makefile | 28 ++++
tools/ocaml/test/xtl.ml | 40 +++++
14 files changed, 576 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 100755 tools/ocaml/libs/xentoollog/genlevels.py
create mode 100644 tools/ocaml/libs/xentoollog/xentoollog.ml.in
create mode 100644 tools/ocaml/libs/xentoollog/xentoollog.mli.in
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 3253675..f51c345 100644
--- a/.gitignore
+++ b/.gitignore
@@ -384,6 +384,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 05cb0de..bb1b67d 100644
--- a/.hgignore
+++ b/.hgignore
@@ -308,6 +308,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..e535ba5
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/Makefile
@@ -0,0 +1,61 @@
+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
+
+GENERATED_FILES += xentoollog.ml xentoollog.ml.tmp xentoollog.mli xentoollog.mli.tmp
+GENERATED_FILES += _xtl_levels.mli.in _xtl_levels.ml.in _xtl_levels.inc META
+
+all: $(INTF) $(LIBS)
+
+xentoollog.ml: xentoollog.ml.in _xtl_levels.ml.in
+ $(Q)sed -e '1i\
+(*\
+ * AUTO-GENERATED FILE DO NOT EDIT\
+ * Generated from xentoollog.ml.in and _xtl_levels.ml.in\
+ *)\
+' \
+ -e '/^(\* @@XTL_LEVELS@@ \*)$$/r_xtl_levels.ml.in' \
+ < xentoollog.ml.in > xentoollog.ml.tmp
+ $(Q)mv xentoollog.ml.tmp xentoollog.ml
+
+xentoollog.mli: xentoollog.mli.in _xtl_levels.mli.in
+ $(Q)sed -e '1i\
+(*\
+ * AUTO-GENERATED FILE DO NOT EDIT\
+ * Generated from xentoollog.mli.in and _xtl_levels.mli.in\
+ *)\
+' \
+ -e '/^(\* @@XTL_LEVELS@@ \*)$$/r_xtl_levels.mli.in' \
+ < xentoollog.mli.in > xentoollog.mli.tmp
+ $(Q)mv xentoollog.mli.tmp xentoollog.mli
+
+libs: $(LIBS)
+
+_xtl_levels.ml.in _xtl_levels.mli.in _xtl_levels.inc: genlevels.py $(XEN_ROOT)/tools/libxc/xentoollog.h
+ $(PYTHON) genlevels.py _xtl_levels.mli.in _xtl_levels.ml.in _xtl_levels.inc
+
+.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/genlevels.py b/tools/ocaml/libs/xentoollog/genlevels.py
new file mode 100755
index 0000000..6b42f21
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/genlevels.py
@@ -0,0 +1,127 @@
+#!/usr/bin/python
+
+import sys
+
+def read_levels():
+ f = open('../../../libxc/xentoollog.h', 'r')
+
+ levels = []
+ record = False
+ for l in f.readlines():
+ if 'XTL_NUM_LEVELS' in l:
+ break
+ if record == True:
+ levels.append(l.split(',')[0].strip())
+ if 'XTL_NONE' in l:
+ record = True
+
+ f.close()
+
+ olevels = [level[4:].capitalize() for level in levels]
+
+ return levels, olevels
+
+# .ml
+
+def gen_ml(olevels):
+ s = ""
+
+ s += "type level = \n"
+ for level in olevels:
+ s += '\t| %s\n' % level
+
+ s += "\nlet level_to_string level =\n"
+ s += "\tmatch level with\n"
+ for level in olevels:
+ s += '\t| %s -> "%s"\n' % (level, level)
+
+ s += "\nlet level_to_prio level =\n"
+ s += "\tmatch level with\n"
+ for index,level in enumerate(olevels):
+ s += '\t| %s -> %d\n' % (level, index)
+
+ return s
+
+# .mli
+
+def gen_mli(olevels):
+ s = ""
+
+ s += "type level = \n"
+ for level in olevels:
+ s += '\t| %s\n' % level
+
+ return s
+
+# .c
+
+def gen_c(level):
+ s = ""
+
+ s += "static value Val_level(xentoollog_level c_level)\n"
+ s += "{\n"
+ s += "\tswitch (c_level) {\n"
+ s += "\tcase XTL_NONE: /* Not a real value */\n"
+ s += '\t\tcaml_raise_sys_error(caml_copy_string("Val_level XTL_NONE"));\n'
+ s += "\t\tbreak;\n"
+
+ for index,level in enumerate(levels):
+ s += "\tcase %s:\n\t\treturn Val_int(%d);\n" % (level, index)
+
+ s += """\tcase XTL_NUM_LEVELS: /* Not a real value! */
+ \t\tcaml_raise_sys_error(
+ \t\t\tcaml_copy_string("Val_level XTL_NUM_LEVELS"));
+ #if 0 /* Let the compiler catch this */
+ \tdefault:
+ \t\tcaml_raise_sys_error(caml_copy_string("Val_level Unknown"));
+ \t\tbreak;
+ #endif
+ \t}
+ \tabort();
+ }
+ """
+
+ 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"
+ s += reduce(lambda x,y: x + " ", range(len(open_comment + " ")), "")
+ s += "%s" % " ".join(sys.argv)
+ s += "\n " + close_comment + "\n\n"
+ return s
+
+if __name__ == '__main__':
+ if len(sys.argv) < 3:
+ print >>sys.stderr, "Usage: genlevels.py <mli> <ml> <c-inc>"
+ sys.exit(1)
+
+ levels, olevels = read_levels()
+
+ _mli = sys.argv[1]
+ mli = open(_mli, 'w')
+ mli.write(autogen_header("(*", "*)"))
+
+ _ml = sys.argv[2]
+ ml = open(_ml, 'w')
+ ml.write(autogen_header("(*", "*)"))
+
+ _cinc = sys.argv[3]
+ cinc = open(_cinc, 'w')
+ cinc.write(autogen_header("/*", "*/"))
+
+ mli.write(gen_mli(olevels))
+ mli.write("\n")
+
+ ml.write(gen_ml(olevels))
+ ml.write("\n")
+
+ cinc.write(gen_c(levels))
+ cinc.write("\n")
+
+ ml.write("(* END OF AUTO-GENERATED CODE *)\n")
+ ml.close()
+ mli.write("(* END OF AUTO-GENERATED CODE *)\n")
+ mli.close()
+ cinc.close()
+
diff --git a/tools/ocaml/libs/xentoollog/xentoollog.ml.in b/tools/ocaml/libs/xentoollog/xentoollog.ml.in
new file mode 100644
index 0000000..ce9ea1d
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog.ml.in
@@ -0,0 +1,48 @@
+(*
+ * 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
+
+(* @@XTL_LEVELS@@ *)
+
+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 counter = ref 0L
+
+let create name cbs : handle =
+ (* Callback names are supposed to be unique *)
+ let suffix = Int64.to_string !counter in
+ counter := Int64.succ !counter;
+ 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)
+
diff --git a/tools/ocaml/libs/xentoollog/xentoollog.mli.in b/tools/ocaml/libs/xentoollog/xentoollog.mli.in
new file mode 100644
index 0000000..05c098a
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog.mli.in
@@ -0,0 +1,43 @@
+(*
+ * 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.
+ *)
+
+(* @@XTL_LEVELS@@ *)
+
+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
+
diff --git a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
new file mode 100644
index 0000000..3b2f91b
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
@@ -0,0 +1,196 @@
+/*
+ * 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;
+}
+
+#include "_xtl_levels.inc"
+
+/* 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..db30aae
--- /dev/null
+++ b/tools/ocaml/test/xtl.ml
@@ -0,0 +1,40 @@
+open Arg
+open Printf
+open Xentoollog
+
+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
+
+let do_test level =
+ let lgr = create_stdio_logger ~level:level () in
+ begin
+ test lgr;
+ end
+
+let () =
+ let debug_level = ref Info in
+ let speclist = [
+ ("-v", Arg.Unit (fun () -> debug_level := Debug), "Verbose");
+ ("-q", Arg.Unit (fun () -> debug_level := 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] 146+ messages in thread
* [PATCH v4 06/27] libxl: ocaml: allocate a long lived libxl context.
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (4 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 05/27] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 07/27] libxl: ocaml: switch all functions over to take a context Rob Hoes
` (21 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
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>
Acked-by: David Scott <dave.scott@eu.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 | 37 ++++++++++++++++++++++++++++++++++
5 files changed, 49 insertions(+)
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 4195bfc..0408cc2 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..c26226f 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;
@@ -97,6 +103,37 @@ static void failwith_xl(char *fname, struct caml_logger *lg)
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] 146+ messages in thread
* [PATCH v4 07/27] libxl: ocaml: switch all functions over to take a context.
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (5 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 06/27] libxl: ocaml: allocate a long lived libxl context Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 08/27] libxl: idl: add Enumeration.value_namespace property Rob Hoes
` (20 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
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>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Acked-by: David Scott <dave.scott@eu.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 | 474 +++++++++-------------------------
4 files changed, 153 insertions(+), 385 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 1e956ab..bdae886 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):
@@ -236,7 +236,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"
@@ -249,7 +249,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"
@@ -265,7 +265,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 += "}"
@@ -278,14 +278,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"
@@ -334,7 +334,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
@@ -363,7 +363,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"
@@ -388,14 +388,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 c26226f..dd6c781 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -35,47 +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; \
- 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;
@@ -83,24 +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();
- 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;
- 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)
@@ -126,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;
@@ -134,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;
@@ -154,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);
@@ -165,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;
@@ -203,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;
@@ -213,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);
@@ -269,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;
@@ -300,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)
@@ -321,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;
@@ -375,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);
@@ -630,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] 146+ messages in thread
* [PATCH v4 08/27] libxl: idl: add Enumeration.value_namespace property
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (6 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 07/27] libxl: ocaml: switch all functions over to take a context Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-11 14:31 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 09/27] libxl: make the libxl error type an IDL enum Rob Hoes
` (19 subsequent siblings)
27 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
This allows setting the namespace for values of an Enumeration to be different
from the namespace of the Enumeration itself.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
tools/libxl/idl.py | 5 ++++-
tools/libxl/idl.txt | 7 +++++++
2 files changed, 11 insertions(+), 1 deletion(-)
diff --git a/tools/libxl/idl.py b/tools/libxl/idl.py
index f4908dd..e4dc79b 100644
--- a/tools/libxl/idl.py
+++ b/tools/libxl/idl.py
@@ -136,7 +136,7 @@ class EnumerationValue(object):
self.valuename = str.upper(name)
self.rawname = str.upper(enum.rawname) + "_" + self.valuename
- self.name = str.upper(enum.namespace) + self.rawname
+ self.name = str.upper(enum.value_namespace) + self.rawname
self.value = value
class Enumeration(Type):
@@ -144,6 +144,9 @@ class Enumeration(Type):
kwargs.setdefault('dispose_fn', None)
Type.__init__(self, typename, **kwargs)
+ self.value_namespace = kwargs.setdefault('value_namespace',
+ self.namespace)
+
self.values = []
for v in values:
# (value, name)
diff --git a/tools/libxl/idl.txt b/tools/libxl/idl.txt
index 019acbe..439aede 100644
--- a/tools/libxl/idl.txt
+++ b/tools/libxl/idl.txt
@@ -90,6 +90,13 @@ Complex type-Classes
idl.Enumeration
A class representing an enumeration (named integer values).
+ This class has one property besides the ones defined for the Type
+ class:
+
+ Enumeration.value_namespace: (default: namespace)
+
+ The namespace in which the values of the Enumeration (see below) reside.
+ This prefix is prepended to the name of the value.
The values are available in the list Enumeration.values. Each
element in the list is of type idl.EnumerationValue.
--
1.7.10.4
^ permalink raw reply related [flat|nested] 146+ messages in thread
* [PATCH v4 09/27] libxl: make the libxl error type an IDL enum
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (7 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 08/27] libxl: idl: add Enumeration.value_namespace property Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-11 14:31 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 10/27] libxl: ocaml: generate string_of_* functions for enums Rob Hoes
` (18 subsequent siblings)
27 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
This makes it easier to use in language bindings.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
v4: Use value_namespace from previous patch.
---
tools/libxl/libxl.h | 18 ------------------
tools/libxl/libxl_types.idl | 17 +++++++++++++++++
2 files changed, 17 insertions(+), 18 deletions(-)
diff --git a/tools/libxl/libxl.h b/tools/libxl/libxl.h
index 1c6675d..9379694 100644
--- a/tools/libxl/libxl.h
+++ b/tools/libxl/libxl.h
@@ -459,24 +459,6 @@ typedef struct libxl__ctx libxl_ctx;
const libxl_version_info* libxl_get_version_info(libxl_ctx *ctx);
-enum {
- ERROR_NONSPECIFIC = -1,
- ERROR_VERSION = -2,
- ERROR_FAIL = -3,
- ERROR_NI = -4,
- ERROR_NOMEM = -5,
- ERROR_INVAL = -6,
- ERROR_BADFAIL = -7,
- ERROR_GUEST_TIMEDOUT = -8,
- ERROR_TIMEDOUT = -9,
- ERROR_NOPARAVIRT = -10,
- ERROR_NOT_READY = -11,
- ERROR_OSEVENT_REG_FAIL = -12,
- ERROR_BUFFERFULL = -13,
- ERROR_UNKNOWN_CHILD = -14,
-};
-
-
/*
* Some libxl operations can take a long time. These functions take a
* parameter to control their concurrency:
diff --git a/tools/libxl/libxl_types.idl b/tools/libxl/libxl_types.idl
index 5c43d6f..c43c5b1 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -28,6 +28,23 @@ MemKB = UInt(64, init_val = "LIBXL_MEMKB_DEFAULT")
# Constants / Enumerations
#
+libxl_error = Enumeration("error", [
+ (-1, "NONSPECIFIC"),
+ (-2, "VERSION"),
+ (-3, "FAIL"),
+ (-4, "NI"),
+ (-5, "NOMEM"),
+ (-6, "INVAL"),
+ (-7, "BADFAIL"),
+ (-8, "GUEST_TIMEDOUT"),
+ (-9, "TIMEDOUT"),
+ (-10, "NOPARAVIRT"),
+ (-11, "NOT_READY"),
+ (-12, "OSEVENT_REG_FAIL"),
+ (-13, "BUFFERFULL"),
+ (-14, "UNKNOWN_CHILD"),
+ ], value_namespace = "")
+
libxl_domain_type = Enumeration("domain_type", [
(-1, "INVALID"),
(1, "HVM"),
--
1.7.10.4
^ permalink raw reply related [flat|nested] 146+ messages in thread
* [PATCH v4 10/27] libxl: ocaml: generate string_of_* functions for enums
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (8 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 09/27] libxl: make the libxl error type an IDL enum Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-11 14:33 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 11/27] libxl: ocaml: propagate the libxl return error code in exceptions Rob Hoes
` (17 subsequent siblings)
27 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
v4: Now using v.valuename, as suggested by Ian.
---
tools/ocaml/libs/xl/genwrap.py | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index bdae886..0f73e26 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -162,6 +162,14 @@ def gen_ocaml_ml(ty, interface, indent=""):
s += "type %s = \n" % ty.rawname
for v in ty.values:
s += "\t | %s\n" % v.rawname
+
+ if interface:
+ s += "\nval string_of_%s : %s -> string\n" % (ty.rawname, ty.rawname)
+ else:
+ s += "\nlet string_of_%s = function\n" % ty.rawname
+ for v in ty.values:
+ s += '\t| %s -> "%s"\n' % (v.rawname, v.valuename)
+
elif isinstance(ty, idl.Aggregate):
s += ""
--
1.7.10.4
^ permalink raw reply related [flat|nested] 146+ messages in thread
* [PATCH v4 11/27] libxl: ocaml: propagate the libxl return error code in exceptions
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (9 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 10/27] libxl: ocaml: generate string_of_* functions for enums Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 12/27] libxl: ocaml: make Val_defbool GC-proof Rob Hoes
` (16 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
tools/ocaml/libs/xl/genwrap.py | 10 +++----
tools/ocaml/libs/xl/xenlight.ml.in | 10 +++++--
tools/ocaml/libs/xl/xenlight.mli.in | 9 ++++--
tools/ocaml/libs/xl/xenlight_stubs.c | 50 ++++++++++++++++++++++++----------
4 files changed, 55 insertions(+), 24 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 0f73e26..e072386 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -244,7 +244,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"
@@ -257,7 +257,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"
@@ -273,7 +273,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 += "}"
@@ -342,7 +342,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
@@ -371,7 +371,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..a281425 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -13,18 +13,22 @@
* GNU Lesser General Public License for more details.
*)
-exception Error of string
-
type ctx
type domid = int
type devid = int
(* @@LIBXL_TYPES@@ *)
+exception Error of (error * string)
+
external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+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"
-let _ = Callback.register_exception "Xenlight.Error" (Error(""))
+let register_exceptions () =
+ Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""))
+
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in
index e2686bb..d663196 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -13,16 +13,21 @@
* GNU Lesser General Public License for more details.
*)
-exception Error of string
-
type ctx
type domid = int
type devid = int
(* @@LIBXL_TYPES@@ *)
+exception Error of (error * string)
+
+val register_exceptions: unit -> unit
+
external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
+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"
+
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index dd6c781..67612f4 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -47,12 +47,34 @@ static char * dup_String_val(value s)
return c;
}
-static void failwith_xl(char *fname)
+/* Forward reference: this is defined in the auto-generated include file below. */
+static value Val_error (libxl_error error_c);
+
+static void failwith_xl(int error, char *fname)
{
- value *exc = caml_named_value("Xenlight.Error");
+ 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 +100,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 +268,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 +364,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 +390,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 +409,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 +436,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 +458,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 +475,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 +488,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 +503,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] 146+ messages in thread
* [PATCH v4 12/27] libxl: ocaml: make Val_defbool GC-proof
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (10 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 11/27] libxl: ocaml: propagate the libxl return error code in exceptions Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 13/27] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
` (15 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
In order to avoid newly created OCaml values from being GC'ed, they must be
registered as roots with the GC, before an iteration of the GC may happen. The
Val_* functions potentially allocate new values on the OCaml heap, and may
trigger an iteration of the OCaml GC.
The way to register a value with the GC is to assign it to a variable declared
with a CAMLparam or CAMLlocal macro, which put the value into a struct that
can be reached from a GC root.
This leads to slightly weird looking C code, but avoids hard to find segfaults.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
v4: Updated the commit message a little.
---
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 67612f4..94601c4 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -308,15 +308,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] 146+ messages in thread
* [PATCH v4 13/27] libxl: ocaml: add domain_build/create_info/config and events to the bindings.
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (11 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 12/27] libxl: ocaml: make Val_defbool GC-proof Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 14/27] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
` (14 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
We now have enough 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>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Acked-by: David Scott <dave.scott@eu.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 c43c5b1..ce003c6 100644
--- a/tools/libxl/libxl_types.idl
+++ b/tools/libxl/libxl_types.idl
@@ -464,7 +464,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 e072386..4206c87 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -441,11 +441,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] 146+ messages in thread
* [PATCH v4 14/27] libxl: ocaml: fix the handling of enums in the bindings generator
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (12 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 13/27] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 15/27] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
` (13 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Acked-by: David Scott <dave.scott@eu.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 4206c87..5a3fd8d 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -340,7 +340,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] 146+ messages in thread
* [PATCH v4 15/27] libxl: ocaml: use the "string option" type for IDL strings
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (13 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 14/27] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 16/27] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
` (12 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, 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>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@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 5a3fd8d..3d939d6 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 94601c4..372ce8f 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -347,6 +347,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] 146+ messages in thread
* [PATCH v4 16/27] libxl: ocaml: add dominfo_list and dominfo_get
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (14 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 15/27] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 17/27] libxl: ocaml: implement some simple tests Rob Hoes
` (11 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Acked-by: David Scott <dave.scott@eu.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 3d939d6..7a22b20 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 372ce8f..a6b4294 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -450,6 +450,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] 146+ messages in thread
* [PATCH v4 17/27] libxl: ocaml: implement some simple tests
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (15 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 16/27] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 18/27] libxl: ocaml: event management Rob Hoes
` (10 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
.gitignore | 3 ++-
.hgignore | 2 ++
tools/ocaml/test/Makefile | 30 ++++++++++++++++++++++++++----
tools/ocaml/test/list_domains.ml | 28 ++++++++++++++++++++++++++++
tools/ocaml/test/raise_exception.ml | 11 +++++++++++
tools/ocaml/test/send_debug_keys.ml | 15 +++++++++++++++
6 files changed, 84 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 f51c345..88a8c75 100644
--- a/.gitignore
+++ b/.gitignore
@@ -385,7 +385,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 bb1b67d..ee5c084 100644
--- a/.hgignore
+++ b/.hgignore
@@ -309,6 +309,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..8387d43 100644
--- a/tools/ocaml/test/Makefile
+++ b/tools/ocaml/test/Makefile
@@ -2,12 +2,16 @@ XEN_ROOT = $(CURDIR)/../../..
OCAML_TOPLEVEL = $(CURDIR)/..
include $(OCAML_TOPLEVEL)/common.make
+CFLAGS += $(CFLAGS_libxenlight)
+LIBS_xenlight = $(LDLIBS_libxenlight)
+
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 +19,25 @@ 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
+
+send_debug_keys_OBJS = xtl send_debug_keys
+
+list_domains_LIBS = \
+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+list_domains_OBJS = xtl list_domains
+
+raise_exception_LIBS = \
+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+raise_exception_OBJS = raise_exception
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
all: $(PROGRAMS)
diff --git a/tools/ocaml/test/list_domains.ml b/tools/ocaml/test/list_domains.ml
new file mode 100644
index 0000000..c82d40d
--- /dev/null
+++ b/tools/ocaml/test/list_domains.ml
@@ -0,0 +1,28 @@
+open Arg
+open Printf
+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 = Xtl.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..b9cd61e
--- /dev/null
+++ b/tools/ocaml/test/send_debug_keys.ml
@@ -0,0 +1,15 @@
+open Arg
+open Printf
+open Xenlight
+
+let send_keys ctx s =
+ printf "Sending debug key %s\n" s;
+ Xenlight.send_debug_keys ctx s;
+ ()
+
+let _ =
+ let logger = Xtl.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] 146+ messages in thread
* [PATCH v4 18/27] libxl: ocaml: event management
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (16 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 17/27] libxl: ocaml: implement some simple tests Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
2013-11-06 17:49 ` [PATCH v4 19/27] libxl: ocaml: allow device operations to be called asynchronously Rob Hoes
` (9 subsequent siblings)
27 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
tools/ocaml/libs/xl/xenlight.ml.in | 66 +++++++
tools/ocaml/libs/xl/xenlight.mli.in | 47 +++++
tools/ocaml/libs/xl/xenlight_stubs.c | 325 ++++++++++++++++++++++++++++++++++
3 files changed, 438 insertions(+)
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in
index a281425..9eba5d7 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -25,10 +25,76 @@ 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). *)
+
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"
+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 register_exceptions () =
Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""))
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in
index d663196..28e0eb2 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -27,7 +27,54 @@ 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). *)
+
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"
+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 a6b4294..f4ea8ab 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)))
@@ -370,6 +372,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)
@@ -574,6 +596,309 @@ value stub_xl_send_debug_keys(value ctx, value keys)
CAMLreturn(Val_unit);
}
+
+/* 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, 4);
+ 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] 146+ messages in thread
* [PATCH v4 19/27] libxl: ocaml: allow device operations to be called asynchronously
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (17 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 18/27] libxl: ocaml: event management Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 20/27] libxl: ocaml: add NIC helper functions Rob Hoes
` (8 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@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 7a22b20..dc69074 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 f4ea8ab..7dd1918 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -396,15 +396,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] 146+ messages in thread
* [PATCH v4 20/27] libxl: ocaml: add NIC helper functions
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (18 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 19/27] libxl: ocaml: allow device operations to be called asynchronously Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-11 14:43 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 21/27] libxl: ocaml: add PCI device " Rob Hoes
` (7 subsequent siblings)
27 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
v4: Added libxl_device_nic_dispose.
---
tools/ocaml/libs/xl/genwrap.py | 5 ++++-
tools/ocaml/libs/xl/xenlight_stubs.c | 39 ++++++++++++++++++++++++++++++++++
2 files changed, 43 insertions(+), 1 deletion(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index dc69074..8291cdb 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 7dd1918..3495c8e 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -433,6 +433,45 @@ 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);
+ CAMLlocal1(nic);
+ libxl_device_nic c_nic;
+ libxl_devid_to_device_nic(CTX, Int_val(domid), Int_val(devid), &c_nic);
+ nic = Val_device_nic(&c_nic);
+ libxl_device_nic_dispose(&c_nic);
+ CAMLreturn(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] 146+ messages in thread
* [PATCH v4 21/27] libxl: ocaml: add PCI device helper functions
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (19 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 20/27] libxl: ocaml: add NIC helper functions Rob Hoes
@ 2013-11-06 17:49 ` Rob Hoes
2013-11-06 17:50 ` [PATCH v4 22/27] libxl: ocaml: add disk and cdrom " Rob Hoes
` (6 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:49 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@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 8291cdb..320a6e0 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 3495c8e..e67e499 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -472,6 +472,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] 146+ messages in thread
* [PATCH v4 22/27] libxl: ocaml: add disk and cdrom helper functions
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (20 preceding siblings ...)
2013-11-06 17:49 ` [PATCH v4 21/27] libxl: ocaml: add PCI device " Rob Hoes
@ 2013-11-06 17:50 ` Rob Hoes
2013-11-11 14:44 ` Ian Campbell
2013-11-06 17:50 ` [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations Rob Hoes
` (5 subsequent siblings)
27 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
v4: Added libxl_device_disk_dispose.
---
tools/ocaml/libs/xl/genwrap.py | 17 +++++++-----
tools/ocaml/libs/xl/xenlight_stubs.c | 50 ++++++++++++++++++++++++++++++----
2 files changed, 55 insertions(+), 12 deletions(-)
diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index 320a6e0..7a9f498 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 e67e499..2c2b3fd 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -395,7 +395,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) \
{ \
@@ -411,7 +411,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); \
@@ -423,15 +423,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)
{
@@ -472,6 +473,45 @@ 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);
+ CAMLlocal1(disk);
+ libxl_device_disk c_disk;
+ libxl_vdev_to_device_disk(CTX, Int_val(domid), String_val(vdev), &c_disk);
+ disk = Val_device_disk(&c_disk);
+ libxl_device_disk_dispose(&c_disk);
+ CAMLreturn(disk);
+}
+
value stub_xl_device_pci_list(value ctx, value domid)
{
CAMLparam2(ctx, domid);
--
1.7.10.4
^ permalink raw reply related [flat|nested] 146+ messages in thread
* [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (21 preceding siblings ...)
2013-11-06 17:50 ` [PATCH v4 22/27] libxl: ocaml: add disk and cdrom " Rob Hoes
@ 2013-11-06 17:50 ` Rob Hoes
2013-11-11 14:50 ` Ian Campbell
2013-11-12 14:18 ` Ian Campbell
2013-11-06 17:50 ` [PATCH v4 24/27] libxl: ocaml: in send_debug_keys, clean up before raising exception Rob Hoes
` (4 subsequent siblings)
27 siblings, 2 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Also, reorganise toplevel OCaml functions into modules of Xenlight.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
v4:
* Remove wait_shutdown and related functions.
* Factor out ao_how setup.
---
tools/ocaml/libs/xl/xenlight.ml.in | 21 ++++-
tools/ocaml/libs/xl/xenlight.mli.in | 21 ++++-
tools/ocaml/libs/xl/xenlight_stubs.c | 157 ++++++++++++++++++++++++++++++++--
tools/ocaml/test/send_debug_keys.ml | 2 +-
4 files changed, 188 insertions(+), 13 deletions(-)
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in
index 9eba5d7..f04e75f 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -33,9 +33,24 @@ type event =
| POLLHUP (* Device has been disconnected (revents only) *)
| POLLNVAL (* Invalid request: fd not open (revents only). *)
-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"
+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 * Domain_restore_params.t) ->
+ ?async:'a -> unit -> domid = "stub_libxl_domain_create_restore"
+ external shutdown : ctx -> domid -> unit = "stub_libxl_domain_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"
+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 28e0eb2..2fadaf7 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -35,9 +35,24 @@ type event =
| POLLHUP (* Device has been disconnected (revents only) *)
| POLLNVAL (* Invalid request: fd not open (revents only). *)
-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"
+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 * Domain_restore_params.t) ->
+ ?async:'a -> unit -> domid = "stub_libxl_domain_create_restore"
+ external shutdown : ctx -> domid -> unit = "stub_libxl_domain_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"
+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 2c2b3fd..9997944 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -392,6 +392,156 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
caml_callback2(*func, error, (value) for_callback);
}
+static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how *ao_how)
+{
+ CAMLparam1(async);
+
+ if (async != Val_none) {
+ ao_how->callback = async_callback;
+ ao_how->u.for_callback = (void *) Some_val(async);
+ CAMLreturnT(libxl_asyncop_how *, ao_how);
+ }
+ else
+ CAMLreturnT(libxl_asyncop_how *, NULL);
+}
+
+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;
+
+ 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,
+ aohow_val(async, &ao_how), 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 params,
+ value async, value unit)
+{
+ CAMLparam5(ctx, domain_config, params, async, unit);
+ int ret;
+ libxl_domain_config c_dconfig;
+ libxl_domain_restore_params c_params;
+ uint32_t c_domid;
+ libxl_asyncop_how ao_how;
+
+ 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");
+ }
+
+ libxl_domain_restore_params_init(&c_params);
+ ret = domain_restore_params_val(CTX, &c_params, Field(params, 1));
+ if (ret != 0) {
+ libxl_domain_restore_params_dispose(&c_params);
+ failwith_xl(ret, "domain_create_restore");
+ }
+
+ ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, Int_val(Field(params, 0)),
+ &c_params, aohow_val(async, &ao_how), NULL);
+
+ libxl_domain_config_dispose(&c_dconfig);
+ libxl_domain_restore_params_dispose(&c_params);
+
+ if (ret != 0)
+ failwith_xl(ret, "domain_create_restore");
+
+ CAMLreturn(Val_int(c_domid));
+}
+
+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;
+
+ ret = libxl_domain_destroy(CTX, Int_val(domid), aohow_val(async, &ao_how));
+ 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;
+
+ ret = libxl_domain_suspend(CTX, Int_val(domid), Int_val(fd), 0,
+ aohow_val(async, &ao_how));
+ 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)
@@ -406,13 +556,8 @@ value stub_xl_device_##type##_##op(value ctx, value info, value domid, \
\
device_##type##_val(CTX, &c_info, info); \
\
- if (async != Val_none) { \
- ao_how.callback = async_callback; \
- ao_how.u.for_callback = (void *) Some_val(async); \
- } \
- \
ret = libxl_##fn##_##op(CTX, Int_val(domid), &c_info, \
- async != Val_none ? &ao_how : NULL); \
+ aohow_val(async, &ao_how)); \
\
libxl_device_##type##_dispose(&c_info); \
\
diff --git a/tools/ocaml/test/send_debug_keys.ml b/tools/ocaml/test/send_debug_keys.ml
index b9cd61e..2cca322 100644
--- a/tools/ocaml/test/send_debug_keys.ml
+++ b/tools/ocaml/test/send_debug_keys.ml
@@ -4,7 +4,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] 146+ messages in thread
* [PATCH v4 24/27] libxl: ocaml: in send_debug_keys, clean up before raising exception
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (22 preceding siblings ...)
2013-11-06 17:50 ` [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations Rob Hoes
@ 2013-11-06 17:50 ` Rob Hoes
2013-11-06 17:50 ` [PATCH v4 25/27] libxl: ocaml: provide defaults for libxl types Rob Hoes
` (3 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@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 9997944..1212cfb 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -910,11 +910,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] 146+ messages in thread
* [PATCH v4 25/27] libxl: ocaml: provide defaults for libxl types
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (23 preceding siblings ...)
2013-11-06 17:50 ` [PATCH v4 24/27] libxl: ocaml: in send_debug_keys, clean up before raising exception Rob Hoes
@ 2013-11-06 17:50 ` Rob Hoes
2013-11-06 17:50 ` [PATCH v4 26/27] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code Rob Hoes
` (2 subsequent siblings)
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, 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>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@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 7a9f498..5c478e1 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -122,6 +122,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
@@ -161,9 +162,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=""):
@@ -199,17 +202,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
@@ -437,6 +450,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"
@@ -489,12 +534,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] 146+ messages in thread
* [PATCH v4 26/27] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (24 preceding siblings ...)
2013-11-06 17:50 ` [PATCH v4 25/27] libxl: ocaml: provide defaults for libxl types Rob Hoes
@ 2013-11-06 17:50 ` Rob Hoes
2013-11-06 17:50 ` [PATCH v4 27/27] libxl: ocaml: add console reader functions Rob Hoes
2013-11-11 15:47 ` [PATCH v4 00/27] libxl: ocaml: improve the bindings Ian Campbell
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@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 5c478e1..5e43831 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -356,7 +356,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)
@@ -406,7 +406,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] 146+ messages in thread
* [PATCH v4 27/27] libxl: ocaml: add console reader functions
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (25 preceding siblings ...)
2013-11-06 17:50 ` [PATCH v4 26/27] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code Rob Hoes
@ 2013-11-06 17:50 ` Rob Hoes
2013-11-11 15:47 ` [PATCH v4 00/27] libxl: ocaml: improve the bindings Ian Campbell
27 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-06 17:50 UTC (permalink / raw)
To: xen-devel; +Cc: ian.jackson, ian.campbell, Rob Hoes
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
tools/ocaml/libs/xl/xenlight.ml.in | 10 ++++-
tools/ocaml/libs/xl/xenlight.mli.in | 7 ++++
tools/ocaml/libs/xl/xenlight_stubs.c | 68 ++++++++++++++++++++++++++++++++++
tools/ocaml/test/Makefile | 12 ++++--
tools/ocaml/test/dmesg.ml | 18 +++++++++
5 files changed, 111 insertions(+), 4 deletions(-)
create mode 100644 tools/ocaml/test/dmesg.ml
diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in
index f04e75f..dcd30df 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -49,6 +49,13 @@ module Domain = struct
end
module Host = struct
+ type console_reader
+ exception End_of_file
+
+ external xen_console_read_start : ctx -> int -> console_reader = "stub_libxl_xen_console_read_start"
+ external xen_console_read_line : ctx -> console_reader -> string = "stub_libxl_xen_console_read_line"
+ external xen_console_read_finish : ctx -> console_reader -> unit = "stub_libxl_xen_console_read_finish"
+
external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
end
@@ -111,5 +118,6 @@ module Async = functor (S: EVENT_USERS) -> struct
end
let register_exceptions () =
- Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""))
+ Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""));
+ Callback.register_exception "Xenlight.Host.End_of_file" (Host.End_of_file)
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in
index 2fadaf7..8f93651 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -51,6 +51,13 @@ module Domain : sig
end
module Host : sig
+ type console_reader
+ exception End_of_file
+
+ external xen_console_read_start : ctx -> int -> console_reader = "stub_libxl_xen_console_read_start"
+ external xen_console_read_line : ctx -> console_reader -> string = "stub_libxl_xen_console_read_line"
+ external xen_console_read_finish : ctx -> console_reader -> unit = "stub_libxl_xen_console_read_finish"
+
external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
end
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 1212cfb..88cca20 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -918,6 +918,74 @@ value stub_xl_send_debug_keys(value ctx, value keys)
CAMLreturn(Val_unit);
}
+static struct custom_operations libxl_console_reader_custom_operations = {
+ "libxl_console_reader_custom_operations",
+ custom_finalize_default,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+};
+
+#define Console_reader_val(x)(*((libxl_xen_console_reader **) Data_custom_val(x)))
+
+value stub_libxl_xen_console_read_start(value ctx, value clear)
+{
+ CAMLparam2(ctx, clear);
+ CAMLlocal1(handle);
+ libxl_xen_console_reader *cr;
+
+ cr = libxl_xen_console_read_start(CTX, Int_val(clear));
+
+ handle = caml_alloc_custom(&libxl_console_reader_custom_operations, sizeof(cr), 0, 1);
+ Console_reader_val(handle) = cr;
+
+ CAMLreturn(handle);
+}
+
+static void raise_eof(void)
+{
+ static value *exc = NULL;
+
+ /* First time around, lookup by name */
+ if (!exc)
+ exc = caml_named_value("Xenlight.Host.End_of_file");
+
+ if (!exc)
+ caml_invalid_argument("Exception Xenlight.Host.End_of_file not initialized, please link xenlight.cma");
+
+ caml_raise_constant(*exc);
+}
+
+value stub_libxl_xen_console_read_line(value ctx, value reader)
+{
+ CAMLparam2(ctx, reader);
+ CAMLlocal1(line);
+ int ret;
+ char *c_line;
+ libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
+
+ ret = libxl_xen_console_read_line(CTX, cr, &c_line);
+
+ if (ret < 0)
+ failwith_xl(ret, "xen_console_read_line");
+ if (ret == 0)
+ raise_eof();
+
+ line = caml_copy_string(c_line);
+
+ CAMLreturn(line);
+}
+
+value stub_libxl_xen_console_read_finish(value ctx, value reader)
+{
+ CAMLparam2(ctx, reader);
+ libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
+
+ libxl_xen_console_read_finish(CTX, cr);
+
+ CAMLreturn(Val_unit);
+}
/* Event handling */
diff --git a/tools/ocaml/test/Makefile b/tools/ocaml/test/Makefile
index 8387d43..e6ba865 100644
--- a/tools/ocaml/test/Makefile
+++ b/tools/ocaml/test/Makefile
@@ -9,9 +9,9 @@ OCAMLINCLUDE += \
-I $(OCAML_TOPLEVEL)/libs/xentoollog \
-I $(OCAML_TOPLEVEL)/libs/xl
-OBJS = xtl send_debug_keys list_domains raise_exception
+OBJS = xtl send_debug_keys list_domains raise_exception dmesg
-PROGRAMS = xtl send_debug_keys list_domains raise_exception
+PROGRAMS = xtl send_debug_keys list_domains raise_exception dmesg
xtl_LIBS = \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
@@ -37,7 +37,13 @@ raise_exception_LIBS = \
raise_exception_OBJS = raise_exception
-OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
+dmesg_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
+
+dmesg_OBJS = xtl dmesg
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception dmesg
all: $(PROGRAMS)
diff --git a/tools/ocaml/test/dmesg.ml b/tools/ocaml/test/dmesg.ml
new file mode 100644
index 0000000..864fac4
--- /dev/null
+++ b/tools/ocaml/test/dmesg.ml
@@ -0,0 +1,18 @@
+open Printf
+
+let _ =
+ Xenlight.register_exceptions ();
+ let logger = Xtl.create_stdio_logger ~level:Xentoollog.Debug () in
+ let ctx = Xenlight.ctx_alloc logger in
+
+ let open Xenlight.Host in
+ let reader = xen_console_read_start ctx 0 in
+ (try
+ while true do
+ let line = xen_console_read_line ctx reader in
+ print_string line
+ done
+ with End_of_file -> ());
+ let _ = xen_console_read_finish ctx reader in
+ ()
+
--
1.7.10.4
^ permalink raw reply related [flat|nested] 146+ messages in thread
* Re: [PATCH v4 02/27] libxl: ocaml: avoid reserved words in type and field names.
2013-11-06 17:49 ` [PATCH v4 02/27] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
@ 2013-11-11 14:17 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 14:17 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:49 +0000, Rob Hoes wrote:
> Do this by adding a "xl_" prefix to all names that are OCaml keywords.
>
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 08/27] libxl: idl: add Enumeration.value_namespace property
2013-11-06 17:49 ` [PATCH v4 08/27] libxl: idl: add Enumeration.value_namespace property Rob Hoes
@ 2013-11-11 14:31 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 14:31 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:49 +0000, Rob Hoes wrote:
> This allows setting the namespace for values of an Enumeration to be different
> from the namespace of the Enumeration itself.
>
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
> ---
> tools/libxl/idl.py | 5 ++++-
> tools/libxl/idl.txt | 7 +++++++
> 2 files changed, 11 insertions(+), 1 deletion(-)
>
> diff --git a/tools/libxl/idl.py b/tools/libxl/idl.py
> index f4908dd..e4dc79b 100644
> --- a/tools/libxl/idl.py
> +++ b/tools/libxl/idl.py
> @@ -136,7 +136,7 @@ class EnumerationValue(object):
>
> self.valuename = str.upper(name)
> self.rawname = str.upper(enum.rawname) + "_" + self.valuename
> - self.name = str.upper(enum.namespace) + self.rawname
> + self.name = str.upper(enum.value_namespace) + self.rawname
> self.value = value
>
> class Enumeration(Type):
> @@ -144,6 +144,9 @@ class Enumeration(Type):
> kwargs.setdefault('dispose_fn', None)
> Type.__init__(self, typename, **kwargs)
>
> + self.value_namespace = kwargs.setdefault('value_namespace',
> + self.namespace)
> +
> self.values = []
> for v in values:
> # (value, name)
> diff --git a/tools/libxl/idl.txt b/tools/libxl/idl.txt
> index 019acbe..439aede 100644
> --- a/tools/libxl/idl.txt
> +++ b/tools/libxl/idl.txt
> @@ -90,6 +90,13 @@ Complex type-Classes
> idl.Enumeration
>
> A class representing an enumeration (named integer values).
> + This class has one property besides the ones defined for the Type
> + class:
> +
> + Enumeration.value_namespace: (default: namespace)
> +
> + The namespace in which the values of the Enumeration (see below) reside.
> + This prefix is prepended to the name of the value.
>
> The values are available in the list Enumeration.values. Each
> element in the list is of type idl.EnumerationValue.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 09/27] libxl: make the libxl error type an IDL enum
2013-11-06 17:49 ` [PATCH v4 09/27] libxl: make the libxl error type an IDL enum Rob Hoes
@ 2013-11-11 14:31 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 14:31 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:49 +0000, Rob Hoes wrote:
> This makes it easier to use in language bindings.
>
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 10/27] libxl: ocaml: generate string_of_* functions for enums
2013-11-06 17:49 ` [PATCH v4 10/27] libxl: ocaml: generate string_of_* functions for enums Rob Hoes
@ 2013-11-11 14:33 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 14:33 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:49 +0000, Rob Hoes wrote:
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
> Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by:Ian Campbell <ian.campbell@citrix.com>
>
> ---
> v4: Now using v.valuename, as suggested by Ian.
> ---
> tools/ocaml/libs/xl/genwrap.py | 8 ++++++++
> 1 file changed, 8 insertions(+)
>
> diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
> index bdae886..0f73e26 100644
> --- a/tools/ocaml/libs/xl/genwrap.py
> +++ b/tools/ocaml/libs/xl/genwrap.py
> @@ -162,6 +162,14 @@ def gen_ocaml_ml(ty, interface, indent=""):
> s += "type %s = \n" % ty.rawname
> for v in ty.values:
> s += "\t | %s\n" % v.rawname
> +
> + if interface:
> + s += "\nval string_of_%s : %s -> string\n" % (ty.rawname, ty.rawname)
> + else:
> + s += "\nlet string_of_%s = function\n" % ty.rawname
> + for v in ty.values:
> + s += '\t| %s -> "%s"\n' % (v.rawname, v.valuename)
> +
> elif isinstance(ty, idl.Aggregate):
> s += ""
>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-08-27 17:56 ` Ian Jackson
@ 2013-11-11 14:42 ` Ian Jackson
2013-11-11 15:39 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-11-11 14:42 UTC (permalink / raw)
To: Rob Hoes, xen-devel, ian.campbell
Rob Hoes writes ("[PATCH v4 18/27] libxl: ocaml: event management"):
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
> Acked-by: David Scott <dave.scott@eu.citrix.com>
> ---
> tools/ocaml/libs/xl/xenlight.ml.in | 66 +++++++
> tools/ocaml/libs/xl/xenlight.mli.in | 47 +++++
> tools/ocaml/libs/xl/xenlight_stubs.c | 325 ++++++++++++++++++++++++++++++++++
I replied to v2 of this as follows:
Ian Jackson writes ("Re: [Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml: event management"):
> Can you explain in a bit more detail how you expect to use this ?
>
> I'm very surprised that apparently the right interface to provide is
> one which exposes the poll-based event loop machinery to ocaml.
> Surely it would be better to plumb that in at a lower level.
But I haven't had an answer.
I think that whether this is the right approach depends on how event
loops are traditionally done in ocaml.
I'm afraid, though, that in the absence of an explanation:
Nacked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Thanks,
Ian.
PS Does anyone here know how Mirage handles event loops ?
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 20/27] libxl: ocaml: add NIC helper functions
2013-11-06 17:49 ` [PATCH v4 20/27] libxl: ocaml: add NIC helper functions Rob Hoes
@ 2013-11-11 14:43 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 14:43 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:49 +0000, Rob Hoes wrote:
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
> Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 22/27] libxl: ocaml: add disk and cdrom helper functions
2013-11-06 17:50 ` [PATCH v4 22/27] libxl: ocaml: add disk and cdrom " Rob Hoes
@ 2013-11-11 14:44 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 14:44 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:50 +0000, Rob Hoes wrote:
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
> Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
2013-11-06 17:50 ` [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations Rob Hoes
@ 2013-11-11 14:50 ` Ian Campbell
2013-11-11 15:54 ` Rob Hoes
2013-11-12 14:18 ` Ian Campbell
1 sibling, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 14:50 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:50 +0000, Rob Hoes wrote:
> + if (async != Val_none) {
> + ao_how->callback = async_callback;
> + ao_how->u.for_callback = (void *) Some_val(async);
> + CAMLreturnT(libxl_asyncop_how *, ao_how);
> + }
> + else
> + CAMLreturnT(libxl_asyncop_how *, NULL);
This doesn't appear to be in my caml headers on Debian Wheezy
(3.12.1-4). A random hit on google
http://docs.camlcity.org/docs/godisrc/oasis-ocaml-fd-1.1.1.tar.gz/ocaml-fd-1.1.1/lib/fd_stubs.c suggests this was new in 3.09.4 so why don't I have it?
We would really like to keep this stuff working with some of the more
common distro's stable versions of ocaml, so if this is really missing
then perhaps a compat version would be needed?
WTF is it doing anyway? Something to do with this C struct pointer
containing a Value?
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 05/27] libxc: ocaml: add simple binding for xentoollog (output only).
2013-11-06 17:49 ` [PATCH v4 05/27] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
@ 2013-11-11 15:30 ` Ian Campbell
2013-11-12 13:46 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 15:30 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:49 +0000, Rob Hoes wrote:
> +xtl_LIBS = \
> + -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
> + -cclib -lxenctrl
Sadly:
/usr/bin/ld: cannot find -lxenctrl
collect2: error: ld returned 1 exit status
File "caml_startup", line 1, characters 0-1:
Error: Error during linking
You need to be using LDLIBS_libxenlight and CFLAGS_libxenlight etc like
the tools/ocaml/libs/xl/Makefile does. On your system you are probably
linking locally against the library in /usr/lib etc which is not
desired...
I'm part way through applying this series, so what I'm going to try and
do is drop the test case from this patch and the patch which adds some
more later. Ones the dust has settled please can you send a separate
patch (or patches) to readd these tests.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-11 14:42 ` [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages] Ian Jackson
@ 2013-11-11 15:39 ` Rob Hoes
2013-11-12 14:56 ` Ian Jackson
0 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-11 15:39 UTC (permalink / raw)
To: Ian Jackson, xen-devel, Ian Campbell
> I replied to v2 of this as follows:
>
> Ian Jackson writes ("Re: [Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml:
> event management"):
> > Can you explain in a bit more detail how you expect to use this ?
> >
> > I'm very surprised that apparently the right interface to provide is
> > one which exposes the poll-based event loop machinery to ocaml.
> > Surely it would be better to plumb that in at a lower level.
>
> But I haven't had an answer.
Sorry, I had missed this... :(
> I think that whether this is the right approach depends on how event loops
> are traditionally done in ocaml.
Having bindings to the low-level functions libxl_osevent_register_hooks and related, allows us to run an event loop in OCaml; either one we write ourselves, or one that is available elsewhere.
We are currently running a straightforward, custom event loop in xenopsd. It simply maintains a list of fds and timeouts, and runs poll in a loop, as you would expect (see https://github.com/xapi-project/xenopsd/blob/master/xl/xenlight_events.ml for the full code).
The Lwt cooperative threads library (http://ocsigen.org/lwt/), which is quite popular these days, has an event loop that can be easily extended to poll any additional fds that we get from libxl. Lwt provides a "lightweight" threading model, which does not let you run any other (POSIX) threads in your application, and therefore excludes an event loop implemented in the C bindings. We have not ported xenopsd to use Lwt yet, but there were plans to do so in future.
Exposing the low-level event hooks in OCaml gives us the choice to implement either of the above options.
> I'm afraid, though, that in the absence of an explanation:
>
> Nacked-by: Ian Jackson <ian.jackson@eu.citrix.com>
>
> Thanks,
> Ian.
>
> PS Does anyone here know how Mirage handles event loops ?
I believe Mirage uses Lwt, and therefore probably uses its event loop.
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 00/27] libxl: ocaml: improve the bindings
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
` (26 preceding siblings ...)
2013-11-06 17:50 ` [PATCH v4 27/27] libxl: ocaml: add console reader functions Rob Hoes
@ 2013-11-11 15:47 ` Ian Campbell
2013-11-12 11:28 ` Rob Hoes
27 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 15:47 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:49 +0000, Rob Hoes wrote:
> 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
> XenServer). 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.
>
> This is version 4 of this patch series to fix the OCaml binding to libxl. See
> the individual patches for detailed changes with respect to v3.
I have now applied #1..#16
6ea2941 libxl: ocaml: support for Arrays in bindings generator.
842b59e libxl: ocaml: avoid reserved words in type and field names.
98caa06 libxl: ocaml: support for KeyedUnion in the bindings generator.
a6efa2e libxl: ocaml: add some more builtin types.
80e18cd libxc: ocaml: add simple binding for xentoollog (output only).
06722d7 libxl: ocaml: allocate a long lived libxl context.
974d108 libxl: ocaml: switch all functions over to take a context.
e06ac98 libxl: idl: add Enumeration.value_namespace property
b37a126 libxl: make the libxl error type an IDL enum
56799c5 libxl: ocaml: generate string_of_* functions for enums
67c8b33 libxl: ocaml: propagate the libxl return error code in exceptions
999dce0 libxl: ocaml: make Val_defbool GC-proof
4ca3004 libxl: ocaml: add domain_build/create_info/config and events to the bi
1bb2c5e libxl: ocaml: fix the handling of enums in the bindings generator
21b9ec6 libxl: ocaml: use the "string option" type for IDL strings
bf7fddd libxl: ocaml: add dominfo_list and dominfo_get
Note that in #5 (add simple binding for xentoollog (output only)) I
dropped the little test case. You have mail on the subject..
#17 (implement some simple tests) skipped due to changes in add simple
binding for xentoollog (output only).
Ian J has nacked #18 (in a reply to the v2-resend thread).
#19 (allow device operations to be called asynchronously) appears to
rely on #18
#20..21 seemed ok:
01237a2 libxl: ocaml: add NIC helper functions
73d1b47 libxl: ocaml: add PCI device helper functions
#22 (add disk and cdrom helper functions) failed after I dropped #19.
I had a comment on #23 so I skipped it but then I was able to apply #24..#26:
d8a276f libxl: ocaml: in send_debug_keys, clean up before raising exception
dc189b1 libxl: ocaml: provide defaults for libxl types
4cc845e libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code
#27 "add console reader functions" failed to apply. I suspect it needed
something prior to it, at least contextually.
At least, this is what I think I've done, it was a bit fluid as I
dropped one or two bits. git rebase should tell you the true story!
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
2013-11-11 14:50 ` Ian Campbell
@ 2013-11-11 15:54 ` Rob Hoes
2013-11-11 15:58 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-11 15:54 UTC (permalink / raw)
To: Ian Campbell; +Cc: Ian Jackson, xen-devel
> On Wed, 2013-11-06 at 17:50 +0000, Rob Hoes wrote:
> > + if (async != Val_none) {
> > + ao_how->callback = async_callback;
> > + ao_how->u.for_callback = (void *) Some_val(async);
> > + CAMLreturnT(libxl_asyncop_how *, ao_how);
> > + }
> > + else
> > + CAMLreturnT(libxl_asyncop_how *, NULL);
>
> This doesn't appear to be in my caml headers on Debian Wheezy (3.12.1-4).
> A random hit on google http://docs.camlcity.org/docs/godisrc/oasis-ocaml-
> fd-1.1.1.tar.gz/ocaml-fd-1.1.1/lib/fd_stubs.c suggests this was new in 3.09.4
> so why don't I have it?
That's very odd... I am just doing what is advised on http://caml.inria.fr/pub/docs/manual-ocaml-312/manual032.html#toc14, which is the official documentation for OCaml 3.12.
> We would really like to keep this stuff working with some of the more
> common distro's stable versions of ocaml, so if this is really missing then
> perhaps a compat version would be needed?
I'll see if I can find out more...
> WTF is it doing anyway? Something to do with this C struct pointer
> containing a Value?
The docs say:
"The macros CAMLreturn, CAMLreturn0, and CAMLreturnT are used to replace the C keyword return. Every occurence of return x must be replaced by CAMLreturn (x) if x has type value, or CAMLreturnT (t, x) (where t is the type of x); every occurence of return without argument must be replaced by CAMLreturn0. If your C function is a procedure (i.e. if it returns void), you must insert CAMLreturn0 at the end (to replace C’s implicit return)."
My compiler complained when I initially tried to use just CAMLreturn().
Rob
_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xen.org
http://lists.xen.org/xen-devel
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
2013-11-11 15:54 ` Rob Hoes
@ 2013-11-11 15:58 ` Ian Campbell
2013-11-12 12:27 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-11-11 15:58 UTC (permalink / raw)
To: Rob Hoes; +Cc: Ian Jackson, Dave Scott, xen-devel
(adding Dave Scott...)
On Mon, 2013-11-11 at 15:54 +0000, Rob Hoes wrote:
> > On Wed, 2013-11-06 at 17:50 +0000, Rob Hoes wrote:
> > > + if (async != Val_none) {
> > > + ao_how->callback = async_callback;
> > > + ao_how->u.for_callback = (void *) Some_val(async);
> > > + CAMLreturnT(libxl_asyncop_how *, ao_how);
> > > + }
> > > + else
> > > + CAMLreturnT(libxl_asyncop_how *, NULL);
> >
> > This doesn't appear to be in my caml headers on Debian Wheezy (3.12.1-4).
> > A random hit on google http://docs.camlcity.org/docs/godisrc/oasis-ocaml-
> > fd-1.1.1.tar.gz/ocaml-fd-1.1.1/lib/fd_stubs.c suggests this was new in 3.09.4
> > so why don't I have it?
>
> That's very odd... I am just doing what is advised on
> http://caml.inria.fr/pub/docs/manual-ocaml-312/manual032.html#toc14,
> which is the official documentation for OCaml 3.12.
In the source .dsc it is in byterun/memory.h but this doesn't seem to be
installed. Perhaps because I'm not using hte bytecode version but the
native code one?
>
> > We would really like to keep this stuff working with some of the more
> > common distro's stable versions of ocaml, so if this is really missing then
> > perhaps a compat version would be needed?
>
> I'll see if I can find out more...
>
> > WTF is it doing anyway? Something to do with this C struct pointer
> > containing a Value?
>
> The docs say:
> "The macros CAMLreturn, CAMLreturn0, and CAMLreturnT are used to
> replace the C keyword return. Every occurence of return x must be
> replaced by CAMLreturn (x) if x has type value, or CAMLreturnT (t, x)
> (where t is the type of x); every occurence of return without argument
> must be replaced by CAMLreturn0. If your C function is a procedure
> (i.e. if it returns void), you must insert CAMLreturn0 at the end (to
> replace C’s implicit return)."
There are quite a number of bare returns in the bindings. I guess all
cases which have no CAMLlocal etc?
Ian.
_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xen.org
http://lists.xen.org/xen-devel
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 00/27] libxl: ocaml: improve the bindings
2013-11-11 15:47 ` [PATCH v4 00/27] libxl: ocaml: improve the bindings Ian Campbell
@ 2013-11-12 11:28 ` Rob Hoes
2013-11-20 17:15 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-12 11:28 UTC (permalink / raw)
To: Ian Campbell; +Cc: Ian Jackson, xen-devel
> From: Ian Campbell
> Sent: 11 November 2013 3:48 PM
> To: Rob Hoes
> Cc: xen-devel@lists.xen.org; Ian Jackson
> Subject: Re: [PATCH v4 00/27] libxl: ocaml: improve the bindings
>
> On Wed, 2013-11-06 at 17:49 +0000, Rob Hoes wrote:
> > 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 XenServer). 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.
> >
> > This is version 4 of this patch series to fix the OCaml binding to
> > libxl. See the individual patches for detailed changes with respect to v3.
>
> I have now applied #1..#16
> 6ea2941 libxl: ocaml: support for Arrays in bindings generator.
> 842b59e libxl: ocaml: avoid reserved words in type and field names.
> 98caa06 libxl: ocaml: support for KeyedUnion in the bindings generator.
> a6efa2e libxl: ocaml: add some more builtin types.
> 80e18cd libxc: ocaml: add simple binding for xentoollog (output only).
> 06722d7 libxl: ocaml: allocate a long lived libxl context.
> 974d108 libxl: ocaml: switch all functions over to take a context.
> e06ac98 libxl: idl: add Enumeration.value_namespace property
> b37a126 libxl: make the libxl error type an IDL enum
> 56799c5 libxl: ocaml: generate string_of_* functions for enums
> 67c8b33 libxl: ocaml: propagate the libxl return error code in exceptions
> 999dce0 libxl: ocaml: make Val_defbool GC-proof
> 4ca3004 libxl: ocaml: add domain_build/create_info/config and events to
> the bi 1bb2c5e libxl: ocaml: fix the handling of enums in the bindings
> generator
> 21b9ec6 libxl: ocaml: use the "string option" type for IDL strings bf7fddd
> libxl: ocaml: add dominfo_list and dominfo_get
>
> Note that in #5 (add simple binding for xentoollog (output only)) I dropped
> the little test case. You have mail on the subject..
>
> #17 (implement some simple tests) skipped due to changes in add simple
> binding for xentoollog (output only).
>
> Ian J has nacked #18 (in a reply to the v2-resend thread).
>
> #19 (allow device operations to be called asynchronously) appears to rely on
> #18
>
> #20..21 seemed ok:
> 01237a2 libxl: ocaml: add NIC helper functions
> 73d1b47 libxl: ocaml: add PCI device helper functions
>
> #22 (add disk and cdrom helper functions) failed after I dropped #19.
>
> I had a comment on #23 so I skipped it but then I was able to apply #24..#26:
>
> d8a276f libxl: ocaml: in send_debug_keys, clean up before raising exception
> dc189b1 libxl: ocaml: provide defaults for libxl types 4cc845e libxl: ocaml:
> use CAMLlocal1 macro rather than value-type in auto-generated C-code
>
> #27 "add console reader functions" failed to apply. I suspect it needed
> something prior to it, at least contextually.
>
> At least, this is what I think I've done, it was a bit fluid as I dropped one or
> two bits. git rebase should tell you the true story!
Great, thanks, we are getting there! I'll have a look at the remaining issues today.
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
2013-11-11 15:58 ` Ian Campbell
@ 2013-11-12 12:27 ` Rob Hoes
2013-11-12 13:54 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-12 12:27 UTC (permalink / raw)
To: Ian Campbell; +Cc: Ian Jackson, Dave Scott, xen-devel
> From: Ian Campbell
> Sent: 11 November 2013 3:58 PM
> To: Rob Hoes
> Cc: xen-devel@lists.xen.org; Ian Jackson; Dave Scott
> Subject: Re: [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
>
> (adding Dave Scott...)
> On Mon, 2013-11-11 at 15:54 +0000, Rob Hoes wrote:
> > > On Wed, 2013-11-06 at 17:50 +0000, Rob Hoes wrote:
> > > > + if (async != Val_none) {
> > > > + ao_how->callback = async_callback;
> > > > + ao_how->u.for_callback = (void *) Some_val(async);
> > > > + CAMLreturnT(libxl_asyncop_how *, ao_how);
> > > > + }
> > > > + else
> > > > + CAMLreturnT(libxl_asyncop_how *, NULL);
> > >
> > > This doesn't appear to be in my caml headers on Debian Wheezy (3.12.1-
> 4).
> > > A random hit on google
> > > http://docs.camlcity.org/docs/godisrc/oasis-ocaml-
> > > fd-1.1.1.tar.gz/ocaml-fd-1.1.1/lib/fd_stubs.c suggests this was new
> > > in 3.09.4 so why don't I have it?
> >
> > That's very odd... I am just doing what is advised on
> > http://caml.inria.fr/pub/docs/manual-ocaml-312/manual032.html#toc14,
> > which is the official documentation for OCaml 3.12.
>
> In the source .dsc it is in byterun/memory.h but this doesn't seem to be
> installed. Perhaps because I'm not using hte bytecode version but the
> native code one?
As far as I can see, the code is in Wheezy's ocaml-nox_3.12.1-4_amd64.deb, in the file /usr/lib/ocaml/caml/memory.h. Have you got that package?
> >
> > > We would really like to keep this stuff working with some of the
> > > more common distro's stable versions of ocaml, so if this is really
> > > missing then perhaps a compat version would be needed?
> >
> > I'll see if I can find out more...
> >
> > > WTF is it doing anyway? Something to do with this C struct pointer
> > > containing a Value?
> >
> > The docs say:
> > "The macros CAMLreturn, CAMLreturn0, and CAMLreturnT are used to
> > replace the C keyword return. Every occurence of return x must be
> > replaced by CAMLreturn (x) if x has type value, or CAMLreturnT (t, x)
> > (where t is the type of x); every occurence of return without argument
> > must be replaced by CAMLreturn0. If your C function is a procedure
> > (i.e. if it returns void), you must insert CAMLreturn0 at the end (to
> > replace C’s implicit return)."
>
> There are quite a number of bare returns in the bindings. I guess all cases
> which have no CAMLlocal etc?
That is fine in functions that do not allocate any OCaml values. It does look though, that there are still some functions that use OCaml values in them, that do not have CAMLlocal/param/return. This is not necessarily a problem, but it may be better to add those macros, just to be absolutely sure. I'll see if a follow-up patch is desirable.
Cheers,
Rob
_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xen.org
http://lists.xen.org/xen-devel
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 05/27] libxc: ocaml: add simple binding for xentoollog (output only).
2013-11-11 15:30 ` Ian Campbell
@ 2013-11-12 13:46 ` Rob Hoes
2013-11-12 13:52 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-12 13:46 UTC (permalink / raw)
To: Ian Campbell; +Cc: Ian Jackson, xen-devel
> > +xtl_LIBS = \
> > + -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog
> $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
> > + -cclib -lxenctrl
>
> Sadly:
> /usr/bin/ld: cannot find -lxenctrl
> collect2: error: ld returned 1 exit status
> File "caml_startup", line 1, characters 0-1:
> Error: Error during linking
>
> You need to be using LDLIBS_libxenlight and CFLAGS_libxenlight etc like the
> tools/ocaml/libs/xl/Makefile does. On your system you are probably linking
> locally against the library in /usr/lib etc which is not desired...
So does that mean this?
+xtl_LIBS = \
+ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+ -cclib $(LDLIBS_libxenctrl)
(this links fine on my machine)
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 05/27] libxc: ocaml: add simple binding for xentoollog (output only).
2013-11-12 13:46 ` Rob Hoes
@ 2013-11-12 13:52 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-11-12 13:52 UTC (permalink / raw)
To: Rob Hoes; +Cc: Ian Jackson, xen-devel
On Tue, 2013-11-12 at 13:46 +0000, Rob Hoes wrote:
> > > +xtl_LIBS = \
> > > + -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog
> > $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
> > > + -cclib -lxenctrl
> >
> > Sadly:
> > /usr/bin/ld: cannot find -lxenctrl
> > collect2: error: ld returned 1 exit status
> > File "caml_startup", line 1, characters 0-1:
> > Error: Error during linking
> >
> > You need to be using LDLIBS_libxenlight and CFLAGS_libxenlight etc like the
> > tools/ocaml/libs/xl/Makefile does. On your system you are probably linking
> > locally against the library in /usr/lib etc which is not desired...
>
> So does that mean this?
>
> +xtl_LIBS = \
> + -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
> + -cclib $(LDLIBS_libxenctrl)
>
> (this links fine on my machine)
Looks better to me. I think all the usual confusion about C libraries in
ocaml stubs are not a worry because this binary is in tree.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
2013-11-12 12:27 ` Rob Hoes
@ 2013-11-12 13:54 ` Ian Campbell
2013-11-12 14:09 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-11-12 13:54 UTC (permalink / raw)
To: Rob Hoes; +Cc: Ian Jackson, Dave Scott, xen-devel
On Tue, 2013-11-12 at 12:27 +0000, Rob Hoes wrote:
> As far as I can see, the code is in Wheezy's
> ocaml-nox_3.12.1-4_amd64.deb, in the
> file /usr/lib/ocaml/caml/memory.h. Have you got that package?
Ah, I was only grepping under /usr/include/ocaml of course!
I suppose some magic in the ocamlc compiler adds this path to the search
path?
>
> > >
> > > > We would really like to keep this stuff working with some of the
> > > > more common distro's stable versions of ocaml, so if this is really
> > > > missing then perhaps a compat version would be needed?
> > >
> > > I'll see if I can find out more...
> > >
> > > > WTF is it doing anyway? Something to do with this C struct pointer
> > > > containing a Value?
> > >
> > > The docs say:
> > > "The macros CAMLreturn, CAMLreturn0, and CAMLreturnT are used to
> > > replace the C keyword return. Every occurence of return x must be
> > > replaced by CAMLreturn (x) if x has type value, or CAMLreturnT (t, x)
> > > (where t is the type of x); every occurence of return without argument
> > > must be replaced by CAMLreturn0. If your C function is a procedure
> > > (i.e. if it returns void), you must insert CAMLreturn0 at the end (to
> > > replace C’s implicit return)."
> >
> > There are quite a number of bare returns in the bindings. I guess all cases
> > which have no CAMLlocal etc?
>
> That is fine in functions that do not allocate any OCaml values. It
> does look though, that there are still some functions that use OCaml
> values in them, that do not have CAMLlocal/param/return. This is not
> necessarily a problem, but it may be better to add those macros, just
> to be absolutely sure. I'll see if a follow-up patch is desirable.
OK.
Ian.
_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xen.org
http://lists.xen.org/xen-devel
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
2013-11-12 13:54 ` Ian Campbell
@ 2013-11-12 14:09 ` Rob Hoes
2013-11-12 14:16 ` Ian Campbell
0 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-12 14:09 UTC (permalink / raw)
To: Ian Campbell; +Cc: Ian Jackson, Dave Scott, xen-devel
> On Tue, 2013-11-12 at 12:27 +0000, Rob Hoes wrote:
> > As far as I can see, the code is in Wheezy's
> > ocaml-nox_3.12.1-4_amd64.deb, in the file
> > /usr/lib/ocaml/caml/memory.h. Have you got that package?
>
> Ah, I was only grepping under /usr/include/ocaml of course!
>
> I suppose some magic in the ocamlc compiler adds this path to the search
> path?
Well, we do the following, which is supposed to include all those macros:
#include <caml/memory.h>
So is it working for you now?
> >
> > > >
> > > > > We would really like to keep this stuff working with some of the
> > > > > more common distro's stable versions of ocaml, so if this is
> > > > > really missing then perhaps a compat version would be needed?
> > > >
> > > > I'll see if I can find out more...
> > > >
> > > > > WTF is it doing anyway? Something to do with this C struct
> > > > > pointer containing a Value?
> > > >
> > > > The docs say:
> > > > "The macros CAMLreturn, CAMLreturn0, and CAMLreturnT are used to
> > > > replace the C keyword return. Every occurence of return x must be
> > > > replaced by CAMLreturn (x) if x has type value, or CAMLreturnT (t,
> > > > x) (where t is the type of x); every occurence of return without
> > > > argument must be replaced by CAMLreturn0. If your C function is a
> > > > procedure (i.e. if it returns void), you must insert CAMLreturn0
> > > > at the end (to replace C’s implicit return)."
> > >
> > > There are quite a number of bare returns in the bindings. I guess
> > > all cases which have no CAMLlocal etc?
> >
> > That is fine in functions that do not allocate any OCaml values. It
> > does look though, that there are still some functions that use OCaml
> > values in them, that do not have CAMLlocal/param/return. This is not
> > necessarily a problem, but it may be better to add those macros, just
> > to be absolutely sure. I'll see if a follow-up patch is desirable.
>
> OK.
>
> Ian.
_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xen.org
http://lists.xen.org/xen-devel
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
2013-11-12 14:09 ` Rob Hoes
@ 2013-11-12 14:16 ` Ian Campbell
0 siblings, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-11-12 14:16 UTC (permalink / raw)
To: Rob Hoes; +Cc: Ian Jackson, Dave Scott, xen-devel
On Tue, 2013-11-12 at 14:09 +0000, Rob Hoes wrote:
> > On Tue, 2013-11-12 at 12:27 +0000, Rob Hoes wrote:
> > > As far as I can see, the code is in Wheezy's
> > > ocaml-nox_3.12.1-4_amd64.deb, in the file
> > > /usr/lib/ocaml/caml/memory.h. Have you got that package?
> >
> > Ah, I was only grepping under /usr/include/ocaml of course!
> >
> > I suppose some magic in the ocamlc compiler adds this path to the search
> > path?
>
> Well, we do the following, which is supposed to include all those macros:
> #include <caml/memory.h>
>
> So is it working for you now?
Uh, yes, I see it now. I've no idea how I missed it yesterday.
Oh. /usr/include/ocaml is a symlink to /usr/lib/ocaml/caml and for some
reason "grep CAMLreturnT /usr/include" doesn't recurse into it, whereas
"grep CAMLreturnT /usr/include/caml" does! How odd!
Sorry for the noise.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations
2013-11-06 17:50 ` [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations Rob Hoes
2013-11-11 14:50 ` Ian Campbell
@ 2013-11-12 14:18 ` Ian Campbell
1 sibling, 0 replies; 146+ messages in thread
From: Ian Campbell @ 2013-11-12 14:18 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.jackson, xen-devel
On Wed, 2013-11-06 at 17:50 +0000, Rob Hoes wrote:
> Also, reorganise toplevel OCaml functions into modules of Xenlight.
>
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
> Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-11 15:39 ` Rob Hoes
@ 2013-11-12 14:56 ` Ian Jackson
2013-11-12 15:49 ` David Scott
` (2 more replies)
0 siblings, 3 replies; 146+ messages in thread
From: Ian Jackson @ 2013-11-12 14:56 UTC (permalink / raw)
To: Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("RE: [Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]"):
> > But I haven't had an answer.
>
> Sorry, I had missed this... :(
NP.
> > I think that whether this is the right approach depends on how
> > event loops are traditionally done in ocaml.
>
> Having bindings to the low-level functions
> libxl_osevent_register_hooks and related, allows us to run an event
> loop in OCaml; either one we write ourselves, or one that is
> available elsewhere.
Right.
> We are currently running a straightforward, custom event loop in
> xenopsd. It simply maintains a list of fds and timeouts, and runs
> poll in a loop, as you would expect (see
> https://github.com/xapi-project/xenopsd/blob/master/xl/xenlight_events.ml
> for the full code).
OK, that makes sense.
> Exposing the low-level event hooks in OCaml gives us the choice to
> implement either of the above options.
Right. Good.
I have some questions about the details:
Firstly, locking. Is all of this code running inside a single big
lock which is never released ? If so I think everything is fine. If
something more complicated might be happening then there are possible
deadlock problems.
See the comment on "Lock hierarchy" in libxl_event.h. In particular,
I worry about the following scenario:
AIUI in your setup the callback might, in principle, call any ocaml
function. That ocaml function might call back into some long-running
C function which temporarily gives up the ocaml lock. If another
thread then takes the ocaml lock, and enters libxl, it will block
waiting for the libxl lock. The original thread will presumably at
some point come back from the long-running operation and try to
acquire the ocaml lock. Deadlock.
Have you considered this problem ?
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml: event management"):
> +/* Event handling */
...
> +short Poll_val(value event)
...
> + switch (Int_val(event)) {
> + case 0: res = POLLIN; break;
> + case 1: res = POLLPRI; break;
...
> +short Poll_events_val(value event_list)
...
> + while (event_list != Val_emptylist) {
> + events |= Poll_val(Field(event_list, 0));
> + event_list = Field(event_list, 1);
This is quite striking. You're converting a bitfield into a linked
list of consed enums. Does ocaml really not have something more
resembling a set-of-small-enum type, represeted as a bitfield ?
The result is going to be a lot of consing every time libxl scratches
its nose. In some cases very frequently. For example, if we're
running the bootloader and copying input and output back and forth,
we're using the datacopier machinery in libxl_aoutils.c. That
involves enabling the fd writeability callback on each output fd,
every time data is read from the input fd, and then disabling the
writeability callback every time the data has been written. So one
fd register/deregister pair for every lump of console output. There
are probably other examples.
...
> +value stub_libxl_event_register_callbacks(value ctx, value user)
...
> + c_user = malloc(sizeof(*c_user));
> + c_user->user = (void *) user;
Shouldn't you be using some kind of error-handling wrapper for
malloc ? Having the program dereference null when malloc fails is
rather an unfortunate failure mode. At the very least printing
something to stderr would be useful.
Thanks,
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-12 14:56 ` Ian Jackson
@ 2013-11-12 15:49 ` David Scott
2013-11-12 16:41 ` Ian Jackson
2013-11-12 17:14 ` Rob Hoes
2013-11-28 16:46 ` Ian Jackson
2 siblings, 1 reply; 146+ messages in thread
From: David Scott @ 2013-11-12 15:49 UTC (permalink / raw)
To: Ian Jackson, Rob Hoes; +Cc: ian.campbell, xen-devel
Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml:
event management"):
>> +/* Event handling */
> ...
>> +short Poll_val(value event)
> ...
>> + switch (Int_val(event)) {
>> + case 0: res = POLLIN; break;
>> + case 1: res = POLLPRI; break;
> ...
>> +short Poll_events_val(value event_list)
> ...
>> + while (event_list != Val_emptylist) {
>> + events |= Poll_val(Field(event_list, 0));
>> + event_list = Field(event_list, 1);
On 12/11/13 14:56, Ian Jackson wrote:
> This is quite striking. You're converting a bitfield into a linked
> list of consed enums. Does ocaml really not have something more
> resembling a set-of-small-enum type, represeted as a bitfield ?
>
> The result is going to be a lot of consing every time libxl scratches
> its nose. In some cases very frequently. For example, if we're
> running the bootloader and copying input and output back and forth,
> we're using the datacopier machinery in libxl_aoutils.c. That
> involves enabling the fd writeability callback on each output fd,
> every time data is read from the input fd, and then disabling the
> writeability callback every time the data has been written. So one
> fd register/deregister pair for every lump of console output. There
> are probably other examples.
Unfortunately there's no direct support for bitfields in OCaml's heap
data representation. The common pattern is to convert bitfields into
lists of constructors e.g.
https://github.com/ocaml/ocaml/blob/trunk/otherlibs/unix/open.c#L74
On the positive side, the GC is optimised specifically for the case of
short-lived small objects, since this is what you get when you write a
compiler or a theorem prover. An allocation in the minor heap is simply
a pointer bump, and the trash is chucked out pretty often. The rule of
thumb is that anything which has the allocation profile of a compiler or
a theorem prover usually works pretty well :-)
I think if we're allocating a (shortish) list per "lump" of console I/O
we're probably ok since I assume we're allocating and deallocating
bigger buffers for the console data anyway. For higher throughput
channels (vchan, network, disk etc) I'd go for larger,
statically-allocated pools of buffers for the data and use a bigger
lump-size to amortize the cost of the metadata handling.
Cheers,
Dave
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-12 15:49 ` David Scott
@ 2013-11-12 16:41 ` Ian Jackson
0 siblings, 0 replies; 146+ messages in thread
From: Ian Jackson @ 2013-11-12 16:41 UTC (permalink / raw)
To: David Scott; +Cc: xen-devel, Rob Hoes, ian.campbell
David Scott writes ("Re: [Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]"):
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml:
> event management"):
> > This is quite striking. You're converting a bitfield into a linked
> > list of consed enums. Does ocaml really not have something more
> > resembling a set-of-small-enum type, represeted as a bitfield ?
..
> Unfortunately there's no direct support for bitfields in OCaml's heap
> data representation. The common pattern is to convert bitfields into
> lists of constructors e.g.
>
> https://github.com/ocaml/ocaml/blob/trunk/otherlibs/unix/open.c#L74
How sad.
> On the positive side, the GC is optimised specifically for the case of
> short-lived small objects, since this is what you get when you write a
> compiler or a theorem prover. An allocation in the minor heap is simply
> a pointer bump, and the trash is chucked out pretty often. The rule of
> thumb is that anything which has the allocation profile of a compiler or
> a theorem prover usually works pretty well :-)
OK :-).
> I think if we're allocating a (shortish) list per "lump" of console I/O
> we're probably ok since I assume we're allocating and deallocating
> bigger buffers for the console data anyway. For higher throughput
> channels (vchan, network, disk etc) I'd go for larger,
> statically-allocated pools of buffers for the data and use a bigger
> lump-size to amortize the cost of the metadata handling.
libxl doesn't normally concern itself with the main data path, so
vchan, network and disk i/o aren't a problem.
So, I'm reassured on this point.
The locking question is more difficult, I think.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-12 14:56 ` Ian Jackson
2013-11-12 15:49 ` David Scott
@ 2013-11-12 17:14 ` Rob Hoes
2013-11-12 17:18 ` Ian Jackson
2013-11-28 16:46 ` Ian Jackson
2 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-12 17:14 UTC (permalink / raw)
To: Ian Jackson; +Cc: Ian Campbell, xen-devel
> > > I think that whether this is the right approach depends on how event
> > > loops are traditionally done in ocaml.
> >
> > Having bindings to the low-level functions
> > libxl_osevent_register_hooks and related, allows us to run an event
> > loop in OCaml; either one we write ourselves, or one that is available
> > elsewhere.
>
> Right.
>
> > We are currently running a straightforward, custom event loop in
> > xenopsd. It simply maintains a list of fds and timeouts, and runs poll
> > in a loop, as you would expect (see
> > https://github.com/xapi-
> project/xenopsd/blob/master/xl/xenlight_events
> > .ml
> > for the full code).
>
> OK, that makes sense.
>
> > Exposing the low-level event hooks in OCaml gives us the choice to
> > implement either of the above options.
>
> Right. Good.
Thanks. I'll add a summary of this to the commit message.
> I have some questions about the details:
>
>
> Firstly, locking. Is all of this code running inside a single big lock which is
> never released ? If so I think everything is fine. If something more
> complicated might be happening then there are possible deadlock
> problems.
>
> See the comment on "Lock hierarchy" in libxl_event.h. In particular, I worry
> about the following scenario:
>
> AIUI in your setup the callback might, in principle, call any ocaml function.
> That ocaml function might call back into some long-running C function which
> temporarily gives up the ocaml lock. If another thread then takes the ocaml
> lock, and enters libxl, it will block waiting for the libxl lock. The original
> thread will presumably at some point come back from the long-running
> operation and try to acquire the ocaml lock. Deadlock.
>
> Have you considered this problem ?
Yes, I have encountered such deadlocks, and got around them by making all calls into libxl mutually exclusive. This should mean that there can be only one thread at a time holding or waiting for the libxl lock, and I think that avoids the deadlock you described. It seems to be running smoothly now in our test setup.
>
>
> Rob Hoes writes ("[Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml: event
> management"):
> > +/* Event handling */
> ...
> > +short Poll_val(value event)
> ...
> > + switch (Int_val(event)) {
> > + case 0: res = POLLIN; break;
> > + case 1: res = POLLPRI; break;
> ...
> > +short Poll_events_val(value event_list)
> ...
> > + while (event_list != Val_emptylist) {
> > + events |= Poll_val(Field(event_list, 0));
> > + event_list = Field(event_list, 1);
>
> This is quite striking. You're converting a bitfield into a linked list of consed
> enums. Does ocaml really not have something more resembling a set-of-
> small-enum type, represeted as a bitfield ?
>
> The result is going to be a lot of consing every time libxl scratches its nose.
> In some cases very frequently. For example, if we're running the
> bootloader and copying input and output back and forth, we're using the
> datacopier machinery in libxl_aoutils.c. That involves enabling the fd
> writeability callback on each output fd, every time data is read from the
> input fd, and then disabling the writeability callback every time the data has
> been written. So one fd register/deregister pair for every lump of console
> output. There are probably other examples.
Dave has already responded to this.
> ...
> > +value stub_libxl_event_register_callbacks(value ctx, value user)
> ...
> > + c_user = malloc(sizeof(*c_user));
> > + c_user->user = (void *) user;
>
> Shouldn't you be using some kind of error-handling wrapper for malloc ?
> Having the program dereference null when malloc fails is rather an
> unfortunate failure mode. At the very least printing something to stderr
> would be useful.
Yes, that would be better. I'll update the patch.
Thanks,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-12 17:14 ` Rob Hoes
@ 2013-11-12 17:18 ` Ian Jackson
2013-11-14 17:39 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-11-12 17:18 UTC (permalink / raw)
To: Rob Hoes; +Cc: Ian Campbell, xen-devel
Rob Hoes writes ("RE: [Xen-devel] [PATCH v2-resend 22/30] libxl:
ocaml: event management [and 1 more messages]"):
> [Ian Jackson:]
> > Have you considered this problem ?
>
> Yes, I have encountered such deadlocks, and got around them by
> making all calls into libxl mutually exclusive. This should mean
> that there can be only one thread at a time holding or waiting for
> the libxl lock, and I think that avoids the deadlock you
> described. It seems to be running smoothly now in our test setup.
I'm not sure how that would help. libxl already has a mutex which it
takes on entry, so all calls into libxl are already mututally
exclusive.
What would happen if your fd registration callback ocaml code tried to
make a libxl call ?
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-12 17:18 ` Ian Jackson
@ 2013-11-14 17:39 ` Rob Hoes
2013-11-14 18:08 ` Ian Jackson
0 siblings, 1 reply; 146+ messages in thread
From: Rob Hoes @ 2013-11-14 17:39 UTC (permalink / raw)
To: Ian Jackson; +Cc: Dave Scott, Ian Campbell, xen-devel
[Ian Jackson:]
> I'm not sure how that would help. libxl already has a mutex which it takes
> on entry, so all calls into libxl are already mututally exclusive.
>
> What would happen if your fd registration callback ocaml code tried to make
> a libxl call ?
Ok, what I said was not quite right. You are referring to the fact that libxl keeps hold of its lock in the fd registration callback. A possible deadlock scenario like the following may then occur:
Thread 1 Thread 2
======== ========
xenopsd thread starts .
acquire ocaml heap lock .
.
xenopsd calls libxl .
acquire libxl lock .
.
libxl asks xenopsd to register fd .
.
xenopsd does blocking write .
drop ocaml heap lock .
write() .
.
xenopsd thread starts
acquire ocaml heap lock
.
xenopsd calls libxl
acquire libxl lock
==> held by thread 1
acquire ocaml heap lock
==> held by thread 2
The experts here have suggested that the common thing to do is to release the ocaml heap lock when calling libxl functions, and reaquire it when returning or calling back into ocaml. I tried to avoid this, because it complicates things, but it seems I have no choice now :)
In this case, the ocaml heap lock is never held together with the libxl lock, except in the registration callbacks. If we then promise to not call any libxl functions inside the callback, I think we can avoid deadlocks.
The picture becomes as follows:
Thread 1 Thread 2
======== ========
xenopsd thread starts .
acquire ocaml heap lock .
.
xenopsd calls libxl .
drop ocaml heap lock .
acquire libxl lock .
.
libxl asks xenopsd to register fd .
acquire ocaml heap lock .
.
xenopsd does blocking write .
drop ocaml heap lock .
write() .
.
xenopsd thread starts
acquire ocaml heap lock
.
xenopsd calls libxl
drop ocaml heap lock
acquire libxl lock
.
acquire ocaml heap lock .
.
return to libxl .
drop ocaml heap lock .
.
return to xenopsd .
drop libxl lock .
acquire ocaml heap lock .
.
return to xenopsd
drop libxl lock
acquire ocaml heap lock
...and all is ok.
Does that sound right?
How about event_occurs callback, and async callbacks? Is the situation the same?
Thanks,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-14 17:39 ` Rob Hoes
@ 2013-11-14 18:08 ` Ian Jackson
2013-11-26 18:03 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-11-14 18:08 UTC (permalink / raw)
To: Rob Hoes; +Cc: Dave Scott, Ian Campbell, xen-devel
Rob Hoes writes ("RE: [Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]"):
> [Ian Jackson:]
> > I'm not sure how that would help. libxl already has a mutex which it takes
> > on entry, so all calls into libxl are already mututally exclusive.
> >
> > What would happen if your fd registration callback ocaml code tried to make
> > a libxl call ?
>
> Ok, what I said was not quite right. You are referring to the fact
> that libxl keeps hold of its lock in the fd registration callback. A
> possible deadlock scenario like the following may then occur:
>
> [diagram]
Exactly.
> The experts here have suggested that the common thing to do is to
> release the ocaml heap lock when calling libxl functions, and
> reaquire it when returning or calling back into ocaml. I tried to
> avoid this, because it complicates things, but it seems I have no
> choice now :)
That would be one way to do it. It's the way it's done in libvirt.
Other possibilities that come to mind are:
* Somehow ensure in the ocaml code that a thread processing a libxl
fd registration registration never calls any blocking C functions
which would drop the ocaml lock. I'm not sure how easy this would
be in ocaml.
* Have fd and timeout registrations put on a queue in the C code in
the ocaml bindings, and process them later with the ocaml lock
held. Although if you do this you need to make sure that the
queue is looked at before delivering any events, and you would
need a way to wake up your event loop in another thread to tell it
that there were fd/timeout registrations which it needs to deal
with.
* Use the beforepoll/afterpoll functions rather than the
registration machinery. This would be quite workable from a
performance point of view if each of your processes handles a
single domain (or only a few).
> In this case, the ocaml heap lock is never held together with the
> libxl lock, except in the registration callbacks. If we then promise
> to not call any libxl functions inside the callback, I think we can
> avoid deadlocks.
Yes.
> The picture becomes as follows:
> [diagram]
Yes, precisely.
> Does that sound right?
>
> How about event_occurs callback, and async callbacks? Is the situation the same?
The event occurs and async completion callbacks are made by libxl with
the libxl lock _released_. The libxl machinery queues them up
internally to make this possible. So they aren't affected by these
restrictions.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 00/27] libxl: ocaml: improve the bindings
2013-11-12 11:28 ` Rob Hoes
@ 2013-11-20 17:15 ` Ian Campbell
2013-11-20 17:43 ` Rob Hoes
0 siblings, 1 reply; 146+ messages in thread
From: Ian Campbell @ 2013-11-20 17:15 UTC (permalink / raw)
To: Rob Hoes; +Cc: Ian Jackson, xen-devel
On Tue, 2013-11-12 at 11:28 +0000, Rob Hoes wrote:
> Great, thanks, we are getting there! I'll have a look at the remaining issues today.
I think I'm waiting for a resend of the remainder, or at least I can't
see a v5, sorry if I missed it.
It seems that Ian J's queries about the event mechanism and locking etc
have all been cleared up (right?), IIRC that was the last sticking point
for much of it.
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v4 00/27] libxl: ocaml: improve the bindings
2013-11-20 17:15 ` Ian Campbell
@ 2013-11-20 17:43 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-20 17:43 UTC (permalink / raw)
To: Ian Campbell; +Cc: Ian Jackson, xen-devel
Ian Campbell wrote:
> On Tue, 2013-11-12 at 11:28 +0000, Rob Hoes wrote:
> > Great, thanks, we are getting there! I'll have a look at the remaining
> issues today.
>
> I think I'm waiting for a resend of the remainder, or at least I can't see
> a v5, sorry if I missed it.
>
> It seems that Ian J's queries about the event mechanism and locking etc
> have all been cleared up (right?), IIRC that was the last sticking point
> for much of it.
Yes, sorry. I was working on an update, and a fix for the deadlock issue identified by Ian J. It's taking a little longer, because I really want to test the deadlock stuff quite well. But unfortunately I have been distracted with other work, and not managed to finish this. Hopefully still this week...
Cheers,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-14 18:08 ` Ian Jackson
@ 2013-11-26 18:03 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-26 18:03 UTC (permalink / raw)
To: Ian Jackson; +Cc: Dave Scott, Ian Campbell, xen-devel
Hi Ian,
Sorry for taking so long to get back to you on this.
> That would be one way to do it. It's the way it's done in libvirt.
I have just submitted v5 of the (remaining) patches, where this solution is implemented.
> Other possibilities that come to mind are:
>
> * Somehow ensure in the ocaml code that a thread processing a libxl
> fd registration registration never calls any blocking C functions
> which would drop the ocaml lock. I'm not sure how easy this would
> be in ocaml.
Indeed, but it is probably impossible to guarantee this, because it will not let you do much in the callbacks. Especially if we'd run a third-party event loop, we'd have to call library functions inside the callbacks which are not under our control.
> * Have fd and timeout registrations put on a queue in the C code in
> the ocaml bindings, and process them later with the ocaml lock
> held. Although if you do this you need to make sure that the
> queue is looked at before delivering any events, and you would
> need a way to wake up your event loop in another thread to tell it
> that there were fd/timeout registrations which it needs to deal
> with.
>
> * Use the beforepoll/afterpoll functions rather than the
> registration machinery. This would be quite workable from a
> performance point of view if each of your processes handles a
> single domain (or only a few).
These are good options indeed, which we could use in xenopsd. However, they would not allow us to run a third-party event loop, for example from Lwt.
> > How about event_occurs callback, and async callbacks? Is the situation
> the same?
>
> The event occurs and async completion callbacks are made by libxl with the
> libxl lock _released_. The libxl machinery queues them up internally to
> make this possible. So they aren't affected by these restrictions.
Good, that is clear.
Thanks,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-12 14:56 ` Ian Jackson
2013-11-12 15:49 ` David Scott
2013-11-12 17:14 ` Rob Hoes
@ 2013-11-28 16:46 ` Ian Jackson
2013-11-28 17:53 ` Rob Hoes
2 siblings, 1 reply; 146+ messages in thread
From: Ian Jackson @ 2013-11-28 16:46 UTC (permalink / raw)
To: Rob Hoes, xen-devel, ian.campbell
Ian Jackson writes ("Re: [Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]"):
> > +value stub_libxl_event_register_callbacks(value ctx, value user)
> ...
> > + c_user = malloc(sizeof(*c_user));
> > + c_user->user = (void *) user;
>
> Shouldn't you be using some kind of error-handling wrapper for
> malloc ? Having the program dereference null when malloc fails is
> rather an unfortunate failure mode. At the very least printing
> something to stderr would be useful.
There's some more of this in v6. I don't think it's a blocker for
inclusion but I thought I'd mention it again since my comment seems to
have been overlooked.
Thanks,
Ian.
^ permalink raw reply [flat|nested] 146+ messages in thread
* Re: [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages]
2013-11-28 16:46 ` Ian Jackson
@ 2013-11-28 17:53 ` Rob Hoes
0 siblings, 0 replies; 146+ messages in thread
From: Rob Hoes @ 2013-11-28 17:53 UTC (permalink / raw)
To: Ian Jackson, xen-devel, Ian Campbell
Ian Jackson wrote:
> Sent: 28 November 2013 4:47 PM
> To: Rob Hoes; xen-devel@lists.xen.org; Ian Campbell
> Subject: Re: [Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml: event
> management [and 1 more messages]
>
> Ian Jackson writes ("Re: [Xen-devel] [PATCH v2-resend 22/30] libxl: ocaml:
> event management [and 1 more messages]"):
> > > +value stub_libxl_event_register_callbacks(value ctx, value user)
> > ...
> > > + c_user = malloc(sizeof(*c_user));
> > > + c_user->user = (void *) user;
> >
> > Shouldn't you be using some kind of error-handling wrapper for malloc
> > ? Having the program dereference null when malloc fails is rather an
> > unfortunate failure mode. At the very least printing something to
> > stderr would be useful.
>
> There's some more of this in v6. I don't think it's a blocker for
> inclusion but I thought I'd mention it again since my comment seems to
> have been overlooked.
Yes, sorry, I missed that :(
Thanks,
Rob
^ permalink raw reply [flat|nested] 146+ messages in thread
end of thread, other threads:[~2013-11-28 17:53 UTC | newest]
Thread overview: 146+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2013-11-06 17:49 [PATCH v4 00/27] libxl: ocaml: improve the bindings Rob Hoes
2013-11-06 17:49 ` [PATCH v4 01/27] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
2013-11-06 17:49 ` [PATCH v4 02/27] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
2013-11-11 14:17 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 03/27] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
2013-11-06 17:49 ` [PATCH v4 04/27] libxl: ocaml: add some more builtin types Rob Hoes
2013-11-06 17:49 ` [PATCH v4 05/27] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
2013-11-11 15:30 ` Ian Campbell
2013-11-12 13:46 ` Rob Hoes
2013-11-12 13:52 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 06/27] libxl: ocaml: allocate a long lived libxl context Rob Hoes
2013-11-06 17:49 ` [PATCH v4 07/27] libxl: ocaml: switch all functions over to take a context Rob Hoes
2013-11-06 17:49 ` [PATCH v4 08/27] libxl: idl: add Enumeration.value_namespace property Rob Hoes
2013-11-11 14:31 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 09/27] libxl: make the libxl error type an IDL enum Rob Hoes
2013-11-11 14:31 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 10/27] libxl: ocaml: generate string_of_* functions for enums Rob Hoes
2013-11-11 14:33 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 11/27] libxl: ocaml: propagate the libxl return error code in exceptions Rob Hoes
2013-11-06 17:49 ` [PATCH v4 12/27] libxl: ocaml: make Val_defbool GC-proof Rob Hoes
2013-11-06 17:49 ` [PATCH v4 13/27] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
2013-11-06 17:49 ` [PATCH v4 14/27] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
2013-11-06 17:49 ` [PATCH v4 15/27] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
2013-11-06 17:49 ` [PATCH v4 16/27] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
2013-11-06 17:49 ` [PATCH v4 17/27] libxl: ocaml: implement some simple tests Rob Hoes
2013-11-06 17:49 ` [PATCH v4 18/27] libxl: ocaml: event management Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 01/30] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
2013-08-27 14:54 ` Ian Jackson
[not found] ` <12f36dbf-3fdc-45e8-b3c1-5194ea356197@FTLPEX01CL02.citrite.net>
2013-09-10 10:55 ` Ian Campbell
2013-08-22 10:50 ` [PATCH v2-resend 02/30] libxl: idl: allow KeyedUnion members to be empty Rob Hoes
2013-08-27 14:53 ` Ian Jackson
2013-08-27 14:56 ` Ian Campbell
2013-08-27 14:59 ` Ian Jackson
2013-08-27 15:04 ` Ian Campbell
2013-08-27 16:27 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 03/30] libxl: idl: add domain_type field to libxl_dominfo struct Rob Hoes
2013-08-27 14:55 ` Ian Jackson
2013-09-10 10:56 ` Ian Campbell
2013-09-10 11:00 ` Ian Campbell
2013-09-10 11:03 ` Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 04/30] libxl: idl: complete some enums in the IDL with their defaults Rob Hoes
2013-08-27 14:56 ` Ian Jackson
2013-09-10 10:57 ` Ian Campbell
2013-09-10 11:02 ` Ian Campbell
2013-08-22 10:50 ` [PATCH v2-resend 05/30] libxl: ocaml: fix code intended to output comments before definitions Rob Hoes
2013-08-27 14:57 ` Ian Jackson
2013-09-10 10:57 ` Ian Campbell
2013-08-22 10:50 ` [PATCH v2-resend 06/30] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
2013-08-27 14:59 ` Ian Jackson
2013-08-27 15:06 ` Ian Campbell
2013-08-27 15:12 ` Ian Jackson
2013-08-28 14:37 ` Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 07/30] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
2013-08-27 15:01 ` Ian Jackson
2013-08-29 10:29 ` Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 08/30] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
2013-08-27 15:09 ` Ian Jackson
2013-08-27 15:13 ` Ian Campbell
2013-08-27 15:20 ` Ian Jackson
2013-08-27 15:28 ` Ian Campbell
2013-08-28 14:47 ` Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 09/30] libxl: ocaml: add some more builtin types Rob Hoes
2013-08-27 15:21 ` Ian Jackson
2013-08-28 14:52 ` Rob Hoes
2013-08-22 10:50 ` [PATCH v2-resend 10/30] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
2013-08-27 15:33 ` Ian Jackson
2013-08-29 12:54 ` Rob Hoes
2013-08-29 13:12 ` Ian Campbell
2013-08-29 15:07 ` Ian Jackson
2013-08-29 15:05 ` Ian Jackson
2013-08-22 10:50 ` [PATCH v2-resend 11/30] libxl: ocaml: allocate a long lived libxl context Rob Hoes
2013-08-27 15:38 ` Ian Jackson
2013-08-28 15:55 ` Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 12/30] libxl: ocaml: switch all functions over to take a context Rob Hoes
2013-08-27 15:41 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 13/30] libxl: ocaml: propagate the libxl return error code in exceptions Rob Hoes
2013-08-27 15:43 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 14/30] libxl: ocaml: make Val_defbool GC-proof Rob Hoes
2013-08-27 15:48 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 15/30] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
2013-08-27 15:50 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 16/30] libxl: ocaml: add META to list of generated files in Makefile Rob Hoes
2013-08-27 17:49 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 17/30] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
2013-08-27 17:41 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 18/30] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
2013-08-27 17:44 ` Ian Jackson
2013-08-28 8:30 ` Ian Campbell
2013-08-28 10:33 ` Ian Jackson
2013-08-28 10:41 ` Ian Campbell
2013-08-22 10:51 ` [PATCH v2-resend 19/30] libxl: ocaml: add xen_console_read Rob Hoes
2013-08-27 17:46 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 20/30] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
2013-08-27 17:51 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 21/30] libxl: ocaml: implement some simple tests Rob Hoes
2013-08-27 17:52 ` Ian Jackson
2013-08-22 10:51 ` [PATCH v2-resend 22/30] libxl: ocaml: event management Rob Hoes
2013-08-27 17:56 ` Ian Jackson
2013-11-11 14:42 ` [PATCH v2-resend 22/30] libxl: ocaml: event management [and 1 more messages] Ian Jackson
2013-11-11 15:39 ` Rob Hoes
2013-11-12 14:56 ` Ian Jackson
2013-11-12 15:49 ` David Scott
2013-11-12 16:41 ` Ian Jackson
2013-11-12 17:14 ` Rob Hoes
2013-11-12 17:18 ` Ian Jackson
2013-11-14 17:39 ` Rob Hoes
2013-11-14 18:08 ` Ian Jackson
2013-11-26 18:03 ` Rob Hoes
2013-11-28 16:46 ` Ian Jackson
2013-11-28 17:53 ` Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 23/30] libxl: ocaml: allow device operations to be called asynchronously Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 24/30] libxl: ocaml: add NIC helper functions Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 25/30] libxl: ocaml: add PCI device " Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 26/30] libxl: ocaml: add disk and cdrom " Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 27/30] libxl: ocaml: add VM lifecycle operations Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 28/30] libxl: ocaml: in send_debug_keys, clean up before raising exception Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 29/30] libxl: ocaml: provide defaults for libxl types Rob Hoes
2013-08-22 10:51 ` [PATCH v2-resend 30/30] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code Rob Hoes
2013-09-10 10:58 ` [PATCH v2-resend 00/30] libxl: ocaml: improve the bindings Ian Campbell
2013-09-10 11:02 ` Rob Hoes
2013-09-10 12:57 ` Ian Campbell
2013-09-10 13:06 ` Rob Hoes
2013-11-06 17:49 ` [PATCH v4 19/27] libxl: ocaml: allow device operations to be called asynchronously Rob Hoes
2013-11-06 17:49 ` [PATCH v4 20/27] libxl: ocaml: add NIC helper functions Rob Hoes
2013-11-11 14:43 ` Ian Campbell
2013-11-06 17:49 ` [PATCH v4 21/27] libxl: ocaml: add PCI device " Rob Hoes
2013-11-06 17:50 ` [PATCH v4 22/27] libxl: ocaml: add disk and cdrom " Rob Hoes
2013-11-11 14:44 ` Ian Campbell
2013-11-06 17:50 ` [PATCH v4 23/27] libxl: ocaml: add VM lifecycle operations Rob Hoes
2013-11-11 14:50 ` Ian Campbell
2013-11-11 15:54 ` Rob Hoes
2013-11-11 15:58 ` Ian Campbell
2013-11-12 12:27 ` Rob Hoes
2013-11-12 13:54 ` Ian Campbell
2013-11-12 14:09 ` Rob Hoes
2013-11-12 14:16 ` Ian Campbell
2013-11-12 14:18 ` Ian Campbell
2013-11-06 17:50 ` [PATCH v4 24/27] libxl: ocaml: in send_debug_keys, clean up before raising exception Rob Hoes
2013-11-06 17:50 ` [PATCH v4 25/27] libxl: ocaml: provide defaults for libxl types Rob Hoes
2013-11-06 17:50 ` [PATCH v4 26/27] libxl: ocaml: use CAMLlocal1 macro rather than value-type in auto-generated C-code Rob Hoes
2013-11-06 17:50 ` [PATCH v4 27/27] libxl: ocaml: add console reader functions Rob Hoes
2013-11-11 15:47 ` [PATCH v4 00/27] libxl: ocaml: improve the bindings Ian Campbell
2013-11-12 11:28 ` Rob Hoes
2013-11-20 17:15 ` Ian Campbell
2013-11-20 17:43 ` Rob Hoes
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.