(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** Abstract syntax and semantics for the Csharpminor language. *)

Require Import Coqlib.
Require Import Maps.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Values.
Require Import Memory.
Require Import Events.
Require Import Globalenvs.
Require Cminor.
Require Import Smallstep.

(** Abstract syntax *)

(** Csharpminor is a low-level imperative language structured in expressions,
  statements, functions and programs.  Expressions include
  reading global or local variables, reading store locations,
  arithmetic operations, function calls, and conditional expressions
  (similar to [e1 ? e2 : e3] in C).

  Unlike in Cminor (the next intermediate language of the back-end),
  Csharpminor local variables reside in memory, and their addresses can
  be taken using [Eaddrof] expressions.
*)

Inductive constant : Type :=
  | Ointconst: int -> constant          (**r integer constant *)
  | Ofloatconst: float -> constant.     (**r floating-point constant *)

Definition unary_operation : Type := Cminor.unary_operation.
Definition binary_operation : Type := Cminor.binary_operation.

Inductive expr : Type :=
  | Evar : ident -> expr                (**r reading a scalar variable  *)
  | Etempvar : ident -> expr            (**r reading a temporary variable *)
  | Eaddrof : ident -> expr             (**r taking the address of a variable *)
  | Econst : constant -> expr           (**r constants *)
  | Eunop : unary_operation -> expr -> expr  (**r unary operation *)
  | Ebinop : binary_operation -> expr -> expr -> expr (**r binary operation *)
  | Eload : memory_chunk -> expr -> expr (**r memory read *)
  | Econdition : expr -> expr -> expr -> expr. (**r conditional expression *)

(** Statements include expression evaluation, variable assignment,
  memory stores, function calls, an if/then/else conditional,
  infinite loops, blocks and early block exits, and early function returns.
  [Sexit n] terminates prematurely the execution of the [n+1] enclosing
  [Sblock] statements. *)

Definition label := ident.

Inductive stmt : Type :=
  | Sskip: stmt
  | Sassign : ident -> expr -> stmt
  | Sset : ident -> expr -> stmt
  | Sstore : memory_chunk -> expr -> expr -> stmt
  | Scall : option ident -> signature -> expr -> list expr -> stmt
  | Sbuiltin : option ident -> external_function -> list expr -> stmt
  | Sseq: stmt -> stmt -> stmt
  | Sifthenelse: expr -> stmt -> stmt -> stmt
  | Sloop: stmt -> stmt
  | Sblock: stmt -> stmt
  | Sexit: nat -> stmt
  | Sswitch: expr -> lbl_stmt -> stmt
  | Sreturn: option expr -> stmt
  | Slabel: label -> stmt -> stmt
  | Sgoto: label -> stmt

with lbl_stmt : Type :=
  | LSdefault: stmt -> lbl_stmt
  | LScase: int -> stmt -> lbl_stmt -> lbl_stmt.

(** The variables can be either scalar variables
  (whose type, size and signedness are given by a [memory_chunk]
  or array variables (of the indicated sizes and alignment).
  The only operation permitted on an array variable is taking its address. *)

Inductive var_kind : Type :=
  | Vscalar(chunk: memory_chunk)
  | Varray(sz al: Z).

Definition sizeof (lv: var_kind) : Z :=
  match lv with
  | Vscalar chunk => size_chunk chunk
  | Varray sz al => Zmax 0 sz
  end.

Definition type_of_kind (lv: var_kind) : typ :=
  match lv with
  | Vscalar chunk => type_of_chunk chunk
  | Varray _ _ => Tint
  end.

(** Functions are composed of a return type, a list of parameter names
  with associated [var_kind] descriptions, a list of
  local variables with associated [var_kind] descriptions, and a
  statement representing the function body.  *)

Definition variable_name (v: ident * var_kind) := fst v.
Definition variable_kind (v: ident * var_kind) := snd v.

Record function : Type := mkfunction {
  fn_return: option typ;
  fn_params: list (ident * var_kind);
  fn_vars: list (ident * var_kind);
  fn_temps: list ident;
  fn_body: stmt
}.

Definition fundef := AST.fundef function.

Definition program : Type := AST.program fundef var_kind.

Definition fn_sig (f: function) :=
  mksignature (List.map type_of_kind (List.map variable_kind f.(fn_params)))
              f.(fn_return).

Definition funsig (fd: fundef) :=
  match fd with
  | Internal f => fn_sig f
  | External ef => ef_sig ef
  end.

Definition fn_variables (f: function) := f.(fn_params) ++ f.(fn_vars).

Definition fn_params_names (f: function) := List.map variable_name f.(fn_params).
Definition fn_vars_names (f: function) := List.map variable_name f.(fn_vars).

(** * Operational semantics *)

(** Three evaluation environments are involved:
- [genv]: global environments, map symbols and functions to memory blocks,
    and maps symbols to variable informations (type [var_kind])
- [env]: local environments, map local variables
    to pairs (memory block, variable information)
- [temp_env]: local environments, map temporary variables to
    their current values.
*)

Definition genv := Genv.t fundef var_kind.
Definition env := PTree.t (block * var_kind).
Definition temp_env := PTree.t val.

Definition empty_env : env := PTree.empty (block * var_kind).
Definition empty_temp_env : temp_env := PTree.empty val.

(** Continuations *)

Inductive cont: Type :=
  | Kstop: cont                         (**r stop program execution *)
  | Kseq: stmt -> cont -> cont          (**r execute stmt, then cont *)
  | Kblock: cont -> cont                (**r exit a block, then do cont *)
  | Kcall: option ident -> function -> env -> temp_env -> cont -> cont.
                                        (**r return to caller *)

(** States *)

Inductive state: Type :=
  | State:                      (**r Execution within a function *)
      forall (f: function)              (**r currently executing function  *)
             (s: stmt)                  (**r statement under consideration *)
             (k: cont)                  (**r its continuation -- what to do next *)
             (e: env)                   (**r current local environment *)
             (le: temp_env)             (**r current temporary environment *)
             (m: mem),                  (**r current memory state *)
      state
  | Callstate:                  (**r Invocation of a function *)
      forall (f: fundef)                (**r function to invoke *)
             (args: list val)           (**r arguments provided by caller *)
             (k: cont)                  (**r what to do next  *)
             (m: mem),                  (**r memory state *)
      state
  | Returnstate:                (**r Return from a function *)
      forall (v: val)                   (**r Return value *)
             (k: cont)                  (**r what to do next *)
             (m: mem),                  (**r memory state *)
      state.

(** Pop continuation until a call or stop *)

Fixpoint call_cont (k: cont) : cont :=
  match k with
  | Kseq s k => call_cont k
  | Kblock k => call_cont k
  | _ => k
  end.

Definition is_call_cont (k: cont) : Prop :=
  match k with
  | Kstop => True
  | Kcall _ _ _ _ _ => True
  | _ => False
  end.

(** Resolve [switch] statements. *)

Fixpoint select_switch (n: int) (sl: lbl_stmt) {struct sl} : lbl_stmt :=
  match sl with
  | LSdefault _ => sl
  | LScase c s sl' => if Int.eq c n then sl else select_switch n sl'
  end.

Fixpoint seq_of_lbl_stmt (sl: lbl_stmt) : stmt :=
  match sl with
  | LSdefault s => s
  | LScase c s sl' => Sseq s (seq_of_lbl_stmt sl')
  end.

(** Find the statement and manufacture the continuation
  corresponding to a label *)

Fixpoint find_label (lbl: label) (s: stmt) (k: cont)
                    {struct s}: option (stmt * cont) :=
  match s with
  | Sseq s1 s2 =>
      match find_label lbl s1 (Kseq s2 k) with
      | Some sk => Some sk
      | None => find_label lbl s2 k
      end
  | Sifthenelse a s1 s2 =>
      match find_label lbl s1 k with
      | Some sk => Some sk
      | None => find_label lbl s2 k
      end
  | Sloop s1 =>
      find_label lbl s1 (Kseq (Sloop s1) k)
  | Sblock s1 =>
      find_label lbl s1 (Kblock k)
  | Sswitch a sl =>
      find_label_ls lbl sl k
  | Slabel lbl' s' =>
      if ident_eq lbl lbl' then Some(s', k) else find_label lbl s' k
  | _ => None
  end

