Ian Campbell
2012-Nov-20 17:23 UTC
[PATCH 13 of 15] libxl: ocaml: propagate the libxl return error code in exceptions
# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID c8d22bfef298ce525c98b5a3f0c394068ab01572
# Parent e4525795eac22c7d199ceae8714e95ed660a00c4
libxl: ocaml: propagate the libxl return error code in exceptions
Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/genwrap.py
--- a/tools/ocaml/libs/xl/genwrap.py Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/genwrap.py Tue Nov 20 17:22:21 2012 +0000
@@ -228,7 +228,7 @@ def c_val(ty, c, o, indent="", parent =
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"
@@ -241,7 +241,7 @@ def c_val(ty, c, o, indent="", parent =
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"
@@ -257,7 +257,7 @@ def c_val(ty, c, o, indent="", parent =
s += "%s" % c_val(f.type, fexpr, 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 += "}"
@@ -326,7 +326,7 @@ def ocaml_Val(ty, o, c, indent="", paren
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
@@ -347,7 +347,7 @@ def ocaml_Val(ty, o, c, indent="", paren
#s += "\t %s = caml_alloc(%d,%d);\n" %
(o,len(f.type.fields),n)
s += "\t break;\n"
n += 1
- 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 -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/xenlight.ml.in
--- a/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 +0000
@@ -15,7 +15,47 @@
open Xentoollog
-exception Error of string
+type error =
+ Nonspecific |
+ Version |
+ Fail |
+ Ni |
+ Nomem |
+ Inval |
+ Badfail |
+ Guest_Timedout |
+ Timedout |
+ Noparavirt |
+ Not_Ready |
+ Osevent_Reg_Fail |
+ Bufferfull |
+ Unknown_Child
+
+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)
+
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx =
"stub_libxl_ctx_alloc"
+external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
+
+external test_raise_exception: unit -> unit =
"stub_raise_exception"
type domid = int
type devid = int
@@ -26,15 +66,10 @@ end
(* @@LIBXL_TYPES@@ *)
-type ctx
-
-external ctx_alloc: Xentoollog.handle -> ctx =
"stub_libxl_ctx_alloc"
-external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
-
external list_domain: ctx -> Dominfo.t list =
"stub_libxl_list_domain"
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 : ctx -> string -> unit =
"stub_xl_send_debug_keys"
-let _ = Callback.register_exception "Xenlight.Error"
(Error(""))
+let _ = Callback.register_exception "Xenlight.Error" (Error(Fail,
""))
diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/xenlight.mli.in
--- a/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 +0000
@@ -15,7 +15,32 @@
open Xentoollog
-exception Error of string
+type error =
+ Nonspecific |
+ Version |
+ Fail |
+ Ni |
+ Nomem |
+ Inval |
+ Badfail |
+ Guest_Timedout |
+ Timedout |
+ Noparavirt |
+ Not_Ready |
+ Osevent_Reg_Fail |
+ Bufferfull |
+ Unknown_Child
+
+val string_of_error: error -> string
+
+exception Error of (error * string)
+
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx =
"stub_libxl_ctx_alloc"
+external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
+
+external test_raise_exception: unit = "stub_raise_exception"
type domid = int
type devid = int
@@ -24,9 +49,6 @@ type devid = int
type ctx
-external ctx_alloc: Xentoollog.handle -> ctx =
"stub_libxl_ctx_alloc"
-external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
-
external list_domain: ctx -> Dominfo.t list =
"stub_libxl_list_domain"
external send_trigger : domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/xenlight_stubs.c
--- a/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 +0000
@@ -43,12 +43,54 @@ static char * dup_String_val(value s)
return c;
}
-static void failwith_xl(char *fname)
+static value Val_error(int error)
{
+ switch (error) {
+ case ERROR_NONSPECIFIC: return Val_int(0);
+ case ERROR_VERSION: return Val_int(1);
+ case ERROR_FAIL: return Val_int(2);
+ case ERROR_NI: return Val_int(3);
+ case ERROR_NOMEM: return Val_int(4);
+ case ERROR_INVAL: return Val_int(5);
+ case ERROR_BADFAIL: return Val_int(6);
+ case ERROR_GUEST_TIMEDOUT: return Val_int(7);
+ case ERROR_TIMEDOUT: return Val_int(8);
+ case ERROR_NOPARAVIRT: return Val_int(9);
+ case ERROR_NOT_READY: return Val_int(10);
+ case ERROR_OSEVENT_REG_FAIL: return Val_int(11);
+ case ERROR_BUFFERFULL: return Val_int(12);
+ case ERROR_UNKNOWN_CHILD: return Val_int(13);
+#if 0 /* Let the compiler catch this */
+ default:
+ caml_raise_sys_error(caml_copy_string("Unknown libxl ERROR"));
+ break;
+#endif
+ }
+ /* Should not reach here */
+ abort();
+}
+
+static void failwith_xl(int error, char *fname)
+{
+ CAMLlocal1(arg);
value *exc = caml_named_value("Xenlight.Error");
+
if (!exc)
caml_invalid_argument("Exception Xenlight.Error not initialized, please
link xl.cma");
- caml_raise_with_string(*exc, fname);
+
+ arg = caml_alloc_small(2, 0);
+
+ Field(arg, 0) = Val_error(error);
+ Field(arg, 1) = caml_copy_string(fname);
+
+ caml_raise_with_arg(*exc, arg);
+}
+
+CAMLprim value stub_raise_exception(value unit)
+{
+ CAMLparam1(unit);
+ failwith_xl(ERROR_FAIL, "test exception");
+ CAMLreturn(Val_unit);
}
CAMLprim value stub_libxl_ctx_alloc(value logger)
@@ -60,7 +102,7 @@ CAMLprim value stub_libxl_ctx_alloc(valu
caml_enter_blocking_section();
ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *)
logger);
if (ret != 0) \
- failwith_xl("cannot init context");
+ failwith_xl(ERROR_FAIL, "cannot init context");
caml_leave_blocking_section();
CAMLreturn((value)ctx);
}
@@ -190,7 +232,7 @@ static int Bitmap_val(libxl_ctx *ctx, li
int i, len = Wosize_val(v);
if (!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);
@@ -295,7 +337,7 @@ value stub_libxl_list_domain(value ctx)
info = libxl_list_domain(CTX, &nr);
if (info == NULL)
- failwith_xl("list_domain");
+ failwith_xl(ERROR_FAIL, "list_domain");
cli = Val_emptylist;
@@ -332,7 +374,7 @@ value stub_xl_device_##type##_##op(value
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); \
}
@@ -358,7 +400,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(CTX, &c_physinfo);
@@ -377,7 +419,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++) {
@@ -402,7 +444,7 @@ value stub_xl_domain_sched_params_get(va
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(CTX, &c_scinfo);
@@ -424,7 +466,7 @@ value stub_xl_domain_sched_params_set(va
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);
}
@@ -441,7 +483,7 @@ value stub_xl_send_trigger(value ctx, va
c_trigger, Int_val(vcpuid));
if (ret != 0)
- failwith_xl("send_trigger");
+ failwith_xl(ret, "send_trigger");
CAMLreturn(Val_unit);
}
@@ -454,7 +496,7 @@ value stub_xl_send_sysrq(value ctx, valu
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);
}
@@ -469,7 +511,7 @@ value stub_xl_send_debug_keys(value ctx,
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);
diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/Makefile
--- a/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000
@@ -6,9 +6,9 @@ OCAMLINCLUDE += \
-I $(OCAML_TOPLEVEL)/libs/xentoollog \
-I $(OCAML_TOPLEVEL)/libs/xl
-OBJS = xtl send_debug_keys list_domains
+OBJS = xtl send_debug_keys list_domains raise_exception
-PROGRAMS = xtl send_debug_keys list_domains
+PROGRAMS = xtl send_debug_keys list_domains raise_exception
xtl_LIBS = \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog
$(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa
@@ -27,7 +27,13 @@ list_domains_LIBS = \
list_domains_OBJS = list_domains
-OCAML_PROGRAM = xtl send_debug_keys 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 -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/list_domains.ml
--- a/tools/ocaml/test/list_domains.ml Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/test/list_domains.ml Tue Nov 20 17:22:21 2012 +0000
@@ -19,8 +19,11 @@ let print_dominfo dominfo let _ =
let logger = Xentoollog.create_stdio_logger (*~level:Xentoollog.Debug*) () in
let ctx = Xenlight.ctx_alloc logger in
- let domains = Xenlight.list_domain ctx in
- List.iter (fun d -> print_dominfo d) domains;
- Xenlight.ctx_free ctx;
- Xentoollog.destroy logger;
-
+ try
+ let domains = Xenlight.list_domain ctx in
+ List.iter (fun d -> print_dominfo d) domains;
+ Xenlight.ctx_free ctx;
+ Xentoollog.destroy logger;
+ with Xenlight.Error(err, fn) -> begin
+ printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error
err) fn;
+ end
diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/raise_exception.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/raise_exception.ml Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,15 @@
+open Printf
+open Xentoollog
+open Xenlight
+
+let _ =
+ let logger = Xentoollog.create_stdio_logger (*~level:Xentoollog.Debug*) () in
+ let ctx = Xenlight.ctx_alloc logger in
+ try
+ Xenlight.test_raise_exception ()
+ with Xenlight.Error(err, fn) -> begin
+ printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error
err) fn;
+ end;
+ Xenlight.ctx_free ctx;
+ Xentoollog.destroy logger;
+
Rob Hoes
2012-Nov-30 11:13 UTC
Re: [PATCH 13 of 15] libxl: ocaml: propagate the libxl return error code in exceptions
> # HG changeset patch > # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID > c8d22bfef298ce525c98b5a3f0c394068ab01572 > # Parent e4525795eac22c7d199ceae8714e95ed660a00c4 > libxl: ocaml: propagate the libxl return error code in exceptions > > Signed-off-by: Ian Campbell <ian.campbell@citrix.com>Acked-by: Rob Hoes <rob.hoes@citrix.com>> diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/genwrap.py > --- a/tools/ocaml/libs/xl/genwrap.py Tue Nov 20 17:22:21 2012 +0000 > +++ b/tools/ocaml/libs/xl/genwrap.py Tue Nov 20 17:22:21 2012 +0000 > @@ -228,7 +228,7 @@ def c_val(ty, c, o, indent="", parent > 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" > @@ -241,7 +241,7 @@ def c_val(ty, c, o, indent="", parent > 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" > @@ -257,7 +257,7 @@ def c_val(ty, c, o, indent="", parent > s += "%s" % c_val(f.type, fexpr, 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 += "}" > @@ -326,7 +326,7 @@ def ocaml_Val(ty, o, c, indent="", paren > 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 > @@ -347,7 +347,7 @@ def ocaml_Val(ty, o, c, indent="", paren > #s += "\t %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n) > s += "\t break;\n" > n += 1 > - 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 -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/xenlight.ml.in > --- a/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 > +0000 > +++ b/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 > +0000 > @@ -15,7 +15,47 @@ > > open Xentoollog > > -exception Error of string > +type error > + Nonspecific | > + Version | > + Fail | > + Ni | > + Nomem | > + Inval | > + Badfail | > + Guest_Timedout | > + Timedout | > + Noparavirt | > + Not_Ready | > + Osevent_Reg_Fail | > + Bufferfull | > + Unknown_Child > + > +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) > + > +type ctx > + > +external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" > +external ctx_free: ctx -> unit = "stub_libxl_ctx_free" > + > +external test_raise_exception: unit -> unit = "stub_raise_exception" > > type domid = int > type devid = int > @@ -26,15 +66,10 @@ end > > (* @@LIBXL_TYPES@@ *) > > -type ctx > - > -external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" > -external ctx_free: ctx -> unit = "stub_libxl_ctx_free" > - > external list_domain: ctx -> Dominfo.t list = "stub_libxl_list_domain" > > 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 : ctx -> string -> unit > "stub_xl_send_debug_keys" > > -let _ = Callback.register_exception "Xenlight.Error" (Error("")) > +let _ = Callback.register_exception "Xenlight.Error" (Error(Fail, "")) > diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/xenlight.mli.in > --- a/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 > +0000 > +++ b/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 > +0000 > @@ -15,7 +15,32 @@ > > open Xentoollog > > -exception Error of string > +type error > + Nonspecific | > + Version | > + Fail | > + Ni | > + Nomem | > + Inval | > + Badfail | > + Guest_Timedout | > + Timedout | > + Noparavirt | > + Not_Ready | > + Osevent_Reg_Fail | > + Bufferfull | > + Unknown_Child > + > +val string_of_error: error -> string > + > +exception Error of (error * string) > + > +type ctx > + > +external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" > +external ctx_free: ctx -> unit = "stub_libxl_ctx_free" > + > +external test_raise_exception: unit = "stub_raise_exception" > > type domid = int > type devid = int > @@ -24,9 +49,6 @@ type devid = int > > type ctx > > -external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" > -external ctx_free: ctx -> unit = "stub_libxl_ctx_free" > - > external list_domain: ctx -> Dominfo.t list = "stub_libxl_list_domain" > > external send_trigger : domid -> trigger -> int -> unit > "stub_xl_send_trigger" > diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/xenlight_stubs.c > --- a/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 > +0000 > +++ b/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 > +0000 > @@ -43,12 +43,54 @@ static char * dup_String_val(value s) > return c; > } > > -static void failwith_xl(char *fname) > +static value Val_error(int error) > { > + switch (error) { > + case ERROR_NONSPECIFIC: return Val_int(0); > + case ERROR_VERSION: return Val_int(1); > + case ERROR_FAIL: return Val_int(2); > + case ERROR_NI: return Val_int(3); > + case ERROR_NOMEM: return Val_int(4); > + case ERROR_INVAL: return Val_int(5); > + case ERROR_BADFAIL: return Val_int(6); > + case ERROR_GUEST_TIMEDOUT: return Val_int(7); > + case ERROR_TIMEDOUT: return Val_int(8); > + case ERROR_NOPARAVIRT: return Val_int(9); > + case ERROR_NOT_READY: return Val_int(10); > + case ERROR_OSEVENT_REG_FAIL: return Val_int(11); > + case ERROR_BUFFERFULL: return Val_int(12); > + case ERROR_UNKNOWN_CHILD: return Val_int(13); #if 0 /* Let the > +compiler catch this */ > + default: > + caml_raise_sys_error(caml_copy_string("Unknown libxl > ERROR")); > + break; > +#endif > + } > + /* Should not reach here */ > + abort(); > +} > + > +static void failwith_xl(int error, char *fname) { > + CAMLlocal1(arg); > value *exc = caml_named_value("Xenlight.Error"); > + > if (!exc) > caml_invalid_argument("Exception Xenlight.Error not > initialized, please link xl.cma"); > - caml_raise_with_string(*exc, fname); > + > + arg = caml_alloc_small(2, 0); > + > + Field(arg, 0) = Val_error(error); > + Field(arg, 1) = caml_copy_string(fname); > + > + caml_raise_with_arg(*exc, arg); > +} > + > +CAMLprim value stub_raise_exception(value unit) { > + CAMLparam1(unit); > + failwith_xl(ERROR_FAIL, "test exception"); > + CAMLreturn(Val_unit); > } > > CAMLprim value stub_libxl_ctx_alloc(value logger) @@ -60,7 +102,7 @@ > CAMLprim value stub_libxl_ctx_alloc(valu > caml_enter_blocking_section(); > ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct > xentoollog_logger *) logger); > if (ret != 0) \ > - failwith_xl("cannot init context"); > + failwith_xl(ERROR_FAIL, "cannot init context"); > caml_leave_blocking_section(); > CAMLreturn((value)ctx); > } > @@ -190,7 +232,7 @@ static int Bitmap_val(libxl_ctx *ctx, li > int i, len = Wosize_val(v); > > if (!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); > @@ -295,7 +337,7 @@ value stub_libxl_list_domain(value ctx) > > info = libxl_list_domain(CTX, &nr); > if (info == NULL) > - failwith_xl("list_domain"); > + failwith_xl(ERROR_FAIL, "list_domain"); > > cli = Val_emptylist; > > @@ -332,7 +374,7 @@ value stub_xl_device_##type##_##op(value > 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); \ > } > @@ -358,7 +400,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(CTX, &c_physinfo); > > @@ -377,7 +419,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++) { > @@ -402,7 +444,7 @@ value stub_xl_domain_sched_params_get(va > > 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(CTX, &c_scinfo); > > @@ -424,7 +466,7 @@ value stub_xl_domain_sched_params_set(va > 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); > } > @@ -441,7 +483,7 @@ value stub_xl_send_trigger(value ctx, va > c_trigger, Int_val(vcpuid)); > > if (ret != 0) > - failwith_xl("send_trigger"); > + failwith_xl(ret, "send_trigger"); > > CAMLreturn(Val_unit); > } > @@ -454,7 +496,7 @@ value stub_xl_send_sysrq(value ctx, valu > 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); > } > @@ -469,7 +511,7 @@ value stub_xl_send_debug_keys(value ctx, > > 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); > > diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/Makefile > --- a/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000 > +++ b/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000 > @@ -6,9 +6,9 @@ OCAMLINCLUDE += \ > -I $(OCAML_TOPLEVEL)/libs/xentoollog \ > -I $(OCAML_TOPLEVEL)/libs/xl > > -OBJS = xtl send_debug_keys list_domains > +OBJS = xtl send_debug_keys list_domains raise_exception > > -PROGRAMS = xtl send_debug_keys list_domains > +PROGRAMS = xtl send_debug_keys list_domains raise_exception > > xtl_LIBS = \ > -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog > $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa > @@ -27,7 +27,13 @@ list_domains_LIBS = \ > > list_domains_OBJS = list_domains > > -OCAML_PROGRAM = xtl send_debug_keys 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 -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/list_domains.ml > --- a/tools/ocaml/test/list_domains.ml Tue Nov 20 17:22:21 2012 > +0000 > +++ b/tools/ocaml/test/list_domains.ml Tue Nov 20 17:22:21 2012 > +0000 > @@ -19,8 +19,11 @@ let print_dominfo dominfo = let _ > let logger = Xentoollog.create_stdio_logger (*~level:Xentoollog.Debug*) () > in > let ctx = Xenlight.ctx_alloc logger in > - let domains = Xenlight.list_domain ctx in > - List.iter (fun d -> print_dominfo d) domains; > - Xenlight.ctx_free ctx; > - Xentoollog.destroy logger; > - > + try > + let domains = Xenlight.list_domain ctx in > + List.iter (fun d -> print_dominfo d) domains; > + Xenlight.ctx_free ctx; > + Xentoollog.destroy logger; > + with Xenlight.Error(err, fn) -> begin > + printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) > + fn; end > diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/raise_exception.ml > --- /dev/null Thu Jan 01 00:00:00 1970 +0000 > +++ b/tools/ocaml/test/raise_exception.ml Tue Nov 20 17:22:21 2012 > +0000 > @@ -0,0 +1,15 @@ > +open Printf > +open Xentoollog > +open Xenlight > + > +let _ > + let logger = Xentoollog.create_stdio_logger > +(*~level:Xentoollog.Debug*) () in > + let ctx = Xenlight.ctx_alloc logger in > + try > + Xenlight.test_raise_exception () > + with Xenlight.Error(err, fn) -> begin > + printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) > +fn; > + end; > + Xenlight.ctx_free ctx; > + Xentoollog.destroy logger; > + > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xen.org > http://lists.xen.org/xen-devel