Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import TableDataOpsIntro.Spec.
Require Import TableDataOpsIntro.Specs.table_destroy.

Local Open Scope Z_scope.

Section Spec.

  Definition table_destroy1_spec (g_rd: Pointer) (map_addr: Z64) (rtt_addr: Z64) (level: Z64) (adt: RData) : option (RData * Z64) :=
    match map_addr, level, rtt_addr with
    | VZ64 map_addr, VZ64 level, VZ64 rtt_addr =>
      rely is_int64 map_addr; rely is_int64 rtt_addr; rely GRANULE_ALIGNED map_addr; rely is_int64 level;
      let idx0 := __addr_to_idx map_addr 0 in
      let idx1 := __addr_to_idx map_addr 1 in
      let idx2 := __addr_to_idx map_addr 2 in
      let idx3 := __addr_to_idx map_addr 3 in
      let ret_idx := (if level =? 1 then idx0 else if level =? 2 then idx1 else if level =? 3 then idx2 else idx3) in
      rely is_int64 idx0; rely is_int64 idx1; rely is_int64 idx2; rely is_int64 idx3;
      let rtt_gidx := __addr_to_gidx rtt_addr in
      rely is_gidx rtt_gidx;
      rely (peq (base g_rd) ginfo_loc);
      rely prop_dec ((buffer (priv adt)) @ SLOT_RD = None);
      rely prop_dec ((buffer (priv adt)) @ SLOT_TABLE = None);
      rely prop_dec ((buffer (priv adt)) @ SLOT_RTT2 = None);
      let rd_gidx := (offset g_rd) in
      let grd := (gs (share adt)) @ rd_gidx in
      rely (g_tag (ginfo grd) =? GRANULE_STATE_RD);
      rely prop_dec (glock grd = Some CPU_ID);
      let root_gidx := (g_rtt (gnorm grd)) in
      rely is_gidx rd_gidx;
      when adt == query_oracle adt;
      (* hold root lock *)
      rely is_gidx root_gidx;
      let adt := adt {log: EVT CPU_ID (ACQ root_gidx) :: log adt} in
      let groot := (gs (share adt)) @ root_gidx in
      rely (tbl_level (gaux groot) =? 0);
      rely prop_dec (glock groot = None);
      rely (g_tag (ginfo groot) =? GRANULE_STATE_TABLE);
      rely (gtype groot =? GRANULE_STATE_TABLE);
      if level =? 1 then
        (* walk until root *)
        let adt := adt {log: EVT CPU_ID (RTT_WALK root_gidx map_addr 0) :: log adt} in
        let adt :=  adt {priv: (priv adt) {wi_llt: root_gidx} {wi_index: idx0}} in
        destroy_table root_gidx idx0 rtt_addr rtt_gidx 1 map_addr adt
      else
        (* walk deeper root *)
        rely (level >? 1);
        let entry0 := (g_data (gnorm groot)) @ idx0 in
          rely is_int64 entry0;
          let phys0 := __entry_to_phys entry0 3 in
          let lv1_gidx := __addr_to_gidx phys0 in
          rely is_int64 phys0;
          if (__entry_is_table entry0) && (GRANULE_ALIGNED phys0) && (is_gidx lv1_gidx) then
            (* level 1 valid, hold level 1 lock *)
            let adt := adt {log: EVT CPU_ID (RTT_WALK root_gidx map_addr 1) :: log adt} in
            let glv1 := (gs (share adt)) @ lv1_gidx in
            rely prop_dec (glock glv1 = None);
            rely (tbl_level (gaux glv1) =? 1);
            if level =? 2 then
              (* walk until level 1 *)
              let adt :=  adt {priv: (priv adt) {wi_llt: lv1_gidx} {wi_index: idx1}} in
              destroy_table lv1_gidx idx1 rtt_addr rtt_gidx 2 map_addr adt
            else
              (* walk deeper level 1 *)
              rely (level >? 2);
              rely (g_tag (ginfo glv1) =? GRANULE_STATE_TABLE);
              rely (gtype glv1 =? GRANULE_STATE_TABLE);
              let entry1 := (g_data (gnorm glv1)) @ idx1 in
              rely is_int64 entry1;
              let phys1 := __entry_to_phys entry1 3 in
              let lv2_gidx := __addr_to_gidx phys1 in
              rely is_int64 phys1;
              if (__entry_is_table entry1) && (GRANULE_ALIGNED phys1) && (is_gidx lv2_gidx) then
                (* level 2 valid, hold level 2 lock *)
                let adt := adt {log: EVT CPU_ID (REL lv1_gidx glv1 {glock: Some CPU_ID}) :: EVT CPU_ID (ACQ lv2_gidx) :: log adt} in
                let glv2 := (gs (share adt)) @ lv2_gidx in
                rely (tbl_level (gaux glv2) =? 2);
                rely prop_dec (glock glv2 = None);
                if level =? 3 then
                  (* walk until level 2 *)
                  let adt :=  adt {priv: (priv adt) {wi_llt: lv2_gidx} {wi_index: idx2}} in
                  destroy_table lv2_gidx idx2 rtt_addr rtt_gidx 3 map_addr adt
                else None
              else
                (* level 2 invalid *)
                rely is_int lv2_gidx;
                Some (adt {log: EVT CPU_ID (REL lv1_gidx glv1 {glock: Some CPU_ID}) :: log adt}
                          {priv: (priv adt) {wi_llt: 0} {wi_index: ret_idx}}, VZ64 1)
          else
            (* level 1 invalid *)
            rely is_int lv1_gidx;
            Some (adt {priv: (priv adt) {wi_llt: 0} {wi_index: ret_idx}}, VZ64 1)
    end.

