Hi, The following patches improve the Xeneventchn interface by: * adding an opaque type to represent a local event channel binding * hiding implementation details from the .mli * adding ocamldoc strings to describe the functions The Xeneventchn interface is now compatible with the Mirage[1] minios-based Eventchn interface so it''s now possible to compile the same code for both a Mirage kernel and Unix userspace (tested by building git://github.com/djs55/ocaml-xen-block-driver although note this still requires external grantdev bindings) The last patch removes an unused exception. Cheers, Dave [1] Mirage: http://www.openmirage.org/
David Scott
2013-Mar-20 20:24 UTC
[PATCH 1/4] ocaml: eventchn: add a ''type t'' to represent an event channel
It''s a common OCaml convention to add a ''type t'' in a
module to
represent the main "thing" that the module is about. We add an
opaque type t and to_int/of_int functions for those who really
need it, in particular:
1. to_int is needed for debug logging; and
2. both to_int and of_int are needed for anyone who communicates
a port number through xenstore.
Signed-off-by: David Scott <dave.scott@eu.citrix.com>
---
tools/ocaml/libs/eventchn/xeneventchn.ml | 6 ++++++
tools/ocaml/libs/eventchn/xeneventchn.mli | 17 +++++++++++------
tools/ocaml/xenstored/domain.ml | 28 ++++++++++++++++++++--------
tools/ocaml/xenstored/event.ml | 6 +++---
tools/ocaml/xenstored/xenstored.ml | 2 +-
5 files changed, 41 insertions(+), 18 deletions(-)
diff --git a/tools/ocaml/libs/eventchn/xeneventchn.ml
b/tools/ocaml/libs/eventchn/xeneventchn.ml
index 79ad9b1..acebe10 100644
--- a/tools/ocaml/libs/eventchn/xeneventchn.ml
+++ b/tools/ocaml/libs/eventchn/xeneventchn.ml
@@ -20,6 +20,9 @@ type handle
external init: unit -> handle = "stub_eventchn_init"
external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
+
+type t = int
+
external notify: handle -> int -> unit = "stub_eventchn_notify"
external bind_interdomain: handle -> int -> int -> int =
"stub_eventchn_bind_interdomain"
external bind_dom_exc_virq: handle -> int =
"stub_eventchn_bind_dom_exc_virq"
@@ -27,4 +30,7 @@ external unbind: handle -> int -> unit =
"stub_eventchn_unbind"
external pending: handle -> int = "stub_eventchn_pending"
external unmask: handle -> int -> unit = "stub_eventchn_unmask"
+let to_int x = x
+let of_int x = x
+
let _ = Callback.register_exception "eventchn.error" (Error
"register_callback")
diff --git a/tools/ocaml/libs/eventchn/xeneventchn.mli
b/tools/ocaml/libs/eventchn/xeneventchn.mli
index 394acc2..2b582cd 100644
--- a/tools/ocaml/libs/eventchn/xeneventchn.mli
+++ b/tools/ocaml/libs/eventchn/xeneventchn.mli
@@ -18,14 +18,19 @@ exception Error of string
type handle
+type t
+
+val to_int: t -> int
+val of_int: int -> t
+
external init : unit -> handle = "stub_eventchn_init"
external fd: handle -> Unix.file_descr = "stub_eventchn_fd"
-external notify : handle -> int -> unit =
"stub_eventchn_notify"
-external bind_interdomain : handle -> int -> int -> int
+external notify : handle -> t -> unit = "stub_eventchn_notify"
+external bind_interdomain : handle -> int -> int -> t
= "stub_eventchn_bind_interdomain"
-external bind_dom_exc_virq : handle -> int =
"stub_eventchn_bind_dom_exc_virq"
-external unbind : handle -> int -> unit =
"stub_eventchn_unbind"
-external pending : handle -> int = "stub_eventchn_pending"
-external unmask : handle -> int -> unit
+external bind_dom_exc_virq : handle -> t =
"stub_eventchn_bind_dom_exc_virq"
+external unbind : handle -> t -> unit = "stub_eventchn_unbind"
+external pending : handle -> t = "stub_eventchn_pending"
+external unmask : handle -> t -> unit
= "stub_eventchn_unmask"
diff --git a/tools/ocaml/xenstored/domain.ml b/tools/ocaml/xenstored/domain.ml
index c17f567..85ab282 100644
--- a/tools/ocaml/xenstored/domain.ml
+++ b/tools/ocaml/xenstored/domain.ml
@@ -17,6 +17,7 @@
open Printf
let debug fmt = Logging.debug "domain" fmt
+let warn fmt = Logging.warn "domain" fmt
type t {
@@ -25,7 +26,7 @@ type t remote_port: int;
interface: Xenmmap.mmap_interface;
eventchn: Event.t;
- mutable port: int;
+ mutable port: Xeneventchn.t option;
}
let get_path dom = "/local/domain/" ^ (sprintf "%u" dom.id)
@@ -34,19 +35,30 @@ let get_interface d = d.interface
let get_mfn d = d.mfn
let get_remote_port d = d.remote_port
+let string_of_port = function
+| None -> "None"
+| Some x -> string_of_int (Xeneventchn.to_int x)
+
let dump d chan - fprintf chan "dom,%d,%nd,%d\n" d.id d.mfn d.port
+ fprintf chan "dom,%d,%nd,%s\n" d.id d.mfn (string_of_port d.port)
-let notify dom = Event.notify dom.eventchn dom.port; ()
+let notify dom = match dom.port with
+| None ->
+ warn "domain %d: attempt to notify on unknown port" dom.id
+| Some port ->
+ Event.notify dom.eventchn port
let bind_interdomain dom - dom.port <- Event.bind_interdomain dom.eventchn
dom.id dom.remote_port;
- debug "domain %d bound port %d" dom.id dom.port
+ dom.port <- Some (Event.bind_interdomain dom.eventchn dom.id
dom.remote_port);
+ debug "domain %d bound port %s" dom.id (string_of_port dom.port)
let close dom - debug "domain %d unbound port %d" dom.id dom.port;
- Event.unbind dom.eventchn dom.port;
+ debug "domain %d unbound port %s" dom.id (string_of_port dom.port);
+ begin match dom.port with
+ | None -> ()
+ | Some port -> Event.unbind dom.eventchn port
+ end;
Xenmmap.unmap dom.interface;
()
@@ -56,7 +68,7 @@ let make id mfn remote_port interface eventchn = {
remote_port = remote_port;
interface = interface;
eventchn = eventchn;
- port = -1
+ port = None
}
let is_dom0 d = d.id = 0
diff --git a/tools/ocaml/xenstored/event.ml b/tools/ocaml/xenstored/event.ml
index cca8d93..ccca90b 100644
--- a/tools/ocaml/xenstored/event.ml
+++ b/tools/ocaml/xenstored/event.ml
@@ -17,12 +17,12 @@
(**************** high level binding ****************)
type t = {
handle: Xeneventchn.handle;
- mutable virq_port: int;
+ mutable virq_port: Xeneventchn.t option;
}
-let init () = { handle = Xeneventchn.init (); virq_port = -1; }
+let init () = { handle = Xeneventchn.init (); virq_port = None; }
let fd eventchn = Xeneventchn.fd eventchn.handle
-let bind_dom_exc_virq eventchn = eventchn.virq_port <-
Xeneventchn.bind_dom_exc_virq eventchn.handle
+let bind_dom_exc_virq eventchn = eventchn.virq_port <- Some
(Xeneventchn.bind_dom_exc_virq eventchn.handle)
let bind_interdomain eventchn domid port = Xeneventchn.bind_interdomain
eventchn.handle domid port
let unbind eventchn port = Xeneventchn.unbind eventchn.handle port
let notify eventchn port = Xeneventchn.notify eventchn.handle port
diff --git a/tools/ocaml/xenstored/xenstored.ml
b/tools/ocaml/xenstored/xenstored.ml
index 64cc106..c3c4661 100644
--- a/tools/ocaml/xenstored/xenstored.ml
+++ b/tools/ocaml/xenstored/xenstored.ml
@@ -300,7 +300,7 @@ let _ and handle_eventchn fd let port = Event.pending
eventchn in
finally (fun () ->
- if port = eventchn.Event.virq_port then (
+ if Some port = eventchn.Event.virq_port then (
let (notify, deaddom) = Domains.cleanup xc domains in
List.iter (Connections.del_domain cons) deaddom;
if deaddom <> [] || notify then
--
1.8.1.2
David Scott
2013-Mar-20 20:24 UTC
[PATCH 2/4] ocaml: eventchn: in the interface, we don''t have to give implementation details
Remove the mention of the C function names from the .mli -- this is only needed in the implementation .ml Signed-off-by: David Scott <dave.scott@eu.citrix.com> --- tools/ocaml/libs/eventchn/xeneventchn.mli | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/tools/ocaml/libs/eventchn/xeneventchn.mli b/tools/ocaml/libs/eventchn/xeneventchn.mli index 2b582cd..74e581b 100644 --- a/tools/ocaml/libs/eventchn/xeneventchn.mli +++ b/tools/ocaml/libs/eventchn/xeneventchn.mli @@ -23,14 +23,13 @@ type t val to_int: t -> int val of_int: int -> t -external init : unit -> handle = "stub_eventchn_init" -external fd: handle -> Unix.file_descr = "stub_eventchn_fd" +val init: unit -> handle +val fd: handle -> Unix.file_descr -external notify : handle -> t -> unit = "stub_eventchn_notify" -external bind_interdomain : handle -> int -> int -> t - = "stub_eventchn_bind_interdomain" -external bind_dom_exc_virq : handle -> t = "stub_eventchn_bind_dom_exc_virq" -external unbind : handle -> t -> unit = "stub_eventchn_unbind" -external pending : handle -> t = "stub_eventchn_pending" -external unmask : handle -> t -> unit - = "stub_eventchn_unmask" +val notify : handle -> t -> unit +val bind_interdomain : handle -> int -> int -> t + +val bind_dom_exc_virq : handle -> t +val unbind : handle -> t -> unit +val pending : handle -> t +val unmask : handle -> t -> unit -- 1.8.1.2
David Scott
2013-Mar-20 20:24 UTC
[PATCH 3/4] ocaml: eventchn: add ocamldoc strings to the interface
Also add a reference to tools/libxc/xenctrl.h, which is where the underlying C functions are defined. Signed-off-by: David Scott <dave.scott@eu.citrix.com> --- tools/ocaml/libs/eventchn/xeneventchn.mli | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/tools/ocaml/libs/eventchn/xeneventchn.mli b/tools/ocaml/libs/eventchn/xeneventchn.mli index 74e581b..a35743b 100644 --- a/tools/ocaml/libs/eventchn/xeneventchn.mli +++ b/tools/ocaml/libs/eventchn/xeneventchn.mli @@ -14,22 +14,51 @@ * GNU Lesser General Public License for more details. *) +(** Event channel bindings: see tools/libxc/xenctrl.h *) + exception Error of string type handle +(** An initialised event channel interface. *) type t +(** A local event channel. *) val to_int: t -> int + val of_int: int -> t val init: unit -> handle +(** Return an initialised event channel interface. On error it + will throw a Failure exception. *) + val fd: handle -> Unix.file_descr +(** Return a file descriptor suitable for Unix.select. When + the descriptor becomes readable, it is safe to call ''pending''. + On error it will throw a Failure exception. *) val notify : handle -> t -> unit +(** Notify the given event channel. On error it will throw a + Failure exception. *) + val bind_interdomain : handle -> int -> int -> t +(** [bind_interdomain h domid remote_port] returns a local event + channel connected to domid:remote_port. On error it will + throw a Failure exception. *) val bind_dom_exc_virq : handle -> t +(** Binds a local event channel to the VIRQ_DOM_EXC + (domain exception VIRQ). On error it will throw a Failure + exception. *) + val unbind : handle -> t -> unit +(** Unbinds the given event channel. On error it will throw a + Failure exception. *) + val pending : handle -> t +(** Returns the next event channel to become pending. On error it + will throw a Failure exception. *) + val unmask : handle -> t -> unit +(** Unmasks the given event channel. On error it will throw a + Failure exception. *) -- 1.8.1.2
David Scott
2013-Mar-20 20:24 UTC
[PATCH 4/4] ocaml: eventchn: remove the unused exception ''Eventchn.Error''
Signed-off-by: David Scott <dave.scott@eu.citrix.com> --- tools/ocaml/libs/eventchn/xeneventchn.ml | 4 ---- tools/ocaml/libs/eventchn/xeneventchn.mli | 2 -- 2 files changed, 6 deletions(-) diff --git a/tools/ocaml/libs/eventchn/xeneventchn.ml b/tools/ocaml/libs/eventchn/xeneventchn.ml index acebe10..89edb92 100644 --- a/tools/ocaml/libs/eventchn/xeneventchn.ml +++ b/tools/ocaml/libs/eventchn/xeneventchn.ml @@ -14,8 +14,6 @@ * GNU Lesser General Public License for more details. *) -exception Error of string - type handle external init: unit -> handle = "stub_eventchn_init" @@ -32,5 +30,3 @@ external unmask: handle -> int -> unit = "stub_eventchn_unmask" let to_int x = x let of_int x = x - -let _ = Callback.register_exception "eventchn.error" (Error "register_callback") diff --git a/tools/ocaml/libs/eventchn/xeneventchn.mli b/tools/ocaml/libs/eventchn/xeneventchn.mli index a35743b..e4e02a4 100644 --- a/tools/ocaml/libs/eventchn/xeneventchn.mli +++ b/tools/ocaml/libs/eventchn/xeneventchn.mli @@ -16,8 +16,6 @@ (** Event channel bindings: see tools/libxc/xenctrl.h *) -exception Error of string - type handle (** An initialised event channel interface. *) -- 1.8.1.2
On Wed, 2013-03-20 at 20:24 +0000, David Scott wrote:> Hi, > > The following patches improve the Xeneventchn interface by: > * adding an opaque type to represent a local event channel binding > * hiding implementation details from the .mli > * adding ocamldoc strings to describe the functionsThese seem either pretty mechanical or non-dangerous (docs) and it builds for me so I''ve applied the lot, thanks,