xen-devel.lists.xenproject.org archive mirror
 help / color / mirror / Atom feed
From: Rob Hoes <rob.hoes@citrix.com>
To: xen-devel@lists.xen.org
Cc: ian.campbell@citrix.com, Rob Hoes <rob.hoes@citrix.com>
Subject: [PATCH 11/28] libxl: ocaml: propagate the libxl return error code in exceptions
Date: Mon, 25 Mar 2013 14:45:12 +0000	[thread overview]
Message-ID: <1364222729-6982-12-git-send-email-rob.hoes@citrix.com> (raw)
In-Reply-To: <1364222729-6982-1-git-send-email-rob.hoes@citrix.com>

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   |   45 ++++++++++++++++++++---
 tools/ocaml/libs/xl/xenlight.mli.in  |   28 ++++++++++++---
 tools/ocaml/libs/xl/xenlight_stubs.c |   66 +++++++++++++++++++++++++++-------
 4 files changed, 123 insertions(+), 26 deletions(-)

diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index b087817..9e440ae 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, struct_tag = 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
@@ -351,7 +351,7 @@ def ocaml_Val(ty, o, c, indent="", parent = None, struct_tag = 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 319c593..3e83355 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -13,20 +13,55 @@
  * GNU Lesser General Public License for more details.
  *)
 
-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
 
-type domid = int
-type devid = int
+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"
 
-(* @@LIBXL_TYPES@@ *)
+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
+
+(* @@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 c797ceb..e562c4b 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -13,18 +13,38 @@
  * GNU Lesser General Public License for more details.
  *)
 
-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
 
-type domid = int
-type devid = int
+val string_of_error: error -> string
 
-(* @@LIBXL_TYPES@@ *)
+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
+
+(* @@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 c65d22d..6c26a6a 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -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)
@@ -59,7 +101,7 @@ CAMLprim value stub_libxl_ctx_alloc(value logger)
 
 	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");
 	CAMLreturn((value)ctx);
 }
 
@@ -185,7 +227,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);
@@ -281,7 +323,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);						\
 }
@@ -307,7 +349,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);
 
@@ -326,7 +368,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++) {
@@ -351,7 +393,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);
 
@@ -373,7 +415,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);
 }
@@ -390,7 +432,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);
 }
@@ -403,7 +445,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);
 }
@@ -418,7 +460,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

  parent reply	other threads:[~2013-03-25 14:45 UTC|newest]

