From: Rob Hoes Date: Wed, 6 Nov 2013 17:49:49 +0000 (+0000) Subject: libxl: ocaml: propagate the libxl return error code in exceptions X-Git-Tag: 4.4.0-rc1~285 X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=38d5aaff4c495eae2d06999a6a18a07eaf719833;p=xen.git libxl: ocaml: propagate the libxl return error code in exceptions Signed-off-by: Ian Campbell Signed-off-by: Rob Hoes Acked-by: David Scott --- diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py index 0f73e26eae..e072386f09 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 dffba72d92..a2814252e6 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 e2686bb284..d663196cbb 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 dd6c781124..67612f486f 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