Require Import CoqlibC.
Require Import SmallstepC.
Require Import Simulation.
Require Import ModSem AsmregsC GlobalenvsC MemoryC ASTC.
Require Import Skeleton SimModSemLift SimMem SimMemLift SimSymb.
Require Import Sound Preservation ModSemProps.

Set Implicit Arguments.

Section MATCHSIMFORWARD.

  Context {SM: SimMem.class} {SS: SimSymb.class SM} {SU: Sound.class}.
  Context {SML: SimMemLift.class SM}.

  Variable msp: ModSemPair.t.
  Variable index: Type.
  Variable order: index -> index -> Prop.
  Hypothesis WFORD: well_founded order.
  Let ms_src: ModSem.t := msp.(ModSemPair.src).
  Let ms_tgt: ModSem.t := msp.(ModSemPair.tgt).
  Variable sidx: Type.
  Hypothesis INHAB: inhabited sidx.
  Variable sound_states: sidx -> Sound.t -> mem -> ms_src.(state) -> Prop.
  Hypothesis PRSV: forall si, local_preservation ms_src (sound_states si).

  Variable match_states: forall
      (idx: index) (st_src0: ms_src.(ModSem.state)) (st_tgt0: ms_tgt.(ModSem.state)) (sm0: SimMem.t),
      Prop.

  Variable match_states_at: forall
      (st_src0: ms_src.(ModSem.state)) (st_tgt0: ms_tgt.(ModSem.state)) (sm_at sm_arg: SimMem.t),
      Prop.

  (* you maintain some kind of `ownership` here. *)
  (* normal ownership: if I alloced, I can free that *)
  (* here: if I freed, I can unfree that *)
  Variable has_footprint: forall
      (st_init_src: ms_src.(ModSem.state)) (st_init_tgt: ms_tgt.(ModSem.state)) (sm0: SimMem.t),
      Prop.

  Variable mle_excl: forall
      (st_init_src: ms_src.(ModSem.state)) (st_init_tgt: ms_tgt.(ModSem.state)) (sm0: SimMem.t) (sm1: SimMem.t),
      Prop.

  Hypothesis FOOTEXCL: forall st_at_src st_at_tgt sm0 sm1 sm2
        (MWF: SimMem.wf sm0)
        (FOOT: has_footprint st_at_src st_at_tgt sm0)
        (MLEEXCL: (mle_excl st_at_src st_at_tgt) sm1 sm2)
        (MLE: SimMem.le sm0 sm1),
        <<MLE: SimMem.le sm0 sm2>>.

  Hypothesis (EXCLPRIV: forall st_init_src st_init_tgt sm0 sm1
                 (MWF: SimMem.wf sm0)
                 (EXCL: mle_excl st_init_src st_init_tgt sm0 sm1),
                 <<LE: SimMem.lepriv sm0 sm1>>).

  Inductive match_states_at_helper
            (idx_at: index) (st_src0: ms_src.(ModSem.state)) (st_tgt0: ms_tgt.(ModSem.state)) (sm_at sm_arg: SimMem.t): Prop :=
  | match_states_at_intro
      (MATCH: match_states idx_at st_src0 st_tgt0 sm_at)
      args_src args_tgt
      (CALLSRC: ms_src.(ModSem.at_external) st_src0 args_src)
      (CALLTGT: ms_tgt.(ModSem.at_external) st_tgt0 args_tgt)
      (SIMARGS: SimMem.sim_args args_src args_tgt sm_arg)
      (MLE: SimMem.le sm_at sm_arg)
      (MWF: SimMem.wf sm_arg)
      (MATCHARG: match_states_at st_src0 st_tgt0 sm_at sm_arg).
      (* (FOOT: has_footprint st_src0 st_tgt0 sm_at) *)

  Hypothesis INITBSIM: forall sm_arg args_src args_tgt st_init_tgt
      (SIMSKENV: ModSemPair.sim_skenv msp sm_arg)
      (MWF: SimMem.wf sm_arg)
      (SIMARGS: SimMem.sim_args args_src args_tgt sm_arg)
      (INITTGT: ms_tgt.(ModSem.initial_frame) args_tgt st_init_tgt)
      (SAFESRC: exists _st_init_src, ms_src.(ModSem.initial_frame) args_src _st_init_src),
      exists st_init_src sm_init idx_init,
        (<<INITSRC: ms_src.(ModSem.initial_frame) args_src st_init_src>>) /\
        (<<MLE: SimMem.le sm_arg sm_init>>) /\
        (<<MATCH: match_states idx_init st_init_src st_init_tgt sm_init>>).

  Hypothesis INITPROGRESS: forall sm_arg args_src args_tgt
      (SIMSKENV: ModSemPair.sim_skenv msp sm_arg)
      (MWF: SimMem.wf sm_arg)
      (SIMARGS: SimMem.sim_args args_src args_tgt sm_arg)
      (SAFESRC: exists st_init_src, ms_src.(ModSem.initial_frame) args_src st_init_src),
      exists st_init_tgt, (<<INITTGT: ms_tgt.(ModSem.initial_frame) args_tgt st_init_tgt>>).

  Hypothesis ATMWF: forall idx0 st_src0 st_tgt0 sm0
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (CALLSRC: ms_src.(ModSem.is_call) st_src0),
      <<MWF: SimMem.wf sm0>>.

  Hypothesis ATFSIM: forall idx0 st_src0 st_tgt0 sm0 args_src
      (SIMSKENV: ModSemPair.sim_skenv msp sm0)
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (CALLSRC: ms_src.(ModSem.at_external) st_src0 args_src)
      (SOUND: forall si, exists su0 m_init, (sound_states si) su0 m_init st_src0),
      exists args_tgt sm_arg,
        (<<CALLTGT: ms_tgt.(ModSem.at_external) st_tgt0 args_tgt>>) /\
        (<<SIMARGS: SimMem.sim_args args_src args_tgt sm_arg>>) /\
        (<<FOOT: has_footprint st_src0 st_tgt0 sm0>>) /\
        (<<MLE: SimMem.le sm0 sm_arg>>) /\
        (<<MWF: SimMem.wf sm_arg>>) /\
        (<<MATCHAT: match_states_at st_src0 st_tgt0 sm0 sm_arg>>).

  Hypothesis AFTERFSIM: forall idx0 st_src0 st_tgt0 sm0 sm_arg sm_ret retv_src retv_tgt st_src1
      (SIMSKENV: ModSemPair.sim_skenv msp sm0)
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (MLE: SimMem.le sm0 sm_arg)
      (* (MWF: SimMem.wf sm_arg) *)
      (MLE: SimMem.le (SimMemLift.lift sm_arg) sm_ret)
      (MWF: SimMem.wf sm_ret)
      (SIMRET: SimMem.sim_retv retv_src retv_tgt sm_ret)
      (AFTERSRC: ms_src.(ModSem.after_external) st_src0 retv_src st_src1)
      (SOUND: forall si, exists su0 m_init, (sound_states si) su0 m_init st_src0)

      (* history *)
      (HISTORY: match_states_at_helper idx0 st_src0 st_tgt0 sm0 sm_arg)

      (* just helpers *)
      (MWFAFTR: SimMem.wf (SimMemLift.unlift sm_arg sm_ret))
      (MLEAFTR: SimMem.le sm_arg (SimMemLift.unlift sm_arg sm_ret)),
      exists sm_after idx1 st_tgt1,
        (<<MLE: mle_excl st_src0 st_tgt0 (SimMemLift.unlift sm_arg sm_ret) sm_after>>) /\
        forall (MLE: SimMem.le sm0 sm_after) (* helper *),
          ((<<AFTERTGT: ms_tgt.(ModSem.after_external) st_tgt0 retv_tgt st_tgt1>>) /\
           (<<MATCH: match_states idx1 st_src1 st_tgt1 sm_after>>)).

  Hypothesis FINALFSIM: forall idx0 st_src0 st_tgt0 sm0 retv_src
      (SIMSKENV: ModSemPair.sim_skenv msp sm0)
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (FINALSRC: ms_src.(ModSem.final_frame) st_src0 retv_src),
      exists sm_ret retv_tgt,
        (<<FINALTGT: ms_tgt.(ModSem.final_frame) st_tgt0 retv_tgt>>) /\
        (<<SIMRET: SimMem.sim_retv retv_src retv_tgt sm_ret>>) /\
        (<<MLE: SimMem.le sm0 sm_ret>>) /\
        (<<MWF: SimMem.wf sm_ret>>).

  Let STEPFSIM idx0 st_src0 st_tgt0 sm0 :=
      (<<RECEP: receptive_at ms_src st_src0>>) /\
      (<<STEPFSIM: forall tr st_src1
             (STEPSRC: Step ms_src st_src0 tr st_src1) ,
             exists st_src2 idx1 st_tgt1 sm1,
               (<<STARSRC: Star ms_src st_src1 nil st_src2>>) /\
               (<<PLUS: DPlus ms_tgt st_tgt0 tr st_tgt1>> \/
                           <<STAR: DStar ms_tgt st_tgt0 tr st_tgt1 /\ order idx1 idx0>>)
               /\ (<<MLE: SimMem.le sm0 sm1>>)
               (* Note: We require le for mle_preserves_sim_ge, but we cannot require SimMem.wf, beacuse of DCEproof *)
               /\ (<<MATCH: match_states idx1 st_src2 st_tgt1 sm1>>)>>).

  Let STEPBSIM idx0 st_src0 st_tgt0 sm0 :=
      (<<PROGRESS: safe_modsem ms_src st_src0 -> ModSem.is_step ms_tgt st_tgt0>>) /\
      (<<STEPBSIM: forall tr st_tgt1
             (STEPTGT: Step ms_tgt st_tgt0 tr st_tgt1) ,
             exists idx1 st_src1 sm1,
               (<<PLUS: Plus ms_src st_src0 tr st_src1>> \/
                           <<STAR: Star ms_src st_src0 tr st_src1 /\ order idx1 idx0>>)
               /\ (<<MLE: SimMem.le sm0 sm1>>)
               (* Note: We require le for mle_preserves_sim_ge, but we cannot require SimMem.wf, beacuse of DCEproof *)
               /\ (<<MATCH: match_states idx1 st_src1 st_tgt1 sm1>>)>>).

  Hypothesis STEPSIM: forall idx0 st_src0 st_tgt0 sm0
      (SIMSKENV: ModSemPair.sim_skenv msp sm0)
      (NOTCALL: ~ ModSem.is_call ms_src st_src0)
      (NOTRET: ~ ModSem.is_return ms_src st_src0)
      (MATCH: match_states idx0 st_src0 st_tgt0 sm0)
      (SOUND: forall si, exists su0 m_init, (sound_states si) su0 m_init st_src0),
      STEPFSIM idx0 st_src0 st_tgt0 sm0 \/ STEPBSIM idx0 st_src0 st_tgt0 sm0.

  Hypothesis BAR: bar_True.

  Lemma match_states_lxsim
        i0 st_src0 st_tgt0 sm0
        (SIMSKENV: ModSemPair.sim_skenv msp sm0)
        (* (MWF: SimMem.wf sm0) *)
        (* (MCOMPAT: mem_compat st_src0 st_tgt0 sm0) *)
        (MATCH: match_states i0 st_src0 st_tgt0 sm0):
        (* su0 *)
      (* <<LXSIM: lxsim ms_src ms_tgt (sound_state su0) sm_init i0.(to_idx WFORD) st_src0 st_tgt0 sm0>> *)
      <<LXSIM: lxsimL ms_src ms_tgt (fun st => forall si, exists su0 m_init, sound_states si su0 m_init st)
                      has_footprint mle_excl
                      (Ord.lift_idx (wf_lex_ord WFORD lt_wf) (i0, 1%nat)) st_src0 st_tgt0 sm0>>.
  Proof.
    (* move su0 at top. *)
    revert_until BAR. pcofix CIH. i. pfold. ii.
    generalize (classic (ModSem.is_call ms_src st_src0)). intro CALLSRC; des.
    { (* CALL *)
      - (* u in CALLSRC. des. *)
        exploit ATMWF; eauto. i; des. ii. eapply lxsim_at_external; eauto. ii. clear CALLSRC.
        exploit ATFSIM; eauto. { ii. eapply SUSTAR; eauto. eapply star_refl. } i; des.
        (* determ_tac ModSem.at_external_dtm. clear_tac. *)
        esplits; eauto. i. exploit AFTERFSIM; try apply SAFESRC; try apply SIMRET; eauto.
        { ii. eapply SUSTAR. eapply star_refl. }
        { econs; eauto. }
        { eapply SimMemLift.unlift_wf; eauto. }
        { eapply SimMemLift.lift_spec; eauto. }
        i; des.
        assert(MLE3: SimMem.le sm0 sm_after).
        { eapply FOOTEXCL; et. etrans; et. eapply SimMemLift.lift_spec; et. }
        spc H1. des. esplits; eauto. right.
        eapply CIH; [..|eauto].
        { eapply ModSemPair.mfuture_preserves_sim_skenv; try apply SIMSKENV; eauto.
          apply rtc_once. left. et.
        }
    }
    generalize (classic (ModSem.is_return ms_src st_src0)). intro RETSRC; des.
    { (* RETURN *)
      u in RETSRC. des. exploit FINALFSIM; eauto. i; des. ii.
      eapply lxsim_final; try apply SIMRET; eauto.
    }
    exploit STEPSIM; eauto. { ii. eapply SUSTAR; eauto. eapply star_refl. } clear STEPSIM. intro STEPSIM.
    destruct STEPSIM as [STEPFSIM0|STEPBSIM0].
    { eapply lxsim_step_forward; eauto. i.
      r in STEPFSIM0. des.
      esplits; eauto. econs 1; eauto. ii. exploit STEPFSIM1; eauto. i; des_safe. esplits; eauto.
      - des.
        + left. eauto.
        + right. esplits; eauto. eapply Ord.lift_idx_spec; eauto. econs 1; eauto.
      - left. pfold. ii. eapply lxsim_step_backward; eauto. ii.
        econs 2; eauto.
        { esplits; eauto. eapply Ord.lift_idx_spec; eauto. econs 2; eauto. }
        { refl. }
        right. eapply CIH; [..|eauto].
        { eapply ModSemPair.mfuture_preserves_sim_skenv; try apply SIMSKENV; eauto. apply rtc_once; eauto. }
    }
    { rr in STEPBSIM0.
      eapply lxsim_step_backward; eauto. ii. des.
      econs 1; eauto.
      - ii. exploit STEPBSIM1; eauto. i; des_safe. esplits; eauto.
        + des.
          * left. eauto.
          * right. esplits; eauto. eapply Ord.lift_idx_spec; eauto. econs 1; eauto.
        + right. eapply CIH; [..|eauto].
          { eapply ModSemPair.mfuture_preserves_sim_skenv; try apply SIMSKENV; eauto. apply rtc_once; eauto. }
      - eapply PROGRESS; eauto.
    }
  Qed.

  Theorem match_states_sim: <<SIM: msp.(ModSemPair.sim)>>.
  Proof.
    eapply sim_mod_sem_implies; et. inv INHAB. econs; eauto.
    { i. eapply local_preservation_noguarantee_weak; eauto. }
    ii; ss. folder.
    exploit SimSymb.sim_skenv_func_bisim; eauto. { apply SIMSKENV. } intro FSIM; des.
    inv FSIM. exploit FUNCFSIM; eauto. { apply SimMem.sim_args_sim_fptr; et. } i; des.
    split; ii.
    - exploit INITBSIM; eauto. i; des.
      esplits; eauto.
      eapply match_states_lxsim; eauto.
      { eapply ModSemPair.mfuture_preserves_sim_skenv; try apply SIMSKENV; eauto. apply rtc_once; eauto. }
    - exploit INITPROGRESS; eauto.
  Unshelve.
    all: ss.
  Qed.