Thread overview: 87+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2013-03-25 14:45 [PATCH 00/28] libxl: ocaml: improve the bindings Rob Hoes
2013-03-25 14:45 ` [PATCH 01/28] libxl: Add LIBXL_SHUTDOWN_REASON_UNKNOWN Rob Hoes
2013-03-25 14:45 ` [PATCH 02/28] libxl: idl: allow KeyedUnion members to be empty Rob Hoes
2013-03-25 14:45 ` [PATCH 03/28] libxl: ocaml: fix code intended to output comments before definitions Rob Hoes
2013-03-25 14:45 ` [PATCH 04/28] libxl: ocaml: support for Arrays in bindings generator Rob Hoes
2013-03-25 14:45 ` [PATCH 05/28] libxl: ocaml: avoid reserved words in type and field names Rob Hoes
2013-03-25 14:45 ` [PATCH 06/28] libxl: ocaml: support for KeyedUnion in the bindings generator Rob Hoes
2013-03-26  9:21   ` David Scott
2013-04-05 13:37     ` Rob Hoes
2013-03-25 14:45 ` [PATCH 07/28] libxl: ocaml: add some more builtin types Rob Hoes
2013-03-25 14:45 ` [PATCH 08/28] libxc: ocaml: add simple binding for xentoollog (output only) Rob Hoes
2013-03-26 11:14   ` David Scott
2013-04-05 14:04     ` Rob Hoes
2013-04-11 11:31       ` Ian Campbell
2013-04-15  9:39         ` David Scott
2013-04-15  9:47           ` Ian Campbell
2013-03-25 14:45 ` [PATCH 09/28] libxl: ocaml: allocate a long lived libxl context Rob Hoes
2013-03-25 14:45 ` [PATCH 10/28] libxl: ocaml: switch all functions over to take a context Rob Hoes
2013-03-25 14:45 ` Rob Hoes [this message]
2013-03-26 11:33   ` [PATCH 11/28] libxl: ocaml: propagate the libxl return error code in exceptions David Scott
2013-04-05 14:15     ` Rob Hoes
2013-04-11 11:33     ` Ian Campbell
2013-04-23 13:28       ` Rob Hoes
2013-03-25 14:45 ` [PATCH 12/28] libxl: ocaml: add domain_build/create_info/config and events to the bindings Rob Hoes
2013-03-25 14:45 ` [PATCH 13/28] libxl: idl: add domain_type field to libxl_dominfo struct Rob Hoes
2013-04-11 11:19   ` Ian Campbell
2013-04-23 13:10     ` Rob Hoes
2013-04-23 13:21       ` Ian Campbell
2013-04-23 13:27         ` Rob Hoes
2013-03-25 14:45 ` [PATCH 14/28] libxl: ocaml: fix the META file Rob Hoes
2013-04-11 11:20   ` Ian Campbell
2013-03-25 14:45 ` [PATCH 15/28] libxl: ocaml: fix the handling of enums in the bindings generator Rob Hoes
2013-04-11 11:20   ` Ian Campbell
2013-03-25 14:45 ` [PATCH 16/28] libxl: ocaml: use the "string option" type for IDL strings Rob Hoes
2013-03-26 11:43   ` David Scott
2013-04-05 14:17     ` Rob Hoes
2013-03-25 14:45 ` [PATCH 17/28] libxl: ocaml: add with_ctx helper function Rob Hoes
2013-04-11 11:19   ` Ian Campbell
2013-04-23 13:03     ` Rob Hoes
2013-03-25 14:45 ` [PATCH 18/28] libxl: ocaml: add xen_console_read Rob Hoes
2013-03-26 11:48   ` David Scott
2013-03-26 15:27     ` Andrew Cooper
2013-04-05 14:33       ` Rob Hoes
2013-03-25 14:45 ` [PATCH 19/28] libxl: ocaml: add dominfo_list and dominfo_get Rob Hoes
2013-04-11 11:23   ` Ian Campbell
2013-04-23 13:18     ` Rob Hoes
2013-03-25 14:45 ` [PATCH 20/28] libxl: ocaml: implement some simple tests Rob Hoes
2013-03-25 14:45 ` [PATCH 21/28] libxl: ocaml: add wrappers for poll Rob Hoes
2013-03-26 11:53   ` David Scott
2013-04-05 14:18     ` Rob Hoes
2013-04-11 12:31   ` Ian Campbell
2013-04-23 13:37     ` Rob Hoes
2013-04-23 13:43       ` Ian Campbell
2013-04-23 13:56         ` David Scott
2013-04-23 15:31           ` Ian Campbell
2013-04-25  9:09         ` Rob Hoes
2013-03-25 14:45 ` [PATCH 22/28] libxl: ocaml: event management Rob Hoes
2013-03-26 11:55   ` David Scott
2013-03-26 12:03   ` David Scott
2013-04-05 14:20     ` Rob Hoes
2013-04-11 12:41   ` Ian Campbell
2013-04-23 15:33     ` Rob Hoes
2013-04-23 15:58       ` Ian Campbell
2013-04-23 16:30         ` Rob Hoes
2013-04-23 16:39           ` Ian Campbell
2013-04-23 16:50             ` Ian Jackson
2013-04-24  9:02               ` Ian Campbell
2013-04-25  8:58                 ` Rob Hoes
2013-04-23 16:14       ` Ian Jackson
2013-03-25 14:45 ` [PATCH 23/28] libxl: ocaml: allow device operations to be called asynchronously Rob Hoes
2013-04-11 12:51   ` Ian Campbell
2013-04-23 15:59     ` Rob Hoes
2013-03-25 14:45 ` [PATCH 24/28] libxl: ocaml: add NIC helper functions Rob Hoes
2013-04-11 12:56   ` Ian Campbell
2013-04-23 17:04     ` Rob Hoes
2013-03-25 14:45 ` [PATCH 25/28] libxl: ocaml: add PCI device " Rob Hoes
2013-04-11 12:56   ` Ian Campbell
2013-03-25 14:45 ` [PATCH 26/28] libxl: ocaml: add disk and cdrom " Rob Hoes
2013-04-11 12:58   ` Ian Campbell
2013-04-29 11:41     ` Rob Hoes
2013-03-25 14:45 ` [PATCH 27/28] libxl: ocaml: add VM lifecycle operations Rob Hoes
2013-04-11 13:03   ` Ian Campbell
2013-04-29 14:01     ` Rob Hoes
2013-03-25 14:45 ` [PATCH 28/28] libxl: ocaml: provide default records for libxl types Rob Hoes
2013-04-11 13:08   ` Ian Campbell
2013-04-29 14:13     ` Rob Hoes
2013-04-29 14:19       ` Ian Campbell

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1364222729-6982-12-git-send-email-rob.hoes@citrix.com \
    --to=rob.hoes@citrix.com \
    --cc=ian.campbell@citrix.com \
    --cc=xen-devel@lists.xen.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).