cachet/lib-solo5/cachet_solo5.ml

63 lines
2.3 KiB
OCaml

let failwithf fmt = Format.kasprintf failwith fmt
open Solo5_os.Solo5
type solo5_block_info = { capacity: int64; block_size: int64 }
type file_descr = int64
external solo5_block_acquire : string -> solo5_result * int64 * solo5_block_info
= "mirage_solo5_block_acquire"
external solo5_block_read :
int64 -> int64 -> Cachet.bigstring -> int -> int -> solo5_result
= "mirage_solo5_block_read_3"
external set_uint8 : Cachet.bigstring -> int -> int -> unit = "%caml_ba_set_1"
external set_int32_ne : Cachet.bigstring -> int -> int32 -> unit
= "%caml_bigstring_set32"
let _max_int31 = 2147483647L
let _max_int63 = 9223372036854775807L
let bstr_empty = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 0
let bstr_create len =
let bstr = Bigarray.Array1.create Bigarray.char Bigarray.c_layout len in
let len0 = len land 3 in
let len1 = len lsr 2 in
for i = 0 to len1 - 1 do
let i = i * 4 in
set_int32_ne bstr i 0l
done;
for i = 0 to len0 - 1 do
let i = (len1 * 4) + i in
set_uint8 bstr i 0
done;
bstr
let connect ?cachesize name =
match solo5_block_acquire name with
| SOLO5_R_AGAIN, _, _ -> assert false
| SOLO5_R_EINVAL, _, _ -> failwithf "connect(%s): Invalid argument" name
| SOLO5_R_EUNSPEC, _, _ -> failwithf "connect(%s): Unspecified error" name
| SOLO5_R_OK, handle, info ->
if Sys.word_size == 32 && info.capacity > _max_int31 then
failwithf "connect(%s): Too large block device" name;
if Sys.word_size == 64 && info.capacity > _max_int63 then
failwithf "connect(%s): Too large block device" name;
if Sys.word_size == 32 && info.block_size > _max_int31 then
failwithf "connect(%s): Too large page size" name;
if Sys.word_size == 64 && info.block_size > _max_int63 then
failwithf "connect(%s): Too large page size" name;
let max = Int64.to_int info.capacity in
let pagesize = Int64.to_int info.block_size in
let map handle ~pos _len =
if pos > max then bstr_empty
else
let len = Int.min (max - pos) pagesize in
let raw = bstr_create pagesize in
match solo5_block_read handle (Int64.of_int pos) raw 0 len with
| SOLO5_R_OK -> raw
| _ -> bstr_empty
in
Cachet.make ?cachesize ~pagesize ~map handle