End MATCHSIMFORWARD.


Require Import RelationClasses.
Require Import List.

Require Import sflib.
From Paco Require Import paco.

Require Import Basic.
Require Import Axioms.
Require Import Loc.
Require Import Coqlib.
Require Import LibTactics.
Require Import Integers.
Require Import Language.
Require Import ZArith.
Require Import Maps.
Require Import FSets.
Require Import FSetInterface.
Require Import Lattice.
Require Import Event.
Require Import Syntax.
Require Import Semantics.

Require Import Kildall.
Require Import CorrectOpt.

Require Import Language.
Require Import Time.
Require Import Event.
Require Import View.
Require Import Cell.
Require Import Memory.
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.
Require Import WFConfig.
Require Import MsgMapping.
Require Import DelaySet.
Require Import LocalSim.
Require Import MemoryMerge.

Require Import CompAuxDef.
Require Import MemoryProps.
Require Import promiseCertifiedAux.
Require Import ConsistentProp.
Require Import Mem_at_eq_lemmas.
Require Import ConsistentStableEnv.
Require Import ConsistentLemmas.

Require Import DetLoop.
Require Import LICM.
Require Import Lib_Step.
Require Import LICMProofMState.
Require Import LICMProofStep.
Require Import CSEProof.

(** * Correctness Proof of Loop Invariant Code Motion *)
(** ** Well-Formed Invariant *)
(** The invariant [I_linv] is well-formed. *)
Lemma WF_I_linv: wf_I I_linv.
Proof.
  unfold wf_I. ii.
  destruct S; ss. des.
  econs; eauto; subst.
  - ii. unfold spec_inj. rewrite MSG.
    inv MEM_LE. exploit COMPLETE; eauto. i. des1.
    do 3 eexists. splits; eauto.
  - ii. unfold spec_inj in *. destruct (Memory.get loc t T_MEM) eqn:Heqe; ss.
    destruct p. destruct t1; ss. inv INJ.
    inv MEM_LE. exploit COMPLETE; eauto.
  - unfold spec_inj; ii.
    destruct (Memory.get loc t1 T_MEM) eqn:Heqe1; ss. destruct p. destruct t0; ss. inv INJ1.
    destruct (Memory.get loc t2 T_MEM) eqn:Heqe2; ss. destruct p. destruct t1; ss. inv INJ2.
    eauto.
