Section PRESERVATION.
Variable prog: RTL.program.
Variable tprog: LTL.program.
Hypothesis TRANSF: match_prog prog tprog.
Let ge := Genv.globalenv prog.
Let tge := Genv.globalenv tprog.
Proof (Genv.find_symbol_match TRANSF).
Proof (Genv.senv_match TRANSF).
Proof (Genv.find_funct_transf_partial TRANSF).
Proof (Genv.find_funct_ptr_transf_partial TRANSF).
(** The simulation relation *)
Inductive match_stackframes: list RTL.stackframe -> list LTL.stackframe -> signature -> Prop :=
| match_stackframes_nil: forall sg,
sg.(sig_res) = Tint ->
match_stackframes nil nil sg
| match_stackframes_cons:
forall res f sp pc rs s tf bb ls ts sg an e env
(STACKS: match_stackframes s ts (fn_sig tf))
(FUN: transf_function f = OK tf)
(ANL: analyze f env (pair_codes f tf) = Some an)
(EQ: transfer f env (pair_codes f tf) pc an!!pc = OK e)
(WTF: wt_function f env)
(WTRS: wt_regset env rs)
(WTRES: env res = proj_sig_res sg)
(STEPS: forall v ls1 m,
Val.lessdef v (Locmap.getpair (map_rpair R (loc_result sg)) ls1) ->
Val.has_type v (env res) ->
agree_callee_save ls ls1 ->
exists ls2,
star LTL.step tge (Block ts tf sp bb ls1 m)
E0 (State ts tf sp pc ls2 m)
/\ satisf (rs#res <- v) ls2 e),
match_stackframes
(RTL.Stackframe res f sp pc rs :: s)
(LTL.Stackframe tf sp ls bb :: ts)
sg.
Inductive match_states: RTL.state -> LTL.state -> Prop :=
| match_states_intro:
forall s f sp pc rs m ts tf ls m' an e env
(STACKS: match_stackframes s ts (fn_sig tf))
(FUN: transf_function f = OK tf)
(ANL: analyze f env (pair_codes f tf) = Some an)
(EQ: transfer f env (pair_codes f tf) pc an!!pc = OK e)
(SAT: satisf rs ls e)
(MEM: Mem.extends m m')
(WTF: wt_function f env)
(WTRS: wt_regset env rs),
match_states (RTL.State s f sp pc rs m)
(LTL.State ts tf sp pc ls m')
| match_states_call:
forall s f args m ts tf ls m'
(STACKS: match_stackframes s ts (funsig tf))
(FUN: transf_fundef f = OK tf)
(ARGS: Val.lessdef_list args (map (fun p => Locmap.getpair p ls) (loc_arguments (funsig tf))))
(AG: agree_callee_save (parent_locset ts) ls)
(MEM: Mem.extends m m')
(WTARGS: Val.has_type_list args (sig_args (funsig tf))),
match_states (RTL.Callstate s f args m)
(LTL.Callstate ts tf ls m')
| match_states_return:
forall s res m ts ls m' sg
(STACKS: match_stackframes s ts sg)
(RES: Val.lessdef res (Locmap.getpair (map_rpair R (loc_result sg)) ls))
(AG: agree_callee_save (parent_locset ts) ls)
(MEM: Mem.extends m m')
(WTRES: Val.has_type res (proj_sig_res sg)),
match_states (RTL.Returnstate s res m)
(LTL.Returnstate ts ls m').
Ltac UseShape :=
match goal with
| [ WT: wt_function _ _, CODE: (RTL.fn_code _)!_ = Some _, EQ: transfer _ _ _ _ _ = OK _ |- _ ] =>
destruct (invert_code _ _ _ _ _ _ _ WT CODE EQ) as (eafter & bsh & bb & AFTER & BSH & TCODE & EBS & TR & WTI);
inv EBS; unfold transfer_aux in TR; MonadInv
end.
Remark addressing_not_long:
forall env f addr args dst s r,
wt_instr f env (Iload Mint64 addr args dst s) -> Archi.splitlong = true ->
In r args -> r <> dst.
(** The proof of semantic preservation is a simulation argument of the "plus" kind. *)

Theorem transf_program_correct:
forward_simulation (RTL.semantics prog) (LTL.semantics tprog).