[Xen-changelog] [xen master] ocaml: eventchn: add a 'type t' to represent an event channel

[patchbot@xxxxxxx]

commit dfb9738cdc8cdbdf38747edfcdcf1bae46f074f2
Author:     David Scott <dave.scott@xxxxxxxxxxxxx>
AuthorDate: Wed Mar 20 20:24:42 2013 +0000
Commit:     Ian Campbell <ian.campbell@xxxxxxxxxx>
CommitDate: Thu Apr 11 12:03:11 2013 +0100

    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@xxxxxxxxxxxxx>
    Acked-by: Ian Campbell <ian.campbell@xxxxxxxxxx>
---
 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 3416666..4045aed 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
--
generated by git-patchbot for /home/xen/git/xen.git#master

_______________________________________________
Xen-changelog mailing list
Xen-changelog@xxxxxxxxxxxxx
http://lists.xensource.com/xen-changelog