ocaml: eventchn: tidy up the module

xen-devel.lists.xenproject.org archive mirror
 help / color / mirror / Atom feed

* ocaml: eventchn: tidy up the module
@ 2013-03-20 20:24 David Scott
  2013-03-20 20:24 ` [PATCH 1/4] ocaml: eventchn: add a 'type t' to represent an event channel David Scott
                   ` (4 more replies)
  0 siblings, 5 replies; 6+ messages in thread
From: David Scott @ 2013-03-20 20:24 UTC (permalink / raw)
  To: xen-devel; +Cc: jonathan.ludlam

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/

^ permalink raw reply	[flat|nested] 6+ messages in thread

* [PATCH 1/4] ocaml: eventchn: add a 'type t' to represent an event channel
  2013-03-20 20:24 ocaml: eventchn: tidy up the module David Scott
@ 2013-03-20 20:24 ` David Scott
  2013-03-20 20:24 ` [PATCH 2/4] ocaml: eventchn: in the interface, we don't have to give implementation details David Scott
                   ` (3 subsequent siblings)
  4 siblings, 0 replies; 6+ messages in thread
From: David Scott @ 2013-03-20 20:24 UTC (permalink / raw)
  To: xen-devel; +Cc: jonathan.ludlam, David Scott

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

^ permalink raw reply related	[flat|nested] 6+ messages in thread

* [PATCH 2/4] ocaml: eventchn: in the interface, we don't have to give implementation details
  2013-03-20 20:24 ocaml: eventchn: tidy up the module David Scott
  2013-03-20 20:24 ` [PATCH 1/4] ocaml: eventchn: add a 'type t' to represent an event channel David Scott
@ 2013-03-20 20:24 ` David Scott
  2013-03-20 20:24 ` [PATCH 3/4] ocaml: eventchn: add ocamldoc strings to the interface David Scott
                   ` (2 subsequent siblings)
  4 siblings, 0 replies; 6+ messages in thread
From: David Scott @ 2013-03-20 20:24 UTC (permalink / raw)
  To: xen-devel; +Cc: jonathan.ludlam, David Scott

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

^ permalink raw reply related	[flat|nested] 6+ messages in thread

* [PATCH 3/4] ocaml: eventchn: add ocamldoc strings to the interface
  2013-03-20 20:24 ocaml: eventchn: tidy up the module David Scott
  2013-03-20 20:24 ` [PATCH 1/4] ocaml: eventchn: add a 'type t' to represent an event channel David Scott
  2013-03-20 20:24 ` [PATCH 2/4] ocaml: eventchn: in the interface, we don't have to give implementation details David Scott
@ 2013-03-20 20:24 ` David Scott
  2013-03-20 20:24 ` [PATCH 4/4] ocaml: eventchn: remove the unused exception 'Eventchn.Error' David Scott
  2013-04-11 11:16 ` ocaml: eventchn: tidy up the module Ian Campbell
  4 siblings, 0 replies; 6+ messages in thread
From: David Scott @ 2013-03-20 20:24 UTC (permalink / raw)
  To: xen-devel; +Cc: jonathan.ludlam, David Scott

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

^ permalink raw reply related	[flat|nested] 6+ messages in thread

* [PATCH 4/4] ocaml: eventchn: remove the unused exception 'Eventchn.Error'
  2013-03-20 20:24 ocaml: eventchn: tidy up the module David Scott
                   ` (2 preceding siblings ...)
  2013-03-20 20:24 ` [PATCH 3/4] ocaml: eventchn: add ocamldoc strings to the interface David Scott
@ 2013-03-20 20:24 ` David Scott
  2013-04-11 11:16 ` ocaml: eventchn: tidy up the module Ian Campbell
  4 siblings, 0 replies; 6+ messages in thread
From: David Scott @ 2013-03-20 20:24 UTC (permalink / raw)
  To: xen-devel; +Cc: jonathan.ludlam, David Scott

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

^ permalink raw reply related	[flat|nested] 6+ messages in thread

* Re: ocaml: eventchn: tidy up the module
  2013-03-20 20:24 ocaml: eventchn: tidy up the module David Scott
                   ` (3 preceding siblings ...)
  2013-03-20 20:24 ` [PATCH 4/4] ocaml: eventchn: remove the unused exception 'Eventchn.Error' David Scott
@ 2013-04-11 11:16 ` Ian Campbell
  4 siblings, 0 replies; 6+ messages in thread
From: Ian Campbell @ 2013-04-11 11:16 UTC (permalink / raw)
  To: David Scott; +Cc: Jonathan Ludlam, xen-devel@lists.xen.org

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 functions

These seem either pretty mechanical or non-dangerous (docs) and it
builds for me so I've applied the lot, thanks,

^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2013-04-11 11:16 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2013-03-20 20:24 ocaml: eventchn: tidy up the module David Scott
2013-03-20 20:24 ` [PATCH 1/4] ocaml: eventchn: add a 'type t' to represent an event channel David Scott
2013-03-20 20:24 ` [PATCH 2/4] ocaml: eventchn: in the interface, we don't have to give implementation details David Scott
2013-03-20 20:24 ` [PATCH 3/4] ocaml: eventchn: add ocamldoc strings to the interface David Scott
2013-03-20 20:24 ` [PATCH 4/4] ocaml: eventchn: remove the unused exception 'Eventchn.Error' David Scott
2013-04-11 11:16 ` ocaml: eventchn: tidy up the module Ian Campbell

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).