[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Xen-devel] [PATCH v2 13/30] libxl: ocaml: propagate the libxl return error code in exceptions



Signed-off-by: Ian Campbell <ian.campbell@xxxxxxxxxx>
Signed-off-by: Rob Hoes <rob.hoes@xxxxxxxxxx>
---
 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


_______________________________________________
Xen-devel mailing list
Xen-devel@xxxxxxxxxxxxx
http://lists.xen.org/xen-devel


 


Rackspace

Lists.xenproject.org is hosted with RackSpace, monitoring our
servers 24x7x365 and backed by RackSpace's Fanatical Support®.