package granary

  1. Overview
  2. Docs
package granary
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file mirage_backend.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
open Lwt.Syntax

(* Default page size when none is supplied (#95). *)
let default_page_size = 4096

module Make (B : Mirage_block.S) = struct
  type t =
    { dev : B.t
    ; page_size : int
    ; sectors_per_page : int
    ; capacity : int64
    ; mutable n_pages : int64
    }

  let connect ?(page_size = default_page_size) dev =
    let* info = B.get_info dev in
    let sector_size = info.Mirage_block.sector_size in
    if page_size mod sector_size <> 0
    then
      Lwt.fail_with
        (Printf.sprintf
           "mirage_backend: page_size %d not divisible by sector_size %d"
           page_size
           sector_size)
    else (
      let sectors_per_page = page_size / sector_size in
      let capacity =
        Int64.div info.Mirage_block.size_sectors (Int64.of_int sectors_per_page)
      in
      Lwt.return { dev; page_size; sectors_per_page; capacity; n_pages = 0L })
  ;;

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

  let in_capacity t page_id =
    Int64.compare page_id 0L >= 0 && Int64.compare page_id t.capacity < 0
  ;;

  let read_page t ~page_id buf =
    if not (in_capacity t page_id)
    then
      Lwt.return
        (Error
           (Printf.sprintf
              "read_page: page_id=%Ld out of capacity=%Ld"
              page_id
              t.capacity))
    else (
      let sector = Int64.mul page_id (Int64.of_int t.sectors_per_page) in
      let* r = B.read t.dev sector [ buf ] in
      Lwt.return (Result.map_error (Format.asprintf "%a" B.pp_error) r))
  ;;

  let write_page t ~page_id buf =
    if not (in_capacity t page_id)
    then
      Lwt.return
        (Error
           (Printf.sprintf
              "write_page: page_id=%Ld out of capacity=%Ld"
              page_id
              t.capacity))
    else (
      let sector = Int64.mul page_id (Int64.of_int t.sectors_per_page) in
      let* r = B.write t.dev sector [ buf ] in
      Lwt.return (Result.map_error (Format.asprintf "%a" B.pp_write_error) r))
  ;;

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

  let resize t ~n_pages =
    if Int64.compare n_pages t.capacity > 0
    then
      Lwt.return
        (Error
           (Printf.sprintf
              "resize: %Ld pages exceeds device capacity %Ld"
              n_pages
              t.capacity))
    else (
      t.n_pages <- n_pages;
      Lwt.return (Ok ()))
  ;;

  let close t = B.disconnect t.dev
end

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