Source file mmap.ml

open Utils
open Stdint

module Arch64 = struct
  module Buffer = struct
    type t = Cstruct.t

    let len = Cstruct.length

    let to_string t = Cstruct.to_string t

    let get_char = Cstruct.get_char

    let set_char = Cstruct.set_char

    let get_uint8 = Cstruct.get_uint8

    let set_uint8 = Cstruct.set_uint8

    let get_uint16 = Cstruct.LE.get_uint16

    let set_uint16 = Cstruct.LE.set_uint16

    let get_uint32 = Xcstruct.get_uint32

    let set_uint32 = Xcstruct.set_uint32

    let get_uint64 = Xcstruct.get_uint64

    let set_uint64 = Xcstruct.set_uint64

    let get_index buf i = Index.of_int @@ get_uint32 buf i

    let set_index buf i v = set_uint32 buf i @@ Index.to_int v

    let copy = Cstruct.copy

    let blit_from_string = Cstruct.blit_from_string

    let write_string s buf off =
      blit_from_string s 0 buf off (String.length s)

    let create = Cstruct.create

    let duplicate c =
      Cstruct.of_string (Cstruct.to_string c)
  end

  type t = Bigstring.t

  let null : Bigstring.t = Bigstring.create 0

  let is_null t = t == null

  let make fd ~pos ~shared size : t =
    let open Bigarray in
    let size =
      if size > Int64.of_int Stdlib.max_int then
        failwithf "Size %Ld bytes is too big in this archtecture" size
      else Int64.to_int size
    in
    let ga = Unix.map_file fd ~pos char c_layout shared [| size |] in
    array1_of_genarray ga

  let madvise_random t = Plebeia_msync.Msync.madvise_random @@ Bigarray.genarray_of_array1 t
  let msync t = Plebeia_msync.Msync.msync @@ Bigarray.genarray_of_array1 t
  let msync_lwt t = Plebeia_msync.Msync.Lwt.msync @@ Bigarray.genarray_of_array1 t

  let get_buffer ~off ~len bigstr = Xcstruct.of_bigarray ~off ~len bigstr

  let len = Bigstring.length

  let get_char = Bigstring.get

  let init = Bigstring.init
end

let m : (module Mmap_intf.S) =
  if Sys.word_size >= 64 then (module Arch64)
  else failwith "64bit arch required"

include (val m : Mmap_intf.S)