(* *********************************************************************)
(*                                                                     *)
(*            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.                                  *)
(*                                                                     *)
(* *********************************************************************)
(* *********************************************************************)
(*                                                                     *)
(*                   Proof of functional correctness                   *)
(*          for the C functions implemented in the MALT layer          *)
(*                                                                     *)
(*                        David Costanzo                               *)
(*                                                                     *)
(*                          Yale University                            *)
(*                                                                     *)
(* *********************************************************************)
Require Import Coqlib.
Require Import Maps.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Values.
Require Import MemoryX.
Require Import MemWithData.
Require Import EventsX.
Require Import Globalenvs.
Require Import Locations.
Require Import LAsm.
Require Import Smallstep.
Require Import ClightBigstep.
Require Import Cop.
Require Import ZArith.Zwf.
Require Import LoopProof.
Require Import VCGen.
Require Import RealParams.
Require Import liblayers.compcertx.Stencil.
Require Import liblayers.compcertx.MakeProgram.
Require Import liblayers.compat.CompatLayers.
Require Import liblayers.compat.CompatGenSem.
Require Import CompatClightSem.
Require Import PrimSemantics.
Require Import Clight.
Require Import CDataTypes.
Require Import Ctypes.
Require Import ContainerGenSpec.
Require Import MALTCSource.
Require Import TacticsForTesting.
Require Import MALT.

Require Import AbstractDataType.
Require Import CommonTactic.

(*Global Opaque compatdata_layerdata ldata_type.*)

