Source file mem.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
(* Default page size when none is supplied (#95). *)
let default_page_size = 4096

type error =
  | Out_of_bounds of
      { page_id : int64
      ; n_pages : int64
      }

let pp_error fmt = function
  | Out_of_bounds { page_id; n_pages } ->
    Format.fprintf fmt "Out_of_bounds page_id=%Ld n_pages=%Ld" page_id n_pages
;;

type t =
  { mutable pages : Bytes.t array
  ; mutable n_pages : int64
  ; page_size : int (** bytes per page for this device (#95) *)
  }

let pp fmt t = Format.fprintf fmt "Mem.t { n_pages = %Ld }" t.n_pages

let create ?(page_size = default_page_size) ~n_pages () =
  let n = Int64.to_int n_pages in
  let pages = Array.init n (fun _ -> Bytes.make page_size '\x00') in
  { pages; n_pages; page_size }
;;

let n_pages t = t.n_pages
let page_size t = t.page_size

let in_bounds t page_id =
  Int64.compare page_id 0L >= 0 && Int64.compare page_id t.n_pages < 0
;;

let read_page t ~page_id buf =
  if not (in_bounds t page_id)
  then Lwt.return (Error (Out_of_bounds { page_id; n_pages = t.n_pages }))
  else (
    let src = t.pages.(Int64.to_int page_id) in
    (* Transfer the caller's buffer length (#95): a short read (e.g. the
       4096-byte geometry peek of page 0) reads only the leading bytes. *)
    let n = min (Bytes.length src) (Cstruct.length buf) in
    Cstruct.blit_from_bytes src 0 buf 0 n;
    Lwt.return (Ok ()))
;;

let write_page t ~page_id buf =
  if not (in_bounds t page_id)
  then Lwt.return (Error (Out_of_bounds { page_id; n_pages = t.n_pages }))
  else (
    let dst = t.pages.(Int64.to_int page_id) in
    let n = min (Bytes.length dst) (Cstruct.length buf) in
    Cstruct.blit_to_bytes buf 0 dst 0 n;
    Lwt.return (Ok ()))
;;

let sync _ = Lwt.return (Ok ())

let resize t ~n_pages =
  let n = Int64.to_int n_pages in
  let cur = Array.length t.pages in
  if n > cur
  then (
    let extra = Array.init (n - cur) (fun _ -> Bytes.make t.page_size '\x00') in
    t.pages <- Array.append t.pages extra)
  else if n < cur
  then t.pages <- Array.sub t.pages 0 n;
  t.n_pages <- n_pages;
  Lwt.return (Ok ())
;;

[@@@ai_disclosure "ai-generated"]
[@@@ai_model "claude-opus-4-7"]
[@@@ai_provider "Anthropic"]