src/concrete/concrete_memory.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
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Copyright © 2021-2026 OCamlPro *)
(* Written by the Owi programmers *)

let page_size = 65_536

type t =
  { mutable limits : Binary.Mem.Type.limits
  ; mutable data : bytes
  }

let get_min : Binary.Mem.Type.limits -> int = function
  | I32 { min; _ } -> Int32.to_int min
  | I64 { min; _ } -> min

let set_min (limits : Binary.Mem.Type.limits) new_min : Binary.Mem.Type.limits =
  match limits with
  | I32 l -> I32 { l with min = Int32.of_int new_min }
  | I64 l -> I64 { l with min = new_min }

let init limits : t =
  (* TODO: overflow check? (page_size * limits.min) / page_size = limits.min? *)
  let data = Bytes.make (page_size * get_min limits) '\x00' in
  { limits; data }

let update_memory mem data =
  let limits =
    set_min mem.limits
      (max (get_min mem.limits) (Bytes.length data / page_size))
  in
  mem.limits <- limits;
  mem.data <- data

let grow mem delta =
  let delta = Int32.to_int delta in
  let old_size = Bytes.length mem.data in
  let new_mem = Bytes.extend mem.data 0 delta in
  Bytes.unsafe_fill new_mem old_size delta (Char.chr 0);
  update_memory mem new_mem;
  mem

let fill mem ~pos ~len c =
  let pos = Int32.to_int pos in
  let len = Int32.to_int len in
  Bytes.unsafe_fill mem.data pos len c;
  Ok mem

let blit ~src ~src_idx ~dst ~dst_idx ~len =
  let src_idx = Int32.to_int src_idx in
  let dst_idx = Int32.to_int dst_idx in
  let len = Int32.to_int len in
  Bytes.unsafe_blit src.data src_idx dst.data dst_idx len;
  Ok dst

let blit_string mem str ~src ~dst ~len =
  let src = Int32.to_int src in
  let dst = Int32.to_int dst in
  let len = Int32.to_int len in
  Bytes.unsafe_blit_string str src mem.data dst len;
  Ok mem

let get_limit_max { limits; _ } =
  match limits with
  | I32 { max; _ } -> Option.map (fun maxv -> Int32.to_int maxv) max
  | I64 { max; _ } -> max

let get_limits { limits; _ } = limits

let store_8 mem ~addr n =
  let addr = Int32.to_int addr in
  let n = Int32.to_int n in
  Bytes.set_int8 mem.data addr n;
  Ok mem

let store_16 mem ~addr n =
  let addr = Int32.to_int addr in
  let n = Int32.to_int n in
  Bytes.set_int16_le mem.data addr n;
  Ok mem

let store_32 mem ~addr n =
  let addr = Int32.to_int addr in
  Bytes.set_int32_le mem.data addr n;
  Ok mem

let store_64 mem ~addr n =
  let addr = Int32.to_int addr in
  Bytes.set_int64_le mem.data addr n;
  Ok mem

let store_128 mem ~addr n =
  let addr = Int32.to_int addr in
  let left, right = Concrete_v128.to_i64x2 n in
  Bytes.set_int64_le mem.data addr left;
  Bytes.set_int64_le mem.data (addr + 8) right;
  Ok mem

let load_8_s mem addr =
  let addr = Int32.to_int addr in
  Ok (Int32.of_int @@ Bytes.get_int8 mem.data addr)

let load_8_u mem addr =
  let addr = Int32.to_int addr in
  Ok (Int32.of_int @@ Bytes.get_uint8 mem.data addr)

let load_16_s mem addr =
  let addr = Int32.to_int addr in
  Ok (Int32.of_int @@ Bytes.get_int16_le mem.data addr)

let load_16_u mem addr =
  let addr = Int32.to_int addr in
  Ok (Int32.of_int @@ Bytes.get_uint16_le mem.data addr)

let load_32 mem addr =
  let addr = Int32.to_int addr in
  Ok (Bytes.get_int32_le mem.data addr)

let load_64 mem addr =
  let addr = Int32.to_int addr in
  Ok (Bytes.get_int64_le mem.data addr)

let load_128 mem addr =
  let addr = Int32.to_int addr in
  let left = Bytes.get_int64_le mem.data addr in
  let right = Bytes.get_int64_le mem.data (addr + 8) in
  let v = Concrete_v128.of_i64x2 left right in
  Ok v

let size_in_pages mem = Int32.of_int @@ (Bytes.length mem.data / page_size)

let size mem = Int32.of_int @@ Bytes.length mem.data