Qed.

Lemma I_linv_hold_init
      lo:
  I_linv lo inj_init (Build_Rss TimeMap.bot Memory.init TimeMap.bot Memory.init).
Proof.
  econs; eauto. eapply mem_id_le_identity; eauto.
  split. eapply View.TimeMap.le_PreOrder_obligation_1; eauto.
  eapply functional_extensionality. ii.
  eapply functional_extensionality. ii.
  unfold inj_init, spec_inj.
  des_if; subst. unfold Memory.init. ss.
  unfold Memory.init; ss. unfold Memory.get.
  rewrite Cell.init_get. des_if; eauto.
  ss.
Qed.

Lemma match_state_implies_SI
      inj lo b
      state_tgt lc_tgt sc_tgt mem_tgt
      state_src lc_src sc_src mem_src
      (MATCH_STATE: match_state_linv inj lo b
                                     (Thread.mk rtl_lang state_tgt lc_tgt sc_tgt mem_tgt)
                                     (Thread.mk rtl_lang state_src lc_src sc_src mem_src)):
  SI inj lo (state_tgt, lc_tgt, mem_tgt) (state_src, lc_src, mem_src) (@dset_init nat).
Proof.
  inv MATCH_STATE; ss. do 2 des1.
  assert (INCR_INJ: incr_inj inj inj').
  {
    des; subst. unfold incr_inj; ii; eauto.
    unfold incr_inj; ii; eauto.
  }
  clear ATM_BIT.
  econs; eauto; ss.
  - ii. unfold incr_inj in INCR_INJ. exploit INCR_INJ; eauto.
    ii. subst. unfold spec_inj in H1.
    destruct (Memory.get loc t mem_tgt) eqn:GET_MEM; ss.
    destruct p. destruct t1; ss. inv H1.
    clear - TVIEW_LE H0. inv TVIEW_LE.
    inv CUR. unfold TimeMap.le in RLX.
    specialize (RLX loc).
    auto_solve_time_rel.
  - exists (@dset_init nat). split.
    ii. rewrite dset_gempty in H; ss.
    econs; eauto.
    ii. rewrite dset_gempty in H; ss.
    ii. exploit PRM_INDOM; eauto. ii; des1.
    exploit INCR_INJ; eauto. ii; subst.
    unfold spec_inj in H1.
    destruct (Memory.get loc t mem_tgt) eqn:GET; ss.
    destruct p. destruct t1; ss. inv H1.
    exists to' f val R. split; eauto.
    ii. exploit PRM_INDOM; eauto. ii; des.
    assert (t' = to').
    {
      eapply INCR_INJ in H0. subst.
      exploit spec_inj_identity_inj; eauto.
    }
    subst.
    exists to'. splits; eauto.
  - subst.
    eapply mem_id_le_2_mem_at_eq; eauto.
Qed.

Lemma match_state_linv_implies_sim:
  forall inj lo b
    state_tgt lc_tgt sc_tgt mem_tgt
    state_src lc_src sc_src mem_src
    (MATCH_STATE: match_state_linv inj lo b
                                   (Thread.mk rtl_lang state_tgt lc_tgt sc_tgt mem_tgt)
                                   (Thread.mk rtl_lang state_src lc_src sc_src mem_src)),
    @local_sim_state nat lt rtl_lang I_linv lo inj dset_init b
                     (Thread.mk rtl_lang state_tgt lc_tgt sc_tgt mem_tgt)
                     (Thread.mk rtl_lang state_src lc_src sc_src mem_src).
Proof.
  cofix COFIX_HP.
  introv MATCH_STATE.
  destruct (classic (Local.promise_consistent lc_tgt)) as [PROMS_CONS | NOT_PROM_CONS].
  2: {
    eapply local_sim_state_tgt_not_prm_consistent_intro; eauto.
  }
  assert (CONS_SRC: Local.promise_consistent lc_src).
  {
    clear - MATCH_STATE PROMS_CONS. inv MATCH_STATE; ss.
    clear - PROMS_CONS TVIEW_LE. unfold Local.promise_consistent in *; ss.
    ii. exploit PROMS_CONS; eauto. i.
    inv TVIEW_LE. inv CUR; ss. unfold TimeMap.le in *; ss.
    specialize (RLX loc).
    auto_solve_time_rel.
  }
  destruct (classic (Thread.is_abort (Thread.mk rtl_lang state_src lc_src sc_src mem_src) lo)).
  eapply local_sim_state_abort_intro; eauto.

  eapply local_sim_state_step_intro.
  - eapply match_state_implies_SI; eauto.
  - introv THRD_STEP. splits.
    {
      (* atomic or out step *)
      introv THRD_AT_OR_OUT.
      destruct lc_tgt as (tview_tgt & prm_tgt).
      destruct lc_src as (tview_src & prm_src).
      destruct e_tgt'.
      renames state to state_tgt', local to lc_tgt', sc to sc_tgt', memory to mem_tgt'.
      destruct lc_tgt' as (tview_tgt' & prm_tgt').
      eapply atomic_or_out_step_case in THRD_STEP; eauto. des.
      do 4 eexists.
      split. eauto. split. eauto.
      split. eauto. split. eapply COFIX_HP; eauto.
      eauto.
    }
    {
      (* non-atomic step *)
      introv NA_STEP. destruct te; ss.
      + (* silent *)
        inv THRD_STEP; ss. inv STEP.
        destruct lc_tgt as (tview_tgt & prm_tgt).
        destruct lc_src as (tview_src & prm_src).
        destruct e_tgt'.
        renames state to state_tgt', local to lc_tgt', sc to sc_tgt', memory to mem_tgt'.
        destruct lc_tgt' as (tview_tgt' & prm_tgt').
        eapply silent_step_case in STEP; eauto. des; tryfalse.
        eexists. exists (@dset_init nat) (@dset_init nat) (@dset_init nat).
        splits.
        {
          eapply dset_become_na_read. ii; ss. eauto.
        }
        {
          eapply Thread_na_steps_to_na_steps_dset; eauto.
        }
        {
          econs. introv DSET_GET. rewrite dset_gempty in DSET_GET. tryfalse.
          introv DSET_GET. rewrite dset_gempty in DSET_GET. tryfalse.
        }
        {
          eapply COFIX_HP; eauto.
        }
      + (* non-atomic read *)
        destruct ord; tryfalse.
        inv THRD_STEP; ss. inv STEP.
        destruct lc_tgt as (tview_tgt & prm_tgt).
        destruct lc_src as (tview_src & prm_src).
        destruct e_tgt'.
        renames state to state_tgt', local to lc_tgt', sc to sc_tgt', memory to mem_tgt'.
        destruct lc_tgt' as (tview_tgt' & prm_tgt').
        eapply na_read_step_case in STEP; eauto.
        des.
        eexists. exists (@dset_init nat) (@dset_init nat) (@dset_init nat).
        splits.
        {
          eapply dset_become_na_read. ii; ss. eauto.
        }
        {
          eapply Thread_na_steps_to_na_steps_dset; eauto.
        }
        {
          econs. introv DSET_GET. rewrite dset_gempty in DSET_GET. tryfalse.
          introv DSET_GET. rewrite dset_gempty in DSET_GET. tryfalse.
        }
        {
          eapply COFIX_HP; eauto.
        }
      + (* non-atomic write *)
        destruct ord; tryfalse.
        inv THRD_STEP; ss. inv STEP.
        destruct lc_tgt as (tview_tgt & prm_tgt).
        destruct lc_src as (tview_src & prm_src).
        destruct e_tgt'.
        renames state to state_tgt', local to lc_tgt', sc to sc_tgt', memory to mem_tgt'.
        destruct lc_tgt' as (tview_tgt' & prm_tgt').
        eapply na_write_step_case in STEP; eauto.
        des.
        do 2 eexists. exists (@dset_init nat) (@dset_init nat).
        splits.
        {
          econs; eauto.
        }
        {
          instantiate (2 := 5%nat).
          eapply Operators_Properties.clos_rt1n_step.
          eapply na_steps_dset_write. eapply STEP.
          right. exists to. rewrite dset_remove_add; eauto.
        }
        {
          econs. introv DSET_GET. rewrite dset_gempty in DSET_GET. tryfalse.
          introv DSET_GET. rewrite dset_gempty in DSET_GET. tryfalse.
        }
        {
          eapply COFIX_HP; eauto.
        }
    }
    {
      (* promise step *)
      introv PROM_STEP. ii; subst.
      destruct lc_tgt as (tview_tgt & prm_tgt).
      destruct lc_src as (tview_src & prm_src).
      destruct e_tgt'.
      renames state to state_tgt', local to lc_tgt', sc to sc_tgt', memory to mem_tgt'.
      destruct lc_tgt' as (tview_tgt' & prm_tgt').
      eapply promise_step_case in THRD_STEP; eauto. clear PROM_STEP.
      des.
      do 2 eexists. split. eauto. split. eauto.
      eapply COFIX_HP. eauto.
    }
    {
      (* pf promise step *)
      introv PF_PROM_STEP. ii; subst.
      destruct lc_tgt as (tview_tgt & prm_tgt).
      destruct lc_src as (tview_src & prm_src).
      destruct e_tgt'.
      renames state to state_tgt', local to lc_tgt', sc to sc_tgt', memory to mem_tgt'.
      destruct lc_tgt' as (tview_tgt' & prm_tgt').
      eapply pf_promise_step_case in THRD_STEP; eauto.
      des.
      eexists. split; eauto.
    }
  - ii; subst.
    split.
    {
      clear - MATCH_STATE. inv MATCH_STATE. destruct ATM_BIT.
      destruct H; tryfalse. destruct H; subst. eauto.
    }
    {
      introv RELY INV.
      destruct lc_tgt as (tview_tgt & prm_tgt).
      destruct lc_src as (tview_src & prm_src).
      eapply rely_step_case in RELY; eauto.
    }
  - introv THRD_DONE.
    destruct lc_tgt as (tview_tgt & prm_tgt).
    destruct lc_src as (tview_src & prm_src).
    lets MATCH_STATE': MATCH_STATE.
    eapply done_step_case in MATCH_STATE; eauto. des.
    eexists. exists inj'.
    splits; eauto.
  - introv THRD_ABORT.
    destruct lc_tgt as (tview_tgt & prm_tgt).
    destruct lc_src as (tview_src & prm_src).
    lets MATCH_STATE': MATCH_STATE.
    eapply abort_step_case in MATCH_STATE; eauto.
Qed.

(** ** Correctness of the Loop Invariant Code Motion *)
(** [LInv] is verified. *)
Theorem verif_linv:
  forall code_s code_t lo,
      LInv lo code_s = Some code_t
      ->
      @local_sim nat lt rtl_lang I_linv lo code_t code_s.
Proof.
  ii. econs.
  - (* well_founded index *)
    eapply nat_lt_is_well_founded.
  - (* well-formed I_linv *)
    eapply WF_I_linv; eauto.
  - (* I_linv holds in initial state *)
    eapply I_linv_hold_init; eauto.
  - (* local simulation *)
    introv TGT_INIT.
    unfold Language.init in *; ss.
    unfold State.init in *; ss.
    destruct (code_t ! fid) eqn:FUNC_T; ss. destruct f; ss.
    renames c to cdhp_t. renames f to l_t.
    destruct (cdhp_t ! l_t) eqn:ENTRY_BB_T; ss. inv TGT_INIT; ss.
    unfold LInv in H. inv H.
    rewrite PTree.gmap in FUNC_T. unfold option_map in FUNC_T.
    destruct (code_s ! fid) eqn:SCODE_GET; ss.
    unfold det_loop_invs in FUNC_T.
    rewrite PTree.gmap in FUNC_T. unfold option_map in FUNC_T.
    rewrite SCODE_GET in FUNC_T. inv FUNC_T.
    destruct f as (cdph_s & l_s). renames t to BB_t.
    destruct (cdph_s ! l_s) eqn:CDHP_S.
    {
      renames t to BB_s.
      eapply transC_prop in H0; eauto.
      2: {  instantiate (1 := lo). right. exists BB_s. split; eauto. }
      do 7 des1.
      eexists. split; eauto.
      eapply match_state_linv_implies_sim.
      econs; eauto.
      {
        eapply I_linv_hold_init; eauto.
      }
      {
        econs; eauto. 2: { econs; eauto. }
        des1.
        {
          des1.
          rewrite CDHP_S in GET_BB_S. symmetry in GET_BB_S. inv GET_BB_S.
          eapply EXEC_NOT_PH; eauto.
          unfold det_loop_invs.
          rewrite PTree.gmap. unfold option_map. rewrite SCODE_GET.
          rewrite CDHP_S. eauto.
          ii. eapply reg_in_blk_in_cdhp; eauto.
        }
        {
          des1.
          eapply EXEC_PH with (f := fid); eauto.
          unfold det_loop_invs.
          rewrite PTree.gmap. unfold option_map.
          rewrite SCODE_GET. rewrite CDHP_S. eauto.
        }
      }
      {
        eapply TView.TView.le_PreOrder_obligation_1; eauto.
      }
      {
        ii. rewrite Memory.bot_get in H. ss.
      }
      {
        eapply Local.wf_init; eauto.
      }
      {
        unfold Memory.closed_timemap. ii.
        unfold TimeMap.bot.
        unfold Memory.get, Memory.init.
        rewrite Cell.init_get. des_if; ss; eauto.
        unfold Message.elt. eauto.
      }
      {
        eapply Memory.init_closed; eauto.
      }
      {
        eapply Local.wf_init; eauto.
      }
      {
        unfold Memory.closed_timemap. ii.
        unfold TimeMap.bot.
        unfold Memory.get, Memory.init.
        rewrite Cell.init_get. des_if; ss; eauto.
        unfold Message.elt. eauto.
      }
      {
        eapply Memory.init_closed; eauto.
      }
    }
    {
      ss.
      assert (GET_EMPTY: (PTree.empty positive) ! l_s = None).
      rewrite PTree.gempty. eauto.
      rewrite GET_EMPTY in H0; ss. inv H0. tryfalse.
    }
Qed.

(** Loop invariant code motion optimizer is correct. *)
Theorem correct_licm:
  Correct licm.
Proof.
  unfold licm.
  eapply correct_optimizer_transitive; eauto.
  eapply correct_cse; eauto.
  eapply Verif_implies_Correctness.
  unfolds Verif. intros. exists I_linv nat lt.
  eapply verif_linv; eauto.
Qed.


Require Import FunInd.
Require Import Zwf CoqlibC Maps Integers Floats Lattice.
Require Import Compopts AST.
Require Import Values MemoryC Globalenvs Events.
Require Import Registers RTL.
Require Import sflib.
(** newly added **)
Require Export ValueDomain.
Require Import Skeleton.
Require Import Sound UnreachC.
Require Import ModSem.

(* TODO: remove redundancy, move it to ValueDomain maybe *)
Definition bc2su (bc: block_classification) (ge_nb: block) (nb: block): Unreach.t :=
  Unreach.mk (fun blk => if plt blk nb then block_class_eq (bc blk) BCinvalid else false) ge_nb nb.

Lemma sound_state_sound_args
      bc m0 p skenv_link vs_arg rm (ge: genv)
      (GENV: ge = (SkEnv.revive (SkEnv.project skenv_link (Sk.of_program fn_sig p)) p))
      (ARGS: forall v : val, In v vs_arg -> vmatch bc v Vtop)
      (RO: romatch bc m0 rm)
      (MM: mmatch bc m0 mtop)
      (GE: genv_match bc ge)
      (NOSTK: forall b, bc b <> BCstack)
      fptr_arg sg_arg
      (SIG: exists skd, Genv.find_funct skenv_link fptr_arg = Some skd /\ Sk.get_csig skd = sg_arg):
    args' (bc2su bc ge.(Genv.genv_next) m0.(Mem.nextblock)) (Args.mk fptr_arg vs_arg m0).
Proof.
  { r. s. esplits; eauto.
    - des. unfold Genv.find_funct, Genv.find_funct_ptr in *. des_ifs. ss. r. ii; clarify. ss.
      r in GE. des. specialize (GE0 blk). exploit GE0; eauto.
      { ss. eapply Genv.genv_defs_range; eauto. }
      i; des.
      (* exploit sound_stack_unreach_compat; eauto. intro CPT. des. *)
      (* inv SU. ss. *)
      esplits; eauto.
      + ii. des_ifs. des_sumbool. congruence.
      + inv MM. eapply mmatch_below; eauto. rewrite H; ss.
    - rewrite Forall_forall. i. spcN 1 ARGS. spc ARGS. ii; clarify.
      assert(BCV: bc blk <> BCinvalid).
      { inv ARGS; ss. inv H1; ss. }
      esplits; eauto.
      + u. ii. des_ifs. des_sumbool. ss.
      + inv MM. eapply mmatch_below; eauto.
    - inv MM. econs; eauto.
      + ii. clarify.
        assert(BCV: bc blk <> BCinvalid).
        { u in PUB. ii. rewrite H in *. ss. exploit Mem.perm_valid_block; eauto. i; des. des_ifs. }
        assert(BCV0: bc blk0 <> BCinvalid).
        {
          exploit mmatch_top; eauto.
          (* spcN 0%nat mmatch_top. spc mmatch_top. inv mmatch_top. *)
          intro SM. inv SM.
          specialize (H0 ofs%Z blk0 ofs0 q n).
          exploit H0.
          { eapply Mem_loadbytes_succeeds; et. }
          intro PM.
          inv PM. ss.
        }
        esplits; eauto.
        { u. des_ifs. i; des_sumbool; ss. }
        s. eapply mmatch_below; eauto.
      + u. ii. des_ifs.
      + ss. r in GE. ss. des. r in mmatch_below.
        apply NNPP. ii. apply Pos.lt_nle in H.
        exploit GE0; eauto. i; des.
        exploit mmatch_below; eauto. { rewrite H0; ss. } i; des. xomega.
    - econs; ss; i; des_ifs. r in GE. des. ss. des_sumbool. apply NNPP. ii.
      exploit (GE0 x0); eauto. { xomega. } i; des. congruence.
  }
Qed.

(* copied from above *)
Lemma sound_state_sound_retv
      bc m_ret p skenv_link v_ret rm (ge: genv)
      (GENV: ge = (SkEnv.revive (SkEnv.project skenv_link (Sk.of_program fn_sig p)) p))
      (RES: vmatch bc v_ret Vtop)
      (RO: romatch bc m_ret rm)
      (MM: mmatch bc m_ret mtop)
      (GE: genv_match bc ge)
      (NOSTK: forall b, bc b <> BCstack):
    Sound.retv (bc2su bc ge.(Genv.genv_next) m_ret.(Mem.nextblock)) (Retv.mk v_ret m_ret).
Proof.
  { r. s. esplits; eauto.
    - ii; clarify.
      assert(BCV: bc blk <> BCinvalid).
      { inv RES; ss. inv H0; ss. }
      esplits; eauto.
      + u. ii. des_ifs. des_sumbool. ss.
      + inv MM. eapply mmatch_below; eauto.
    - inv MM. econs; eauto.
      + ii. clarify.
        assert(BCV: bc blk <> BCinvalid).
        { u in PUB. ii. rewrite H in *. ss. exploit Mem.perm_valid_block; eauto. i; des. des_ifs. }
        assert(BCV0: bc blk0 <> BCinvalid).
        {
          exploit mmatch_top; eauto.
          (* spcN 0%nat mmatch_top. spc mmatch_top. inv mmatch_top. *)
          intro SM. inv SM.
          specialize (H0 ofs blk0 ofs0 q n).
          exploit H0.
          { eapply Mem_loadbytes_succeeds; et. }
          intro PM. inv PM. ss.
        }
        esplits; eauto.
        { u. des_ifs. i; des_sumbool; ss. }
        s. eapply mmatch_below; eauto.
      + u. ii. des_ifs.
      + ss. r in GE. ss. des. r in mmatch_below.
        apply NNPP. ii. apply Pos.lt_nle in H.
        exploit GE0; eauto. i; des.
        exploit mmatch_below; eauto. { rewrite H0; ss. } i; des. xomega.
    - econs; eauto; ss; i; des_ifs. des_sumbool.
      rr in GE. des. apply NNPP. ii.
      exploit (GE0 x0); eauto.
      { unfold fundef in *. xomega. }
      i; des. congruence.
  }
Qed.


(* *********************************************************************)
(*                                                                     *)
(*            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.                                  *)
(*                                                                     *)
(* *********************************************************************)
(* *********************************************************************)
(*                                                                     *)
(*          Low Level Specification                                    *)
(*                                                                     *)
(*          Ronghui Gu <ronghui.gu@yale.edu>                           *)
(*                                                                     *)
(*          Yale Flint Group                                           *)
(*                                                                     *)
(* *********************************************************************)
(** This file provide the contextual refinement proof between MBoot layer and MALInit layer*)
Require Import Coqlib.
Require Import Errors.
Require Import AST.
Require Import Integers.
Require Import Floats.
Require Import Op.
Require Import Asm.
Require Import Events.
Require Import Globalenvs.
Require Import Smallstep.
Require Import Values.
Require Import Memory.
Require Import Maps.
Require Import AuxLemma.
Require Import FlatMemory.
Require Import AuxStateDataType.
Require Import Constant.
Require Import GlobIdent.
Require Import RealParams.
Require Import AsmImplLemma.
Require Import GenSem.
Require Import PrimSemantics.
Require Import Conventions.

Require Import liblayers.logic.PTreeModules.
Require Import liblayers.logic.LayerLogicImpl.
Require Import liblayers.compcertx.Stencil.
Require Import liblayers.compcertx.MakeProgram.
Require Import liblayers.compat.CompatLayers.
Require Import liblayers.compat.CompatGenSem.
Require Import compcert.cfrontend.Ctypes.
Require Import AbstractDataType.

Require Import PIPC.

Local Open Scope string_scope.
Local Open Scope error_monad_scope.
Local Open Scope Z_scope.

(** * Definition of the refinement relation*)
Section Refinement.

  Context `{real_params: RealParams}.

  Notation LDATA := RData.

  Notation LDATAOps := (cdata LDATA).

  Inductive elf_load_spec_low_step `{StencilOps} `{Mem.MemoryModelOps} `{UseMemWithData mem}:
    sprimcall_sem (mem := mwd LDATAOps):=
  | elf_load_spec_low_intro s (m'0: mwd LDATAOps) n be ofse sig rs b:
      find_symbol s elf_load = Some b ->
      rs PC = Vptr b Int.zero ->
      (exists elf_id, find_symbol s elf_id = Some be) ->
      sig = mksignature (AST.Tint::AST.Tint::nil) None cc_default ->
      extcall_arguments rs m'0 sig (Vptr be ofse :: Vint n :: nil)  ->
      asm_invariant (mem := mwd LDATAOps) s rs m'0 ->
      elf_load_spec_low_step s rs m'0 (rs#RA<- Vundef#PC <- (rs#RA)) m'0.

  Inductive uctx_get_spec_low_step `{StencilOps} `{Mem.MemoryModelOps} `{UseMemWithData mem}:
    sextcall_sem (mem := mwd LDATAOps) :=
    uctx_get_spec_low_intro s (WB: _ -> Prop) (m'0: mwd LDATAOps) b0 n ofs v:
      find_symbol s UCTX_LOC = Some b0 ->
      Mem.load Mint32 m'0 b0 ((Int.unsigned n) * UCTXT_SIZE * 4 + Int.unsigned ofs * 4) = Some (Vint v) ->
      0 <= (Int.unsigned n) < num_proc ->
      is_UCTXT_ptr (Int.unsigned ofs) = false ->
      kernel_mode (snd m'0) ->
      uctx_get_spec_low_step s WB (Vint n :: Vint ofs :: nil) m'0 (Vint v) m'0.

  Inductive uctx_set_spec_low_step `{StencilOps} `{Mem.MemoryModelOps} `{UseMemWithData mem}:
    sextcall_sem (mem := mwd LDATAOps) :=
    uctx_set_spec_low_intro s (WB: _ -> Prop) (m'0 m0: mwd LDATAOps) b0 n ofs v:
      find_symbol s UCTX_LOC = Some b0 ->
      Mem.store Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + Int.unsigned ofs * 4) (Vint v) = Some m0 ->
      0 <= (Int.unsigned n) < num_proc ->
      is_UCTXT_ptr (Int.unsigned ofs) = false ->
      kernel_mode (snd m'0) ->
      uctx_set_spec_low_step s WB (Vint n :: Vint ofs :: Vint v :: nil) m'0 Vundef m0.

  Inductive uctx_set_eip_spec_low_step `{StencilOps} `{Mem.MemoryModelOps} `{UseMemWithData mem}:
    sextcall_sem (mem := mwd LDATAOps) :=
    uctx_set_eip_spec_low_intro s (WB: _ -> Prop) (m'0 m0: mwd LDATAOps) b0 n bf ofs:
      find_symbol s UCTX_LOC = Some b0 ->
      Mem.store Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_EIP * 4) (Vptr bf ofs) = Some m0 ->
      0 <= (Int.unsigned n) < num_proc ->
      (exists fun_id, find_symbol s fun_id = Some bf) ->
      kernel_mode (snd m'0) ->
      uctx_set_eip_spec_low_step s WB (Vint n :: Vptr bf ofs :: nil) m'0 Vundef m0.

  Inductive save_uctx_spec_low_step `{StencilOps} `{Mem.MemoryModelOps} `{UseMemWithData mem}:
    sextcall_sem (mem := mwd LDATAOps) :=
    save_uctx_spec_low_intro s (WB: _ -> Prop)
                             (m0 m1 m2 m3 m4 m5 m6 m7 m8 m9 m10 m11 m12 m13 m14
                                 m15 m16 m17: mwd LDATAOps)
                             u0 u1 u2 u3 u4 u5 u6 u7 u8 u9 u10 u11 u12 u13 u14 u15 u16 b1 n:
      find_symbol s UCTX_LOC = Some b1 ->
      Mem.store Mint32 m0 b1 (UCTXT_SIZE * 4 * n + 4 * U_EDI) (Vint u0) = Some m1 ->
      Mem.store Mint32 m1 b1 (UCTXT_SIZE * 4 * n + 4 * U_ESI) (Vint u1) = Some m2 ->
      Mem.store Mint32 m2 b1 (UCTXT_SIZE * 4 * n + 4 * U_EBP) (Vint u2) = Some m3 ->
      Mem.store Mint32 m3 b1 (UCTXT_SIZE * 4 * n + 4 * U_OESP) (Vint u3) = Some m4 ->
      Mem.store Mint32 m4 b1 (UCTXT_SIZE * 4 * n + 4 * U_EBX) (Vint u4) = Some m5 ->
      Mem.store Mint32 m5 b1 (UCTXT_SIZE * 4 * n + 4 * U_EDX) (Vint u5) = Some m6 ->
      Mem.store Mint32 m6 b1 (UCTXT_SIZE * 4 * n + 4 * U_ECX) (Vint u6) = Some m7 ->
      Mem.store Mint32 m7 b1 (UCTXT_SIZE * 4 * n + 4 * U_EAX) (Vint u7) = Some m8 ->
      Mem.store Mint32 m8 b1 (UCTXT_SIZE * 4 * n + 4 * U_ES) (Vint u8) = Some m9 ->
      Mem.store Mint32 m9 b1 (UCTXT_SIZE * 4 * n + 4 * U_DS) (Vint u9) = Some m10 ->
      Mem.store Mint32 m10 b1 (UCTXT_SIZE * 4 * n + 4 * U_TRAPNO) (Vint u10) = Some m11 ->
      Mem.store Mint32 m11 b1 (UCTXT_SIZE * 4 * n + 4 * U_ERR) (Vint u11) = Some m12 ->
      Mem.store Mint32 m12 b1 (UCTXT_SIZE * 4 * n + 4 * U_EIP) (Vint u12) = Some m13 ->
      Mem.store Mint32 m13 b1 (UCTXT_SIZE * 4 * n + 4 * U_CS) (Vint u13) = Some m14 ->
      Mem.store Mint32 m14 b1 (UCTXT_SIZE * 4 * n + 4 * U_EFLAGS) (Vint u14) = Some m15 ->
      Mem.store Mint32 m15 b1 (UCTXT_SIZE * 4 * n + 4 * U_ESP) (Vint u15) = Some m16 ->
      Mem.store Mint32 m16 b1 (UCTXT_SIZE * 4 * n + 4 * U_SS) (Vint u16) = Some m17 ->
      cid (snd m0) = n ->
      kernel_mode (snd m0) ->
      pg (snd m0) = true ->
      save_uctx_spec_low_step s WB (Vint u0::Vint u1::Vint u2::Vint u3::Vint u4::Vint u5::Vint u6::
                                         Vint u7::Vint u8::Vint u9::Vint u10::Vint u11::Vint u12::Vint u13
                                         ::Vint u14::Vint u15::Vint u16::nil) m0 Vundef m17.

  Inductive restore_uctx_spec_low_step `{StencilOps} `{Mem.MemoryModelOps} `{UseMemWithData mem}:
    sprimcall_sem (mem := mwd LDATAOps):=
    restore_uctx_spec_low_intro s v0 v1 v2 v4 v5 v6 v7 v8 v9
                                (m'0: mem) b0 n rs rs' labd labd' sig b:
      find_symbol s restore_uctx = Some b ->
      rs PC = Vptr b Int.zero ->
      find_symbol s UCTX_LOC = Some b0 ->
      Mem.load Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_EDI) = Some v0 ->
      Mem.load Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_ESI * 4) = Some v1 ->
      Mem.load Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_EBP * 4) = Some v2 ->
      Mem.load Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_EBX * 4) = Some v4 ->
      Mem.load Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_EDX * 4) = Some v5 ->
      Mem.load Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_ECX * 4) = Some v6 ->
      Mem.load Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_EAX * 4) = Some v7 ->
      Mem.load Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_ESP * 4) = Some v8 ->
      Mem.load Mint32 m'0 b0 (Int.unsigned n * UCTXT_SIZE * 4 + U_EIP * 4) = Some v9 ->
      rs' = (undef_regs (CR ZF :: CR CF :: CR PF :: CR SF :: CR OF
                            :: IR ECX :: IR EAX :: RA :: nil)
                        (undef_regs (List.map preg_of destroyed_at_call) rs)) ->
      trapout_spec labd = Some labd' ->
      cid labd = Int.unsigned n ->
      kernel_mode labd ->
      asm_invariant (mem := mwd LDATAOps) s rs (m'0, labd) ->
      high_level_invariant labd ->
      sig = mksignature (AST.Tint::nil) None cc_default ->
      extcall_arguments rs m'0 sig (Vint n ::nil) ->
      restore_uctx_spec_low_step s rs (m'0, labd)
                                 (rs'#Asm.EDI <- v0 #Asm.ESI <- v1 #Asm.EBP <- v2 #Asm.ESP<- v8#Asm.EBX <- v4
                                     #EDX<- v5 #ECX<-v6 #EAX <- v7# PC <- v9) (m'0, labd').

  Section WITHMEM.

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

    Definition uctx_get_spec_low: compatsem LDATAOps :=
      csem uctx_get_spec_low_step (type_of_list_type (Tint32::Tint32::nil)) Tint32.

    Definition uctx_set_spec_low: compatsem LDATAOps :=
      csem uctx_set_spec_low_step (type_of_list_type (Tint32::Tint32::Tint32::nil)) Tvoid.

    Definition uctx_set_eip_spec_low: compatsem LDATAOps :=
      csem uctx_set_eip_spec_low_step (type_of_list_type (Tint32::Tpointer Tvoid noattr::nil)) Tvoid.

    Definition elf_load_spec_low: compatsem LDATAOps :=
      asmsem_withsig elf_load elf_load_spec_low_step (mksignature (AST.Tint::AST.Tint::nil) None cc_default).

    Definition save_uctx_spec_low: compatsem LDATAOps :=
      csem save_uctx_spec_low_step (type_of_list_type
                                      (Tint32::Tint32::Tint32::Tint32::
                                             Tint32::Tint32::Tint32::Tint32::
                                             Tint32::Tint32::Tint32::Tint32::
                                             Tint32::Tint32::Tint32::Tint32::
                                             Tint32::nil)) Tvoid.

    Definition restore_uctx_spec_low: compatsem LDATAOps :=
      asmsem_withsig restore_uctx restore_uctx_spec_low_step (mksignature (AST.Tint::nil) None cc_default).

    (*Definition MSpec : compatlayer LDATAOps :=
           uctx_get ↦ uctx_get_spec_low
           ⊕ uctx_set ↦ uctx_set_spec_low
           ⊕ uctx_set_eip ↦ uctx_set_eip_spec_low
           ⊕ restore_uctx ↦ restore_uctx_spec_low
           ⊕ save_uctx ↦ save_uctx_spec_low
           ⊕ elf_load ↦ elf_load_spec_low.

    Definition MVar : compatlayer LDATAOps :=
      UCTX_LOC ↦ mkglobvar (Tarray Tint32 (num_proc * UCTXT_SIZE * 4) (mk_attr false None))
              (Init_space (num_proc * UCTXT_SIZE * 4) :: nil) false false.*)

  End WITHMEM.

End Refinement.