with find_label_ls (lbl: label) (sl: lbl_stmt) (k: cont)
                   {struct sl}: option (stmt * cont) :=
  match sl with
  | LSdefault s => find_label lbl s k
  | LScase _ s sl' =>
      match find_label lbl s (Kseq (seq_of_lbl_stmt sl') k) with
      | Some sk => Some sk
      | None => find_label_ls lbl sl' k
      end
  end.

(** Evaluation of operator applications. *)

Definition eval_constant (cst: constant) : option val :=
  match cst with
  | Ointconst n => Some (Vint n)
  | Ofloatconst n => Some (Vfloat n)
  end.

Definition eval_unop := Cminor.eval_unop.

Definition eval_binop := Cminor.eval_binop.

(** Allocation of local variables at function entry.  Each variable is
  bound to the reference to a fresh block of the appropriate size. *)

Inductive alloc_variables: env -> mem ->
                           list (ident * var_kind) ->
                           env -> mem -> Prop :=
  | alloc_variables_nil:
      forall e m,
      alloc_variables e m nil e m
  | alloc_variables_cons:
      forall e m id lv vars m1 b1 m2 e2,
      Mem.alloc m 0 (sizeof lv) = (m1, b1) ->
      alloc_variables (PTree.set id (b1, lv) e) m1 vars e2 m2 ->
      alloc_variables e m ((id, lv) :: vars) e2 m2.

(** List of blocks mentioned in an environment, with low and high bounds *)

Definition block_of_binding (id_b_lv: ident * (block * var_kind)) :=
  match id_b_lv with (id, (b, lv)) => (b, 0, sizeof lv) end.

Definition blocks_of_env (e: env) : list (block * Z * Z) :=
  List.map block_of_binding (PTree.elements e).

Section RELSEM.

Variable ge: genv.

(** Initialization of local variables that are parameters.  The value
  of the corresponding argument is stored into the memory block
  bound to the parameter. *)

Definition val_normalized (v: val) (chunk: memory_chunk) : Prop :=
  Val.load_result chunk v = v.

Inductive bind_parameters: env ->
                           mem -> list (ident * var_kind) -> list val ->
                           mem -> Prop :=
  | bind_parameters_nil:
      forall e m,
      bind_parameters e m nil nil m
  | bind_parameters_scalar:
      forall e m id chunk params v1 vl b m1 m2,
      PTree.get id e = Some (b, Vscalar chunk) ->
      val_normalized v1 chunk ->
      Mem.store chunk m b 0 v1 = Some m1 ->
      bind_parameters e m1 params vl m2 ->
      bind_parameters e m ((id, Vscalar chunk) :: params) (v1 :: vl) m2
  | bind_parameters_array:
      forall e m id sz al params v1 vl b m1 m2,
      PTree.get id e = Some (b, Varray sz al) ->
      extcall_memcpy_sem sz al
                         ge (Vptr b Int.zero :: v1 :: nil) m E0 Vundef m1 ->
      bind_parameters e m1 params vl m2 ->
      bind_parameters e m ((id, Varray sz al) :: params) (v1 :: vl) m2.

(* Evaluation of the address of a variable:
   [eval_var_addr prg ge e id b] states that variable [id]
   in environment [e] evaluates to block [b]. *)

Inductive eval_var_addr: env -> ident -> block -> Prop :=
  | eval_var_addr_local:
      forall e id b vi,
      PTree.get id e = Some (b, vi) ->
      eval_var_addr e id b
  | eval_var_addr_global:
      forall e id b,
      PTree.get id e = None ->
      Genv.find_symbol ge id = Some b ->
      eval_var_addr e id b.

(* Evaluation of a reference to a scalar variable:
   [eval_var_ref prg ge e id b chunk] states
   that variable [id] in environment [e] evaluates to block [b]
   and is associated with the memory chunk [chunk]. *)

Inductive eval_var_ref: env -> ident -> block -> memory_chunk -> Prop :=
  | eval_var_ref_local:
      forall e id b chunk,
      PTree.get id e = Some (b, Vscalar chunk) ->
      eval_var_ref e id b chunk
  | eval_var_ref_global:
      forall e id b gv chunk,
      PTree.get id e = None ->
      Genv.find_symbol ge id = Some b ->
      Genv.find_var_info ge b = Some gv ->
      gvar_info gv = Vscalar chunk ->
      eval_var_ref e id b chunk.

(** Evaluation of an expression: [eval_expr prg e m a v] states
  that expression [a], in initial memory state [m] and local
  environment [e], evaluates to value [v]. *)

Section EVAL_EXPR.

Variable e: env.
Variable le: temp_env.
Variable m: mem.

Inductive eval_expr: expr -> val -> Prop :=
  | eval_Evar: forall id b chunk v,
      eval_var_ref e id b chunk ->
      Mem.load chunk m b 0 = Some v ->
      eval_expr (Evar id) v
  | eval_Etempvar: forall id v,
      le!id = Some v ->
      eval_expr (Etempvar id) v
  | eval_Eaddrof: forall id b,
      eval_var_addr e id b ->
      eval_expr (Eaddrof id) (Vptr b Int.zero)
  | eval_Econst: forall cst v,
      eval_constant cst = Some v ->
      eval_expr (Econst cst) v
  | eval_Eunop: forall op a1 v1 v,
      eval_expr a1 v1 ->
      eval_unop op v1 = Some v ->
      eval_expr (Eunop op a1) v
  | eval_Ebinop: forall op a1 a2 v1 v2 v,
      eval_expr a1 v1 ->
      eval_expr a2 v2 ->
      eval_binop op v1 v2 m = Some v ->
      eval_expr (Ebinop op a1 a2) v
  | eval_Eload: forall chunk a v1 v,
      eval_expr a v1 ->
      Mem.loadv chunk m v1 = Some v ->
      eval_expr (Eload chunk a) v
  | eval_Econdition: forall a b c v1 vb1 v2,
      eval_expr a v1 ->
      Val.bool_of_val v1 vb1 ->
      eval_expr (if vb1 then b else c) v2 ->
      eval_expr (Econdition a b c) v2.

(** Evaluation of a list of expressions:
  [eval_exprlist prg e m al vl] states that the list [al] of
  expressions evaluate to the list [vl] of values.  The other
  parameters are as in [eval_expr]. *)

Inductive eval_exprlist: list expr -> list val -> Prop :=
  | eval_Enil:
      eval_exprlist nil nil
  | eval_Econs: forall a1 al v1 vl,
      eval_expr a1 v1 -> eval_exprlist al vl ->
      eval_exprlist (a1 :: al) (v1 :: vl).

End EVAL_EXPR.

(** Execution of an assignment to a variable. *)

Inductive exec_assign: env -> mem -> ident -> val -> mem -> Prop :=
  exec_assign_intro: forall e m id v b chunk m',
    eval_var_ref e id b chunk ->
    val_normalized v chunk ->
    Mem.store chunk m b 0 v = Some m' ->
    exec_assign e m id v m'.

(** One step of execution *)

Inductive step: state -> trace -> state -> Prop :=

  | step_skip_seq: forall f s k e le m,
      step (State f Sskip (Kseq s k) e le m)
        E0 (State f s k e le m)
  | step_skip_block: forall f k e le m,
      step (State f Sskip (Kblock k) e le m)
        E0 (State f Sskip k e le m)
  | step_skip_call: forall f k e le m m',
      is_call_cont k ->
      f.(fn_return) = None ->
      Mem.free_list m (blocks_of_env e) = Some m' ->
      step (State f Sskip k e le m)
        E0 (Returnstate Vundef k m')

  | step_assign: forall f id a k e le m m' v,
      eval_expr e le m a v ->
      exec_assign e m id v m' ->
      step (State f (Sassign id a) k e le m)
        E0 (State f Sskip k e le m')

  | step_set: forall f id a k e le m v,
      eval_expr e le m a v ->
      step (State f (Sset id a) k e le m)
        E0 (State f Sskip k e (PTree.set id v le) m)

  | step_store: forall f chunk addr a k e le m vaddr v m',
      eval_expr e le m addr vaddr ->
      eval_expr e le m a v ->
      Mem.storev chunk m vaddr v = Some m' ->
      step (State f (Sstore chunk addr a) k e le m)
        E0 (State f Sskip k e le m')

  | step_call: forall f optid sig a bl k e le m vf vargs fd,
      eval_expr e le m a vf ->
      eval_exprlist e le m bl vargs ->
      Genv.find_funct ge vf = Some fd ->
      funsig fd = sig ->
      step (State f (Scall optid sig a bl) k e le m)
        E0 (Callstate fd vargs (Kcall optid f e le k) m)

  | step_builtin: forall f optid ef bl k e le m vargs t vres m',
      eval_exprlist e le m bl vargs ->
      external_call ef ge vargs m t vres m' ->
      step (State f (Sbuiltin optid ef bl) k e le m)
         t (State f Sskip k e (Cminor.set_optvar optid vres le) m')

  | step_seq: forall f s1 s2 k e le m,
      step (State f (Sseq s1 s2) k e le m)
        E0 (State f s1 (Kseq s2 k) e le m)

  | step_ifthenelse: forall f a s1 s2 k e le m v b,
      eval_expr e le m a v ->
      Val.bool_of_val v b ->
      step (State f (Sifthenelse a s1 s2) k e le m)
        E0 (State f (if b then s1 else s2) k e le m)

  | step_loop: forall f s k e le m,
      step (State f (Sloop s) k e le m)
        E0 (State f s (Kseq (Sloop s) k) e le m)

  | step_block: forall f s k e le m,
      step (State f (Sblock s) k e le m)
        E0 (State f s (Kblock k) e le m)

  | step_exit_seq: forall f n s k e le m,
      step (State f (Sexit n) (Kseq s k) e le m)
        E0 (State f (Sexit n) k e le m)
  | step_exit_block_0: forall f k e le m,
      step (State f (Sexit O) (Kblock k) e le m)
        E0 (State f Sskip k e le m)
  | step_exit_block_S: forall f n k e le m,
      step (State f (Sexit (S n)) (Kblock k) e le m)
        E0 (State f (Sexit n) k e le m)

  | step_switch: forall f a cases k e le m n,
      eval_expr e le m a (Vint n) ->
      step (State f (Sswitch a cases) k e le m)
        E0 (State f (seq_of_lbl_stmt (select_switch n cases)) k e le m)

  | step_return_0: forall f k e le m m',
      Mem.free_list m (blocks_of_env e) = Some m' ->
      step (State f (Sreturn None) k e le m)
        E0 (Returnstate Vundef (call_cont k) m')
  | step_return_1: forall f a k e le m v m',
      eval_expr e le m a v ->
      Mem.free_list m (blocks_of_env e) = Some m' ->
      step (State f (Sreturn (Some a)) k e le m)
        E0 (Returnstate v (call_cont k) m')
  | step_label: forall f lbl s k e le m,
      step (State f (Slabel lbl s) k e le m)
        E0 (State f s k e le m)

  | step_goto: forall f lbl k e le m s' k',
      find_label lbl f.(fn_body) (call_cont k) = Some(s', k') ->
      step (State f (Sgoto lbl) k e le m)
        E0 (State f s' k' e le m)

  | step_internal_function: forall f vargs k m m1 m2 e,
      list_norepet (fn_params_names f ++ fn_vars_names f) ->
      alloc_variables empty_env m (fn_variables f) e m1 ->
      bind_parameters e m1 f.(fn_params) vargs m2 ->
      step (Callstate (Internal f) vargs k m)
        E0 (State f f.(fn_body) k e empty_temp_env m2)

  | step_external_function: forall ef vargs k m t vres m',
      external_call ef ge vargs m t vres m' ->
      step (Callstate (External ef) vargs k m)
         t (Returnstate vres k m')

  | step_return: forall v optid f e le k m,
      step (Returnstate v (Kcall optid f e le k) m)
        E0 (State f Sskip k e (Cminor.set_optvar optid v le) m).

End RELSEM.

(** Execution of whole programs are described as sequences of transitions
  from an initial state to a final state.  An initial state is a [Callstate]
  corresponding to the invocation of the ``main'' function of the program
  without arguments and with an empty continuation. *)

Inductive initial_state (p: program): state -> Prop :=
  | initial_state_intro: forall b f m0,
      let ge := Genv.globalenv p in
      Genv.init_mem p = Some m0 ->
      Genv.find_symbol ge p.(prog_main) = Some b ->
      Genv.find_funct_ptr ge b = Some f ->
      funsig f = mksignature nil (Some Tint) ->
      initial_state p (Callstate f nil Kstop m0).

(** A final state is a [Returnstate] with an empty continuation. *)

Inductive final_state: state -> int -> Prop :=
  | final_state_intro: forall r m,
      final_state (Returnstate (Vint r) Kstop m) r.

(** Wrapping up these definitions in a small-step semantics. *)

Definition semantics (p: program) :=
  Semantics step (initial_state p) final_state (Genv.globalenv p).


(**************************************************************************)
(*  This file is part of CertrBPF,                                        *)
(*  a formally verified rBPF verifier + interpreter + JIT in Coq.         *)
(*                                                                        *)
(*  Copyright (C) 2022 Inria                                              *)
(*                                                                        *)
(*  This program is free software; you can redistribute it and/or modify  *)
(*  it under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation; either version 2 of the License, or     *)
(*  (at your option) any later version.                                   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful,       *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU General Public License for more details.                          *)
(*                                                                        *)
(**************************************************************************)

(** Definition of matching relation between Coq and C representation *)
From bpf.comm Require Import LemmaInt State MemRegion Regs Flag ListAsArray rBPFMemType.
From compcert Require Import Coqlib Integers Values AST Clight Memory Memtype.

From bpf.clightlogic Require Import CommonLemma CommonLib Clightlogic.
From Coq Require Import ZArith.
Open Scope Z_scope.

Global Transparent Archi.ptr64.

Definition match_region_at_ofs (mr:memory_region) (state_blk mrs_blk ins_blk: block) (ofs : ptrofs) (m: mem)  : Prop :=
  (exists vl,  Mem.loadv AST.Mint32 m (Vptr mrs_blk ofs) = Some (Vint vl) /\ (start_addr mr) = Vint vl)    /\ (**r start_addr mr = Vint vl*)
    (exists vl,  Mem.loadv AST.Mint32 m (Vptr mrs_blk (Ptrofs.add ofs (Ptrofs.repr 4))) = Some (Vint vl) /\ (block_size mr) = Vint vl) /\ (**r block_size mr = Vint vl*)
    (exists vl,  Mem.loadv AST.Mint32 m (Vptr mrs_blk (Ptrofs.add ofs (Ptrofs.repr 8))) = Some (Vint vl) /\ correct_perm (block_perm mr)  vl) /\ (**r block_perm mr = Vint vl*)
    (exists b, Mem.loadv AST.Mptr  m (Vptr mrs_blk (Ptrofs.add ofs (Ptrofs.repr 12))) = Some (Vptr b Ptrofs.zero) /\ (block_ptr mr) = Vptr b Ptrofs.zero /\ (Mem.valid_block m b /\ b <> state_blk /\ b <> mrs_blk /\ b <> ins_blk)).

(*Definition size_of_region  :=  16. (* 4 * 32 bits *)*)
(*
Fixpoint match_list_region (m:mem) (bl_regions: block) (ofs:ptrofs) (l:list memory_region) :=
  match l with
  | nil => True
  | mr :: l' => match_region_at_ofs  mr bl_regions ofs m /\
                  match_list_region  m bl_regions (Ptrofs.add ofs (Ptrofs.repr 16)) l'
  end. *)

(*
Fixpoint match_list_region (m:mem) (b: block) (ofs: nat) (l:list memory_region) :=
  match l with
  | nil => True
  | mr :: l' => match_region_at_ofs mr b (Ptrofs.repr (16 * Z.of_nat ofs)) m /\ match_list_region m b (ofs+1) l'
  end. *)

Definition match_list_region (m:mem) (state_blk mrs_blk ins_blk: block) (l:list memory_region) :=
  forall i, (0 <= i < List.length l)%nat -> match_region_at_ofs (List.nth i l default_memory_region) state_blk mrs_blk ins_blk (Ptrofs.repr (16 * Z.of_nat i)) m.

Definition match_regions (state_blk mrs_blk ins_blk: block) (st: State.state) (m:mem) :=
  List.length (bpf_mrs st) = (mrs_num st) /\ (**r the number of bpf_mrs is exactly the mrs_num *)
  Z.of_nat (List.length (bpf_mrs st)) * 16 <= Ptrofs.max_unsigned /\ (**r there is not overflow *)
  match_list_region m state_blk mrs_blk ins_blk (bpf_mrs st).

Lemma match_regions_in:
  forall l mr m state_blk mrs_blk ins_blk
    (Hnth_error : In mr l)
    (Hmatch : match_list_region m state_blk mrs_blk ins_blk l),
      exists n, match_region_at_ofs mr state_blk mrs_blk ins_blk (Ptrofs.repr (16 * Z.of_nat n)) m.
Proof.
  unfold match_list_region.
  intros.
  apply In_nth_error in Hnth_error.
  destruct Hnth_error as (n & Hnth_error).
  apply nth_error_some_length in Hnth_error as Hlen.
  specialize (Hmatch n Hlen).
  destruct Hlen as ( _ & Hlen).
  apply nth_error_nth' with (d:= default_memory_region) in Hlen.
  rewrite Hlen in Hnth_error.
  inversion Hnth_error.
  subst.
  exists n; assumption.
Qed.

(*
Fixpoint match_list_ins (m:mem) (b: block) (ofs:ptrofs) (l: MyListType) :=
  match l with
  | nil => True
  | hd :: tl => Mem.loadv AST.Mint64 m (Vptr b ofs) = Some (Vlong hd) /\
                  match_list_ins m b (Ptrofs.add ofs (Ptrofs.repr 8)) tl
  end. *)

Definition match_list_ins (m:mem) (b: block) (l: list int64) :=
  forall i, (0 <= i < List.length l)%nat ->
    Mem.loadv AST.Mint64 m  (Vptr b (Ptrofs.repr (8 * (Z.of_nat i)))) = Some (Vlong (List.nth i l Int64.zero)) (*/\
    0 <= (Int64.unsigned (Int64.shru (Int64.and (List.nth i l Int64.zero) (Int64.repr 4095)) (Int64.repr 8))) <= 10 /\ (**r dst \in [0,10] *)
    0 <= (Int64.unsigned (Int64.shru (Int64.and (List.nth i l Int64.zero) (Int64.repr 65535)) (Int64.repr 12))) <= 10 (**r src \in [0,10] *) *).

Definition match_ins (ins_blk: block) (st: State.state) (m:mem) :=
  List.length (ins st) = (ins_len st) /\
  Z.of_nat (List.length (ins st)) * 8 <= Ptrofs.max_unsigned /\
  match_list_ins m ins_blk (ins st).

Class special_blocks : Type :=
  { st_blk : block;
    mrs_blk  : block;
    ins_blk  : block }.

Section S.

  Context {Blocks : special_blocks}.

  Definition match_registers  (rmap:regmap) (bl_reg:block) (ofs : ptrofs) (m : mem) : Prop:=
    forall (r:reg),
    exists vl, Mem.loadv Mint64 m (Vptr bl_reg (Ptrofs.add ofs (Ptrofs.repr (8 * (id_of_reg r))))) = Some (Vlong vl) /\ (**r it should be `(eval_regmap r rmap)`*)
            Vlong vl = eval_regmap r rmap.
           (*Val.inject inject_id (eval_regmap r rmap) (Vlong vl) . (**r each register is Vlong *)*)

  (*Definition size_of_regs := 88. (**r 11 * 8: we have 11 regs R0 - R10 *)*)
  Definition size_of_state (st: State.state) := 100 + 16 * (Z.of_nat (mrs_num st)) + 8 *(Z.of_nat (ins_len st)).

(**r
Definition state_struct_def: Ctypes.composite_definition :=
  Ctypes.Composite state_id Ctypes.Struct [
    (pc_id, C_U32);
    (flag_id, C_S32);
    (regmaps_id, C_regmap);;
    (mem_num_id, C_U32)
    (mem_regs_id, mem_region_type)
  ] Ctypes.noattr.

*)

  Record match_state  (st: State.state) (m: mem) : Prop :=
    {
      munchange: Mem.unchanged_on (fun b _ => b <> st_blk /\ b <> mrs_blk /\ b <> ins_blk) (bpf_m st) m; (**r (bpf_m st) = m - {state_blk, mrs_blk, ins_blk} *)
      mpc      : Mem.loadv AST.Mint32 m (Vptr st_blk (Ptrofs.repr 0)) = Some (Vint  (pc_loc st));
      mflags   : Mem.loadv AST.Mint32 m (Vptr st_blk (Ptrofs.repr 4)) = Some (Vint  (int_of_flag (flag st)));
      mregs    : match_registers (regs_st st) st_blk (Ptrofs.repr 8) m;
      mins_len : Mem.loadv AST.Mint32 m (Vptr st_blk (Ptrofs.repr 96)) = Some (Vint  (Int.repr (Z.of_nat (ins_len st)))) /\ Z.of_nat (ins_len st) >= 1;
      mins     : Mem.loadv AST.Mptr m (Vptr st_blk (Ptrofs.repr 100)) = Some (Vptr ins_blk (Ptrofs.repr 0)) /\ match_ins ins_blk st m;
      mmrs_num : Mem.loadv AST.Mint32 m (Vptr st_blk (Ptrofs.repr 104)) = Some (Vint  (Int.repr (Z.of_nat (mrs_num st)))) /\
                 (Z.of_nat(mrs_num st)) >= 1; (**r at least we have the memory region that corresponds to the input paramters of the interpreter *)
      mem_regs : Mem.loadv AST.Mptr m (Vptr st_blk (Ptrofs.repr 108)) = Some (Vptr mrs_blk (Ptrofs.repr 0)) /\ match_regions st_blk mrs_blk ins_blk st m;
      mperm    : Mem.range_perm m st_blk 0 (size_of_state st) Cur Freeable /\
                 Mem.range_perm m mrs_blk   0 (Z.of_nat (mrs_num st)) Cur Freeable /\
                 Mem.range_perm m ins_blk   0 (Z.of_nat (ins_len st)) Cur Readable; (**r we also need to say `mrs/ins_blk` *)
      minvalid : (~Mem.valid_block (bpf_m st) st_blk /\
                  ~Mem.valid_block (bpf_m st) mrs_blk /\
                  ~Mem.valid_block (bpf_m st) ins_blk) /\
                 (mrs_blk <> st_blk /\ mrs_blk <> ins_blk /\ ins_blk <> st_blk) /\
                 (forall b, b <> st_blk /\ b <> mrs_blk /\ b <> ins_blk ->
                  Mem.valid_block m b -> Mem.valid_block (bpf_m st) b);
    }.

End S.

(* Permission Lemmas: deriving from riot-rbpf/MemInv.v *)
Lemma range_perm_included:
  forall m b p lo hi ofs_lo ofs_hi,
    lo <= ofs_lo -> ofs_lo < ofs_hi -> ofs_hi <= hi ->  (**r `<` -> `<=` *)
    Mem.range_perm m b lo hi Cur p ->
      Mem.range_perm m b ofs_lo ofs_hi Cur p.
Proof.
  intros.
  apply (Mem.range_perm_implies _ _ _ _ _ p _); [idtac | constructor].
  unfold Mem.range_perm in *; intros.
  apply H2.
  lia.
Qed.

(** Permission Lemmas: upd_pc *)
Lemma upd_pc_write_access:
  forall m0 {bl:special_blocks} st
    (Hst: match_state  st m0),
    Mem.valid_access m0 Mint32 st_blk 0 Writable.
Proof.
  intros; unfold Mem.valid_access; destruct Hst; clear - mem_regs0 mperm0; simpl in mem_regs0.
  unfold match_regions, size_of_state in *.
  destruct mperm0 as (mperm0 & _ & _).
  apply (Mem.range_perm_implies _ _ _ _ _ _ Writable) in mperm0; [idtac | constructor].

  unfold size_chunk, align_chunk.
  split.
  - simpl; apply (range_perm_included _ _ Writable _ _ 0 4) in mperm0; [assumption | lia | lia | idtac].
    assert (H: 0<= Z.of_nat (State.mrs_num st)). { apply Nat2Z.is_nonneg. }
    lia.
  - apply Z.divide_0_r.
Qed.

Lemma upd_pc_store:
  forall m0 {S: special_blocks} pc st
    (Hst: match_state  st m0),
    exists m1,
    Mem.store AST.Mint32 m0 st_blk 0 (Vint pc) = Some m1.
Proof.
  intros.
  apply upd_pc_write_access  in Hst.
  apply (Mem.valid_access_store _ _ _ _ (Vint pc)) in Hst.
  destruct Hst as (m2 & Hstore).
  exists m2; assumption.
Qed.

(** Permission Lemmas: upd_flags *)
Lemma upd_flags_write_access:
  forall m0 {S:special_blocks} st
    (Hst: match_state  st m0),
    Mem.valid_access m0 Mint32 st_blk 4 Writable.
Proof.
  intros; unfold Mem.valid_access; destruct Hst; clear - mperm0; simpl in mperm0.
  unfold size_of_state in *.
  destruct mperm0 as (mperm0 & _ & _).
  apply (Mem.range_perm_implies _ _ _ _ _ _ Writable) in mperm0; [idtac | constructor].

  unfold size_chunk, align_chunk.
  split.
  - simpl.
    apply (range_perm_included _ _ Writable _ _ 4 8) in mperm0; [assumption | lia | lia | lia].
  - apply Z.divide_refl.
Qed.

Lemma upd_flags_store:
  forall m0 {S: special_blocks} st v
    (Hst: match_state  st m0),
    exists m1,
    Mem.store AST.Mint32 m0 st_blk 4 (Vint v) = Some m1.
Proof.
  intros.
  apply (upd_flags_write_access _ _ ) in Hst.
  apply (Mem.valid_access_store _ _ _ _ (Vint v)) in Hst.
  destruct Hst as (m2 & Hstore).
  exists m2; assumption.
Qed.

(** Permission Lemmas: upd_regs *)
Lemma upd_regs_write_access:
  forall m0 {S: special_blocks} st r
    (Hst: match_state  st m0),
    Mem.valid_access m0 Mint64 st_blk (8 + (8 * (id_of_reg r))) Writable.
Proof.
  intros; unfold Mem.valid_access; destruct Hst; clear - mperm0; simpl in mperm0.
  unfold size_of_state in *.
  destruct mperm0 as (mperm0 & _ & _).
  apply (Mem.range_perm_implies _ _ _ _ _ _ Writable) in mperm0; [idtac | constructor].
  assert (H: 0<= Z.of_nat (State.mrs_num st)). { apply Nat2Z.is_nonneg. }
  apply (range_perm_included _ _ Writable _ _ 0 100) in mperm0; [idtac | lia | lia | lia].

  unfold id_of_reg.
  unfold size_chunk, align_chunk.
  split.
  - apply (range_perm_included _ _ Writable _ _ (8 + (8 * (id_of_reg r))) (8 + (8 * (id_of_reg r +1)))) in mperm0;
  destruct r; simpl in *; try lia; try assumption.
  - assert (Heq: forall x, 8 + 8 * x = 8 * (1 + x)). {
      intros.
      rewrite Zred_factor2.
      reflexivity.
    }
    rewrite Heq.
    apply Z.divide_factor_l.
Qed.

Lemma upd_regs_store:
  forall m0 {S: special_blocks} st r v
    (Hst: match_state  st m0),
    exists m1,
    Mem.store AST.Mint64 m0 st_blk (8 + (8 * (id_of_reg r))) (Vlong v) = Some m1.
Proof.
  intros.
  apply upd_regs_write_access with (r:=r) in Hst.
  apply (Mem.valid_access_store _ _ _ _ (Vlong v)) in Hst.
  destruct Hst as (m2 & Hstore).
  exists m2; assumption.
Qed.

(** Permission Lemmas: upd_mem_regions *)

(** TODO: nothing to do because we never update memory_regions, it should be done before running the interpter *)

Definition match_region (st_blk mrs_blk ins_blk : block) (mr: memory_region) (v: val) (st: State.state) (m:Memory.Mem.mem) :=
  exists o, v = Vptr mrs_blk o /\
              match_region_at_ofs mr st_blk mrs_blk ins_blk o m.

(*
Definition match_region_list (st_blk mrs_blk ins_blk: block) (mrl: list memory_region) (v: val) (st: State.state) (m:Memory.Mem.mem) :=
  v = Vptr mrs_blk Ptrofs.zero /\
  mrl = (bpf_mrs st) /\
  List.length mrl = (mrs_num st) /\ (**r those two are from the match_state relation *)
  match_list_region m st_blk mrs_blk ins_blk mrl. *)

Lemma same_memory_match_region :
  forall st_blk mrs_blk ins_blk st st' m m' mr v
         (UMOD : unmodifies_effect ModNothing m m' st st'),
    match_region st_blk mrs_blk ins_blk mr v st m ->
    match_region st_blk mrs_blk ins_blk mr v st' m'.
Proof.
  intros.
  unfold match_region in *.
  destruct H as (o & E & MR).
  exists o.
  split; auto.
  unfold match_region_at_ofs in *.
  unfold unmodifies_effect in UMOD.
  destruct UMOD; subst.
  repeat rewrite <- UMOD by (simpl ; tauto).
  intuition.
Qed.

(**r a set of lemmas say upd_reg/flag/pc... don't change the memory/regs/flag/pc of rbpf *)

Lemma upd_reg_same_mem:
  forall st0 r vl,
    bpf_m st0 = bpf_m (State.upd_reg r vl st0).
Proof.
  unfold State.upd_reg.
  intros.
  reflexivity.
Qed.

Lemma upd_reg_same_pc:
  forall st0 r vl,
    pc_loc st0 = pc_loc (State.upd_reg r vl st0).
Proof.
  unfold State.upd_reg.
  intros.
  reflexivity.
Qed.

Lemma upd_reg_same_flag:
  forall st0 r vl,
    flag st0 = flag (State.upd_reg r vl st0).
Proof.
  unfold State.upd_reg.
  intros.
  reflexivity.
Qed.

Lemma upd_reg_same_mrs:
  forall st0 r vl,
    bpf_mrs st0 = bpf_mrs (State.upd_reg r vl st0).
Proof.
  unfold State.upd_reg.
  intros.
  reflexivity.
Qed.

Lemma upd_reg_same_mrs_num:
  forall st0 r vl,
    State.mrs_num st0 = State.mrs_num (State.upd_reg r vl st0).
Proof.
  unfold State.upd_reg.
  intros.
  reflexivity.
Qed.

Lemma upd_reg_same_ins:
  forall st0 r vl,
    ins st0 = ins (State.upd_reg r vl st0).
Proof.
  unfold State.upd_reg.
  intros.
  reflexivity.
Qed.

Lemma upd_reg_same_ins_len:
  forall st0 r vl,
    ins_len st0 = ins_len (State.upd_reg r vl st0).
Proof.
  unfold State.upd_reg.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_same_mem:
  forall st0 pc,
    bpf_m st0 = bpf_m (State.upd_pc pc st0).
Proof.
  unfold State.upd_pc.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_same_regs:
  forall st0 pc,
    regs_st st0 = regs_st (State.upd_pc pc st0).
Proof.
  unfold State.upd_pc.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_same_flag:
  forall st0 pc,
    flag st0 = flag (State.upd_pc pc st0).
Proof.
  unfold State.upd_pc.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_same_mrs:
  forall st0 pc,
    bpf_mrs st0 = bpf_mrs (State.upd_pc pc st0).
Proof.
  unfold State.upd_pc.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_same_mrs_num:
  forall st0 pc,
    State.mrs_num st0 = State.mrs_num (State.upd_pc pc st0).
Proof.
  unfold State.upd_pc.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_same_ins:
  forall st0 pc,
    ins st0 = ins (State.upd_pc pc st0).
Proof.
  unfold State.upd_pc.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_same_ins_len:
  forall st0 pc,
    ins_len st0 = ins_len (State.upd_pc pc st0).
Proof.
  unfold State.upd_pc.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_incr_same_mem:
  forall st0,
    bpf_m st0 = bpf_m (State.upd_pc_incr st0).
Proof.
  unfold State.upd_pc_incr.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_incr_same_regs:
  forall st0,
    regs_st st0 = regs_st (State.upd_pc_incr st0).
Proof.
  unfold State.upd_pc_incr.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_incr_same_flag:
  forall st0,
    flag st0 = flag (State.upd_pc_incr st0).
Proof.
  unfold State.upd_pc_incr.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_incr_same_mrs:
  forall st0,
    bpf_mrs st0 = bpf_mrs (State.upd_pc_incr st0).
Proof.
  unfold State.upd_pc_incr.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_incr_same_mrs_num:
  forall st0,
    State.mrs_num st0 = State.mrs_num (State.upd_pc_incr st0).
Proof.
  unfold State.upd_pc_incr.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_incr_same_ins:
  forall st0,
    ins st0 = ins (State.upd_pc_incr st0).
Proof.
  unfold State.upd_pc_incr.
  intros.
  reflexivity.
Qed.

Lemma upd_pc_incr_same_ins_len:
  forall st0,
    ins_len st0 = ins_len (State.upd_pc_incr st0).
Proof.
  unfold State.upd_pc_incr.
  intros.
  reflexivity.
Qed.

Lemma upd_flag_same_mem:
  forall st0 f,
    bpf_m st0 = bpf_m (State.upd_flag f st0).
Proof.
  unfold State.upd_flag.
  intros.
  reflexivity.
Qed.

Lemma upd_flag_same_regs:
  forall st0 f,
    regs_st st0 = regs_st (State.upd_flag f st0).
Proof.
  unfold State.upd_flag.
  intros.
  reflexivity.
Qed.

Lemma upd_flag_same_pc:
  forall st0 f,
    pc_loc st0 = pc_loc (State.upd_flag f st0).
Proof.
  unfold State.upd_flag.
  intros.
  reflexivity.
Qed.

Lemma upd_flag_same_mrs:
  forall st0 f,
    bpf_mrs st0 = bpf_mrs (State.upd_flag f st0).
Proof.
  unfold State.upd_flag.
  intros.
  reflexivity.
Qed.

Lemma upd_flag_same_mrs_num:
  forall st0 f,
    State.mrs_num st0 = State.mrs_num (State.upd_flag f st0).
Proof.
  unfold State.upd_flag.
  intros.
  reflexivity.
Qed.

Lemma upd_flag_same_ins:
  forall st0 f,
    ins st0 = ins (State.upd_flag f st0).
Proof.
  unfold State.upd_flag.
  intros.
  reflexivity.
Qed.

Lemma upd_flag_same_ins_len:
  forall st0 f,
    ins_len st0 = ins_len (State.upd_flag f st0).
Proof.
  unfold State.upd_flag.
  intros.
  reflexivity.
Qed.

Lemma upd_unchanged_on:
  forall st m0 m1 {S:special_blocks} chunk ofs vl
  (Hst    : match_state  st m0)
  (Hstore : Mem.store chunk m0 st_blk ofs vl = Some m1),
    Mem.unchanged_on (fun b _ => b <> st_blk /\ b <> mrs_blk /\ b <> ins_blk) m0 m1.
Proof.
  intros.
  destruct Hst. (*
  destruct minj0.
  clear - mi_inj mi_freeblocks minvalid0 munchange0 mByte0 Hstore. *)
  eapply Mem.store_unchanged_on.
  rewrite Hstore.
  reflexivity.
  intros.
  intro.
  destruct H0 as (H0 & _).
  apply H0; reflexivity.
Qed.

Lemma upd_preserves_match_list_ins:
  forall l chunk m0 m1 st_blk ins_blk ofs0 vl
  (Hstore : Mem.store chunk m0 st_blk ofs0 vl = Some m1)
  (mem_regs : match_list_ins m0 ins_blk l)
  (Hneq_blk : st_blk <> ins_blk),
    match_list_ins m1 ins_blk l.
Proof.
  intro l.
  induction l.
  unfold match_list_ins in *.
  intros.
  simpl in H.
  lia.

  intros; simpl in *.
  unfold match_list_ins in *.
  intros.
  specialize (mem_regs0 i H).
  unfold Mem.loadv in *. (*
  destruct mem_regs0 as (mem_regs0 & Hdst & Hsrc). *)
  rewrite <- mem_regs0.
  eapply Mem.load_store_other; eauto.
   (*
  split.
  eapply Mem.load_store_other; eauto.
  split; assumption. *)
Qed.

Lemma upd_preserves_match_list_region:
  forall l chunk m0 m1 st_blk mrs_blk ins_blk b ofs0 vl
  (Hstore : Mem.store chunk m0 b ofs0 vl = Some m1)
  (mem_regs : match_list_region m0 st_blk mrs_blk ins_blk l)
  (Hneq_blk : b <> mrs_blk),
    match_list_region m1 st_blk mrs_blk ins_blk l.
Proof.
  intro l.
  induction l;
  unfold match_list_region in *.
  intros; simpl in *.
  lia.

  intros.
  unfold match_region_at_ofs in *.
  specialize (mem_regs0 i H).
  destruct mem_regs0 as  ((vl0 & Hload0 & Heq0) & (vl1 & Hload1 & Heq1) & (vl2 & Hload2 & Heq2) & (blk3 & Hload3 & Heq_ptr)).

  split.
  exists vl0; rewrite <- Hload0; split; [
  eapply Mem.load_store_other; eauto | assumption].

  split.
  exists vl1; rewrite <- Hload1; split; [
  eapply Mem.load_store_other; eauto | assumption].

  split.
  exists vl2; rewrite <- Hload2; split; [
  eapply Mem.load_store_other; eauto | assumption].

  exists blk3; rewrite <- Hload3; split; [
  eapply Mem.load_store_other; eauto | ].
  intuition.
  eapply Mem.store_valid_block_1; eauto.
Qed.

Lemma upd_reg_preserves_match_state:
  forall st0 st1 m0 m1 {S:special_blocks} r vl
  (Hst    : match_state  st0 m0)
  (Hst1   : State.upd_reg r (Vlong vl) st0 = st1)
  (Hstore : Mem.store AST.Mint64 m0 st_blk (8 + 8 * id_of_reg r) (Vlong vl) = Some m1),
    match_state  st1 m1.
Proof.
  intros.
  subst.
  set (Hst' := Hst).
  destruct Hst'.
  split; unfold Mem.loadv in *.
  -
    rewrite <- (upd_reg_same_mem _ r (Vlong vl)).
    assert (Hunchanged_on': Mem.unchanged_on (fun (b : block) (_ : Z) => b <> st_blk /\ b <> mrs_blk /\ b <> ins_blk) m0 m1). {
      eapply Mem.store_unchanged_on; eauto.
      intros.
      intro.
      destruct H0 as (H0 & _).
      apply H0; reflexivity.
    }
    apply Mem.unchanged_on_trans with(m2:= m0); auto.
  -
    rewrite <- (upd_reg_same_pc _ r (Vlong vl)).
    rewrite <- mpc0.
    eapply Mem.load_store_other; eauto.
    right; left.
    unfold id_of_reg; simpl.
    fold Ptrofs.zero.
    rewrite Ptrofs.unsigned_zero.
    destruct r; try lia.
  - rewrite <- (upd_reg_same_flag _ r (Vlong vl)).
    rewrite <- mflags0.
    eapply Mem.load_store_other; eauto.
    right; left.
    rewrite Ptrofs_unsigned_repr_n; [| try simpl; lia].
    unfold id_of_reg; simpl; destruct r; try lia.
  - unfold match_registers in *.
    intros.
    specialize (mregs0 r0).
    destruct mregs0 as (vl0 & mregs0 & mregs1).
    unfold Mem.loadv, Ptrofs.add in *.

    rewrite Hreg_eq in *.
    destruct (reg_eq r0 r).
    + (**r case: r0 = r *)
      subst.
      exists vl.
      split.
      assert (Hload_result: Val.load_result Mint64 (Vlong vl) = (Vlong vl)). {
        reflexivity.
      }
      rewrite <- Hload_result.
      eapply Mem.load_store_same; eauto.
      unfold State.upd_reg; simpl.
      rewrite eval_upd_regmap_same.
      reflexivity.
    +
      exists vl0.
      unfold State.upd_reg, regs_st.

      rewrite eval_upd_regmap_other.
      split.
      2:{
        rewrite mregs1.
        reflexivity.
      }
      rewrite <- mregs0.
      eapply Mem.load_store_other; eauto.
      right.
      2:{ assumption. }
      destruct r0, r; simpl; [try (exfalso; apply n; reflexivity) || (try left; lia) || (try right; lia) ..].
  - simpl.
    destruct mins_len0 as (mins_len0 & mins_len1).
    split; [| assumption].

    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    rewrite <- mins_len0.
    eapply Mem.load_store_other; eauto.
    right; right.
    unfold id_of_reg, size_chunk; destruct r; lia.
  - (**r match_ins *)
    unfold match_ins.
    unfold match_ins in mins0.
    destruct mins0 as (Hload & mins_len & mins_max & mins0).
    split.
    rewrite <- Hload.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    unfold id_of_reg, size_chunk; destruct r; lia.

    split; [assumption | ].
    split; [assumption | ].
    assert (Hins_eq : ins (State.upd_reg r (Vlong vl) st0) = ins st0). {
      unfold State.upd_reg.
      simpl.
      reflexivity.
    }
    rewrite Hins_eq; clear Hins_eq.
    destruct minvalid0 as (_ & minvalid0 & _).
    eapply upd_preserves_match_list_ins; eauto. intuition.
  - rewrite <- (upd_reg_same_mrs_num _ r (Vlong vl)).
    destruct mmrs_num0 as (Hload & Hge).
    split; [| assumption].
    rewrite <- Hload.
    eapply Mem.load_store_other; eauto.
    right; right.
    unfold size_chunk.
    assert (Hle_104: 8 + 8 * id_of_reg r + 8 <= 104). { unfold id_of_reg; destruct r; lia. }
    rewrite Ptrofs_unsigned_repr_n; [| try simpl; lia].
    assumption.
  - unfold match_regions in *.
    destruct mem_regs0 as (Hload & mrs_len & mrs_max & mem_regs0).
    rewrite <- (upd_reg_same_mrs _ r (Vlong vl)).

    split.
    rewrite <- Hload.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    unfold id_of_reg, size_chunk; destruct r; lia.

    split; [assumption | ].
    split; [assumption | ].
    destruct minvalid0 as (_ & minvalid0 & _).
    eapply upd_preserves_match_list_region; eauto. intuition.

  - clear - mperm0 Hstore.
    unfold Mem.range_perm in *.
    destruct mperm0 as (mperm0 & mperm1 & mperm2).
    split; intros.
    eapply Mem.perm_store_1.
    apply Hstore.
    apply mperm0.
    unfold size_of_state in *.
    rewrite <- upd_reg_same_mrs_num in *.
    assumption.
    split; intros.
    eapply Mem.perm_store_1.
    apply Hstore.
    apply mperm1.
    unfold size_of_state in *.
    rewrite <- upd_reg_same_mrs_num in *.
    assumption.
    eapply Mem.perm_store_1.
    apply Hstore.
    apply mperm2.
    unfold size_of_state in *.
    rewrite <- upd_reg_same_ins_len in *.
    assumption.
  - rewrite <- upd_reg_same_mem.
    intuition.
    apply H14; auto.
    eapply Mem.store_valid_block_2; eauto.
Qed.

Lemma upd_pc_preserves_match_state:
  forall st0 st1 m0 m1 {S:special_blocks} pc
  (Hst    : match_state  st0 m0)
  (Hst1   : State.upd_pc pc st0 = st1)
  (Hstore : Mem.store AST.Mint32 m0 st_blk 0 (Vint pc) = Some m1),
    match_state  st1 m1.
Proof.
  intros.
  subst.
  set (Hst' := Hst).
  split.
  -
    destruct Hst' as (Hunchanged_on, _, _, _, _, _, _, _, _, _).
    rewrite <- upd_pc_same_mem.
    assert (Hunchanged_on': Mem.unchanged_on (fun (b : block) (_ : Z) => b <> st_blk /\ b <> mrs_blk /\ b <> ins_blk) m0 m1). {
      eapply Mem.store_unchanged_on; eauto.
      intros.
      intro.
      destruct H0 as(H0 & _).
      apply H0; reflexivity.
    }
    apply Mem.unchanged_on_trans with(m2:= m0); auto.
  -
    destruct Hst' as (_ , Hpc, _, _, _, _, _, _, _, _).
    unfold Mem.loadv in *.
    fold Ptrofs.zero in *.
    rewrite Ptrofs.unsigned_zero in *.
    apply Mem.load_store_same in Hstore.
    rewrite Hstore.
    unfold Val.load_result.
    reflexivity.
  -
    destruct Hst' as (_ , _, Hflag, _, _, _, _, _, _, _).
    rewrite <- upd_pc_same_flag.
    rewrite <- Hflag.
    eapply Mem.load_store_other.
    apply Hstore.
    right; right.
    rewrite Ptrofs_unsigned_repr_n; [| try simpl; lia].
    reflexivity.
  -
    destruct Hst' as (_ , _, _, Hregs, _, _, _, _, _, _).
    rewrite <- upd_pc_same_regs.
    unfold match_registers in *.
    intros.
    specialize (Hregs r).
    destruct Hregs as (vl & Hload & Hvl_eq).
    exists vl.
    split; [| assumption].
    rewrite <- Hload.
    unfold Mem.loadv.
    eapply Mem.load_store_other.
    apply Hstore.
    right; right.
    unfold Ptrofs.add in *.
    unfold size_chunk.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    rewrite Ptrofs_unsigned_repr_id_of_reg in *.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    unfold id_of_reg; destruct r; lia.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    rewrite Ptrofs_unsigned_repr_n with (n:= 8 * id_of_reg r) in *; try (simpl; lia).
    all: unfold id_of_reg; destruct r; lia.
  -
    destruct Hst' as (_ , _, _, _, (Hins_len & Hge), _, _, _, _, _).
    rewrite <- upd_pc_same_ins_len.
    split; [| assumption].
    rewrite <- Hins_len.
    simpl.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
  -
    destruct Hst' as (_ , _, _, _, _, Hins, _, _, _, (_ & Hneq_blk & _)).
    unfold match_ins in *.
    destruct Hins as (Hload & Hins_len & Hins_max & Hins).
    rewrite <- upd_pc_same_ins.
    rewrite <- upd_pc_same_ins_len.
    split.
    rewrite <- Hload.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).

    split; [assumption |].
    split; [assumption |].
    eapply upd_preserves_match_list_ins; eauto. intuition.
  -
    destruct Hst' as (_ , _, _, _, _, _, (Hmrs_len & Hge), _, _, _).
    rewrite <- upd_pc_same_mrs_num.
    split; [| assumption].
    rewrite <- Hmrs_len.
    simpl.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
  -
    destruct Hst' as (_ , _, _, _, _, _, _, Hmrs, _, (_ & Hneq_blk & _)).
    unfold match_regions in *.
    rewrite <- upd_pc_same_mrs.
    rewrite <- upd_pc_same_mrs_num.
    destruct Hmrs as (Hload & Hmrs_len & Hmrs_ge & Hmrs).

    split.
    rewrite <- Hload.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).

    split; [assumption| ].
    split; [assumption| ].
    eapply upd_preserves_match_list_region; eauto. intuition.
  -
    destruct Hst' as (_ , _, _, _, _, _, _, _, Hperm, _).
    unfold size_of_state in *.
    rewrite <- upd_pc_same_mrs_num.
    unfold Mem.range_perm in *.
    destruct Hperm as (Hperm0 & Hperm1 & Hperm2).
    split; intros.
    eapply Mem.perm_store_1.
    apply Hstore.
    apply Hperm0.
    assumption.
    split; intros.
    eapply Mem.perm_store_1.
    apply Hstore.
    apply Hperm1.
    assumption.
    eapply Mem.perm_store_1.
    apply Hstore.
    apply Hperm2.
    assumption.
  -
    destruct Hst' as (_ , _, _, _, _, _, _, _, _, Hvalid).
    rewrite <- upd_pc_same_mem.
    intuition.
    apply H3; auto.
    eapply Mem.store_valid_block_2; eauto.
Qed.

Lemma upd_flag_preserves_match_state:
  forall st0 st1 m0 m1 {S: special_blocks} flag
  (Hst    : match_state  st0 m0)
  (Hst1   : State.upd_flag flag st0 = st1)
  (Hstore : Mem.store AST.Mint32 m0 st_blk 4 (Vint (int_of_flag flag)) = Some m1),
    match_state  st1 m1.
Proof.
  intros.
  subst.
  set (Hst' := Hst).
  split.
  -
    destruct Hst' as (Hunchanged_on, _, _, _, _, _, _, _, _, _).
    rewrite <- upd_flag_same_mem.
    assert (Hunchanged_on': Mem.unchanged_on (fun (b : block) (_ : Z) => b <> st_blk /\ b <> mrs_blk /\ b <> ins_blk) m0 m1). {
      eapply Mem.store_unchanged_on; eauto.
      intros.
      intro H0; destruct H0 as (H0 & _); apply H0; reflexivity.
    }
    apply Mem.unchanged_on_trans with(m2:= m0); auto.
  -
    destruct Hst' as (_ , Hpc, _, _, _, _, _, _, _, _).
    rewrite <- upd_flag_same_pc.
    rewrite <- Hpc.
    eapply Mem.load_store_other.
    apply Hstore.
    right; left.
    fold Ptrofs.zero; rewrite Ptrofs.unsigned_zero.
    reflexivity.
  -
    destruct Hst' as (_ , _, Hflag, _, _, _, _, _, _, _).

    unfold Mem.loadv in *.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    apply Mem.load_store_same in Hstore.
    rewrite Hstore.
    unfold Val.load_result.
    reflexivity.
  -
    destruct Hst' as (_ , _, _, Hregs, _, _, _, _, _, _).
    rewrite <- upd_flag_same_regs.
    unfold match_registers in *.
    intros.
    specialize (Hregs r).
    destruct Hregs as (vl & Hload & Hvl_eq).
    exists vl.
    split; [| assumption].
    rewrite <- Hload.
    unfold Mem.loadv.
    eapply Mem.load_store_other.
    apply Hstore.
    right; right.
    unfold Ptrofs.add in *.
    unfold size_chunk.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    4:
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    4:
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
    all: unfold id_of_reg; destruct r; lia.
  -
    destruct Hst' as (_ , _, _, _, (Hins_len & Hge), _, _, _, _, _).
    rewrite <- upd_flag_same_ins_len.
    split; [| assumption].
    rewrite <- Hins_len.
    simpl.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
  -
    destruct Hst' as (_ , _, _, _, _, Hins, _, _, _, (_ & Hneq_blk & _)).
    unfold match_ins in *.
    destruct Hins as (Hload & Hins_len & Hins_max & Hins).
    rewrite <- upd_flag_same_ins.
    rewrite <- upd_flag_same_ins_len.

    split.
    rewrite <- Hload.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).

    split; [assumption |].
    split; [assumption |].
    eapply upd_preserves_match_list_ins; eauto. intuition.
  -
    destruct Hst' as (_ , _, _, _, _, _, (Hmrs_len & Hge), _, _, _).
    rewrite <- upd_flag_same_mrs_num.
    split; [| assumption].
    rewrite <- Hmrs_len.
    simpl.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).
  -
    destruct Hst' as (_ , _, _, _, _, _, _, Hmrs, _, (_ & Hneq_blk & _)).
    unfold match_regions in *.
    rewrite <- upd_flag_same_mrs.
    rewrite <- upd_flag_same_mrs_num.
    destruct Hmrs as (Hload & Hmrs_len & Hmrs_ge & Hmrs).

    split.
    rewrite <- Hload.
    eapply Mem.load_store_other; eauto.
    right; right.
    rewrite Ptrofs_unsigned_repr_n in *; try (simpl; lia).

    split; [assumption| ].
    split; [assumption| ].
    eapply upd_preserves_match_list_region; eauto. intuition.
  -
    destruct Hst' as (_ , _, _, _, _, _, _, _, Hperm, _).
    unfold size_of_state in *.
    rewrite <- upd_flag_same_mrs_num.
    unfold Mem.range_perm in *.
    destruct Hperm as (Hperm0 & Hperm1 & Hperm2).
    split; intros.
    eapply Mem.perm_store_1.
    apply Hstore.
    apply Hperm0.
    assumption.
    split; intros.
    eapply Mem.perm_store_1.
    apply Hstore.
    apply Hperm1.
    assumption.
    eapply Mem.perm_store_1.
    apply Hstore.
    apply Hperm2.
    assumption.
  -
    destruct Hst' as (_ , _, _, _, _, _, _, _, _, Hvalid).
    rewrite <- upd_flag_same_mem.
    intuition.
    apply H3; auto.
    eapply Mem.store_valid_block_2; eauto.
Qed.

Lemma match_state_implies_valid_pointer:
  forall  {S:special_blocks} st m b ofs
    (Hmatch : match_state  st m)
    (Hvalid : Mem.valid_pointer (bpf_m st) b ofs = true),
      Mem.valid_pointer m b ofs = true.
Proof.
  intros.
  rewrite Mem.valid_pointer_nonempty_perm in *.
  destruct Hmatch.
  eapply Mem.perm_unchanged_on; eauto.
  simpl.
  apply Mem.perm_valid_block in Hvalid.
  clear - minvalid0 Hvalid.
  destruct minvalid0 as ((Hv0 & Hv1 & Hv2) & H).
  repeat split.
  all: eapply Mem.valid_not_valid_diff; eauto.
Qed.

Lemma match_state_implies_loadv_equal:
  forall {S: special_blocks} st m chunk b ofs v
    (Hmatch : match_state  st m)
    (Hload: Mem.load chunk (bpf_m st) b ofs = Some v),
      Mem.load chunk m b ofs = Some v.
Proof.
  intros.
  set (Hmatch' := Hmatch).
  destruct Hmatch' as (Hunchanged, _, _, _, _, _, _, _, _, Hinvalid).
  rewrite <- Hload.
  destruct Hinvalid as (Hinvalid & _ & Hvalid_block).
  apply Mem.load_valid_access in Hload.
  assert (Hload' : Mem.valid_access (bpf_m st) chunk b ofs Nonempty). {
    eapply Mem.valid_access_implies; eauto.
    constructor.
  }
  eapply Mem.valid_access_valid_block in Hload'; eauto.
  eapply Mem.load_unchanged_on_1; eauto.
  simpl; intros.
  intuition congruence.
Qed.

Lemma store_match_state_same:
  forall st1 m m1 m2 chunk b ofs addr
    (Hstore : Mem.store chunk (bpf_m st1) b ofs addr = Some m)
    (Hstore_m2 : Mem.store chunk m1 b ofs addr = Some m2)
    (Hunchanged_on_contents : Maps.ZMap.get ofs (Maps.PMap.get b (Mem.mem_contents m1)) =
                        Maps.ZMap.get ofs
                          (Maps.PMap.get b (Mem.mem_contents (bpf_m st1)))),
      Maps.ZMap.get ofs (Maps.PMap.get b (Mem.mem_contents m2)) =
      Maps.ZMap.get ofs (Maps.PMap.get b (Mem.mem_contents m)).
Proof.
  intros.
  apply Mem.store_mem_contents in Hstore as Hcontents0; auto.
  apply Mem.store_mem_contents in Hstore_m2 as Hcontents1; auto.
  rewrite Hcontents0, Hcontents1.
  repeat rewrite Maps.PMap.gss.
  clear - Hunchanged_on_contents.
  generalize (encode_val chunk addr).
  intros.
  destruct l.
  - simpl.
    assumption.
  - simpl.
    rewrite Mem.setN_other; [|intros; lia].
    rewrite Mem.setN_other; [|intros; lia].
    repeat rewrite Maps.ZMap.gss.
    reflexivity.
Qed.

Lemma store_match_state_same_other:
  forall st1 m m1 m2 chunk b ofs ofs0 addr
    (Hstore : Mem.store chunk (bpf_m st1) b ofs addr = Some m)
    (Hstore_m2 : Mem.store chunk m1 b ofs addr = Some m2)
    (Hother: ofs < ofs0 < ofs + size_chunk chunk)
    (Hunchanged_on_contents : Maps.ZMap.get ofs0 (Maps.PMap.get b (Mem.mem_contents m1)) =
                        Maps.ZMap.get ofs0
                          (Maps.PMap.get b (Mem.mem_contents (bpf_m st1)))),
      Maps.ZMap.get ofs0 (Maps.PMap.get b (Mem.mem_contents m2)) =
      Maps.ZMap.get ofs0 (Maps.PMap.get b (Mem.mem_contents m)).
Proof.
  intros.
  apply Mem.store_mem_contents in Hstore as Hcontents0; auto.
  apply Mem.store_mem_contents in Hstore_m2 as Hcontents1; auto.
  rewrite Hcontents0, Hcontents1.
  repeat rewrite Maps.PMap.gss.

  assert (Hlen: List.length (encode_val chunk addr) = size_chunk_nat chunk) by apply encode_val_length.
  revert Hlen.
  generalize (encode_val chunk addr).
  unfold size_chunk_nat.
  intros.
  assert (Hofs0_eq: exists n, 0 < Z.of_nat n < size_chunk chunk /\ ofs0 = ofs+ Z.of_nat n). {
    clear - Hother.
    assert (Heq: Z.of_nat (Z.to_nat (ofs0 - ofs)) = ofs0 - ofs). {
      rewrite Z2Nat.id.
      reflexivity.
      lia.
    }
    exists (Z.to_nat(ofs0 - ofs)).
    lia.
  }
  destruct Hofs0_eq as (z & Hz_range & Hofs0_eq); subst.
  repeat rewrite mem_get_in.
  reflexivity.
  lia.
  lia.
Qed.

Lemma store_match_state_other:
  forall st1 m m1 m2 chunk b ofs addr
    (Hstore : Mem.store chunk (bpf_m st1) b ofs addr = Some m)
    (Hstore_m2 : Mem.store chunk m1 b ofs addr = Some m2),
    forall b0 ofs0
    (Hother: b0 <> b \/ ofs0 < ofs \/ ofs + size_chunk chunk <= ofs0)
    (Hunchanged_on_contents :
      Maps.ZMap.get ofs0 (Maps.PMap.get b0 (Mem.mem_contents m1)) =
      Maps.ZMap.get ofs0 (Maps.PMap.get b0 (Mem.mem_contents (bpf_m st1)))),
      Maps.ZMap.get ofs0 (Maps.PMap.get b0 (Mem.mem_contents m2)) =
      Maps.ZMap.get ofs0 (Maps.PMap.get b0 (Mem.mem_contents m)).
Proof.
  intros.
  apply Mem.store_mem_contents in Hstore as Hcontents0; auto.
  apply Mem.store_mem_contents in Hstore_m2 as Hcontents1; auto.
  rewrite Hcontents0, Hcontents1.
  destruct (b0 =? b)%positive eqn: Hblk_eq; [rewrite Pos.eqb_eq in Hblk_eq | rewrite Pos.eqb_neq in Hblk_eq].
  - subst.
    repeat rewrite Maps.PMap.gss.
    destruct Hother as [Hfalse | Hother]; [intuition|].
    repeat rewrite Mem.setN_outside.
    + assumption.
    + rewrite Memdata.encode_val_length.
      unfold size_chunk_nat, size_chunk.
      unfold size_chunk in Hother.
      destruct Hother as [Hle | Hge].
      * left.
        lia.
      * right.
        destruct chunk; lia.
    + rewrite Memdata.encode_val_length.
      unfold size_chunk_nat, size_chunk.
      unfold size_chunk in Hother.
      destruct Hother as [Hle | Hge].
      * left.
        lia.
      * right.
        destruct chunk; lia.
  - repeat (rewrite Maps.PMap.gso; [| lia]).
    assumption.
Qed.

Lemma store_reg_preserive_match_state:
  forall {S:special_blocks} st1 st2 m1 chunk b ofs addr m
    (Hst: match_state  st1 m1)
    (Hstore: Mem.store chunk (bpf_m st1) b ofs addr = Some m)
    (Hupd_st: upd_mem m st1 = st2),
      exists m2,
        Mem.store chunk m1 b ofs addr = Some m2 /\
        match_state  st2 m2.
Proof.
  intros.
  assert (Hvalid_blk': Mem.valid_block (bpf_m st1) b). {
    destruct Hst as (Hunchanged_on, _, _, _, _, _, _, _, _, _).
    apply Mem.store_valid_access_3 in Hstore.
    assert (Hstore' : Mem.valid_access (bpf_m st1) chunk b ofs Nonempty). {
      eapply Mem.valid_access_implies; eauto.
      constructor.
    }
    eapply Mem.valid_access_valid_block in Hstore'; eauto.
  }
  assert (Hvalid_blk: Mem.valid_block m1 b). {
    destruct Hst as (Hunchanged_on, _, _, _, _, _, _, _, _, _).
    eapply Mem.valid_block_unchanged_on; eauto.
  }

  assert (Hinvalid: b <> st_blk /\ b <> mrs_blk /\ b <> ins_blk). {
    destruct Hst as (_, _, _, _, _, _, _, _, _, Hinvalid).
    destruct Hinvalid as ((Hinvalid0 & Hinvalid1 & Hinvalid2) & _ & _).
    split.
    intro; subst.
    apply Hinvalid0; assumption.
    split; intro; subst.
    apply Hinvalid1; assumption.
    apply Hinvalid2; assumption.
  }

  assert (Hvalid_access: Mem.valid_access m1 chunk b ofs Writable). {
    destruct Hst.
    destruct minvalid0 as ( _ & _ & Hvalid).
    specialize (Hvalid b Hinvalid Hvalid_blk).
    clear - munchange0 Hvalid Hvalid_blk Hinvalid Hstore.
    destruct munchange0.

    eapply Mem.store_valid_access_3 in Hstore as Hvalid_acc; eauto.
    eapply Mem.valid_access_store with (v:= addr) in Hvalid_acc as Hres; eauto.

    unfold Mem.valid_access in *.
    destruct Hvalid_acc as (Hvalid_acc & Haligh).
    split; [| assumption].
    unfold Mem.range_perm in *.
    intros.
    specialize (Hvalid_acc ofs0 H).
    specialize (unchanged_on_perm b ofs0 Cur Writable Hinvalid Hvalid).
    apply unchanged_on_perm; assumption.
  }
  eapply Mem.valid_access_store with (v:= addr) in Hvalid_access; eauto.
  destruct Hvalid_access as (m2 & Hstore_m2).
  exists m2.
  split; [assumption |].

  subst.
  set (Hst' := Hst).
  split.
  - (**r Mem.unchanged_on *)
    destruct Hst' as (Hunchanged_on, _, _, _, _, _, _, _, _, _).
    destruct Hunchanged_on.
    unfold upd_mem; simpl.
    split.
    + eapply Mem.nextblock_store in Hstore_m2; auto.
      rewrite Hstore_m2.
      eapply Mem.nextblock_store in Hstore; auto.
      rewrite Hstore.
      assumption.
    + intros.
      eapply Mem.store_valid_block_2 in Hstore as Hvalid_block; eauto.
      specialize (unchanged_on_perm b0 ofs0 k p H Hvalid_block).
      eapply store_perm_iff with (b0:=b0) (ofs0:=ofs0) (k:=k) (p:=p) in Hstore as Hperm_1; eauto.
      eapply store_perm_iff with (b0:=b0) (ofs0:=ofs0) (k:=k) (p:=p) in Hstore_m2 as Hperm_2; eauto.
      intuition.
    + intros.
      eapply Mem.perm_store_2 in Hstore as Hperm; eauto.
      specialize (unchanged_on_contents b0 ofs0 H Hperm).
      clear unchanged_on_nextblock unchanged_on_perm H0 Hperm.

      destruct (b0 =? b)%positive eqn: Hblk_eq; [rewrite Pos.eqb_eq in Hblk_eq | rewrite Pos.eqb_neq in Hblk_eq].
      * (**r b0 = b *)
        subst.
        destruct (ofs0 =? ofs)%Z eqn: Hofs_eq; [rewrite Z.eqb_eq in Hofs_eq | rewrite Z.eqb_neq in Hofs_eq].
        ** (**r ofs0 = ofs *)
          subst.
          eapply store_match_state_same; eauto.
        ** (**r ofs0 <> ofs *)
          rewrite Z.lt_gt_cases in Hofs_eq.
          destruct Hofs_eq as [Hofs_le | Hofs_ge].
          { (**r ofs0 < ofs*)
            eapply store_match_state_other; eauto.
          }
          { (**r ofs < ofs0 *)
            destruct (ofs + size_chunk chunk <=? ofs0)%Z eqn: Hge; [rewrite Z.leb_le in Hge | rewrite Z.leb_gt in Hge].
            { (**r ofs + size_chunk chunk <= ofs0 *)
              eapply store_match_state_other; eauto.
            }
            { (**r ofs < ofs0 < ofs + size_chunk chunk *)
              eapply store_match_state_same_other; eauto.
            }
          }
      * (**r b0 <> b *)
        eapply store_match_state_other; eauto.
  - (**r pc *)
    destruct Hst' as (_, Hpc, _, _, _, _, _, _, _, _).
    unfold Mem.loadv in *.
    unfold upd_mem; simpl.
    eapply Mem.load_store_other in Hstore_m2.
    rewrite Hstore_m2.
    assumption.
    intuition.
  - (**r flag *)
    destruct Hst' as (_, _, Hflag, _, _, _, _, _, _, _).
    unfold Mem.loadv in *.
    unfold upd_mem; simpl.
    eapply Mem.load_store_other in Hstore_m2.
    rewrite Hstore_m2.
    assumption.
    intuition.
  - (**r registers *)
    destruct Hst' as (_, _, _, Hreg, _, _, _, _, _, _).
    unfold match_registers in *.
    intros.
    specialize (Hreg r).
    destruct Hreg as (vl & Hload & Hvl_eq).
    unfold Mem.loadv in *.
    unfold upd_mem; simpl regs_st.
    exists vl.
    split; [| assumption].
    eapply Mem.load_store_other in Hstore_m2.
    rewrite Hstore_m2.
    assumption.
    intuition.
  - (**r ins_len *)
    destruct Hst' as (_, _, _, _, Hins_len, _, _, _, _, _).
    unfold Mem.loadv in *.
    unfold upd_mem; simpl.
    destruct Hins_len as (Hload & Hge).
    split; [| assumption].
    eapply Mem.load_store_other in Hstore_m2.
    rewrite Hstore_m2.
    assumption.
    intuition.
  - (**r ins *)
    destruct Hst' as (_, _, _, _, _, Hins, _, _, _, _).
    unfold Mem.loadv in *.
    unfold match_ins in *.
    destruct Hins as (Hload & Hlen & Hmax & Hmatch).
    unfold upd_mem; simpl.
    split.

    eapply Mem.load_store_other in Hstore_m2.
    rewrite Hstore_m2.
    assumption.
    intuition.

    split; [assumption| ].
    split; [assumption| ].
    eapply upd_preserves_match_list_ins; eauto.
    intuition.
  - (**r mrs_num *)
    destruct Hst' as (_, _, _, _, _, _, Hmrs_num, _, _, _).
    unfold Mem.loadv in *.
    destruct Hmrs_num as (Hload & Hother).
    unfold upd_mem; simpl.
    split.

    eapply Mem.load_store_other in Hstore_m2.
    rewrite Hstore_m2.
    assumption.
    intuition.

    assumption.
  - (**r mrs_block *)
    destruct Hst' as (_, _, _, _, _, _, _, Hmrs_block, _, _).
    unfold Mem.loadv in *.
    unfold match_regions in *.
    unfold upd_mem; simpl.
    destruct Hmrs_block as (Hload & Hlen & Hmax & Hmatch).
    split.

    eapply Mem.load_store_other in Hstore_m2.
    rewrite Hstore_m2.
    assumption.
    intuition.

    split; [assumption| ].
    split; [assumption| ].
    eapply upd_preserves_match_list_region; eauto.
    intuition.
  - (**r range_perm *)
    destruct Hst' as (_, _, _, _, _, _, _, _, Hrange_perm, _).
    unfold size_of_state in *.
    unfold upd_mem.
    simpl mrs_num.
    simpl ins_len.
    destruct Hrange_perm as (Hrange_perm_st & Hrange_perm_mrs & Hrange_perm_ins).
    split; [eapply store_range_perm; eauto; intuition |].
    split; eapply store_range_perm; eauto; intuition.
  - (**r valid_block *)
    destruct Hst' as (_, _, _, _, _, _, _, _, _, Hvalid_block).
    unfold upd_mem; simpl.
    destruct Hvalid_block as (Hinvalid_blk & Hneq_blk & Hvalid).
    destruct Hinvalid_blk as (Hinvalid_blk0 & Hinvalid_blk1 & Hinvalid_blk2).
    split.
    split.
    intro H; apply Hinvalid_blk0; eapply Mem.store_valid_block_2; eauto.
    split.
    intro H; apply Hinvalid_blk1; eapply Mem.store_valid_block_2; eauto.
    intro H; apply Hinvalid_blk2; eapply Mem.store_valid_block_2; eauto.
    split; [assumption | ].
    intros.
    specialize (Hvalid b0 H).
    eapply Mem.store_valid_block_2 in Hstore_m2; eauto.
    specialize (Hvalid Hstore_m2).
    eapply Mem.store_valid_block_1 in Hstore; eauto.
Qed.

Close Scope Z_scope.

#[global] Notation dcons := (DList.DCons (F:= fun x => x -> Inv State.state)).


(* *********************************************************************)
(*                                                                     *)
(*            The CertiKOS Certified Kit Operating System              *)
(*                                                                     *)
(*                   The FLINT Group, Yale University                  *)
(*                                                                     *)
(*  Copyright The FLINT Group, Yale University.  All rights reserved.  *)
(*  This file is distributed under the terms of the Yale University    *)
(*  Non-Commercial License Agreement.                                  *)
(*                                                                     *)
(* *********************************************************************)
(* *********************************************************************)
(*                                                                     *)
(*              Object Primitives                                      *)
(*                                                                     *)
(*          Ronghui Gu <ronghui.gu@yale.edu>                           *)
(*                                                                     *)
(*          Yale Flint Group                                           *)
(*                                                                     *)
(* *********************************************************************)

Require Import Coqlib.
Require Import Maps.
Require Import AuxStateDataType.
Require Import FlatMemory.
Require Import AbstractDataType.
Require Import Integers.
Require Import Values.
Require Import Constant.
Require Import RealParams.
Require Import CalRealIDPDE.
Require Import CalRealInitPTE.
Require Import CalRealPTPool.
Require Import CalRealPT.
Require Import CalRealSMSPool.
Require Import CalRealProcModule.
(*Require Import CalRealIntelModule.*)
Require Import liblayers.compat.CompatGenSem.
(*
Require Import ObjLMM.
Require Import ObjVMM.*)

Section OBJ_Arg.

  Function uctx_arg1_spec (adt : RData) : option Z :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        match (ZMap.get U_EAX (ZMap.get (cid adt) (uctxt adt))) with
          | Vint n => Some (Int.unsigned n)
          | _ => None
        end
      | _ => None
    end.

  Function uctx_arg2_spec (adt : RData) : option Z :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        match (ZMap.get U_EBX (ZMap.get (cid adt) (uctxt adt))) with
          | Vint n => Some (Int.unsigned n)
          | _ => None
        end
      | _ => None
    end.

  Function uctx_arg3_spec (adt : RData) : option Z :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        match (ZMap.get U_ECX (ZMap.get (cid adt) (uctxt adt))) with
          | Vint n => Some (Int.unsigned n)
          | _ => None
        end
      | _ => None
    end.

  Function uctx_arg4_spec (adt : RData) : option Z :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        match (ZMap.get U_EDX (ZMap.get (cid adt) (uctxt adt))) with
          | Vint n => Some (Int.unsigned n)
          | _ => None
        end
      | _ => None
    end.

  Function uctx_arg5_spec (adt : RData) : option Z :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        match (ZMap.get U_ESI (ZMap.get (cid adt) (uctxt adt))) with
          | Vint n => Some (Int.unsigned n)
          | _ => None
        end
      | _ => None
    end.

  Function uctx_arg6_spec (adt : RData) : option Z :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        match (ZMap.get U_EDI (ZMap.get (cid adt) (uctxt adt))) with
          | Vint n => Some (Int.unsigned n)
          | _ => None
        end
      | _ => None
    end.

  Function uctx_set_errno_spec (n: Z) (adt : RData) : option RData :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        let uctx := ZMap.get (cid adt) (uctxt adt) in
        let uctx':= ZMap.set U_EAX (Vint (Int.repr n)) uctx in
        Some (adt {uctxt: ZMap.set (cid adt) uctx' (uctxt adt)})
      | _ => None
    end.

  Function uctx_set_retval1_spec (n: Z) (adt : RData) : option RData :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        let uctx := ZMap.get (cid adt) (uctxt adt) in
        let uctx':= ZMap.set U_EBX (Vint (Int.repr n)) uctx in
        Some (adt {uctxt: ZMap.set (cid adt) uctx' (uctxt adt)})
      | _ => None
    end.

  Function uctx_set_retval2_spec (n: Z) (adt : RData) : option RData :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        let uctx := ZMap.get (cid adt) (uctxt adt) in
        let uctx':= ZMap.set U_ECX (Vint (Int.repr n)) uctx in
        Some (adt {uctxt: ZMap.set (cid adt) uctx' (uctxt adt)})
      | _ => None
    end.

  Function uctx_set_retval3_spec (n: Z) (adt : RData) : option RData :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        let uctx := ZMap.get (cid adt) (uctxt adt) in
        let uctx':= ZMap.set U_EDX (Vint (Int.repr n)) uctx in
        Some (adt {uctxt: ZMap.set (cid adt) uctx' (uctxt adt)})
      | _ => None
    end.

  Function uctx_set_retval4_spec (n: Z) (adt : RData) : option RData :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        let uctx := ZMap.get (cid adt) (uctxt adt) in
        let uctx':= ZMap.set U_ESI (Vint (Int.repr n)) uctx in
        Some (adt {uctxt: ZMap.set (cid adt) uctx' (uctxt adt)})
      | _ => None
    end.

  Function uctx_set_retval5_spec (n: Z) (adt : RData) : option RData :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        let uctx := ZMap.get (cid adt) (uctxt adt) in
        let uctx':= ZMap.set U_EDI (Vint (Int.repr n)) uctx in
        Some (adt {uctxt: ZMap.set (cid adt) uctx' (uctxt adt)})
      | _ => None
    end.

  (*Function la2pa_resv_spec (vadr : Z) (adt: RData) : option (RData * Z):=
    match (pg adt, ptRead_spec (cid adt) vadr adt) with
      | (true, Some padr) =>
        if zeq padr 0 then
          match ptResv_spec (cid adt) vadr PT_PERM_PTU adt with
            | Some (adt', _) =>
              match ptRead_spec (cid adt) vadr adt' with
                | Some padr' =>
                  if zlt_lt 0 padr' maxpage then
                    Some (adt', padr' * PgSize + (vadr mod PgSize))
                  else None
                | _ => None
              end
            | _ => None
          end
        else
          if zlt_lt 0 padr maxpage then
            Some (adt, padr * PgSize + (vadr mod PgSize))
          else None
      | _ => None
    end.*)

End OBJ_Arg.

Require Import liblayers.compat.CompatGenSem.
Require Import liblayers.compat.CompatLayers.
Require Import CommonTactic.
Require Import RefinementTactic.
Require Import PrimSemantics.
Require Import AuxLemma.
Require Import Observation.

Section OBJ_SIM.

  Context `{Hobs: Observation}.

  Context `{data : CompatData(Obs:=Obs) RData}.
  Context `{data0 : CompatData(Obs:=Obs) RData}.

  Context `{Hstencil: Stencil}.
  Context `{Hmem: Mem.MemoryModel}.
  Context `{Hmwd: UseMemWithData mem}.

  Notation HDATAOps := (cdata (cdata_prf := data) RData).
  Notation LDATAOps := (cdata (cdata_prf := data0) RData).

  Context `{rel_prf: CompatRel _ (Obs:=Obs) (memory_model_ops:= memory_model_ops) _
                               (stencil_ops:= stencil_ops) HDATAOps LDATAOps}.

  Local Open Scope Z.

  Context {re1: relate_impl_iflags}.
  Context {re2: relate_impl_cid}.
  Context {re3: relate_impl_uctxt}.

  Definition uctx_argn_spec n (adt : RData) : option Z :=
    match (ikern adt, pg adt, ihost adt) with
      | (true, true, true) =>
        match (ZMap.get n (ZMap.get (cid adt) (uctxt adt))) with
          | Vint n => Some (Int.unsigned n)
          | _ => None
        end
      | _ => None
    end.

  Lemma uctx_argn_exist:
    forall n, 0 <= n < UCTXT_SIZE ->
    forall s habd z labd f,
      uctx_argn_spec n habd = Some z ->
      0 <= cid habd < num_proc ->
      relate_AbData s f habd labd ->
      uctx_argn_spec n labd = Some z.
  Proof.
    unfold uctx_argn_spec in *. intros.
    exploit relate_impl_iflags_eq; eauto. inversion 1.
    exploit relate_impl_cid_eq; eauto. intros.
    exploit relate_impl_uctxt_eq; eauto.
    revert H0; subrewrite. inversion 1; subdestruct.
    inv HQ. inv H6. reflexivity.
  Qed.

  Lemma uctx_argn_sim:
    forall n, 0 <= n < UCTXT_SIZE ->
    forall id,
      (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                  0 <= cid d1 < num_proc) ->
      sim (crel RData RData) (id ↦ gensem (uctx_argn_spec n))
          (id ↦ gensem (uctx_argn_spec n)).
  Proof.
    intros ? valid_n ? valid_cid.
    layer_sim_simpl. compatsim_simpl (@match_AbData). intros.
    match_external_states_simpl.
    erewrite uctx_argn_exist; eauto.
    reflexivity.
  Qed.

  Lemma uctx_arg1_sim:
    forall id,
      (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                  0 <= cid d1 < num_proc) ->
      sim (crel RData RData) (id ↦ gensem uctx_arg1_spec)
          (id ↦ gensem uctx_arg1_spec).
  Proof.
    apply uctx_argn_sim.
    split; [ discriminate | reflexivity ].
  Qed.

  Lemma uctx_arg2_sim:
    forall id,
      (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                  0 <= cid d1 < num_proc) ->
      sim (crel RData RData) (id ↦ gensem uctx_arg2_spec)
          (id ↦ gensem uctx_arg2_spec).
  Proof.
    apply uctx_argn_sim.
    split; [ discriminate | reflexivity ].
  Qed.

  Lemma uctx_arg3_sim:
    forall id,
      (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                  0 <= cid d1 < num_proc) ->
      sim (crel RData RData) (id ↦ gensem uctx_arg3_spec)
          (id ↦ gensem uctx_arg3_spec).
  Proof.
    apply uctx_argn_sim.
    split; [ discriminate | reflexivity ].
  Qed.

  Lemma uctx_arg4_sim:
    forall id,
      (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                  0 <= cid d1 < num_proc) ->
      sim (crel RData RData) (id ↦ gensem uctx_arg4_spec)
          (id ↦ gensem uctx_arg4_spec).
  Proof.
    apply uctx_argn_sim.
    split; [ discriminate | reflexivity ].
  Qed.

  Lemma uctx_arg5_sim:
    forall id,
      (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                  0 <= cid d1 < num_proc) ->
      sim (crel RData RData) (id ↦ gensem uctx_arg5_spec)
          (id ↦ gensem uctx_arg5_spec).
  Proof.
    apply uctx_argn_sim.
    split; [ discriminate | reflexivity ].
  Qed.

  Lemma uctx_arg6_sim:
    forall id,
      (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                  0 <= cid d1 < num_proc) ->
      sim (crel RData RData) (id ↦ gensem uctx_arg6_spec)
          (id ↦ gensem uctx_arg6_spec).
  Proof.
    apply uctx_argn_sim.
    split; [ discriminate | reflexivity ].
  Qed.

  Section UCTX_SET_REGK_SIM.
    Variable k : Z.
    (* Hypothesis k_range : 0 <= k < UCTXT_SIZE. *)

    Definition uctx_set_regk_spec (n: Z) (adt : RData) : option RData :=
      match (ikern adt, pg adt, ihost adt) with
        | (true, true, true) =>
          let uctx := ZMap.get (cid adt) (uctxt adt) in
          let uctx':= ZMap.set k (Vint (Int.repr n)) uctx in
          Some (adt {uctxt: ZMap.set (cid adt) uctx' (uctxt adt)})
        | _ => None
      end.

    Lemma uctx_set_regk_exist:
      forall s habd habd' labd n f,
        uctx_set_regk_spec n habd = Some habd'
        -> relate_AbData s f habd labd
        -> 0 <= cid habd < num_proc
        -> exists labd', uctx_set_regk_spec n labd = Some labd'
                         /\ relate_AbData s f habd' labd'.
    Proof.
      unfold uctx_set_regk_spec; intros.
      exploit relate_impl_iflags_eq; eauto. inversion 1.
      exploit relate_impl_cid_eq; eauto. intros.
      revert H. subrewrite. subdestruct.
      inv HQ; refine_split'; trivial.

      apply relate_impl_uctxt_update; try assumption.
      unfold uctxt_inj; intros.
      destruct (zeq i (cid labd)) as [ -> | ? ];
        [ rewrite 2 ZMap.gss
        | rewrite 2 ZMap.gso; try eapply relate_impl_uctxt_eq; eassumption ].
      destruct (zeq j k) as [ -> | ? ];
        [ rewrite 2 ZMap.gss; constructor
        | rewrite 2 ZMap.gso; try eapply relate_impl_uctxt_eq; eassumption ].
    Qed.

    Context {mt1: match_impl_uctxt}.

    Lemma uctx_set_regk_match:
      forall s d d' m n f,
        uctx_set_regk_spec n d = Some d'
        -> match_AbData s d m f
        -> match_AbData s d' m f.
    Proof.
      unfold uctx_set_regk_spec; intros. subdestruct; inv H; trivial.
      eapply match_impl_uctxt_update. assumption.
    Qed.

    Context {inv: PreservesInvariants (HD:= data) uctx_set_regk_spec}.
    Context {inv0: PreservesInvariants (HD:= data0) uctx_set_regk_spec}.

    Lemma uctx_set_regk_sim:
      forall id,
        (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                    0 <= cid d1 < num_proc) ->
        sim (crel RData RData) (id ↦ gensem uctx_set_regk_spec)
            (id ↦ gensem uctx_set_regk_spec).
    Proof.
      intros ? valid_cid. layer_sim_simpl. compatsim_simpl (@match_AbData). intros.
      exploit uctx_set_regk_exist; eauto; intros [labd' [HP HM]].
      match_external_states_simpl.
      eapply uctx_set_regk_match; eauto.
    Qed.

  End UCTX_SET_REGK_SIM.

  Lemma uctx_set_errno_sim
      {mt1: match_impl_uctxt}
      {inv: PreservesInvariants (HD:= data) uctx_set_errno_spec}
      {inv0: PreservesInvariants (HD:= data0) uctx_set_errno_spec}:
    forall id,
      (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                  0 <= cid d1 < num_proc) ->
      sim (crel RData RData) (id ↦ gensem uctx_set_errno_spec)
          (id ↦ gensem uctx_set_errno_spec).
  Proof uctx_set_regk_sim U_EAX.

  Lemma uctx_set_retval1_sim
      {mt1: match_impl_uctxt}
      {inv: PreservesInvariants (HD:= data) uctx_set_retval1_spec}
      {inv0: PreservesInvariants (HD:= data0) uctx_set_retval1_spec}:
    forall id,
      (forall d1, high_level_invariant (CompatDataOps:= data_ops) d1 ->
                  0 <= cid d1 < num_proc) ->
      sim (crel RData RData) (id ↦ gensem uctx_set_retval1_spec)
          (id ↦ gensem uctx_set_retval1_spec).
  Proof uctx_set_regk_sim U_EBX.

End OBJ_SIM.