Permalink
Browse files

Remove dependency on lwt from core ring code

Also inline parts of Io_page.t ie a bigarray
  • Loading branch information...
1 parent ec93dbc commit 7951654b9fb13f5b75de0c25e893b44488ed5687 David Scott committed Nov 8, 2012
Showing with 47 additions and 60 deletions.
  1. +30 −34 lib/ring.ml
  2. +17 −26 lib/ring.mli
View
@@ -14,9 +14,14 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
-open Lwt
open Printf
+type buf = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+let sub t off len = Bigarray.Array1.sub t off len
+
+let length t = Bigarray.Array1.dim t
+
let rec pow2 = function
| 0 -> 1
| n -> 2 * (pow2 (n - 1))
@@ -38,26 +43,16 @@ cstruct ring_hdr {
uint64_t stuff
} as little_endian
-(* Allocate a multi-page ring, returning the grants and pages *)
-let allocate ~domid ~order =
- lwt gnt = Gnttab.get () in
- let ring = Io_page.get ~pages_per_block:(pow2 order) () in
-
+let initialise ring =
(* initialise the *_event fields to 1, and the rest to 0 *)
set_ring_hdr_req_prod ring 0l;
set_ring_hdr_req_event ring 1l;
set_ring_hdr_rsp_prod ring 0l;
set_ring_hdr_rsp_event ring 1l;
- set_ring_hdr_stuff ring 0L;
-
- let pages = Io_page.to_pages ring in
- lwt gnts = Gnttab.get_n (List.length pages) in
- let perm = Gnttab.RW in
- List.iter (fun (gnt, page) -> Gnttab.grant_access ~domid ~perm gnt page) (List.combine gnts pages);
- return (gnts, ring)
+ set_ring_hdr_stuff ring 0L
type sring = {
- buf: Io_page.t; (* Overall I/O buffer *)
+ buf: buf; (* Overall I/O buffer *)
header_size: int; (* Header of shared ring variables, in bits *)
idx_size: int; (* Size in bits of an index slot *)
nr_ents: int; (* Number of index entries *)
@@ -70,7 +65,7 @@ let of_buf ~buf ~idx_size ~name =
let round_down_to_nearest_2 x =
int_of_float (2. ** (floor ( (log (float x)) /. (log 2.)))) in
(* Free space in shared ring after header is accounted for *)
- let free_bytes = Io_page.length buf - header_size in
+ let free_bytes = length buf - header_size in
let nr_ents = round_down_to_nearest_2 (free_bytes / idx_size) in
{ name; buf; idx_size; nr_ents; header_size }
@@ -89,24 +84,28 @@ let slot sring idx =
(* TODO should precalculate these and store in the sring? this is fast-path *)
let idx = idx land (sring.nr_ents - 1) in
let off = sring.header_size + (idx * sring.idx_size) in
- Io_page.sub sring.buf off sring.idx_size
+ sub sring.buf off sring.idx_size
module Front = struct
type ('a,'b) t = {
mutable req_prod_pvt: int;
mutable rsp_cons: int;
sring: sring;
+(*
wakers: ('b, 'a Lwt.u) Hashtbl.t; (* id * wakener *)
waiters: unit Lwt.u Lwt_sequence.t;
+*)
}
let init ~sring =
let req_prod_pvt = 0 in
let rsp_cons = 0 in
+(*
let wakers = Hashtbl.create 7 in
let waiters = Lwt_sequence.create () in
- { req_prod_pvt; rsp_cons; sring; wakers; waiters }
+*)
+ { req_prod_pvt; rsp_cons; sring (*; wakers; waiters *) }
let slot t idx = slot t.sring idx
let nr_ents t = t.sring.nr_ents
@@ -155,18 +154,25 @@ module Front = struct
let poll t respfn =
ack_responses t (fun slot ->
let id, resp = respfn slot in
+(*
try
let u = Hashtbl.find t.wakers id in
Hashtbl.remove t.wakers id;
Lwt.wakeup u resp
with Not_found ->
printf "RX: ack id wakener not found\n%!"
+*)
+()
);
+(*
(* Check for any sleepers waiting for free space *)
match Lwt_sequence.take_opt_l t.waiters with
|None -> ()
|Some u -> Lwt.wakeup u ()
+*)
+()
+(*
let wait_for_free_slot t =
if get_free_requests t > 0 then
return ()
@@ -204,6 +210,7 @@ module Front = struct
Hashtbl.add t.wakers id u;
let _ = th >> return (freefn ()) in
return ()
+*)
end
module Back = struct
@@ -212,16 +219,20 @@ module Back = struct
mutable rsp_prod_pvt: int;
mutable req_cons: int;
sring: sring;
+(*
wakers: ('b, 'a Lwt.u) Hashtbl.t; (* id * wakener *)
waiters: unit Lwt.u Lwt_sequence.t;
+*)
}
let init ~sring =
let rsp_prod_pvt = 0 in
let req_cons = 0 in
+(*
let wakers = Hashtbl.create 7 in
let waiters = Lwt_sequence.create () in
- { rsp_prod_pvt; req_cons; sring; wakers; waiters }
+*)
+ { rsp_prod_pvt; req_cons; sring (*; wakers; waiters*) }
let slot t idx = slot t.sring idx
@@ -264,31 +275,20 @@ module Back = struct
done;
if check_for_requests t then ack_requests t fn
- let service_thread t evtchn fn =
- let rec inner () =
- ack_requests t fn;
- Activations.wait evtchn >>
- inner ()
- in inner ()
end
(* Raw ring handling section *)
(* TODO both of these can be combined into one set of bindings now *)
module Console = struct
type t
- let initial_grant_num : Gnttab.r = Gnttab.of_int32 2l
external start_page: unit -> t = "caml_console_start_page"
external zero: t -> unit = "caml_console_ring_init"
external unsafe_write: t -> string -> int -> int = "caml_console_ring_write"
external unsafe_read: t -> string -> int -> int = "caml_console_ring_read"
- let alloc_initial () =
- let page = start_page () in
- initial_grant_num, page
end
module Xenstore = struct
- type t = Io_page.t
- let initial_grant_num : Gnttab.r = Gnttab.of_int32 1l
+ type t = buf
external start_page: unit -> t = "caml_xenstore_start_page"
let of_buf t = t
external zero: t -> unit = "caml_xenstore_ring_init"
@@ -298,9 +298,5 @@ module Xenstore = struct
external unsafe_write : t -> string -> int -> int = "caml_xenstore_back_ring_write"
external unsafe_read : t -> string -> int -> int = "caml_xenstore_back_ring_read"
end
- let alloc_initial () =
- let page = start_page () in
- zero page;
- initial_grant_num, page
end
View
@@ -14,28 +14,22 @@
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*)
-(** Allocate contiguous I/O pages initialised to contain an empty ring,
- that are shared with domain number {[domid]}.
- @param domid domain id to share the I/O page with
- @param order request 2 ** order contiguous pages
- @return Grant table entries and shared pages
- *)
-val allocate : domid:int -> order:int -> (Gnttab.r list * Io_page.t) Lwt.t
-
(** Shared ring handling to communicate with other Xen domains *)
+type buf = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
(** Abstract type for a shared ring *)
type sring
-(** Given a buffer [buf] comprising pre-allocated contiguous
+(** Given a buf [buf] comprising pre-allocated contiguous
I/O pages, return an [sring] where the maximum size of each
request/response is {[idx_size]}.
@param buf pre-allocated contiguous I/O pages
@param idx_size maximum size of each slot, in bytes
@param name Name of the shared ring, for pretty-printing
@return shared ring value
*)
-val of_buf : buf:Io_page.t -> idx_size:int -> name:string -> sring
+val of_buf : buf:buf -> idx_size:int -> name:string -> sring
(** The front-end of the shared ring, which issues requests and reads
responses from the remote domain.
@@ -52,10 +46,10 @@ module Front : sig
val init : sring:sring -> ('a,'b) t
(** Retrieve the request/response slot at the specified index as
- * an Io_page.t.
+ * an buf.
* @param idx Index to retrieve, should be less than nr_ents
*)
- val slot : ('a,'b) t -> int -> Io_page.t
+ val slot : ('a,'b) t -> int -> buf
(** Retrieve number of slots in the shared ring *)
val nr_ents : ('a,'b) t -> int
@@ -76,7 +70,7 @@ module Front : sig
* the responses and wake up any sleeping threads that were
* waiting for that particular response.
*)
- val ack_responses : ('a,'b) t -> (Io_page.t -> unit) -> unit
+ val ack_responses : ('a,'b) t -> (buf -> unit) -> unit
(** Update the shared request producer *)
val push_requests : ('a,'b) t -> unit
@@ -88,25 +82,28 @@ module Front : sig
*)
val push_requests_and_check_notify : ('a,'b) t -> bool
+(*
(** Given a function {[fn]} which writes to a slot and returns
the request id, this will wait for a free request slot,
write the request, and return with the response when it
is available.
@param fn Function that writes to a request slot and returns the request id
@return Thread which returns the response value to the input request
*)
- val push_request_and_wait : ('a,'b) t -> (Io_page.t -> 'b) -> 'a Lwt.t
-
+ val push_request_and_wait : ('a,'b) t -> (buf -> 'b) -> 'a Lwt.t
+*)
(** Poll the ring for responses, and wake up any threads that are
sleeping (as a result of calling {[push_request_and_wait]}).
*)
- val poll : ('a,'b) t -> (Io_page.t -> ('b * 'a)) -> unit
+ val poll : ('a,'b) t -> (buf -> ('b * 'a)) -> unit
+(*
(** Wait for free slot on the ring *)
val wait_for_free_slot : ('a,'b) t -> unit Lwt.t
-
+
(** Push an asynchronous request to the slot and call [freefn] when a response comes in *)
- val push_request_async : ('a,'b) t -> (Io_page.t -> 'b) -> (unit -> unit) -> unit Lwt.t
+ val push_request_async : ('a,'b) t -> (buf -> 'b) -> (unit -> unit) -> unit Lwt.t
+*)
end
module Back : sig
@@ -123,7 +120,7 @@ module Back : sig
* a Io_page.
* @param idx Index to retrieve, should be less than nr_ents
*)
- val slot : ('a,'b) t -> int -> Io_page.t
+ val slot : ('a,'b) t -> int -> buf
(** Retrieve number of slots in the shared ring *)
val nr_ents : ('a,'b) t -> int
@@ -140,17 +137,12 @@ module Back : sig
@return true if an event channel notification is required
*)
val push_responses_and_check_notify : ('a,'b) t -> bool
-
- (** Monitor the ring for requests, calling the given handler
- function for each one. *)
- val service_thread : ('a,'b) t -> int -> (Io_page.t -> unit) -> unit Lwt.t
end
module Console : sig
type t
external unsafe_write : t -> string -> int -> int = "caml_console_ring_write"
external unsafe_read : t -> string -> int -> int = "caml_console_ring_read"
- val alloc_initial : unit -> Gnttab.r * t
end
module Xenstore : sig
@@ -161,6 +153,5 @@ module Xenstore : sig
val unsafe_write : t -> string -> int -> int
val unsafe_read : t -> string -> int -> int
end
- val alloc_initial : unit -> Gnttab.r * t
- val of_buf : Io_page.t -> t
+ val of_buf : buf -> t
end

0 comments on commit 7951654

Please sign in to comment.