Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Page
Library
Module
Module type
Parameter
Class
Class type
Source
rX.ml
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94
(* * Copyright (c) 2010-2013 Anil Madhavapeddy <anil@recoil.org> * Copyright (c) 2014-2015 Citrix Inc * * Permission to use, copy, modify, and distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) module Request = struct type t = { id: int; gref: int32; } let get_req_id c = Cstruct.LE.get_uint16 c 0 let set_req_id c id = Cstruct.LE.set_uint16 c 0 id let get_req_gref c = Cstruct.LE.get_uint32 c 4 let set_req_gref c gref = Cstruct.LE.set_uint32 c 4 gref let sizeof_req = 8 let write t slot = set_req_id slot t.id; set_req_gref slot t.gref let read slot = let id = get_req_id slot in let gref = get_req_gref slot in { id; gref } end module Response = struct type error = int type t = { id: int; offset: int; flags: Flags.t; size: (int, error) result; } let get_resp_id c = Cstruct.LE.get_uint16 c 0 let set_resp_id c id = Cstruct.LE.set_uint16 c 0 id let get_resp_offset c = Cstruct.LE.get_uint16 c 2 let set_resp_offset c off = Cstruct.LE.set_uint16 c 2 off let get_resp_flags c = Cstruct.LE.get_uint16 c 4 let set_resp_flags c fl = Cstruct.LE.set_uint16 c 4 fl let get_resp_status c = Cstruct.LE.get_uint16 c 6 let set_resp_status c s = Cstruct.LE.set_uint16 c 6 s let sizeof_resp = 8 let within_page name x = if x < 0 || x > 4096 then Error (Printf.sprintf "%s is corrupt: expected 0 <= %s <= 4096 but got %d" name name x) else Ok x let read slot = let ( let* ) = Result.bind in let id = get_resp_id slot in let offset = get_resp_offset slot in let* offset = within_page "RX.Response.offset" offset in let flags = Flags.of_int (get_resp_flags slot) in let size = match get_resp_status slot with | status when status > 0 -> Ok status | status -> Error status in Ok { id; offset; flags; size } let write t slot = set_resp_id slot t.id; set_resp_offset slot t.offset; set_resp_flags slot (Flags.to_int t.flags); match t.size with | Ok size -> assert (size > 0); set_resp_status slot size | Error st -> assert (st < 0); set_resp_status slot st let flags t = t.flags let size t = t.size end let total_size = max Request.sizeof_req Response.sizeof_resp let () = assert(total_size = 8)