(** * Operations over memory stores *)

(** The initial store *)

Program Definition empty: mem :=
  mkmem (PMap.init (ZMap.init Undef))
        (PMap.init (fun ofs k => None))
        1%positive _ _ _.(** Allocation of a fresh block with the given bounds.  Return an updated
  memory state and the address of the fresh block, which initially contains
  undefined cells.  Note that allocation never fails: we model an
  infinite memory. *)

Program Definition alloc (m: mem) (lo hi: Z) :=
  (mkmem (PMap.set m.(nextblock)
                   (ZMap.init Undef)
                   m.(mem_contents))
         (PMap.set m.(nextblock)
                   (fun ofs k => if zle lo ofs && zlt ofs hi then Some Freeable else None)
                   m.(mem_access))
         (Pos.succ m.(nextblock))
         _ _ _,
   m.(nextblock)).Definition free (m: mem) (b: block) (lo hi: Z): option mem :=
  if range_perm_dec m b lo hi Cur Freeable
  then Some(unchecked_free m b lo hi)
  else None.Fixpoint free_list (m: mem) (l: list (block * Z * Z)) {struct l}: option mem :=
  match l with
  | nil => Some m
  | (b, lo, hi) :: l' =>
      match free m b lo hi with
      | None => None
      | Some m' => free_list m' l'
      end
  end.(** Memory reads. *)

(** Reading N adjacent bytes in a block content. *)

Fixpoint getN (n: nat) (p: Z) (c: ZMap.t memval) {struct n}: list memval :=
  match n with
  | O => nil
  | S n' => ZMap.get p c :: getN n' (p + 1) c
  end.(** [loadv chunk m addr] is similar, but the address and offset are given
  as a single value [addr], which must be a pointer value. *)

Definition loadv (chunk: memory_chunk) (m: mem) (addr: val) : option val :=
  match addr with
  | Vptr b ofs => load chunk m b (Ptrofs.unsigned ofs)
  | _ => None
  end.(** Memory stores. *)

(** Writing N adjacent bytes in a block content. *)

Fixpoint setN (vl: list memval) (p: Z) (c: ZMap.t memval) {struct vl}: ZMap.t memval :=
  match vl with
  | nil => c
  | v :: vl' => setN vl' (p + 1) (ZMap.set p v c)
  end.Remark setN_other:
  forall vl c p q,
  (forall r, p <= r < p + Z.of_nat (length vl) -> r <> q) ->
  ZMap.get q (setN vl p c) = ZMap.get q c.Remark setN_outside:
  forall vl c p q,
  q < p \/ q >= p + Z.of_nat (length vl) ->
  ZMap.get q (setN vl p c) = ZMap.get q c.Remark getN_setN_same:
  forall vl p c,
  getN (length vl) p (setN vl p c) = vl.Remark getN_exten:
  forall c1 c2 n p,
  (forall i, p <= i < p + Z.of_nat n -> ZMap.get i c1 = ZMap.get i c2) ->
  getN n p c1 = getN n p c2.Remark getN_setN_disjoint:
  forall vl q c n p,
  Intv.disjoint (p, p + Z.of_nat n) (q, q + Z.of_nat (length vl)) ->
  getN n p (setN vl q c) = getN n p c.Remark getN_setN_outside:
  forall vl q c n p,
  p + Z.of_nat n <= q \/ q + Z.of_nat (length vl) <= p ->
  getN n p (setN vl q c) = getN n p c.Remark setN_default:
  forall vl q c, fst (setN vl q c) = fst c.(** [storev chunk m addr v] is similar, but the address and offset are given
  as a single value [addr], which must be a pointer value. *)

Definition storev (chunk: memory_chunk) (m: mem) (addr v: val) : option mem :=
  match addr with
  | Vptr b ofs => store chunk m b (Ptrofs.unsigned ofs) v
  | _ => None
  end.