End Spec.


Require Import floyd.proofauto.
Require Import sha.sha.
Require Import sha.SHA256.
Require Import sha.spec_sha.
Require Import sha.sha_lemmas.
Require Import sha.bdo_lemmas.
Require Import sha.verif_sha_bdo2.
Require Import sha.verif_sha_bdo4.
Require Import sha.verif_sha_bdo7.
Require Import sha.verif_sha_bdo8.
Local Open Scope logic.

Lemma exp_prop: forall A P, exp (fun x: A => prop (P x)) = prop (exists x: A, P x).
Proof.
  intros.
  apply pred_ext; normalize.
  + exists x; auto.
  + destruct H as [x ?].
    apply (exp_right x).
    normalize.
Qed.
(* move somewhere else *)

Lemma body_sha256_block_data_order: semax_body Vprog Gtot f_sha256_block_data_order sha256_block_data_order_spec.
Proof.
start_function.
name a_ _a.
name b_ _b.
name c_ _c.
name d_ _d.
name e_ _e.
name f_ _f.
name g_ _g.
name h_ _h.
name l_ _l.
name Ki _Ki.
name in_ _in.
name ctx_ _ctx.
name i_ _i.
name data_ _data.
simpl_stackframe_of.
unfold POSTCONDITION, abbreviate.

remember (hash_blocks init_registers hashed) as regs eqn:Hregs.
assert (Lregs: length regs = 8%nat)
  by (subst regs; apply length_hash_blocks; auto).
assert (Zregs: Zlength regs = 8%Z)
 by (rewrite Zlength_correct; rewrite Lregs; reflexivity).
forward. (* data = in; *)
apply (assert_PROP (isptr data)); [  entailer | intro ].
 normalize.
 match goal with |- semax _ _ ?c _ =>
  eapply seq_assocN with (cs := sequenceN 8 c)
 end.
*
 eapply semax_frame1.
 + eapply sha256_block_load8 with (ctx:=ctx); eassumption.
 + simplify_Delta; reflexivity.
 + rewrite Zregs.
    instantiate (1:=[`(data_at_ Tsh (tarray tuint 16)) (eval_var _X (tarray tuint 16)),
                         `(data_block sh (intlist_to_Zlist b) data),
                         `(K_vector kv)]).
    instantiate (1:=kv).
   entailer!.
 + auto 50 with closed.
*
abbreviate_semax.
simpl.
forward.  (* i = 0; *)
eapply semax_frame_seq
 with (Frame:= [`(array_at tuint Tsh (tuints (hash_blocks init_registers hashed)) 0 8) (eval_id _ctx) ]).
+ replace Delta with Delta_loop1
    by (simplify_Delta; reflexivity).
    simple apply (sha256_block_data_order_loop1_proof
     _ sh b ctx data regs); auto.
    apply Zlength_length in H; auto.
 + rewrite Zregs.
    unfold data_at_, tarray.
    erewrite data_at_array_at; [| reflexivity | omega | reflexivity].
   (* unfold_data_at 1%nat. (* this line should be like this *)*)
        instantiate (1:=kv).
   entailer!.
 + auto 50 with closed.
 +  simpl; abbreviate_semax.
 eapply semax_frame_seq
 with (Frame := [`(array_at tuint Tsh (tuints (hash_blocks init_registers hashed)) 0 8) (eval_id _ctx),
                          `(data_block sh (intlist_to_Zlist b) data)]).
match goal with |- semax _ _ ?c _ =>
  change c with block_data_order_loop2
end.
apply sha256_block_data_order_loop2_proof
              with (regs:=regs)(b:=b); eassumption.
 instantiate (1:=kv).
entailer!.
auto 50 with closed.
abbreviate_semax.
eapply seq_assocN with (cs := add_them_back).
eapply semax_frame1
 with (Frame := [
   `(K_vector kv),
  `(array_at_ tuint Tsh 0 16) (eval_var _X (tarray tuint 16)),
  `(data_block sh (intlist_to_Zlist b) data)]).
apply (add_them_back_proof _ regs (Round regs (nthi b) 63) ctx); try assumption.
apply length_Round; auto.
simplify_Delta; reflexivity.
rewrite <- Hregs.
        instantiate (1:=kv).
entailer!.
auto 50 with closed.
simpl; abbreviate_semax.
unfold POSTCONDITION, abbreviate; clear POSTCONDITION.
replace Delta with (initialized _t Delta_loop1)
 by (simplify_Delta; reflexivity).
clear Delta.
fold (hash_block regs b).
simple apply sha256_block_data_order_return; auto.
Qed.