Skip to content

Commit

Permalink
libxl: ocaml: propagate the libxl return error code in exceptions
Browse files Browse the repository at this point in the history 
Signed-off-by: Ian Campbell <[email protected]>
Signed-off-by: Rob Hoes <[email protected]>
Acked-by: David Scott <[email protected]>
  • Loading branch information
@robhoes
robhoes authored and Ian Campbell committed Nov 11, 2013
1 parent 40d0e13 commit 38d5aaf
Show file tree
Hide file tree
Showing 4 changed files with 55 additions and 24 deletions.
10 changes: 5 additions & 5 deletions tools/ocaml/libs/xl/genwrap.py
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand All @@ -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"
Expand All @@ -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 += "}"
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down
10 changes: 7 additions & 3 deletions tools/ocaml/libs/xl/xenlight.ml.in
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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, ""))

9 changes: 7 additions & 2 deletions tools/ocaml/libs/xl/xenlight.mli.in
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"

50 changes: 36 additions & 14 deletions tools/ocaml/libs/xl/xenlight_stubs.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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;
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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); \
}
Expand All @@ -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);

Expand All @@ -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++) {
Expand All @@ -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);

Expand All @@ -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);
}
Expand All @@ -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);
}
Expand All @@ -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);
}
Expand All @@ -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);

Expand Down

0 comments on commit 38d5aaf

Please sign in to comment.