(* Specifications: *)
Theorem nextblock_empty: nextblock empty = 1%positive.
Theorem perm_empty: forall b ofs k p, ~perm empty b ofs k p.
Theorem valid_access_empty: forall chunk b ofs p, ~valid_access empty chunk b ofs p.
Theorem valid_access_load: forall m chunk b ofs, valid_access m chunk b ofs Readable -> exists v, load chunk m b ofs = Some v.
Theorem load_valid_access: forall m chunk b ofs v, load chunk m b ofs = Some v -> valid_access m chunk b ofs Readable.
Theorem load_type: forall m chunk b ofs v, load chunk m b ofs = Some v -> Val.has_type v (type_of_chunk chunk).
Theorem load_cast: forall m chunk b ofs v, load chunk m b ofs = Some v -> match chunk with | Mint8signed => v = Val.sign_ext 8 v | Mint8unsigned => v = Val.zero_ext 8 v | Mint16signed => v = Val.sign_ext 16 v | Mint16unsigned => v = Val.zero_ext 16 v | _ => True end.
Theorem load_int8_signed_unsigned: forall m b ofs, load Mint8signed m b ofs = option_map (Val.sign_ext 8) (load Mint8unsigned m b ofs).
Theorem load_int16_signed_unsigned: forall m b ofs, load Mint16signed m b ofs = option_map (Val.sign_ext 16) (load Mint16unsigned m b ofs).
Theorem range_perm_loadbytes: forall m b ofs len, range_perm m b ofs (ofs + len) Cur Readable -> exists bytes, loadbytes m b ofs len = Some bytes.
Theorem loadbytes_range_perm: forall m b ofs len bytes, loadbytes m b ofs len = Some bytes -> range_perm m b ofs (ofs + len) Cur Readable.
Theorem load_loadbytes: forall chunk m b ofs v, load chunk m b ofs = Some v -> exists bytes, loadbytes m b ofs (size_chunk chunk) = Some bytes /\ v = decode_val chunk bytes.
Lemma getN_length: forall c n p, length (getN n p c) = n.
Theorem loadbytes_length: forall m b ofs n bytes, loadbytes m b ofs n = Some bytes -> length bytes = nat_of_Z n.
Theorem loadbytes_empty: forall m b ofs n, n <= 0 -> loadbytes m b ofs n = Some nil.
Lemma getN_concat: forall c n1 n2 p, getN (n1 + n2)%nat p c = getN n1 p c ++ getN n2 (p + Z.of_nat n1) c.
Theorem loadbytes_concat: forall m b ofs n1 n2 bytes1 bytes2, loadbytes m b ofs n1 = Some bytes1 -> loadbytes m b (ofs + n1) n2 = Some bytes2 -> n1 >= 0 -> n2 >= 0 -> loadbytes m b ofs (n1 + n2) = Some(bytes1 ++ bytes2).
Theorem loadbytes_split: forall m b ofs n1 n2 bytes, loadbytes m b ofs (n1 + n2) = Some bytes -> n1 >= 0 -> n2 >= 0 -> exists bytes1, exists bytes2, loadbytes m b ofs n1 = Some bytes1 /\ loadbytes m b (ofs + n1) n2 = Some bytes2 /\ bytes = bytes1 ++ bytes2.
Theorem load_int64_split: forall m b ofs v, load Mint64 m b ofs = Some v -> Archi.ptr64 = false -> exists v1 v2, load Mint32 m b ofs = Some (if Archi.big_endian then v1 else v2) /\ load Mint32 m b (ofs + 4) = Some (if Archi.big_endian then v2 else v1) /\ Val.lessdef v (Val.longofwords v1 v2).
Theorem loadv_int64_split: forall m a v, loadv Mint64 m a = Some v -> Archi.ptr64 = false -> exists v1 v2, loadv Mint32 m a = Some (if Archi.big_endian then v1 else v2) /\ loadv Mint32 m (Val.add a (Vint (Int.repr 4))) = Some (if Archi.big_endian then v2 else v1) /\ Val.lessdef v (Val.longofwords v1 v2).
Theorem valid_access_store: forall m1 chunk b ofs v, valid_access m1 chunk b ofs Writable -> { m2: mem | store chunk m1 b ofs v = Some m2 }.
Lemma store_access: mem_access m2 = mem_access m1.
Theorem perm_store_1: forall b' ofs' k p, perm m1 b' ofs' k p -> perm m2 b' ofs' k p.
Theorem perm_store_2: forall b' ofs' k p, perm m2 b' ofs' k p -> perm m1 b' ofs' k p.
Theorem nextblock_store: nextblock m2 = nextblock m1.
Theorem store_valid_block_1: forall b', valid_block m1 b' -> valid_block m2 b'.
Theorem store_valid_block_2: forall b', valid_block m2 b' -> valid_block m1 b'.
Theorem store_valid_access_1: forall chunk' b' ofs' p, valid_access m1 chunk' b' ofs' p -> valid_access m2 chunk' b' ofs' p.
Theorem store_valid_access_2: forall chunk' b' ofs' p, valid_access m2 chunk' b' ofs' p -> valid_access m1 chunk' b' ofs' p.
Theorem store_valid_access_3: valid_access m1 chunk b ofs Writable.
Theorem load_store_similar: forall chunk', size_chunk chunk' = size_chunk chunk -> align_chunk chunk' <= align_chunk chunk -> exists v', load chunk' m2 b ofs = Some v' /\ decode_encode_val v chunk chunk' v'.
Theorem load_store_similar_2: forall chunk', size_chunk chunk' = size_chunk chunk -> align_chunk chunk' <= align_chunk chunk -> type_of_chunk chunk' = type_of_chunk chunk -> load chunk' m2 b ofs = Some (Val.load_result chunk' v).
Theorem load_store_same: load chunk m2 b ofs = Some (Val.load_result chunk v).
Theorem load_store_other: forall chunk' b' ofs', b' <> b \/ ofs' + size_chunk chunk' <= ofs \/ ofs + size_chunk chunk <= ofs' -> load chunk' m2 b' ofs' = load chunk' m1 b' ofs'.
Theorem loadbytes_store_same: loadbytes m2 b ofs (size_chunk chunk) = Some(encode_val chunk v).
Theorem loadbytes_store_other: forall b' ofs' n, b' <> b \/ n <= 0 \/ ofs' + n <= ofs \/ ofs + size_chunk chunk <= ofs' -> loadbytes m2 b' ofs' n = loadbytes m1 b' ofs' n.
Lemma setN_in: forall vl p q c, p <= q < p + Z.of_nat (length vl) -> In (ZMap.get q (setN vl p c)) vl.
Lemma getN_in: forall c q n p, p <= q < p + Z.of_nat n -> In (ZMap.get q c) (getN n p c).
Lemma load_store_overlap: forall chunk m1 b ofs v m2 chunk' ofs' v', store chunk m1 b ofs v = Some m2 -> load chunk' m2 b ofs' = Some v' -> ofs' + size_chunk chunk' > ofs -> ofs + size_chunk chunk > ofs' -> exists mv1 mvl mv1' mvl', shape_encoding chunk v (mv1 :: mvl) /\ shape_decoding chunk' (mv1' :: mvl') v' /\ ( (ofs' = ofs /\ mv1' = mv1) \/ (ofs' > ofs /\ In mv1' mvl) \/ (ofs' < ofs /\ In mv1 mvl')).