Fix the lwt support

This commit is contained in:
Romain Calascibetta 2024-12-11 11:52:44 +01:00
parent 46d4779f4a
commit 7417b45498
4 changed files with 4 additions and 7 deletions

View file

@ -20,8 +20,8 @@ let blit_to_bytes t ~src_off:logical_address buf ~dst_off ~len =
if len < 0 || dst_off < 0 || dst_off > Bytes.length buf - len then if len < 0 || dst_off < 0 || dst_off > Bytes.length buf - len then
invalid_arg "Cachet_lwt.blit_to_bytes"; invalid_arg "Cachet_lwt.blit_to_bytes";
let pagesize = Cachet.pagesize t in let pagesize = Cachet.pagesize t in
let off = logical_address land ((1 lsl pagesize) - 1) in let off = logical_address land (pagesize - 1) in
if is_aligned off && (1 lsl pagesize) - off >= len then if is_aligned off && pagesize - off >= len then
load t ~len logical_address >|= function load t ~len logical_address >|= function
| None -> out_of_bounds logical_address | None -> out_of_bounds logical_address
| Some slice -> | Some slice ->

View file

@ -441,7 +441,7 @@ type 'fd t = {
and 'fd map = 'fd -> pos:int -> int -> bigstring and 'fd map = 'fd -> pos:int -> int -> bigstring
let fd { fd; _ } = fd let fd { fd; _ } = fd
let pagesize { pagesize; _ } = pagesize let pagesize { pagesize; _ } = 1 lsl pagesize
let copy t = let copy t =
{ {
@ -477,7 +477,6 @@ let load t logical_address =
let none : slice option = None let none : slice option = None
let cache_miss t = t.metrics.cache_miss let cache_miss t = t.metrics.cache_miss
let cache_hit t = t.metrics.cache_hit let cache_hit t = t.metrics.cache_hit
let pagesize t = 1 lsl t.pagesize
let load t ?(len = 1) logical_address = let load t ?(len = 1) logical_address =
if len > 1 lsl t.pagesize then if len > 1 lsl t.pagesize then

View file

@ -240,8 +240,6 @@ val cache_hit : 'fd t -> int
val cache_miss : 'fd t -> int val cache_miss : 'fd t -> int
(** [cache_miss t] is the number of times a load didn't hit the cache. *) (** [cache_miss t] is the number of times a load didn't hit the cache. *)
val pagesize : 'fd t -> int
val copy : 'fd t -> 'fd t val copy : 'fd t -> 'fd t
(** [copy t] creates a new, empty cache using the same [map] function. *) (** [copy t] creates a new, empty cache using the same [map] function. *)