Module MALTCODE.

  (* Helper lemmas related to struct *)
  Open Scope Z_scope.

  Lemma convert_quota :  forall i, Int.unsigned i < num_id ->
    Int.unsigned (Int.mul i (Int.repr 20)) + Int.unsigned (Int.repr 0) = Int.unsigned i * CSIZE + QUOTA.
  Proof.
    intros i Hi.
    assert (Hrange:= Int.unsigned_range_2 i).
    rewrite Int.mul_signed.
    rewrite 2 Int.signed_eq_unsigned; try rewrite max_signed_val; try omega.
    rewrite 3 Int.unsigned_repr; eauto; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
  Qed.

  Lemma convert_usage :  forall i, Int.unsigned i < num_id ->
    Int.unsigned (Int.mul i (Int.repr 20)) + Int.unsigned (Int.repr 4) = Int.unsigned i * CSIZE + USAGE.
  Proof.
    intros i Hi.
    assert (Hrange:= Int.unsigned_range_2 i).
    rewrite Int.mul_signed.
    rewrite 2 Int.signed_eq_unsigned; try rewrite max_signed_val; try omega.
    rewrite 3 Int.unsigned_repr; eauto; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
  Qed.

  Lemma convert_parent :  forall i, Int.unsigned i < num_id ->
    Int.unsigned (Int.mul i (Int.repr 20)) + Int.unsigned (Int.repr 8) = Int.unsigned i * CSIZE + PARENT.
  Proof.
    intros i Hi.
    assert (Hrange:= Int.unsigned_range_2 i).
    rewrite Int.mul_signed.
    rewrite 2 Int.signed_eq_unsigned; try rewrite max_signed_val; try omega.
    rewrite 3 Int.unsigned_repr; eauto; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
  Qed.

  Lemma convert_nchildren :  forall i, Int.unsigned i < num_id ->
    Int.unsigned (Int.mul i (Int.repr 20)) + Int.unsigned (Int.repr 12) = Int.unsigned i * CSIZE + NCHILDREN.
  Proof.
    intros i Hi.
    assert (Hrange:= Int.unsigned_range_2 i).
    rewrite Int.mul_signed.
    rewrite 2 Int.signed_eq_unsigned; try rewrite max_signed_val; try omega.
    rewrite 3 Int.unsigned_repr; eauto; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
  Qed.

  Lemma convert_used :  forall i, Int.unsigned i < num_id ->
    Int.unsigned (Int.mul i (Int.repr 20)) + Int.unsigned (Int.repr 16) = Int.unsigned i * CSIZE + USED.
  Proof.
    intros i Hi.
    assert (Hrange:= Int.unsigned_range_2 i).
    rewrite Int.mul_signed.
    rewrite 2 Int.signed_eq_unsigned; try rewrite max_signed_val; try omega.
    rewrite 3 Int.unsigned_repr; eauto; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
    rewrite Int.unsigned_repr; try rewrite max_unsigned_val; try omega.
  Qed.

  Close Scope Z_scope.

  Section WithPrimitives.

    Context `{real_params: RealParams}.
    Context {memb} `{Hmemx: Mem.MemoryModelX memb}.
    Context `{Hmwd: UseMemWithData memb}.

    Let mem := mwd (cdata RData).

    Context `{Hstencil: Stencil}.
    Context `{make_program_ops: !MakeProgramOps Clight.function type Clight.fundef type}.
    Context `{Hmake_program: !MakeProgram Clight.function type Clight.fundef type}.

    Opaque PTree.get PTree.set.

    Local Open Scope Z_scope.

    (* Helpers for omega *)
    Let Hmax := max_unsigned_val.
    Let Hnps_range := real_nps_range.
    Let Hquota_range := real_quota_range.
    Let Hstruct_size : sizeof t_struct_AC = 20. Proof. auto. Qed.

    Section ContainerInit.

      Let L: compatlayer (cdata RData (cdata_ops:= malt_data_ops) (cdata_prf:= malt_data_prf)) :=
        AC_LOC ↦ container_loc_type
               ⊕ mem_init ↦ gensem mem_init_spec
               ⊕ get_nps ↦ gensem get_nps_spec
               ⊕ is_norm ↦ gensem is_at_norm_spec
               ⊕ at_get ↦ gensem get_at_u_spec.

      Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.

      Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

      Section InitBody.

        Context `{Hwb: WritableBlockOps}.
        Context `{Hwbg: WritableBlockAllowGlobals WB}.

        Variables (s: stencil) (ge: genv).
        Hypothesis Hstencil_matches: stencil_matches s ge.

        (* AC_LOC *)
        Variable b_ac: block.
        Hypothesis hac_loc1 : Genv.find_symbol ge AC_LOC = Some b_ac.

        (* mem_init *)
        Variable b_mi : block.
        Hypothesis hmem_init1 : Genv.find_symbol ge mem_init = Some b_mi.
        Hypothesis hmem_init2 : Genv.find_funct_ptr ge b_mi =
          Some (External (EF_external mem_init
            (signature_of_type (Tcons tint Tnil) Tvoid cc_default)) (Tcons tint Tnil) Tvoid cc_default).

        (* get_nps *)
        Variable b_nps : block.
        Hypothesis hnps1 : Genv.find_symbol ge get_nps = Some b_nps.
        Hypothesis hnps2 : Genv.find_funct_ptr ge b_nps =
          Some (External (EF_external get_nps
            (signature_of_type Tnil tint cc_default)) Tnil tint cc_default).

         (* is_norm *)
        Variable b_norm : block.
        Hypothesis hnorm1 : Genv.find_symbol ge is_norm = Some b_norm.
        Hypothesis hnorm2 : Genv.find_funct_ptr ge b_norm =
          Some (External (EF_external is_norm
            (signature_of_type (Tcons tint Tnil) tint cc_default)) (Tcons tint Tnil) tint cc_default).

        (* at_get *)
        Variable b_atget : block.
        Hypothesis hatget1 : Genv.find_symbol ge at_get = Some b_atget.
        Hypothesis hatget2 : Genv.find_funct_ptr ge b_atget =
          Some (External (EF_external at_get
            (signature_of_type (Tcons tint Tnil) tint cc_default)) (Tcons tint Tnil) tint cc_default).

        Section Container_init_loop_proof.

          Variables (minit : memb) (dinit dpreinit : RData).
          Hypothesis ATinit : AT dinit = real_AT (AT dpreinit).
          Hypotheses (ikerninit : ikern dinit = true) (ihostinit : ihost dinit = true).

          Definition init_loop_body_P (le: temp_env) (m : mem) : Prop :=
            le ! t_nps = Some (Vint (Int.repr real_nps)) /\
            le ! t_rq = Some (Vint (Int.repr 0)) /\
            le ! t_i = Some (Vint (Int.repr 1)) /\ m = (minit, dinit).

          Definition init_loop_body_Q (le : temp_env) (m : mem): Prop :=
            le ! t_rq = Some (Vint (Int.repr real_quota)) /\ m = (minit, dinit).

          Lemma container_init_loop_correct :
            LoopProofSimpleWhile.t container_init_while_condition container_init_while_body
                                   ge (PTree.empty _) init_loop_body_P init_loop_body_Q.
          Proof.
            apply LoopProofSimpleWhile.make with
              (W := Z) (lt := fun z1 z2 => 0 <= z2 /\  z1 < z2)
              (I := fun le m w =>
                      exists i,
                        0 < i <= real_nps /\
                        le ! t_i = Some (Vint (Int.repr i)) /\
                        le ! t_nps = Some (Vint (Int.repr real_nps)) /\
                        le ! t_rq = Some (Vint (Int.repr (unused_pages_AT (AT dinit) (Z.to_nat (i-1))))) /\
                        m = (minit, dinit) /\ w = real_nps - i).
            apply Zwf_well_founded.
            unfold init_loop_body_P; intros le m Hle; decompose [and] Hle; clear Hle; subst.
            exists (real_nps - 1), 1; repeat (apply conj; try omega; auto).
            intros le m w [i Hle]; decompose [and] Hle; clear Hle; subst.
            assert (Hcases: i = real_nps \/ i < real_nps) by omega; destruct Hcases; subst.
            {
              (* while condition is false *)
              eexists; exists false; repeat split; try discriminate.
              repeat vcgen.
              cases; simpl; auto; omega.
              subrewrite'; repeat f_equal.
              rewrite real_quota_convert; rewrite real_quota_unused_pages_AT; reflexivity.
            }
            {
              (* while condition is true *)
              assert (Hi_conv: i = Z.pos (Pos.of_succ_nat (Z.to_nat (i - 1)))).
              {
                change (Z.pos (Pos.of_succ_nat (Z.to_nat (i-1)))) with (Z.of_nat (S (Z.to_nat (i-1)))).
                rewrite Nat2Z.inj_succ; rewrite <- Z.add_1_r.
                rewrite Z2Nat.id; omega.
              }
              eexists; exists true; repeat split; intros; try discriminate.
              repeat vcgen.
              cases; simpl; auto.
              clear Hdestruct; rewrite 2 Int.unsigned_repr in *; omega.
              destruct (ZMap.get i (AT dinit)) as [[|] t v|] eqn:Hat;
                try (destruct (ATType_dec t ATNorm); try subst t).

              (* Case 1: u = true, t = ATNorm *)
              eexists; exists (minit, dinit); repeat split.
              unfold container_init_while_body; d3 vcgen.
              (* call is_norm *)
              repeat vcgen.
              unfold is_at_norm_spec; rewrites; cases; try omega; try congruence.
              change 1 with (Int.unsigned (Int.repr 1)); reflexivity.
              d2 vcgen.
              (* call at_get *)
              repeat vcgen.
              unfold get_at_u_spec; rewrites; cases; try omega.
              change 1 with (Int.unsigned (Int.repr 1)); reflexivity.
              d2 vcgen.
              (* if statement (false) *)
              repeat vcgen.
              (* increment i *)
              repeat vcgen.
              (* reestablish loop invariant *)
              exists (real_nps - i - 1); repeat vcgen.
              exists (i + 1); repeat vcgen.
              replace (Z.to_nat (i+1-1)) with (S (Z.to_nat (i-1))).
              simpl; rewrite <- Hi_conv; rewrites; auto.
              rewrite <- Z2Nat.inj_succ; f_equal; omega.

              (* Case 2: u = true, t <> ATNorm *)
              eexists; exists (minit, dinit); repeat split.
              unfold container_init_while_body; d3 vcgen.
              (* call is_norm *)
              repeat vcgen.
              unfold is_at_norm_spec; rewrites; cases; try omega; try congruence.
              change 0 with (Int.unsigned (Int.repr 0)); reflexivity.
              d2 vcgen.
              (* call at_get *)
              repeat vcgen.
              unfold get_at_u_spec; rewrites; cases; try omega.
              change 1 with (Int.unsigned (Int.repr 1)); reflexivity.
              d2 vcgen.
              (* if statement (false) *)
              repeat vcgen.
              (* increment i *)
              repeat vcgen.
              (* reestablish loop invariant *)
              exists (real_nps - i - 1); repeat vcgen.
              exists (i + 1); repeat vcgen.
              replace (Z.to_nat (i+1-1)) with (S (Z.to_nat (i-1))).
              simpl; rewrite <- Hi_conv; rewrites; auto.
              rewrite <- Z2Nat.inj_succ; f_equal; omega.

              (* Case 3: u = false, t = ATNorm *)
              eexists; exists (minit, dinit); repeat split.
              unfold container_init_while_body; d3 vcgen.
              (* call is_norm *)
              repeat vcgen.
              unfold is_at_norm_spec; rewrites; cases; try omega; try congruence.
              change 1 with (Int.unsigned (Int.repr 1)); reflexivity.
              d2 vcgen.
              (* call at_get *)
              repeat vcgen.
              unfold get_at_u_spec; rewrites; cases; try omega.
              change 0 with (Int.unsigned (Int.repr 0)); reflexivity.
              d2 vcgen.
              (* if statement (true) *)
              repeat vcgen.
              (* increment i *)
              assert (Hrange:= unused_pages_AT_range (Z.to_nat (i - 1)) (AT dinit)).
              rewrite Z2Nat.id in Hrange by omega; repeat vcgen.
              (* reestablish loop invariant *)
              exists (real_nps - i - 1); repeat vcgen.
              exists (i + 1); repeat split; try solve [repeat vcgen].
              ptreesolve; repeat f_equal.
              replace (Z.to_nat (i+1-1)) with (S (Z.to_nat (i-1))).
              simpl; rewrite <- Hi_conv; rewrites; auto; omega.
              rewrite <- Z2Nat.inj_succ; f_equal; omega.

              (* Case 4: u = false, t <> ATNorm *)
              eexists; exists (minit, dinit); repeat split.
              unfold container_init_while_body; d3 vcgen.
              (* call is_norm *)
              repeat vcgen.
              unfold is_at_norm_spec; rewrites; cases; try omega; try congruence.
              change 0 with (Int.unsigned (Int.repr 0)); reflexivity.
              d2 vcgen.
              (* call at_get *)
              repeat vcgen.
              unfold get_at_u_spec; rewrites; cases; try omega.
              change 0 with (Int.unsigned (Int.repr 0)); reflexivity.
              d2 vcgen.
              (* if statement (false) *)
              repeat vcgen.
              (* increment i *)
              repeat vcgen.
              (* reestablish loop invariant *)
              exists (real_nps - i - 1); repeat vcgen.
              exists (i + 1); repeat vcgen.
              replace (Z.to_nat (i+1-1)) with (S (Z.to_nat (i-1))).
              simpl; rewrite <- Hi_conv; rewrites; destruct t; try congruence; auto.
              rewrite <- Z2Nat.inj_succ; f_equal; omega.

              (* Case 5: ATUndef (impossible) *)
              assert (Hcases: (0 <= i < kern_low \/ kern_high <= i < real_nps) \/
                      kern_low <= i < Z.min kern_high real_nps) by (rewrite Zmin_spec; cases; omega).
              rewrite ATinit in Hat; destruct Hcases as [Hi|Hi].
              rewrite (real_at_kern_valid (AT dpreinit) _ Hi) in Hat; discriminate.
              destruct (real_at_usr_valid (AT dpreinit) _ Hi) as [? [[? ?]|?]]; rewrites; discriminate.
            }
          Qed.

        End Container_init_loop_proof.

        Lemma container_init_while_correct:
          forall m d pre_d le,
            ikern d = true -> ihost d = true -> AT d = real_AT (AT pre_d) ->
            le ! t_nps = Some (Vint (Int.repr real_nps)) ->
            le ! t_rq = Some (Vint (Int.repr 0)) ->
            le ! t_i = Some (Vint (Int.repr 1)) ->
            exists le',
              exec_stmt ge (PTree.empty _) le ((m, d) : mem)
                (Swhile container_init_while_condition container_init_while_body)
                E0 le' (m, d) Out_normal /\ le' ! t_rq = Some (Vint (Int.repr real_quota)).
        Proof.
          intros m d pre_d le Hkern Hhost Hat Hnps Hrq Hi.
          assert (Hloop:= container_init_loop_correct m _ _ Hat Hkern Hhost).
          refine (_ (LoopProofSimpleWhile.termination _ _ _ _ _ _ Hloop le (m, d) _)).
          intros [? [? [? [? ?]]]]; subst; eauto.
          repeat split; auto.
        Qed.

        Lemma container_init_body_correct:
          forall m m' (d d' : cdata RData) (m1 m2 m3 m4 : memb) env le mbi,
            env = PTree.empty _ -> le ! _mbi = Some (Vint mbi) ->
            mem_init_spec (Int.unsigned mbi) d = Some d' ->
            Mem.store Mint32 (m,d') b_ac QUOTA (Vint (Int.repr real_quota)) = Some (m1,d') ->
            Mem.store Mint32 (m1,d') b_ac USAGE (Vint Int.zero) = Some (m2,d') ->
            Mem.store Mint32 (m2,d') b_ac PARENT (Vint Int.zero) = Some (m3,d') ->
            Mem.store Mint32 (m3,d') b_ac NCHILDREN (Vint Int.zero) = Some (m4,d') ->
            Mem.store Mint32 (m4,d') b_ac USED (Vint Int.one) = Some (m',d') ->
            exists le',
              exec_stmt ge env le (m, d) container_init_body E0 le' (m', d') Out_normal.
        Proof.
          intros; subst.
          functional inversion H1; subst d'.

          (* Obtain the final le from the while loop and instantiate based on that *)
          destruct (container_init_while_correct m
                      (d {MM : real_mm} {MMSize : real_size} {vmxinfo : real_vmxinfo}
                         {AT : real_AT (AT d)} {nps : real_nps} {init : true}) d
                      (PTree.set t_i (Vint (Int.repr 1))
                         (PTree.set t_rq (Vint (Int.repr 0))
                            (PTree.set t_nps (Vint (Int.repr real_nps)) le))))
             as [le' [Hexec ?]]; auto; simpl; ptreesolve; exists le'.

          unfold container_init_body; simpl; repeat vcgen.
          unfold get_nps_spec; simpl; rewrites.
          rewrite Int.unsigned_repr; try omega; reflexivity.
        Qed.

      End InitBody.

      Theorem container_init_code_correct:
        spec_le (container_init ↦ container_init_spec_low)
                (〚container_init ↦ f_container_init〛 L).
      Proof.
        fbigstep_pre L.
        fbigstep (container_init_body_correct _ _ makeglobalenv _ H0 _ Hb2fs Hb2fp
                    _ Hb3fs Hb3fp _ Hb4fs Hb4fp _ Hb5fs Hb5fp
                    m0 m'0 labd labd' m1 m2 m3 m4 (PTree.empty _)
                   (bind_parameter_temps' (fn_params f_container_init) (Vint mbi :: nil)
                      (create_undef_temps (fn_temps f_container_init)))) tt.
      Qed.

    End ContainerInit.

    Section ContainerGetParent.

      Let L: compatlayer (cdata RData (cdata_ops:= malt_data_ops)) := AC_LOC ↦ container_loc_type.

      Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.

      Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

      Section GetParentBody.

        Context `{Hwb: WritableBlockOps}.

        Variable (s: stencil).

        Variables (ge: genv) (b_ac: block).

        Hypothesis hac_loc1 : Genv.find_symbol ge AC_LOC = Some b_ac.

        Lemma container_get_parent_body_correct:
          forall m d env le v i,
            env = PTree.empty _ -> le ! _id = Some (Vint i) -> 0 <= Int.unsigned i < num_id ->
            Mem.load Mint32 (m, d) b_ac (Int.unsigned i * CSIZE + PARENT) = Some (Vint v) ->
            exec_stmt ge env le (m, d) container_get_parent_body E0 le (m, d) (Out_return (Some (Vint v, tint))).
        Proof.
          intros; subst; unfold PARENT in *.
          unfold container_get_parent_body; simpl; repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
        Qed.

      End GetParentBody.

      Theorem container_get_parent_code_correct:
        spec_le (container_get_parent ↦ container_get_parent_spec_low)
                (〚container_get_parent ↦ f_container_get_parent〛 L).
      Proof.
        fbigstep_pre L.
        fbigstep (container_get_parent_body_correct _ _ H (fst m') (snd m') (PTree.empty _)
                   (bind_parameter_temps' (fn_params f_container_get_parent) (Vint i :: nil) (PTree.empty _))) m'.
      Qed.

    End ContainerGetParent.

    Section ContainerGetNchildren.

      Let L: compatlayer (cdata RData (cdata_ops:= malt_data_ops)) := AC_LOC ↦ container_loc_type.

      Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.

      Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

      Section GetNchildrenBody.

        Context `{Hwb: WritableBlockOps}.

        Variable (s: stencil).

        Variables (ge: genv) (b_ac: block).

        Hypothesis hac_loc1 : Genv.find_symbol ge AC_LOC = Some b_ac.

        Lemma container_get_nchildren_body_correct:
          forall m d env le v i,
            env = PTree.empty _ -> le ! _id = Some (Vint i) -> 0 <= Int.unsigned i < num_id ->
            Mem.load Mint32 (m, d) b_ac (Int.unsigned i * CSIZE + NCHILDREN) = Some (Vint v) ->
            exec_stmt ge env le (m, d) container_get_nchildren_body E0 le (m, d) (Out_return (Some (Vint v, tint))).
        Proof.
          intros; subst; unfold NCHILDREN in *.
          unfold container_get_nchildren_body; simpl; repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
        Qed.

      End GetNchildrenBody.

      Theorem container_get_nchildren_code_correct:
        spec_le (container_get_nchildren ↦ container_get_nchildren_spec_low)
                (〚container_get_nchildren ↦ f_container_get_nchildren〛 L).
      Proof.
        fbigstep_pre L.
        fbigstep (container_get_nchildren_body_correct _ _ H (fst m') (snd m') (PTree.empty _)
                   (bind_parameter_temps' (fn_params f_container_get_nchildren) (Vint i :: nil) (PTree.empty _))) m'.
      Qed.

    End ContainerGetNchildren.

    Section ContainerGetQuota.

      Let L: compatlayer (cdata RData (cdata_ops:= malt_data_ops)) := AC_LOC ↦ container_loc_type.

      Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.

      Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

      Section GetQuotaBody.

        Context `{Hwb: WritableBlockOps}.

        Variable (s: stencil).

        Variables (ge: genv) (b_ac: block).

        Hypothesis hac_loc1 : Genv.find_symbol ge AC_LOC = Some b_ac.

        Lemma container_get_quota_body_correct:
          forall m d env le v i,
            env = PTree.empty _ -> le ! _id = Some (Vint i) -> 0 <= Int.unsigned i < num_id ->
            Mem.load Mint32 (m, d) b_ac (Int.unsigned i * CSIZE + QUOTA) = Some (Vint v) ->
            exec_stmt ge env le (m, d) container_get_quota_body E0 le (m, d) (Out_return (Some (Vint v, tint))).
        Proof.
          intros; subst; unfold QUOTA in *.
          unfold container_get_quota_body; simpl; repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
        Qed.

      End GetQuotaBody.

      Theorem container_get_quota_code_correct:
        spec_le (container_get_quota ↦ container_get_quota_spec_low)
                (〚container_get_quota ↦ f_container_get_quota〛 L).
      Proof.
        fbigstep_pre L.
        fbigstep (container_get_quota_body_correct _ _ H (fst m') (snd m') (PTree.empty _)
                   (bind_parameter_temps' (fn_params f_container_get_quota) (Vint i :: nil) (PTree.empty _))) m'.
      Qed.

    End ContainerGetQuota.

    Section ContainerGetUsage.

      Let L: compatlayer (cdata RData (cdata_ops:= malt_data_ops)) := AC_LOC ↦ container_loc_type.

      Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.

      Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

      Section GetUsageBody.

        Context `{Hwb: WritableBlockOps}.

        Variable (s: stencil).

        Variables (ge: genv) (b_ac: block).

        Hypothesis hac_loc1 : Genv.find_symbol ge AC_LOC = Some b_ac.

        Lemma container_get_usage_body_correct:
          forall m d env le v i,
            env = PTree.empty _ -> le ! _id = Some (Vint i) -> 0 <= Int.unsigned i < num_id ->
            Mem.load Mint32 (m, d) b_ac (Int.unsigned i * CSIZE + USAGE) = Some (Vint v) ->
            exec_stmt ge env le (m, d) container_get_usage_body E0 le (m, d) (Out_return (Some (Vint v, tint))).
        Proof.
          intros; subst; unfold USAGE in *.
          unfold container_get_usage_body; simpl; repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
        Qed.

      End GetUsageBody.

      Theorem container_get_usage_code_correct:
        spec_le (container_get_usage ↦ container_get_usage_spec_low)
                (〚container_get_usage ↦ f_container_get_usage〛 L).
      Proof.
        fbigstep_pre L.
        fbigstep (container_get_usage_body_correct _ _ H (fst m') (snd m') (PTree.empty _)
                   (bind_parameter_temps' (fn_params f_container_get_usage) (Vint i :: nil) (PTree.empty _))) m'.
      Qed.

    End ContainerGetUsage.

    Section ContainerCanConsume.

      Let L: compatlayer (cdata RData (cdata_ops:= malt_data_ops)) := AC_LOC ↦ container_loc_type.

      Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.

      Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

      Section CanConsumeBody.

        Context `{Hwb: WritableBlockOps}.

        Variable (s: stencil).

        Variables (ge: genv) (b_ac: block).

        Hypothesis hac_loc1 : Genv.find_symbol ge AC_LOC = Some b_ac.

        Lemma container_can_consume_body_correct:
          forall m d env le i n q u,
            env = PTree.empty _ -> le ! _id = Some (Vint i) -> le ! _n = Some (Vint n) ->
            0 <= Int.unsigned i < num_id ->
            Mem.load Mint32 (m, d) b_ac (Int.unsigned i * CSIZE + QUOTA) = Some (Vint q) ->
            Mem.load Mint32 (m, d) b_ac (Int.unsigned i * CSIZE + USAGE) = Some (Vint u) ->
            exec_stmt ge env le (m, d) container_can_consume_body E0 le (m, d)
              (Out_return (Some (Vint
                 (match (Int.unsigned n <=? Int.unsigned q,
                         Int.unsigned u <=? Int.unsigned q - Int.unsigned n) with
                  | (true, true) => Int.one
                  | _ => Int.zero end), tint))).
        Proof.
          intros; subst.

          assert (((Int.unsigned n <=? Int.unsigned q) = true /\
                   (Int.unsigned u <=? Int.unsigned q - Int.unsigned n) = true) \/
                  ((Int.unsigned n <=? Int.unsigned q) = true /\
                   (Int.unsigned u <=? Int.unsigned q - Int.unsigned n) = false) \/
                  (Int.unsigned n <=? Int.unsigned q) = false) as Hcases.
          destruct (Int.unsigned n <=? Int.unsigned q); auto.
          destruct (Int.unsigned u <=? Int.unsigned q - Int.unsigned n); auto.

          destruct Hcases as [Hcase1|Hcase2].
          (* Case 1: n <= q && u <= q - n *)
          destruct Hcase1 as [Hle1 Hle2].
          rewrite Hle1; rewrite Hle2.
          vcgen; vcgen; try discriminate.
          vcgen; simpl.
          {
            vcgen; vcgen; eauto.
            vcgen; vcgen.
            vcgen; vcgen; vcgen; vcgen; eauto.
            apply deref_loc_reference; auto.
            simpl; unfold sem_add; simpl; unfold align; simpl.
            rewrite Int.add_zero_l; rewrite Int.mul_commut; auto.
            apply deref_loc_copy; auto.
            apply deref_loc_value with (chunk := Mint32); auto.
            unfold Mem.loadv; unfold align; simpl; unfold lift; simpl.
            rewrite Int.add_unsigned.
            rewrite Int.unsigned_repr; rewrite convert_quota; try rewrite max_unsigned_val; eauto;
              unfold CSIZE; unfold QUOTA; omega.
            vcgen.
          }
          {
            vcgen; simpl; unfold bool_val; simpl.
            destruct (zlt (Int.unsigned q) (Int.unsigned n)); simpl; unfold Int.eq.
            rewrite Z.leb_le in Hle1; omega.
            destruct (zeq (Int.unsigned Int.one) (Int.unsigned Int.zero)); simpl.
            inv e.
            eauto.
          }
          {
            vcgen; simpl.
            vcgen.
            vcgen.
            vcgen.
            vcgen; vcgen.
            vcgen.
            vcgen.
            vcgen; eauto.
            apply deref_loc_reference; auto.
            vcgen; eauto.
            simpl; unfold sem_add; simpl; unfold align; simpl.
            rewrite Int.add_zero_l; rewrite Int.mul_commut; auto.
            apply deref_loc_copy; auto.
            vcgen.
            vcgen.
            apply deref_loc_value with (chunk := Mint32); auto.
            unfold Mem.loadv; unfold align; simpl; unfold lift; simpl.
            rewrite Int.add_unsigned.
            rewrite Int.unsigned_repr; rewrite convert_usage; try rewrite max_unsigned_val; eauto;
              unfold CSIZE; unfold USAGE; omega.
            vcgen.
            vcgen.
            vcgen.
            vcgen.
            vcgen; vcgen.
            vcgen.
            vcgen; eauto.
            apply deref_loc_reference; auto.
            vcgen; eauto.
            simpl; unfold sem_add; simpl; unfold align; simpl.
            rewrite Int.add_zero_l; rewrite Int.mul_commut; auto.
            apply deref_loc_copy; auto.
            vcgen.
            vcgen.
            apply deref_loc_value with (chunk := Mint32); auto.
            unfold Mem.loadv; unfold align; simpl; unfold lift; simpl.
            rewrite Int.add_unsigned.
            rewrite Int.unsigned_repr; rewrite convert_quota; try rewrite max_unsigned_val; eauto;
              unfold CSIZE; unfold QUOTA; omega.
            vcgen; eauto.
            vcgen.
            vcgen.
            simpl.
            rewrite Int.unsigned_repr.
            destruct (zlt (Int.unsigned q - Int.unsigned n) (Int.unsigned u)).
            rewrite Z.leb_le in Hle2; omega.
            vcgen.
            rewrite Z.leb_le in Hle1; assert (Hrange := Int.unsigned_range_2 q).
            rewrite max_unsigned_val in Hrange |- *.
            split; try omega.
            apply Z.le_trans with (m := Int.unsigned q); try omega.
            assert (Hrange' := Int.unsigned_range_2 n); omega.
            simpl; vcgen; vcgen.
          }

          (* Case 2: (n <= q && u > q - n) || n > q *)
          replace E0 with (E0 ** E0).
          vcgen; vcgen.
          {
            destruct Hcase2 as [[Hle1 Hle2]|Hle].

            (* Case 2A: n <= q && u > q - n *)
            vcgen.
            {
              vcgen; vcgen; eauto.
              vcgen.
              vcgen.
              vcgen; vcgen.
              vcgen; vcgen; eauto.
              apply deref_loc_reference; auto.
              vcgen; eauto.
              simpl; unfold sem_add; simpl; unfold align; simpl.
              rewrite Int.add_zero_l; rewrite Int.mul_commut; auto.
              apply deref_loc_copy; auto.
              vcgen.
              vcgen.
              apply deref_loc_value with (chunk := Mint32); auto.
              unfold Mem.loadv; unfold align; simpl; unfold lift; simpl.
              rewrite Int.add_unsigned.
              rewrite Int.unsigned_repr; rewrite convert_quota; try rewrite max_unsigned_val; eauto;
                unfold CSIZE; unfold QUOTA; omega.
              vcgen; eauto.
            }
            {
              simpl; destruct (zlt (Int.unsigned q) (Int.unsigned n)).
              rewrite Z.leb_le in Hle1; omega.
              vcgen.
            }
            {
              vcgen.
              vcgen; vcgen; eauto.
              vcgen.
              vcgen.
              vcgen; vcgen.
              vcgen; vcgen; eauto.
              apply deref_loc_reference; auto.
              vcgen; eauto.
              simpl; unfold sem_add; simpl; unfold align; simpl.
              rewrite Int.add_zero_l; rewrite Int.mul_commut; auto.
              apply deref_loc_copy; auto.
              vcgen.
              vcgen.
              apply deref_loc_value with (chunk := Mint32); auto.
              unfold Mem.loadv; unfold align; simpl; unfold lift; simpl.
              rewrite Int.add_unsigned.
              rewrite Int.unsigned_repr; rewrite convert_usage; try rewrite max_unsigned_val; eauto;
                unfold CSIZE; unfold USAGE; omega.
              vcgen; eauto.
              vcgen.
              vcgen.
              vcgen.
              vcgen.
              vcgen; vcgen.
              vcgen.
              vcgen; eauto.
              apply deref_loc_reference; auto.
              vcgen; eauto.
              simpl; unfold sem_add; simpl; unfold align; simpl.
              rewrite Int.add_zero_l; rewrite Int.mul_commut; auto.
              apply deref_loc_copy; auto.
              vcgen.
              vcgen.
              apply deref_loc_value with (chunk := Mint32); auto.
              unfold Mem.loadv; unfold align; simpl; unfold lift; simpl.
              rewrite Int.add_unsigned.
              rewrite Int.unsigned_repr; rewrite convert_quota; try rewrite max_unsigned_val; eauto;
                unfold CSIZE; unfold QUOTA; omega.
              vcgen; eauto.
              vcgen.
              vcgen.
              simpl.
              rewrite Int.unsigned_repr.
              destruct (zlt (Int.unsigned q - Int.unsigned n) (Int.unsigned u)).
              vcgen.
              rewrite Z.leb_nle in Hle2; omega.
              rewrite Z.leb_le in Hle1; assert (Hrange := Int.unsigned_range_2 q).
              rewrite max_unsigned_val in Hrange |- *.
              split; try omega.
              apply Z.le_trans with (m := Int.unsigned q); try omega.
              assert (Hrange' := Int.unsigned_range_2 n); omega.
              simpl; vcgen.
            }

            (* Case 2B: n > q *)
            vcgen.
            vcgen; vcgen; eauto.
            vcgen.
            vcgen.
            vcgen; vcgen.
            vcgen; vcgen; eauto.
            apply deref_loc_reference; auto.
            vcgen; eauto.
            simpl; unfold sem_add; simpl; unfold align; simpl.
            rewrite Int.add_zero_l; rewrite Int.mul_commut; auto.
            apply deref_loc_copy; auto.
            vcgen.
            vcgen.
            apply deref_loc_value with (chunk := Mint32); auto.
            unfold Mem.loadv; unfold align; simpl; unfold lift; simpl.
            rewrite Int.add_unsigned.
            rewrite Int.unsigned_repr; rewrite convert_quota; try rewrite max_unsigned_val; eauto;
              unfold CSIZE; unfold QUOTA; omega.
            vcgen; eauto.
            simpl.
            destruct (zlt (Int.unsigned q) (Int.unsigned n)).
            vcgen.
            rewrite Z.leb_nle in Hle; omega.
            simpl; vcgen.
          }
          {
            destruct Hcase2 as [[Hle1 Hle2]|Hle].
            rewrite Hle1; rewrite Hle2; vcgen; vcgen.
            rewrite Hle; vcgen; vcgen.
          }
          {
            simpl; auto.
          }
        Qed.

      End CanConsumeBody.

      Theorem container_can_consume_code_correct:
        spec_le (container_can_consume ↦ container_can_consume_spec_low)
                (〚container_can_consume ↦ f_container_can_consume〛 L).
      Proof.
        fbigstep_pre L.
        fbigstep (container_can_consume_body_correct _ _ H (fst m') (snd m') (PTree.empty _)
                   (bind_parameter_temps' (fn_params f_container_can_consume)
                   (Vint i :: Vint n :: nil) (PTree.empty _))) m'.
      Qed.

    End ContainerCanConsume.

    Section ContainerSplit.

      Let L: compatlayer (cdata RData (cdata_ops:= malt_data_ops)) :=
        AC_LOC ↦ container_loc_type.

      Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.

      Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

      Section SplitBody.

        Context `{Hwb: WritableBlockOps}.
        Context `{Hwbg: WritableBlockAllowGlobals WB}.

        Variable (s: stencil).

        Variables (ge: genv) (b_ac b_bl: block).

        Hypothesis hac_loc1 : Genv.find_symbol ge AC_LOC = Some b_ac.

        (* Parameters *)
        Variables (i q : int).

        Lemma container_split_body_correct:
          forall m m' (d : cdata RData) env j u nc (m1 m2 m3 m4 m5 m6: memb),
            env = PTree.empty _ -> 0 <= Int.unsigned i < num_id -> 0 <= Int.unsigned j < num_id ->
            Int.unsigned j = Int.unsigned i * max_children + 1 + Int.unsigned nc ->
            Mem.load Mint32 (m,d) b_ac (Int.unsigned i * CSIZE + USAGE) = Some (Vint u) ->
            Mem.load Mint32 (m,d) b_ac (Int.unsigned i * CSIZE + NCHILDREN) = Some (Vint nc) ->
            Mem.store Mint32 (m,d) b_ac (Int.unsigned j * CSIZE + USED) (Vint Int.one) = Some (m1,d) ->
            Mem.store Mint32 (m1,d) b_ac (Int.unsigned j * CSIZE + QUOTA) (Vint q) = Some (m2,d) ->
            Mem.store Mint32 (m2,d) b_ac (Int.unsigned j * CSIZE + USAGE) (Vint Int.zero) = Some (m3,d) ->
            Mem.store Mint32 (m3,d) b_ac (Int.unsigned j * CSIZE + PARENT) (Vint i) = Some (m4,d) ->
            Mem.store Mint32 (m4,d) b_ac (Int.unsigned j * CSIZE + NCHILDREN) (Vint Int.zero) = Some (m5,d) ->
            Mem.store Mint32 (m5,d) b_ac (Int.unsigned i * CSIZE + USAGE) (Vint (Int.add u q)) = Some (m6,d) ->
            Mem.store Mint32 (m6,d) b_ac (Int.unsigned i * CSIZE + NCHILDREN) (Vint (Int.add nc Int.one)) = Some (m',d) ->
            exists le,
              exec_stmt ge env (PTree.set _n (Vint q) (PTree.set _id (Vint i) (create_undef_temps (fn_temps f_container_split))))
                      (m, d) container_split_body E0 le (m', d) (Out_return (Some (Vint j, tint))).
        Proof.
          intros; subst.
          rename H2 into Hj, H5 into Hs1, H6 into Hs2, H7 into Hs3, H8 into Hs4, H9 into Hs5,
                 H10 into Hs6, H11 into Hs7.

          assert (Hsep: forall m k1 k2 a b : Z, a <> b -> 0 <= m ->
                      0 <= k1 -> k1 + size_chunk Mint32 <= m -> 0 <= k2 -> k2 + size_chunk Mint32 <= m ->
                      a * m + k1 + size_chunk Mint32 <= b * m + k2 \/ b * m + k2 + size_chunk Mint32 <= a * m + k1).
          intros m0 k1 k2 a1 a2 Ha_neq Hm_0 Hk1_0 Hle1 Hk2_0 Hle2.
          assert (a1 < a2 \/ a2 < a1) as Ha; try omega.
          destruct Ha; [left | right].
          apply Z.le_trans with (m := a1 * m0 + m0); try omega.
          replace (a1 * m0 + m0) with ((a1 + 1) * m0).
          assert (a1 + 1 <= a2) as Hle_a; try omega.
          apply Z.mul_le_mono_nonneg_r with (p := m0) in Hle_a; auto; omega.
          rewrite Z.mul_add_distr_r; omega.
          apply Z.le_trans with (m := a2 * m0 + m0); try omega.
          replace (a2 * m0 + m0) with ((a2 + 1) * m0).
          assert (a2 + 1 <= a1) as Hle_a; try omega.
          apply Z.mul_le_mono_nonneg_r with (p := m0) in Hle_a; auto; omega.
          rewrite Z.mul_add_distr_r; omega.
          unfold CSIZE, QUOTA, USAGE, PARENT, NCHILDREN, USED in *.
          unfold size_chunk in Hsep.

          assert (Hneq: Int.unsigned i <> Int.unsigned j)
            by (assert (Hrange:= Int.unsigned_range nc); omega).

          exists ((PTree.set t_child (Vint j) (PTree.set t_nc (Vint nc)
                  (PTree.set _n (Vint q) (PTree.set _id (Vint i)
                     (create_undef_temps (fn_temps f_container_split))))))).
          unfold container_split_body; simpl; d3 vcgen.
          (* set t_nc *)
          repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
          d2 vcgen.
          (* set t_child *)
          repeat vcgen.
          d3 vcgen.
          (* set child's USED *)
          repeat vcgen.
          unfold Mem.storev; rewrite Z.mul_comm; rewrite Hj in *; repeat vcgen.
          d2 vcgen.
          (* set child's QUOTA *)
          repeat vcgen.
          unfold Mem.storev; rewrite Z.mul_comm; rewrite Hj in *; repeat vcgen.
          d2 vcgen.
          (* set child's USAGE *)
          repeat vcgen.
          unfold Mem.storev; rewrite Z.mul_comm; rewrite Hj in *; repeat vcgen.
          d2 vcgen.
          (* set child's PARENT *)
          repeat vcgen.
          unfold Mem.storev; rewrite Z.mul_comm; rewrite Hj in *; repeat vcgen.
          d2 vcgen.
          (* set child's NCHILDREN *)
          repeat vcgen.
          unfold Mem.storev; rewrite Z.mul_comm; rewrite Hj in *; repeat vcgen.
          d2 vcgen.
          (* increase parent's USAGE *)
          repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
          rewrite (Mem.load_store_other _ _ _ _ _ _ Hs5); try solve [right; apply Hsep; auto; try omega].
          rewrite (Mem.load_store_other _ _ _ _ _ _ Hs4); try solve [right; apply Hsep; auto; try omega].
          rewrite (Mem.load_store_other _ _ _ _ _ _ Hs3); try solve [right; apply Hsep; auto; try omega].
          rewrite (Mem.load_store_other _ _ _ _ _ _ Hs2); try solve [right; apply Hsep; auto; try omega].
          rewrite (Mem.load_store_other _ _ _ _ _ _ Hs1); try solve [right; apply Hsep; auto; try omega]; eauto.
          repeat vcgen.
          repeat vcgen.
          unfold Mem.storev; rewrite Z.mul_comm; repeat vcgen.
          d2 vcgen.
          (* increment parent's NCHILDREN *)
          repeat vcgen.
          unfold Mem.storev; rewrite Z.mul_comm; repeat vcgen.
          replace j with (Int.repr (Int.unsigned i * 3 + 1 + Int.unsigned nc)).
          repeat vcgen.
          apply f_equal with (f:= Int.repr) in Hj.
          rewrite Int.repr_unsigned in Hj; congruence.
        Qed.

      End SplitBody.

      Theorem container_split_code_correct:
        spec_le (container_split ↦ container_split_spec_low)
                (〚container_split ↦ f_container_split〛 L).
      Proof.
        fbigstep_pre L.
        repeat (match goal with
                | [ H : _ = _ /\ _ = _ |- _ ] => destruct H
                end).

        fbigstep (container_split_body_correct _ _ H i n (fst m) (fst m') (snd m) (PTree.empty _)
                     j u nc (fst m1) (fst m2) (fst m3) (fst m4) (fst m5) (fst m6)) m.
        rewrite <- H22 in H24; rewrite <- H23 in H24; inv H24.
        rewrite <- H22 in H24; rewrite <- H23 in H24; inv H24.
        destruct m'; auto.
      Qed.

    End ContainerSplit.

    Section ContainerAlloc.

      Let L: compatlayer (cdata RData (cdata_ops:= malt_data_ops)) :=
        AC_LOC ↦ container_loc_type ⊕ palloc ↦ gensem palloc'_spec.

      Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.

      Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

      Section AllocBody.

        Context `{Hwb: WritableBlockOps}.
        Context `{Hwbg: WritableBlockAllowGlobals WB}.

        Variables (s: stencil) (ge: genv).
        Hypothesis Hstencil_matches: stencil_matches s ge.

        Variable b_ac: block.
        Hypothesis hac_loc1 : Genv.find_symbol ge AC_LOC = Some b_ac.

        (* palloc *)
        Variable b_palloc : block.
        Hypothesis hpalloc1 : Genv.find_symbol ge palloc = Some b_palloc.
        Hypothesis hpalloc2 : Genv.find_funct_ptr ge b_palloc =
          Some (External (EF_external palloc
            (signature_of_type Tnil tint cc_default)) Tnil tint cc_default).

        Lemma container_alloc_body_correct0:
          forall m d env le i u,
            env = PTree.empty _ -> le ! _id = Some (Vint i) ->
            0 <= Int.unsigned i < num_id ->
            Mem.load Mint32 (m,d) b_ac (Int.unsigned i * CSIZE + USAGE) = Some (Vint u) ->
            Mem.load Mint32 (m,d) b_ac (Int.unsigned i * CSIZE + QUOTA) = Some (Vint u) ->
            exec_stmt ge env le (m,d) container_alloc_body E0
                      (PTree.set t_q (Vint u) (PTree.set t_u (Vint u) le))
                      (m,d) (Out_return (Some (Vzero,tint))).
        Proof.
          intros; subst.
          unfold container_alloc_body; simpl.
          d3 vcgen.
          (* load usage into u *)
          repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
          d2 vcgen.
          (* load quota into q *)
          repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
          (* evaluate if statement to true and return 0 *)
          apply exec_Sseq_2; try discriminate; repeat vcgen.
        Qed.

        Lemma container_alloc_body_correct1:
          forall m m' (d d' : cdata RData) env le i u q pi,
            env = PTree.empty _ -> le ! _id = Some (Vint i) ->
            0 <= Int.unsigned i < num_id -> Int.unsigned u < Int.unsigned q ->
            0 <= pi <= Int.max_unsigned -> palloc'_spec d = Some (d', pi) ->
            Mem.load Mint32 (m,d) b_ac (Int.unsigned i * CSIZE + USAGE) = Some (Vint u) ->
            Mem.load Mint32 (m,d) b_ac (Int.unsigned i * CSIZE + QUOTA) = Some (Vint q) ->
            Mem.store Mint32 (m,d) b_ac (Int.unsigned i * CSIZE + USAGE) (Vint (Int.add u Int.one)) = Some (m',d) ->
            exec_stmt ge env le (m,d) container_alloc_body E0
                      (PTree.set t_i (Vint (Int.repr pi))
                         (PTree.set t_q (Vint q)
                            (PTree.set t_u (Vint u) le)))
                      (m',d') (Out_return (Some (Vint (Int.repr pi), tint))).
        Proof.
          intros; subst.
          unfold container_alloc_body; simpl.
          d3 vcgen.
          (* load usage into u *)
          repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
          d2 vcgen.
          (* load quota into q *)
          repeat vcgen.
          unfold Mem.loadv; rewrite Z.mul_comm; repeat vcgen.
          d2 vcgen.
          (* evaluate if statement to false and skip over it *)
          repeat vcgen.
          d2 vcgen.
          (* increment usage *)
          repeat vcgen.
          unfold Mem.storev; rewrite Z.mul_comm; repeat vcgen.
          d2 vcgen.
          (* call palloc *)
          repeat vcgen.
          (* return pi *)
          repeat vcgen.
        Qed.

      End AllocBody.

      Theorem container_alloc_code_correct:
        spec_le (container_alloc ↦ container_alloc_spec_low)
                (〚container_alloc ↦ f_container_alloc〛 L).
      Proof.
        fbigstep_pre L.
        fbigstep (container_alloc_body_correct0 _ _ H (fst m') (snd m') (PTree.empty _)
                   (bind_parameter_temps' (fn_params f_container_alloc) (Vint i :: nil)
                      (create_undef_temps (fn_temps f_container_alloc)))) m'.
        fbigstep (container_alloc_body_correct1 _ _ makeglobalenv _ H0 _ Hb2fs Hb2fp
                    m0 m'0 d d' (PTree.empty _)
                    (bind_parameter_temps' (fn_params f_container_alloc) (Vint i :: nil)
                      (create_undef_temps (fn_temps f_container_alloc)))) tt.
      Qed.

    End ContainerAlloc.

  End WithPrimitives.

End MALTCODE.


(* Copyright (c) 2011. Greg Morrisett, Gang Tan, Joseph Tassarotti,
   Jean-Baptiste Tristan, and Edward Gan.

   This file is part of RockSalt.

   This file 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.
*)

(** Broke out the reasoning for the "masked jumps" used in the NaCL verifier
    so I don't have to wait for long compile times on DFACorrectness.v
*)
Require Import Coqlib.
Require Import Parser.
Require Import Ascii.
Require Import String.
Require Import List.
Require Import Bits.
Require Import Decode.
Require Import ReinsVerifierDFA.
Require Import Eqdep.
Unset Automatic Introduction.
Set Implicit Arguments.
Require ExtrOcamlString.
Require ExtrOcamlNatBigInt.
Require ExtrOcamlNatInt.
Import X86_PARSER_ARG.
Import X86_PARSER.
Import X86_BASE_PARSER.
Import X86Syntax.
Require Import ReinsDFACorrectness.
Hint Constructors in_parser.

Import ABSTRACT_MAKE_DFA.

Lemma reinsjmp_nonIAT_parser_splits' :
  forall s v,
    in_parser reinsjmp_nonIAT_mask (flat_map byte_explode s) v ->
    exists s1, exists s2, exists r,
      (r <> ESP /\
      flat_map byte_explode s = s1 ++ s2 /\
      in_parser (reinsjmp_nonIAT_MASK_p r) s1 (fst v) /\
      in_parser (reinsjmp_nonIAT_JMP_p r |+| reinsjmp_nonIAT_CALL_p r) s2 (snd v)) \/
      (r = EAX /\
      flat_map byte_explode s = s1 ++ s2 /\
      in_parser reinsjmp_nonIAT_MASK_EAX25_p s1 (fst v) /\
      in_parser (reinsjmp_nonIAT_JMP_p r |+| reinsjmp_nonIAT_CALL_p r) s2 (snd v)).
Proof.
  unfold reinsjmp_nonIAT_mask, reinsjmp_nonIAT_p, reinsjmp_nonIAT_EAX25_p. simpl. unfold never.
  intros.
    repeat pinv ;
      simpl ;
      econstructor ; econstructor ; econstructor ;
      (left ; repeat split ; eauto ; try congruence ;
      match goal with
      | [ H : in_parser (reinsjmp_nonIAT_JMP_p _) _ _ |- _ ] => eapply Alt_left_pi
      | [ H : in_parser (reinsjmp_nonIAT_CALL_p _) _ _ |- _ ] => eapply Alt_right_pi
      end ; exact H0) ||
      (right ; repeat split ; eauto ; try congruence ;
      match goal with
      | [ H : in_parser (reinsjmp_nonIAT_JMP_p _) _ _ |- _ ] => eapply Alt_left_pi
      | [ H : in_parser (reinsjmp_nonIAT_CALL_p _) _ _ |- _ ] => eapply Alt_right_pi
      end ; exact H0).
Qed.

Lemma reinsjmp_IAT_JMP_or_RET_parser_splits' :
  forall s v,
    in_parser reinsjmp_IAT_JMP_or_RET_mask (flat_map byte_explode s) v ->
    exists s1, exists s2,
      flat_map byte_explode s = s1 ++ s2 /\
      in_parser (reinsjmp_IAT_or_RET_MASK_p) s1 (fst v) /\
      in_parser (reinsjmp_IAT_JMP_p |+| RET_p) s2 (snd v).
Proof.
  unfold reinsjmp_IAT_JMP_or_RET_mask, reinsjmp_IAT_JMP_or_RET_p. simpl. unfold never.
    intros.
      repeat pinv ; simpl ;
      econstructor ; econstructor ; econstructor ;
      repeat split ; eauto ; try congruence ;
      match goal with
      | [ H : in_parser (reinsjmp_IAT_JMP_p) _ _ |- _ ] => eapply Alt_left_pi
      | [ H : in_parser (RET_p) _ _ |- _ ] => eapply Alt_right_pi
      end ; exact H0.
Qed.

Lemma byte_explode_bits b :
  exists b1,exists b2,exists b3,exists b4,exists b5,exists b6,exists b7,exists b8,
    byte_explode b = b1::b2::b3::b4::b5::b6::b7::b8::nil.
Proof.
  unfold byte_explode. repeat econstructor.
Qed.

Local Open Scope nat_scope.
Lemma split_bytes_n :
  forall n bs x1 x2,
    flat_map byte_explode bs = x1 ++ x2 ->
    length x1 = n * 8 ->
    exists b1, exists b2,
      bs = b1 ++ b2 /\ flat_map byte_explode b1 = x1 /\ flat_map byte_explode b2 = x2.
Proof.
  induction n ; simpl ; intros.
  destruct x1. simpl in *. exists nil. exists bs. simpl. auto.
  simpl in H0. congruence.

  destruct x1. simpl in H0. assert False ; [omega | contradiction].
  destruct x1. simpl in H0. assert False ; [omega | contradiction].
  destruct x1. simpl in H0. assert False ; [omega | contradiction].
  destruct x1. simpl in H0. assert False ; [omega | contradiction].
  destruct x1. simpl in H0. assert False ; [omega | contradiction].
  destruct x1. simpl in H0. assert False ; [omega | contradiction].
  destruct x1. simpl in H0. assert False ; [omega | contradiction].
  destruct x1. simpl in H0. assert False ; [omega | contradiction].

  simpl in H0. assert (length x1 = n*8). omega.
  destruct bs.
    simpl in H. congruence.

    replace (flat_map byte_explode (i :: bs)) with
      (byte_explode i ++ flat_map byte_explode bs) in H; auto.
    generalize (byte_explode_bits i). t. rewrite H2 in *.
    injection H . clear H. intros. subst.
    specialize (IHn bs x1 x2 H H1). t.
    exists (i::x). exists x0.
    replace (flat_map byte_explode (i :: x)) with
      (byte_explode i ++ (flat_map byte_explode x)) ; auto.
    rewrite H2. split.
      simpl. rewrite H3. reflexivity.
      split.
        rewrite H4. auto.
        auto.
Qed.

Lemma reinsjmp_nonIAT_parser_splits :
  forall bs v,
    in_parser reinsjmp_nonIAT_mask (flat_map byte_explode bs) v ->
    exists b1, exists b2, exists r,
      (r <> ESP /\
      bs = b1 ++ b2 /\
      in_parser (reinsjmp_nonIAT_MASK_p r) (flat_map byte_explode b1) (fst v) /\
      in_parser (reinsjmp_nonIAT_JMP_p r |+| reinsjmp_nonIAT_CALL_p r) (flat_map byte_explode b2) (snd v)) \/
      (r = EAX /\
      bs = b1 ++ b2 /\
      in_parser reinsjmp_nonIAT_MASK_EAX25_p (flat_map byte_explode b1) (fst v) /\
      in_parser (reinsjmp_nonIAT_JMP_p r |+| reinsjmp_nonIAT_CALL_p r) (flat_map byte_explode b2) (snd v)).
Proof.
  intros.
  generalize (reinsjmp_nonIAT_parser_splits' _ H). t. destruct H0. t.
  assert (length x = 48).
    unfold reinsjmp_nonIAT_MASK_p in H2. unfold bitsleft in H2.
    unfold int32_p in H2. simpl in H2. repeat pinv ; simpl.
    reflexivity. reflexivity.
  generalize (split_bytes_n 6 _ _ _ H1 H4). t.
    exists x2. exists x3. exists x1.
    left. repeat split ; auto.
      rewrite H6. exact H2.
      rewrite H7. exact H3.
  t. assert (length x = 40).
    unfold reinsjmp_nonIAT_MASK_EAX25_p in H2. unfold bitsleft in H2.
    unfold int32_p in H2. simpl in H2. repeat pinv ; simpl.
    reflexivity. reflexivity.
  generalize (split_bytes_n 5 _ _ _ H1 H4). t.
    exists x2. exists x3. exists x1.
    right. repeat split ; auto.
      rewrite H6. exact H2.
      rewrite H7. exact H3.
Qed.

Lemma reinsjmp_IAT_JMP_or_RET_parser_splits :
  forall bs v,
    in_parser reinsjmp_IAT_JMP_or_RET_mask (flat_map byte_explode bs) v ->
    exists b1, exists b2,
      bs = b1 ++ b2 /\
      in_parser reinsjmp_IAT_or_RET_MASK_p (flat_map byte_explode b1) (fst v) /\
      in_parser (reinsjmp_IAT_JMP_p |+| RET_p) (flat_map byte_explode b2) (snd v).
Proof.
  intros. generalize (reinsjmp_IAT_JMP_or_RET_parser_splits' _ H). t.
  assert (length x = 56).
    unfold reinsjmp_IAT_or_RET_MASK_p in H1. unfold bitsleft in H1.
    unfold int32_p in H1. simpl in H1. repeat pinv ; simpl ; auto.
  generalize (split_bytes_n 7 _ _ _ H0 H3). t. exists x1. exists x2.
    repeat split ; auto.
      rewrite H5. exact H1.
      rewrite H6. exact H2.
Qed.

Import CheckDeterministic.

Lemma byte2token_app xs n1 n2 :
  List.map byte2token xs = n1 ++ n2 ->
  exists b1, exists b2,
    xs = b1 ++ b2 /\ List.map byte2token b1 = n1 /\ List.map byte2token b2 = n2.
Proof.
  induction xs.
    simpl. intros. generalize (nil_is_nil_app_nil _ _ H). t. subst.
    exists nil. exists nil. auto.

    simpl. intros. destruct n1.
      simpl in *. destruct n2 ; try congruence.
      injection H . clear H. intros. specialize (IHxs nil n2 H). t. subst.
      exists x. exists (a::x0).
      assert (x = nil).
        destruct x ; auto. simpl in H2. congruence. subst. simpl. auto.
     simpl in *. injection H. clear H. intros.
     specialize (IHxs n1 n2 H). t.
     exists (a::x). exists x0. rewrite H1.
     split ; auto. simpl.
     split.
       rewrite H0. rewrite H2. reflexivity.
       exact H3.
Qed.

Lemma nat2bools_byte2token_is_byte_explode xs :
  flat_map nat2bools (List.map byte2token xs) = flat_map byte_explode xs.
Proof.
  induction xs.
    auto.
    replace (flat_map byte_explode (a::xs)) with
      (byte_explode a ++ (flat_map byte_explode xs)) ; auto.
    replace (flat_map nat2bools (List.map byte2token (a::xs))) with
      (nat2bools (byte2token a) ++ (flat_map nat2bools (List.map byte2token xs))) ; auto.
    rewrite IHxs. replace (nat2bools (byte2token a)) with (byte_explode a) ; auto.
    clear IHxs. unfold byte_explode, nat2bools.
    replace (Z_of_nat (byte2token a)) with (Word.unsigned a) ; auto.
    unfold byte2token.
    rewrite inj_Zabs_nat. unfold Word.unsigned. generalize (Word.intrange _ a).
    intros. rewrite (Zabs_eq _).  reflexivity. omega.
Qed.

Lemma reg_parser r s :
  in_parser (bitslist (register_to_bools r)) s tt ->
  in_parser reg s r.
Proof.
  unfold reg, field. destruct r ; simpl ; intros ; repeat pinv ;
  repeat econstructor ; eauto.
Qed.

Lemma mask_parser s :
  in_parser (int32_p safeMask) s tt ->
  in_parser (word @ (fun w : int32 => Imm_op w %% operand_t)) s (Imm_op safeMask).
Proof.
  unfold word, byte, field, int32_p. simpl. intros.
  repeat pinv.
    repeat econstructor. repeat rewrite <- app_assoc.
    repeat rewrite -> app_nil_l. eexists. vm_compute. reflexivity.
Qed.

Lemma mask_parser' s :
  in_parser (int32_p safeMask) s tt ->
  in_parser word s safeMask.
Proof.
  unfold word, byte, field, int32_p. simpl. intros.
  repeat pinv.
    repeat econstructor. repeat rewrite <- app_assoc.
    repeat rewrite -> app_nil_l. eexists. vm_compute. reflexivity.
Qed.

Lemma reinsjmp_nonIAT_MASK_subset r s i :
  in_parser (reinsjmp_nonIAT_MASK_p r) s i ->
  in_parser instruction_parser s (mkPrefix None None false false, i).
Proof.
  unfold reinsjmp_nonIAT_MASK_p. intros.
  unfold instruction_parser, instruction_parser_list. eapply in_alts_app.
  left. eapply in_map_alts. replace s with (nil ++ s) ; auto.
  econstructor ; eauto.
    unfold prefix_parser_nooverride, option_perm2.
    econstructor ; eauto.
      eapply Alt_left_pi.
      econstructor ; eauto. reflexivity.
    unfold instr_parsers_nosize_pre. simpl.

    unfold bitsleft in H. repeat
    match goal with
    | [ H : in_parser (_  @  _) _ _ |- _ ] => generalize (inv_map_pi H) ; clear H ; t
    | [ H : in_parser (_  $  _) _ _ |- _ ] => generalize (inv_cat_pi H) ; clear H ; t
    end ; subst.
    repeat  match goal with
      | [ |- in_parser ((AND_p _) |+| _) _ _ ] => eapply Alt_left_pi
      | [ |- in_parser (_ |+| _) _ _ ] => eapply Alt_right_pi
    end.
    unfold AND_p, logic_or_arith_p. eapply Alt_right_pi. eapply Alt_right_pi.
    eapply Alt_right_pi. eapply Alt_left_pi.
    econstructor. econstructor. econstructor. eauto.
    econstructor. econstructor. eauto.
    econstructor. econstructor. eauto.
    econstructor. econstructor. eauto.
    econstructor. eapply reg_parser. destruct x21. eauto.
    unfold imm_op. simpl. eapply mask_parser. destruct x22.
    eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto.
    eauto. eauto. eauto. eauto. eauto. eauto. eauto. simpl.
    reflexivity.
Qed.

Lemma reinsjmp_nonIAT_MASK_EAX25_subset s i :
  in_parser reinsjmp_nonIAT_MASK_EAX25_p s i ->
  in_parser instruction_parser s (mkPrefix None None false false, i).
Proof.
  unfold reinsjmp_nonIAT_MASK_EAX25_p. intros.
  unfold instruction_parser, instruction_parser_list. eapply in_alts_app.
  left. eapply in_map_alts. replace s with (nil ++ s) ; auto.
  econstructor ; eauto.
    unfold prefix_parser_nooverride, option_perm2.
    econstructor ; eauto.
      eapply Alt_left_pi.
      econstructor ; eauto. reflexivity.
    unfold instr_parsers_nosize_pre. simpl.
    unfold bitsleft in H. repeat
    match goal with
    | [ H : in_parser (_  @  _) _ _ |- _ ] => generalize (inv_map_pi H) ; clear H ; t
    | [ H : in_parser (_  $  _) _ _ |- _ ] => generalize (inv_cat_pi H) ; clear H ; t
    end ; subst.
    (*0x25 AND*)
    repeat  match goal with
      | [ |- in_parser ((AND_p _) |+| _) _ _ ] => eapply Alt_left_pi
      | [ |- in_parser (_ |+| _) _ _ ] => eapply Alt_right_pi
    end.
    unfold AND_p , logic_or_arith_p. eapply Alt_right_pi. eapply Alt_right_pi.
    eapply Alt_right_pi. eapply Alt_right_pi. eapply Alt_right_pi. eapply Alt_left_pi.
    econstructor. econstructor. econstructor. eauto.
    econstructor. econstructor. eauto.
    unfold imm_op. simpl. eapply mask_parser. destruct x8.
    eauto. eauto. eauto. eauto. eauto. eauto. eauto.
    reflexivity.
Qed.

Lemma in_any_char :
  forall s c i,
    in_parser (Char_p c) s i ->
    in_parser Any_p s i.
Proof.
  intros. pinv. eauto.
Qed.

Lemma in_any_char2 :
  forall s c1 c2 i,
    in_parser (Cat_p (Char_p c1) (Cat_p (Char_p c2) Eps_p)) s i ->
    in_parser (Cat_p Any_p (Cat_p Any_p Eps_p)) s i.
Proof.
  intros. repeat pinv.
  econstructor ; eauto.
Qed.

Definition string_to_register (str : string) : register :=
  match str with
  | "000"%string => EAX
  | "001"%string => ECX
  | "010"%string => EDX
  | "011"%string => EBX
  | "100"%string => ESP
  | "101"%string => EBP
  | "110"%string => ESI
  | "111"%string => EDI
  | _ => EAX
  end.

Lemma bits_bitslist :
  forall str s i c1 c2 c3,
    c1 = "0" \/ c1 = "1" ->
    c2 = "0" \/ c2 = "1" ->
    c3 = "0" \/ c3 = "1" ->
    str = String c1 (String c2 (String c3 EmptyString)) ->
    in_parser (bits str) s i ->
    in_parser (bitslist (register_to_bools (string_to_register str))) s tt.
Proof.
  intros.
  repeat pinv ; psimp ; repeat pinv ; simpl ;
    repeat (econstructor ; econstructor ; eauto).
Qed.

Lemma reinsjmp_IAT_or_RET_MASK_subset s i :
  in_parser (reinsjmp_IAT_or_RET_MASK_p) s i ->
  in_parser instruction_parser s (mkPrefix None None false false, i).
Proof.
  unfold reinsjmp_IAT_or_RET_MASK_p. intros.
  unfold instruction_parser, instruction_parser_list. eapply in_alts_app.
  left. eapply in_map_alts. replace s with (nil ++ s) ; auto.
  econstructor ; eauto.
    unfold prefix_parser_nooverride, option_perm2.
    econstructor ; eauto.
      eapply Alt_left_pi.
      econstructor ; eauto.
    reflexivity.
    unfold instr_parsers_nosize_pre. simpl.
    repeat match goal with
    | [ |- in_parser ((AND_p _) |+| _) _ _ ] => eapply Alt_left_pi
    | [ |- in_parser (_ |+| _) _ _ ] => eapply Alt_right_pi
    end.
    unfold AND_p, logic_or_arith_p.
    repeat eapply Alt_right_pi. unfold bitsleft in H.
    repeat match goal with
    | [ H : in_parser (_ @ _) _ _ |- _ ] => generalize (inv_map_pi H) ; clear H ; t
    | [ H : in_parser (_ $ _) _ _ |- _ ] => generalize (inv_cat_pi H) ; clear H ; t
    end ; subst.
    econstructor. econstructor. econstructor. eauto.
    econstructor. econstructor. eauto.
    econstructor. econstructor. econstructor. econstructor. eexact H11.
    econstructor. eexact H15.
    unfold rm00. eapply Alt_right_pi. eapply Alt_left_pi.
    econstructor. econstructor. eexact H19.
    econstructor. econstructor. econstructor. econstructor. econstructor.
     unfold bits in H23. simpl in H23. unfold field'. eapply in_any_char2.
     eauto. eauto. eauto. eapply reg_parser.
     apply bits_bitslist with
        (str := "100"%string) (c1 := "1") (c2 := "0") (c3 := "0")
        (i := x33) ; auto.
    eexact H27. eauto. eauto. eauto.
    econstructor. eapply Alt_right_pi. eapply Alt_right_pi. eapply Alt_right_pi.
     eapply Alt_right_pi. eapply Alt_left_pi. eexact H30.
    eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto.
    simpl. eauto.
    econstructor. eapply mask_parser'. destruct x38. eexact H31.
    eauto. eauto. eauto. eauto. eauto. eauto.
    repeat rewrite <- app_assoc. reflexivity.
    eauto. eauto.
    simpl. assert (x37 = (true, (false, (false, tt)))).
      unfold bits in H30. simpl in H30. repeat pinv. reflexivity.
    rewrite -> H. simpl. reflexivity.
Qed.

Lemma reinsjmp_nonIAT_jump_subset r s i :
  in_parser (reinsjmp_nonIAT_JMP_p r |+| reinsjmp_nonIAT_CALL_p r) s i ->
  in_parser instruction_parser s (mkPrefix None None false false, i).
Proof.
  intros. unfold instruction_parser, instruction_parser_list.
  eapply in_alts_app. left. eapply in_map_alts.
  replace s with (nil ++ s) ; auto.
  econstructor ; eauto.
    unfold prefix_parser_nooverride, option_perm2.
    econstructor.
      eapply Alt_left_pi.
      econstructor ; eauto.
    reflexivity.
    unfold instr_parsers_nosize_pre. simpl.
    repeat pinv.
      repeat match goal with
      | [ |- in_parser (JMP_p |+| _) _ _ ] => eapply Alt_left_pi
      | [ |- in_parser (_ |+| _) _ _ ] => eapply Alt_right_pi
      end.
      unfold reinsjmp_nonIAT_JMP_p, JMP_p in *.
      eapply Alt_right_pi. eapply Alt_right_pi. eapply Alt_left_pi.
      unfold bitsleft in H.
      repeat match goal with
      | [ H : in_parser (_ @ _) _ _ |- _ ] => generalize (inv_map_pi H) ; clear H ; t
      | [ H : in_parser (_ $ _) _ _ |- _ ] => generalize (inv_cat_pi H) ; clear H ; t
      end ; subst.
      econstructor. econstructor. econstructor. eexact H3.
      econstructor. econstructor. eexact H7.
      unfold ext_op_modrm2.
      econstructor. repeat eapply Alt_right_pi.
      econstructor. eexact H11.
      econstructor. eexact H14.
      unfold rm11. econstructor. eapply reg_parser. destruct x18. eexact H15.
      eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. auto. eauto.
      eauto. simpl. reflexivity.
    repeat match goal with
    | [ |- in_parser (CALL_p |+| _) _ _ ] => eapply Alt_left_pi
    | [ |- in_parser (_ |+| _) _ _ ] => eapply Alt_right_pi
    end.
    unfold reinsjmp_nonIAT_CALL_p, CALL_p in *. eapply Alt_right_pi.
    eapply Alt_left_pi. unfold bitsleft in H.
    repeat match goal with
    | [ H : in_parser (_ @ _) _ _ |- _ ] => generalize (inv_map_pi H) ; clear H ; t
    | [ H : in_parser (_ $ _) _ _ |- _ ] => generalize (inv_cat_pi H) ; clear H ; t
    end ; subst.
    econstructor. econstructor. econstructor. eexact H3.
    econstructor. econstructor. eexact H7.
    unfold ext_op_modrm2. econstructor. repeat eapply Alt_right_pi.
    econstructor. eexact H11.
    econstructor. eexact H14.
    unfold rm11. econstructor. eapply reg_parser. destruct x18. eexact H15.
    eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. auto. eauto.
    eauto. simpl. reflexivity.
Qed.

Lemma reinsjmp_IAT_JMP_or_RET_jump_subset s i :
  in_parser (reinsjmp_IAT_JMP_p |+| RET_p) s i ->
  in_parser instruction_parser s (mkPrefix None None false false, i).
Proof.
  intros. unfold instruction_parser, instruction_parser_list. eapply in_alts_app.
  left. eapply in_map_alts.
  replace s with (nil ++ s) ; auto.
  econstructor ; eauto.
    unfold prefix_parser_nooverride, option_perm2.
    econstructor.
      eapply Alt_left_pi.
      econstructor ; eauto.
      reflexivity.
    unfold instr_parsers_nosize_pre. simpl.
    repeat pinv.
      repeat match goal with
      | [ |- in_parser (JMP_p |+| _) _ _ ] => eapply Alt_left_pi
      | [ |- in_parser (_ |+| _) _ _ ] => eapply Alt_right_pi
      end.
      unfold reinsjmp_IAT_JMP_p, JMP_p in *. eapply Alt_right_pi. eapply Alt_right_pi.
      eapply Alt_left_pi. unfold bitsleft in H.
      repeat match goal with
      | [ H : in_parser (_ @ _) _ _ |- _ ] => generalize (inv_map_pi H) ; clear H ; t
      | [ H : in_parser (_ $ _) _ _ |- _ ] => generalize (inv_cat_pi H) ; clear H ; t
      end ; subst.
      econstructor. econstructor. econstructor. eexact H3.
      econstructor. econstructor. eexact H7.
      unfold ext_op_modrm2. econstructor. eapply Alt_left_pi.
      econstructor. eexact H11.
      econstructor. eexact H15.
      unfold rm00. eapply Alt_right_pi. eapply Alt_right_pi. eapply Alt_right_pi.
      econstructor. econstructor. eexact H19.
      eexact H20. eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto. eauto.
      eauto. eauto. eauto. eauto. eauto. eauto.
      repeat match goal with
      | [ |- in_parser (RET_p |+| _) _ _ ] => eapply Alt_left_pi
      | [ |- in_parser (_ |+| _) _ _ ] => eapply Alt_right_pi
      end.
      exact H.
Qed.

Lemma reinsjmp_nonIAT_parser_inv r s1 s2 i1 i2:
  r <> ESP ->
  in_parser (reinsjmp_nonIAT_MASK_p r) s1 i1 ->
  in_parser (reinsjmp_nonIAT_JMP_p r |+| reinsjmp_nonIAT_CALL_p r) s2 i2 ->
  reinsjmp_nonIAT_mask_instr (mkPrefix None None false false) i1
                     (mkPrefix None None false false) i2 = true.
Proof.
  unfold reinsjmp_nonIAT_MASK_p, reinsjmp_nonIAT_JMP_p, reinsjmp_nonIAT_CALL_p.
  intros.
  repeat pinv  ; unfold reinsjmp_nonIAT_mask_instr ; simpl ;
  destruct (register_eq_dec r ESP) ;
  try congruence ;
  destruct (register_eq_dec r r) ;
  try congruence.
Qed.

Lemma reinsjmp_nonIAT_parser_EAX25_inv s1 s2 i1 i2:
  in_parser reinsjmp_nonIAT_MASK_EAX25_p s1 i1 ->
  in_parser (reinsjmp_nonIAT_JMP_p EAX |+| reinsjmp_nonIAT_CALL_p EAX) s2 i2 ->
  reinsjmp_nonIAT_mask_instr (mkPrefix None None false false) i1
                     (mkPrefix None None false false) i2 = true.
Proof.
  unfold reinsjmp_nonIAT_MASK_EAX25_p, reinsjmp_nonIAT_JMP_p, reinsjmp_nonIAT_CALL_p.
  intros.
  repeat pinv  ;  unfold reinsjmp_nonIAT_mask_instr ;  simpl ; reflexivity.
Qed.

Lemma reinsjmp_IAT_JMP_or_RET_parser_inv s1 s2 i1 i2:
  in_parser (reinsjmp_IAT_or_RET_MASK_p) s1 i1 ->
  in_parser (reinsjmp_IAT_JMP_p |+| RET_p) s2 i2 ->
  reinsjmp_IAT_or_RET_mask_instr (mkPrefix None None false false) i1
                        (mkPrefix None None false false) i2 = true.
Proof.
  unfold reinsjmp_IAT_or_RET_MASK_p, reinsjmp_IAT_JMP_p, RET_p.
  intros.
  repeat pinv ; unfold reinsjmp_IAT_or_RET_mask_instr ; simpl ; reflexivity.
Qed.

Lemma reinsjmp_nonIAT_dfa_corr1 :
  forall (d:DFA),
    abstract_build_dfa 256 nat2bools 400 (par2rec reinsjmp_nonIAT_mask) = Some d ->
    forall (bytes:list int8) (n:nat) (nats2:list nat),
      dfa_recognize 256 d (List.map byte2token bytes) = Some (n,nats2) ->
      exists bytes1, exists pfx1:prefix, exists ins1:instr, exists bytes2,
        exists pfx2:prefix, exists ins2:instr,
        in_parser reinsjmp_nonIAT_mask (flat_map byte_explode (bytes1 ++ bytes2))
        (ins1,ins2) /\
        in_parser instruction_parser (flat_map byte_explode bytes1) (pfx1,ins1) /\
        in_parser instruction_parser (flat_map byte_explode bytes2) (pfx2,ins2) /\
        n = length (bytes1 ++ bytes2) /\
        bytes = bytes1 ++ bytes2 ++ (List.map nat_to_byte nats2) /\
        reinsjmp_nonIAT_mask_instr pfx1 ins1 pfx2 ins2 = true /\
        (forall ts3 ts4,
          (length ts3 < length (bytes1 ++ bytes2))%nat ->
          bytes = ts3 ++ ts4 ->
          forall v0, ~ in_parser reinsjmp_nonIAT_mask (flat_map byte_explode ts3) v0).
Proof.
  intros. subst.
  rewrite build_dfa_eq in H.
    generalize (dfa_recognize_corr _ _ _ _ H (List.map byte2token bytes)
     (bytesLt256 _)).
    clear H.
  rewrite H0. clear H0.
  mysimp.
  generalize (byte2token_app _ _ _ H). t. subst.
  rewrite (nat2bools_byte2token_is_byte_explode _) in H1.
    generalize (reinsjmp_nonIAT_parser_splits _ H1). clear H1.
  t. destruct H0. t. destruct x0. simpl in *.
  exists x. exists (mkPrefix None None false false). exists i.
  exists x3. exists (mkPrefix None None false false). exists i0.
  split.
    rewrite flat_map_app.
    destruct x4  ; try congruence ;
      repeat (try (eapply Alt_left_pi ; econstructor ; eauto ; fail)
             ; eapply Alt_right_pi).
  split. apply (reinsjmp_nonIAT_MASK_subset H3).
  split. eapply (reinsjmp_nonIAT_jump_subset H4).
  split. rewrite H1. rewrite map_length. reflexivity.
  split. subst. rewrite app_assoc.
    assert (x2 = List.map nat_to_byte (List.map byte2token x2))
    ; [ idtac | congruence].
    rewrite n2bs. reflexivity.
  split. eapply reinsjmp_nonIAT_parser_inv ; eauto.
  intros. rewrite H1 in H2.
  specialize (H2 (List.map byte2token ts3) (List.map byte2token ts4)).
  repeat rewrite map_length in H2.
  specialize (H2 H5). subst. rewrite H6 in H2. rewrite map_app in H2.
  specialize (H2 (eq_refl _)).
  rewrite nat2bools_byte2token_is_byte_explode in H2.
  intro. apply (H2 v0 H1).
  t. destruct x0. simpl in *.
  exists x. exists (mkPrefix None None false false). exists i.
  exists x3. exists (mkPrefix None None false false). exists i0.
  split.
    rewrite flat_map_app.
    destruct x4  ; try congruence ;
      repeat (try (eapply Alt_left_pi ; econstructor ; eauto ; fail)
             ; eapply Alt_right_pi).
  split. apply (reinsjmp_nonIAT_MASK_EAX25_subset H3).
  split. eapply (reinsjmp_nonIAT_jump_subset H4).
  split. rewrite H1. rewrite map_length. reflexivity.
  split. subst. rewrite app_assoc.
    assert (x2 = List.map nat_to_byte (List.map byte2token x2))
    ; [ idtac | congruence].
    rewrite n2bs. reflexivity.
  rewrite -> H0 in H4.
  split. eapply reinsjmp_nonIAT_parser_EAX25_inv ; eauto.
  intros. rewrite H1 in H2.
  specialize (H2 (List.map byte2token ts3) (List.map byte2token ts4)).
  repeat rewrite map_length in H2.
  specialize (H2 H5). subst. rewrite H6 in H2. rewrite map_app in H2.
  specialize (H2 (eq_refl _)).
  rewrite nat2bools_byte2token_is_byte_explode in H2.
  intro. apply (H2 v0 H0).
Qed.

Lemma reinsjmp_IAT_JMP_or_RET_dfa_corr1 :
  forall (d:DFA),
    abstract_build_dfa 256 nat2bools 400 (par2rec reinsjmp_IAT_JMP_or_RET_mask) = Some d ->
    forall (bytes:list int8) (n:nat) (nats2:list nat),
      dfa_recognize 256 d (List.map byte2token bytes) = Some (n,nats2) ->
      exists bytes1, exists pfx1:prefix, exists ins1:instr, exists bytes2,
        exists pfx2:prefix, exists ins2:instr,
        in_parser reinsjmp_IAT_JMP_or_RET_mask (flat_map byte_explode (bytes1 ++ bytes2))
        (ins1,ins2) /\
        in_parser instruction_parser (flat_map byte_explode bytes1) (pfx1,ins1) /\
        in_parser instruction_parser (flat_map byte_explode bytes2) (pfx2,ins2) /\
        n = length (bytes1 ++ bytes2) /\
        bytes = bytes1 ++ bytes2 ++ (List.map nat_to_byte nats2) /\
        reinsjmp_IAT_or_RET_mask_instr pfx1 ins1 pfx2 ins2 = true /\
        (forall ts3 ts4,
          (length ts3 < length (bytes1 ++ bytes2))%nat ->
          bytes = ts3 ++ ts4 ->
          forall v0, ~ in_parser reinsjmp_IAT_JMP_or_RET_mask (flat_map byte_explode ts3) v0).
Proof.
  intros. rewrite build_dfa_eq in H.
  generalize (dfa_recognize_corr _ _ _ _ H (List.map byte2token bytes)
    (bytesLt256 _)). clear H.
  rewrite H0. clear H0. mysimp.
  generalize (byte2token_app _ _ _ H). t. subst.
  rewrite (nat2bools_byte2token_is_byte_explode _) in H1.
  generalize (reinsjmp_IAT_JMP_or_RET_parser_splits _ H1). clear H1. t.
  destruct x0. simpl in *.
  exists x. exists (mkPrefix None None false false). exists i.
    exists x3. exists (mkPrefix None None false false). exists i0.
  split. rewrite flat_map_app. econstructor. eauto. eexact H3.
    reflexivity. reflexivity.
  split. apply (reinsjmp_IAT_or_RET_MASK_subset H1).
  split. eapply (reinsjmp_IAT_JMP_or_RET_jump_subset H3).
  split. rewrite H0. rewrite map_length. reflexivity.
  split. subst. rewrite app_assoc.
    assert (x2 = List.map nat_to_byte (List.map byte2token x2))
    ; [ idtac | congruence].
    rewrite n2bs. reflexivity.
  split. eapply reinsjmp_IAT_JMP_or_RET_parser_inv ; eauto.
  intros. rewrite H0 in H2. specialize (H2 (List.map byte2token ts3)
  (List.map byte2token ts4)). repeat rewrite map_length in H2.
  specialize (H2 H4). subst. rewrite H5 in H2. rewrite map_app in H2.
  specialize (H2 (eq_refl _)). rewrite nat2bools_byte2token_is_byte_explode in H2.
  intro. apply (H2 v0 H0).
Qed.

Lemma flat_map_nil_is_nil x :
  flat_map byte_explode x = nil -> x = nil.
Proof.
  induction x ; intros.
    reflexivity.
    replace (flat_map byte_explode (a :: x))
      with (byte_explode a ++ (flat_map byte_explode x)) in H ; auto.
    generalize (nil_is_nil_app_nil _ _ (eq_sym H)). t.
    clear IHx H H1.
    assert False ; try contradiction.
      unfold byte_explode in H0. congruence.
Qed.

(** This should get placed in DFACorrectness and used for the other 2 DFAs. *)
Lemma in_parser_implies_simple_parse
  bytes1 pfx ins bytes2 :
  in_parser instruction_parser (flat_map byte_explode bytes1) (pfx,ins) ->
  simple_parse (bytes1 ++ bytes2) = Some (pfx, ins, bytes2).
Proof.
  unfold simple_parse ; intros.
  Opaque instruction_parser.
  generalize (@simple_parse'_corr2
    instruction_parser (bytes1 ++ bytes2) initial_parser_state nil
    (eq_refl _) (eq_refl _)).
  simpl. intros.
  assert (forall s1 s2, nil = s1 ++ s2 ->
    apply_null (snd (parser2regexp instruction_parser))
          (deriv_parse' (fst (parser2regexp instruction_parser))
             (flat_map byte_explode s1))
          (wf_derivs (snd (parser2regexp instruction_parser))
             (flat_map byte_explode s1)
             (fst (parser2regexp instruction_parser))
             (p2r_wf instruction_parser initial_ctxt)) = nil).
  intros. clear H0.
  generalize (nil_is_nil_app_nil _ _ H1). t. subst.
  generalize (min_count_not_null _ min_instruction_bits).
  generalize instruction_parser.
  clear H H1. simpl.
  intro.
  generalize (apply_null (snd(parser2regexp p)) (fst (parser2regexp p))).
  assert (wf_derivs (snd (parser2regexp p)) nil (fst (parser2regexp p))
         (p2r_wf p initial_ctxt) = p2r_wf p initial_ctxt).
    apply Coqlib.proof_irrelevance.
  generalize H. clear H.
  unfold parser2regexp.
  generalize (p2r_wf p initial_ctxt).
  intros. rewrite <- H in H0. exact H0.
  specialize (H0 H1). clear H1.
  destruct (simple_parse' initial_parser_state (bytes1 ++ bytes2)).
    destruct p. t. destruct p.
    assert (length bytes1 >= length x).
      assert (length bytes1 < length x -> False).
        intros.
        eapply (H2 bytes1 bytes2 (eq_refl _) H3 _ H). omega.
    assert (exists s2, bytes1 = x ++ s2).
      generalize bytes1 x H3 H0.
      induction bytes0 ; destruct x0 ; simpl ; intros.
        exists nil. reflexivity.
        assert False.
          omega.
        contradiction.
        subst. eauto.
        injection H5 ; clear H5 ; t ; subst.
        assert (length bytes0 >= length x0).
          omega.
        specialize (IHbytes0 _ H6 H5). t.
        subst. eauto.
    t. subst. rewrite app_ass in H0. generalize (app_inv_head _ _ _ H0).
    intros. subst. rewrite flat_map_app in H. generalize (parser_determ H).
    intros. specialize (H4 _ _ (p,i) (eq_refl _) H1). t.
    injection H5 ; intros.
    rewrite (flat_map_nil_is_nil _ H4). subst.  auto.
    specialize (H0 bytes1 bytes2 (pfx,ins) (eq_refl _)). contradiction.
Qed.

Lemma reinsjmp_nonIAT_dfa_corr :
  forall (d:DFA),
    abstract_build_dfa 256 nat2bools 400 (par2rec reinsjmp_nonIAT_mask) = Some d ->
    forall (bytes:list int8) (n:nat) (nats2:list nat),
      dfa_recognize 256 d (List.map byte2token bytes) = Some (n, nats2) ->
      exists bytes1, exists pfx1:prefix, exists ins1:instr, exists bytes2,
        exists pfx2:prefix, exists ins2:instr,
        simple_parse bytes = Some ((pfx1,ins1), bytes2 ++ List.map nat_to_byte nats2) /\
        simple_parse (bytes2 ++ List.map nat_to_byte nats2) =
            Some ((pfx2,ins2), List.map nat_to_byte nats2) /\
        reinsjmp_nonIAT_mask_instr pfx1 ins1 pfx2 ins2 = true /\
        n = length (bytes1 ++ bytes2) /\
        bytes = bytes1 ++ bytes2 ++ (List.map nat_to_byte nats2).
Proof.
  intros d H bytes n nats2 H1.
  generalize (@reinsjmp_nonIAT_dfa_corr1 d H bytes n nats2 H1). t.
  exists x. exists x0. exists x1. exists x2. exists x3. exists x4.
  repeat split ; auto.
    rewrite H5. apply in_parser_implies_simple_parse. exact H2.
    apply in_parser_implies_simple_parse. exact H3.
Qed.

Lemma reinsjmp_IAT_JMP_or_RET_dfa_corr :
  forall (d:DFA),
    abstract_build_dfa 256 nat2bools 400 (par2rec reinsjmp_IAT_JMP_or_RET_mask) = Some d ->
    forall (bytes:list int8) (n:nat) (nats2:list nat),
      dfa_recognize 256 d (List.map byte2token bytes) = Some (n, nats2) ->
      exists bytes1, exists pfx1:prefix, exists ins1:instr, exists bytes2,
        exists pfx2:prefix, exists ins2:instr,
        simple_parse bytes = Some ((pfx1,ins1), bytes2 ++ List.map nat_to_byte nats2) /\
        simple_parse (bytes2 ++ List.map nat_to_byte nats2) =
            Some ((pfx2,ins2), List.map nat_to_byte nats2) /\
        reinsjmp_IAT_or_RET_mask_instr pfx1 ins1 pfx2 ins2 = true /\
        n = length (bytes1 ++ bytes2) /\
        bytes = bytes1 ++ bytes2 ++ (List.map nat_to_byte nats2).
Proof.
  intros d H bytes n nats2 H1.
  generalize (@reinsjmp_IAT_JMP_or_RET_dfa_corr1 d H bytes n nats2 H1). t.
  exists x. exists x0. exists x1. exists x2. exists x3. exists x4.
  repeat split ; auto.
    rewrite H5. apply in_parser_implies_simple_parse. exact H2.
    apply in_parser_implies_simple_parse. exact H3.
Qed.

Lemma reinsjmp_nonIAT_mask_dfa_length :
  forall (d:DFA),
    (* Need to use abstract_build_dfa for the same reason as above I believe *)
    abstract_build_dfa 256 nat2bools 400 (par2rec reinsjmp_nonIAT_mask) = Some d ->
    forall (bytes:list int8) (n:nat) (nats2:list nat),
      dfa_recognize 256 d (List.map byte2token bytes) = Some (n, nats2) ->
        (n <= 15).
Proof.
  intros. apply reinsjmp_nonIAT_dfa_corr1 in H0.
    destruct H0. destruct H0. destruct H0. destruct H0.
    destruct H0. destruct H0. destruct H0.
    destruct H1. destruct H2. destruct H3.
    assert (max_bit_count reinsjmp_nonIAT_mask = Some 64).
      vm_compute. reflexivity.
    apply max_count_corr in H0.
    rewrite H5 in H0.
    rewrite byte_explode_mult_len in H0.
    rewrite H3. omega.
    auto.
Qed.

Lemma reinsjmp_IAT_JMP_or_RET_mask_dfa_length :
  forall (d:DFA),
    (* Need to use abstract_build_dfa for the same reason as above I believe *)
    abstract_build_dfa 256 nat2bools 400 (par2rec reinsjmp_IAT_JMP_or_RET_mask) = Some d ->
    forall (bytes:list int8) (n:nat) (nats2:list nat),
      dfa_recognize 256 d (List.map byte2token bytes) = Some (n, nats2) ->
        (n <= 15).
Proof.
  intros. apply reinsjmp_IAT_JMP_or_RET_dfa_corr1 in H0.
    destruct H0. destruct H0. destruct H0. destruct H0.
    destruct H0. destruct H0. destruct H0.
    destruct H1. destruct H2. destruct H3.
    assert (max_bit_count reinsjmp_IAT_JMP_or_RET_mask = Some 104).
      vm_compute; trivial.
    apply max_count_corr in H0.
    rewrite H5 in H0.
    rewrite byte_explode_mult_len in H0.
    rewrite H3. omega.
    auto.
Qed.


(*

  Copyright 2016 Luxembourg University
  Copyright 2017 Luxembourg University
  Copyright 2018 Luxembourg University

  This file is part of Velisarios.

  Velisarios 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 3 of the License, or
  (at your option) any later version.

  Velisarios 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.

  You should have received a copy of the GNU General Public License
  along with Velisarios.  If not, see <http://www.gnu.org/licenses/>.

  Authors: Vincent Rahli
           Ivana Vukotic

 *)

Require Export PBFTreceived_prepare_like2.
Require Export PBFTreceived_prepare_like8.
Require Export PBFTprepare_like2request_data.

Section PBFTreceived_prepare_like9.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { pbft_context : PBFTcontext      }.
  Context { pbft_auth    : PBFTauth         }.
  Context { pbft_keys    : PBFTinitial_keys }.
  Context { pbft_hash    : PBFThash         }.

  Lemma correct_in_intersection :
    forall (eo : EventOrdering) (l1 l2 : list Rep) (E : list Event),
      no_repeats l1
      -> no_repeats l2
      -> 2 * F + 1 <= length l1
      -> 2 * F + 1 <= length l2
      -> AXIOM_exists_at_most_f_faulty E F
      -> exists good,
          In good l1
          /\ In good l2
          /\ forall e, In e E -> node_has_correct_trace_before e good.
  Proof.
    introv nrep1 nrep2 len1 len2 atmost.
    pose proof (two_quorums l1 l2) as quor; repeat (autodimp quor hyp).
    exrepnd.
    pose proof (there_is_one_good_guy_before eo l E) as gg.
    repeat (autodimp gg hyp).
    exrepnd.
    exists good; dands; auto.
  Qed.

(*  Lemma prepare_like_in_log_from_good_replica :
    forall (eo : EventOrdering) (e : Event) good pl i st,
      authenticated_messages_were_sent_or_byz_usys eo PBFTsys
      -> PBFTcorrect_keys eo
      -> loc e = PBFTreplica i
      -> replica_has_correct_trace_before eo e good
      -> prepare_like2sender pl = good
      -> prepare_like_in_log pl (log st)
      -> state_sm_on_event (PBFTreplicaSM i) eo e = Some st
      ->
      exists e' st,
        e' ≼ e
        /\ loc e' = PBFTreplica good
        /\ state_sm_on_event (PBFTreplicaSM good) eo e' = Some st
        /\ prepare_like_in_log pl (log st).
  Proof.
    introv auth ckeys eqloc ctrace goodsender inlog eqst.

    pose proof (correct_prepare_like_messages_are_sent _ pl i e st) as sent.
    repeat (autodimp sent hyp);[].
    exrepnd.

    applydup localLe_implies_loc in sent1.
    pose proof (ckeys e' i st1) as ck1; autodimp ck1 hyp.

    repndors; repnd;[|].

    - pose proof (prepare_like_received_from_good_replica_was_in_log eo e' good pl i) as h.
      repeat (autodimp h hyp); allrw; eauto 3 with eo pbft; try congruence;[].

      exrepnd.

      exists e'0 st0; dands; auto; eauto 4 with eo.

    - exists e st; dands; auto; eauto 3 with eo; try congruence.
  Qed.*)

  Lemma pbft_knows_prepare_like_propagates1 :
    forall (eo : EventOrdering) (e : Event) good pl i st,
      AXIOM_authenticated_messages_were_sent_or_byz_usys eo PBFTsys
      -> AXIOM_PBFTcorrect_keys eo
      -> loc e = PBFTreplica i
      -> node_has_correct_trace_before e good
      -> prepare_like2sender pl = good
      -> prepare_like_in_log pl (log st)
      -> state_sm_on_event (PBFTreplicaSM i) e = Some st
      ->
      exists e' st,
        e' ≼ e
        /\ loc e' = PBFTreplica good
        /\ state_sm_on_event (PBFTreplicaSM good) e' = Some st
        /\ prepare_like_in_log pl (log st).
  Proof.
    introv auth ckeys eqloc ctrace goodsender inlog eqst.
    pose proof (knows_propagates e pl) as q.
    repeat (autodimp q hyp); eauto 3 with pbft;
      try (complete (eexists; eexists; simpl; dands; eauto));
      try (complete (simpl; allrw; subst; auto)).
    exrepnd; unfold knows in *; simpl in *; exrepnd.
    try unfold pbft_pl_data2loc in *.
    rewrite goodsender in *.
    rewrite q2 in *; ginv.
    eexists; eexists; dands; eauto; try congruence.
  Qed.

  Lemma pbft_knows_prepare_like_propagates :
    forall (eo : EventOrdering) (e : Event) pl,
      AXIOM_authenticated_messages_were_sent_or_byz_usys eo PBFTsys
      -> AXIOM_PBFTcorrect_keys eo
      -> node_has_correct_trace_before e (prepare_like2sender pl)
      -> knows e pl
      ->
      exists e',
        e' ≼ e
        /\ loc e' = PBFTreplica (prepare_like2sender pl)
        /\ knows e' pl.
  Proof.
    introv auth ckeys ctrace kn.
    apply knows_propagates in kn; eauto 3 with pbft.
  Qed.

  Lemma prepare_somewhere_in_log_not_from_primary :
    forall p L,
      well_formed_log L
      -> prepare_somewhere_in_log p L = true
      -> prepare2sender p <> PBFTprimary (prepare2view p).
  Proof.
    induction L; introv wf prep; simpl in *; tcsp;[].
    inversion wf as [|? ? imp wf1 wf2]; subst; clear wf; smash_pbft.
    repndors; tcsp;[].
    applydup well_formed_log_entry_no_prepare_from_leader in wf1.
    unfold prepare_in_entry in *; smash_pbft.
    allrw existsb_exists; exrepnd.
    intro e; destruct wf0.
    apply in_map_iff.
    eexists; dands; eauto.
    unfold same_rep_tok in *; smash_pbft.
    unfold is_prepare_for_entry, eq_request_data in *; smash_pbft.
    destruct a, p, b; simpl in *; subst; simpl in *; tcsp.
  Qed.
  Hint Resolve prepare_somewhere_in_log_not_from_primary : pbft.

  Lemma two_own_prepare_like_in_state :
    forall (eo : EventOrdering) (e1 e2 : Event) i pl1 pl2 st1 st2,
      loc e1 = loc e2
      -> state_sm_on_event (PBFTreplicaSM i) e1 = Some st1
      -> state_sm_on_event (PBFTreplicaSM i) e2 = Some st2
      -> prepare_like_in_log pl1 (log st1)
      -> prepare_like_in_log pl2 (log st2)
      -> prepare_like2sender pl1 = i
      -> prepare_like2sender pl2 = i
      -> prepare_like2seq pl1 = prepare_like2seq pl2
      -> prepare_like2view pl1 = prepare_like2view pl2
      -> prepare_like2digest pl1 = prepare_like2digest pl2.
  Proof.
    introv eqloc eqst1 eqst2 prep1 prep2 send1 send2 eqseq eqview.

    apply prepare_like_in_log_implies_or in prep1.
    apply prepare_like_in_log_implies_or in prep2.
    repndors; exrepnd; subst; simpl in *.

    - destruct prep3, prep, b, b0; simpl in *; ginv; subst; eauto 2 with pbft.

    - destruct pp, prep, b, b0; simpl in *; subst.
      apply prepare_somewhere_in_log_not_from_primary in prep0; eauto 2 with pbft.
      simpl in *; tcsp.

    - destruct pp, prep, b, b0; simpl in *; subst.
      apply prepare_somewhere_in_log_not_from_primary in prep3; eauto 2 with pbft.
      simpl in *; tcsp.

    - destruct pp, pp0, b, b0; simpl in *; subst.

      eapply pre_prepare_in_somewhere_in_log_implies_pre_prepare_in_log in prep2;[|eauto].
      eapply pre_prepare_in_somewhere_in_log_implies_pre_prepare_in_log in prep1;[|eauto].

      applydup well_formed_log_implies_correct_digest in prep1;[|eauto 2 with pbft].
      applydup well_formed_log_implies_correct_digest in prep2;[|eauto 2 with pbft].

      pose proof (PBFT_A_1_2_2_local
                    eo e1 e2 (PBFTprimary v)
                    s v d2 d1 a0 a d0 d st1 st2) as q.
      repeat (autodimp q hyp); eauto 2 with pbft; subst; auto.
  Qed.

  Lemma two_know_own_prepare_like :
    forall (eo : EventOrdering) (e1 e2 : Event) pl1 pl2,
      loc e1 = loc e2
      -> knows e1 pl1
      -> knows e2 pl2
      -> loc e1 = PBFTreplica (prepare_like2sender pl1)
      -> loc e2 = PBFTreplica (prepare_like2sender pl2)
      -> prepare_like2seq pl1 = prepare_like2seq pl2
      -> prepare_like2view pl1 = prepare_like2view pl2
      -> prepare_like2digest pl1 = prepare_like2digest pl2.
  Proof.
    introv eqloc kna knb send1 send2 eqseq eqview.
    unfold knows in *; exrepnd; simpl in *.
    assert (PBFTreplica n0 = PBFTreplica n) as xx by congruence; ginv.
    eapply two_own_prepare_like_in_state;
      try (exact eqloc); try (exact kna1); try (exact knb1); auto;
        rewrite send1, send2 in *; ginv;
          try (complete (inversion eqloc; auto)).
  Qed.

  Lemma similar_prepare_like2request_data_implies_same_seq :
    forall pl1 pl2 v1 v2 n d1 d2,
      prepare_like2request_data pl1 = request_data v1 n d1
      -> prepare_like2request_data pl2 = request_data v2 n d2
      -> prepare_like2seq pl1 = prepare_like2seq pl2.
  Proof.
    introv h q.
    destruct pl1 as [p1|p1], pl2 as [p2|p2], p1 as [b1], p2 as [b2], b1, b2;
      simpl in *; ginv; auto.
  Qed.
  Hint Resolve similar_prepare_like2request_data_implies_same_seq : pbft.

  Lemma similar_prepare_like2request_data_implies_same_view :
    forall pl1 pl2 v n1 n2 d1 d2,
      prepare_like2request_data pl1 = request_data v n1 d1
      -> prepare_like2request_data pl2 = request_data v n2 d2
      -> prepare_like2view pl1 = prepare_like2view pl2.
  Proof.
    introv h q.
    destruct pl1 as [p1|p1], pl2 as [p2|p2], p1 as [b1], p2 as [b2], b1, b2;
      simpl in *; ginv; auto.
  Qed.
  Hint Resolve similar_prepare_like2request_data_implies_same_view : pbft.

  Lemma implies_prepare_like_have_same_digests :
    forall pl1 pl2 v1 v2 n1 n2 d1 d2,
      prepare_like2request_data pl1 = request_data v1 n1 d1
      -> prepare_like2request_data pl2 = request_data v2 n2 d2
      -> prepare_like2digest pl1 = prepare_like2digest pl2
      -> d1 = d2.
  Proof.
    introv h q.
    destruct pl1 as [p1|p1], pl2 as [p2|p2], p1 as [b1], p2 as [b2], b1, b2;
      simpl in *; ginv; auto.
  Qed.

End PBFTreceived_prepare_like9.

Hint Resolve prepare_somewhere_in_log_not_from_primary : pbft.
Hint Resolve similar_prepare_like2request_data_implies_same_seq : pbft.
Hint Resolve similar_prepare_like2request_data_implies_same_view : pbft.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import AbsAccessor.Spec.

Local Open Scope Z_scope.

Section Spec.

  Definition handle_ptimer_sysreg_write_spec (rec: Pointer) (esr: Z64) (adt: RData) : option RData :=
    match esr with
    | VZ64 esr =>
      rely is_int64 esr;
      rely (peq (base rec) buffer_loc);
      rely (offset rec =? SLOT_REC);
      when gidx == (buffer (priv adt)) @ (offset rec);
      rely is_gidx gidx;
      let gn := (gs (share adt)) @ gidx in
      rely (g_tag (ginfo gn) =? GRANULE_STATE_REC);
      rely (ref_accessible gn CPU_ID);
      let rt := __ESR_EL2_SYSREG_ISS_RT esr in
      rely is_int rt;
      let val := get_reg rt (g_regs (grec gn)) in
      rely is_int64 val;
      rely is_int (t_masked (g_ptimer (grec gn)));
      rely is_int64 (r_cnthctl_el2 (g_regs (grec gn)));
      let cnth' := Z.lor (r_cnthctl_el2 (g_regs (grec gn))) CNTHCTL_EL2_EL1PTEN in
      let ec := Z.land esr ESR_EL2_SYSREG_MASK in
      if ec =? ESR_EL2_SYSREG_TIMER_CNTP_TVAL_EL0 then
        let cntp_ctl := r_cntp_ctl_el0 (cpu_regs (priv adt)) in
        rely is_int64 cntp_ctl;
        match t_masked (g_ptimer (grec gn)) =? 0, __timer_condition_met cntp_ctl with
        | true, true =>
          Some adt {priv: (priv adt) {cpu_regs: (cpu_regs (priv adt)) {r_cntp_tval_el0: val}}}
        | _, _ =>
          let r' := (grec gn) {g_ptimer: (g_ptimer (grec gn)) {t_asserted: 0}}
                                  {g_regs: (g_regs (grec gn)) {r_cnthctl_el2: cnth'}} in
          Some adt {priv: (priv adt) {cpu_regs: (cpu_regs (priv adt)) {r_cntp_tval_el0: val} {r_cnthctl_el2: cnth'}}}
               {share: (share adt) {gs: (gs (share adt)) # gidx == (gn {grec: r'})}}
        end
      else
        if ec =? ESR_EL2_SYSREG_TIMER_CNTP_CTL_EL0 then
          let masked := Z.land val CNTx_CTL_IMASK in
          let cntp_ctl := Z.lor val CNTx_CTL_IMASK in
          match masked =? 0, __timer_condition_met cntp_ctl with
          | true, true =>
            let r' := (grec gn) {g_ptimer: (g_ptimer (grec gn)) {t_masked: Z.land val CNTx_CTL_IMASK}} in
            Some adt {priv: (priv adt) {cpu_regs: (cpu_regs (priv adt)) {r_cntp_ctl_el0: (Z.lor val CNTx_CTL_IMASK)}}}
                {share: (share adt) {gs: (gs (share adt)) # gidx == (gn {grec: r'})}}
          | _, _=>
            let cnth' := Z.lor (r_cnthctl_el2 (g_regs (grec gn))) CNTHCTL_EL2_EL1PTEN in
            let r' := (grec gn) {g_ptimer: (g_ptimer (grec gn)) {t_asserted: 0} {t_masked: Z.land val CNTx_CTL_IMASK}}
                                {g_regs: (g_regs (grec gn)) {r_cnthctl_el2: cnth'}} in
            Some adt {priv: (priv adt) {cpu_regs: (cpu_regs (priv adt)) {r_cntp_ctl_el0: (Z.lor val CNTx_CTL_IMASK)}
                                                                        {r_cnthctl_el2: cnth'}}}
                {share: (share adt) {gs: (gs (share adt)) # gidx == (gn {grec: r'})}}
          end
        else
          if ec =? ESR_EL2_SYSREG_TIMER_CNTP_CVAL_EL0 then
            let cntp_ctl := r_cntp_ctl_el0 (cpu_regs (priv adt)) in
            rely is_int64 cntp_ctl;
            match t_masked (g_ptimer (grec gn)) =? 0, __timer_condition_met cntp_ctl with
            | true, true =>
              Some adt {priv: (priv adt) {cpu_regs: (cpu_regs (priv adt)) {r_cntp_cval_el0: val}}}
            | _, _ =>
              let r' := (grec gn) {g_ptimer: (g_ptimer (grec gn)) {t_asserted: 0}}
                                      {g_regs: (g_regs (grec gn)) {r_cnthctl_el2: cnth'}} in
              Some adt {priv: (priv adt) {cpu_regs: (cpu_regs (priv adt)) {r_cntp_cval_el0: val} {r_cnthctl_el2: cnth'}}}
                  {share: (share adt) {gs: (gs (share adt)) # gidx == (gn {grec: r'})}}
            end
          else
            let cntp_ctl := r_cntp_ctl_el0 (cpu_regs (priv adt)) in
            rely is_int64 cntp_ctl;
            match t_masked (g_ptimer (grec gn)) =? 0, __timer_condition_met cntp_ctl with
            | true, true =>
              Some adt
            | _, _ =>
              let r' := (grec gn) {g_ptimer: (g_ptimer (grec gn)) {t_asserted: 0}}
                                      {g_regs: (g_regs (grec gn)) {r_cnthctl_el2: cnth'}} in
              Some adt {priv: (priv adt) {cpu_regs: (cpu_regs (priv adt)) {r_cnthctl_el2: cnth'}}}
                  {share: (share adt) {gs: (gs (share adt)) # gidx == (gn {grec: r'})}}
            end
    end.

End Spec.