(** ** Relating states *)
Inductive match_states: RTL.state -> RTL.state -> Prop :=
| match_regular_states: forall stk f sp pc rs m stk' f' sp' rs' m' F fenv ctx
(MS: match_stacks_inside F m m' stk stk' f' ctx sp' rs')
(COMPAT: fenv_compat prog fenv)
(FB: tr_funbody fenv f'.(fn_stacksize) ctx f f'.(fn_code))
(AG: agree_regs F ctx rs rs')
(SP: F sp = Some(sp', ctx.(dstk)))
(MINJ: Mem.inject F m m')
(VB: Mem.valid_block m' sp')
(PRIV: range_private F m m' sp' (ctx.(dstk) + ctx.(mstk)) f'.(fn_stacksize))
(SSZ1: 0 <= f'.(fn_stacksize) < Ptrofs.max_unsigned)
(SSZ2: forall ofs, Mem.perm m' sp' ofs Max Nonempty -> 0 <= ofs <= f'.(fn_stacksize)),
match_states (State stk f (Vptr sp Ptrofs.zero) pc rs m)
(State stk' f' (Vptr sp' Ptrofs.zero) (spc ctx pc) rs' m')
| match_call_states: forall stk fd args m stk' fd' args' m' cunit F
(MS: match_stacks F m m' stk stk' (Mem.nextblock m'))
(LINK: linkorder cunit prog)
(FD: transf_fundef (funenv_program cunit) fd = OK fd')
(VINJ: Val.inject_list F args args')
(MINJ: Mem.inject F m m'),
match_states (Callstate stk fd args m)
(Callstate stk' fd' args' m')
| match_call_regular_states: forall stk f vargs m stk' f' sp' rs' m' F fenv ctx ctx' pc' pc1' rargs
(MS: match_stacks_inside F m m' stk stk' f' ctx sp' rs')
(COMPAT: fenv_compat prog fenv)
(FB: tr_funbody fenv f'.(fn_stacksize) ctx f f'.(fn_code))
(BELOW: context_below ctx' ctx)
(NOP: f'.(fn_code)!pc' = Some(Inop pc1'))
(MOVES: tr_moves f'.(fn_code) pc1' (sregs ctx' rargs) (sregs ctx f.(fn_params)) (spc ctx f.(fn_entrypoint)))
(VINJ: list_forall2 (val_reg_charact F ctx' rs') vargs rargs)
(MINJ: Mem.inject F m m')
(VB: Mem.valid_block m' sp')
(PRIV: range_private F m m' sp' ctx.(dstk) f'.(fn_stacksize))
(SSZ1: 0 <= f'.(fn_stacksize) < Ptrofs.max_unsigned)
(SSZ2: forall ofs, Mem.perm m' sp' ofs Max Nonempty -> 0 <= ofs <= f'.(fn_stacksize)),
match_states (Callstate stk (Internal f) vargs m)
(State stk' f' (Vptr sp' Ptrofs.zero) pc' rs' m')
| match_return_states: forall stk v m stk' v' m' F
(MS: match_stacks F m m' stk stk' (Mem.nextblock m'))
(VINJ: Val.inject F v v')
(MINJ: Mem.inject F m m'),
match_states (Returnstate stk v m)
(Returnstate stk' v' m')
| match_return_regular_states: forall stk v m stk' f' sp' rs' m' F ctx pc' or rinfo
(MS: match_stacks_inside F m m' stk stk' f' ctx sp' rs')
(RET: ctx.(retinfo) = Some rinfo)
(AT: f'.(fn_code)!pc' = Some(inline_return ctx or rinfo))
(VINJ: match or with None => v = Vundef | Some r => Val.inject F v rs'#(sreg ctx r) end)
(MINJ: Mem.inject F m m')
(VB: Mem.valid_block m' sp')
(PRIV: range_private F m m' sp' ctx.(dstk) f'.(fn_stacksize))
(SSZ1: 0 <= f'.(fn_stacksize) < Ptrofs.max_unsigned)
(SSZ2: forall ofs, Mem.perm m' sp' ofs Max Nonempty -> 0 <= ofs <= f'.(fn_stacksize)),
match_states (Returnstate stk v m)
(State stk' f' (Vptr sp' Ptrofs.zero) pc' rs' m').
(** ** Forward simulation *)
Definition measure (S: RTL.state) : nat :=
match S with
| State _ _ _ _ _ _ => 1%nat
| Callstate _ _ _ _ => 0%nat
| Returnstate _ _ _ => 0%nat
end.

(* Specifications: *)
Lemma tr_funbody_inv:
forall fenv sz cts f c pc i,
tr_funbody fenv sz cts f c -> f.(fn_code)!pc = Some i -> tr_instr fenv sz cts pc i c.
Theorem step_simulation:
forall S1 t S2,
step ge S1 t S2 ->
forall S1' (MS: match_states S1 S1'),
(exists S2', plus step tge S1' t S2' /\ match_states S2 S2')
\/ (measure S2 < measure S1 /\ t = E0 /\ match_states S2 S1')%nat.
Lemma transf_initial_states:
forall st1, initial_state prog st1 -> exists st2, initial_state tprog st2 /\ match_states st1 st2.
Lemma transf_final_states:
forall st1 st2 r,
match_states st1 st2 -> final_state st1 r -> final_state st2 r.
Theorem transf_program_correct:
forward_simulation (semantics prog) (semantics tprog).