Section SOUNDNESS.
Variable p: program.
Variable tp: program.
Variable used: IS.t.
Hypothesis USED_VALID: valid_used_set p used.
Hypothesis TRANSF: match_prog_1 used p tp.
Let ge := Genv.globalenv p.
Let tge := Genv.globalenv tp.
Let pm := prog_defmap p.
Definition kept (id: ident) : Prop := IS.In id used.
(** Relating [Genv.find_symbol] operations in the original and transformed program *)
(** Injections that preserve used globals. *)
Record meminj_preserves_globals (f: meminj) : Prop := {
symbols_inject_1: forall id b b' delta,
f b = Some(b', delta) -> Genv.find_symbol ge id = Some b ->
delta = 0 /\ Genv.find_symbol tge id = Some b';
symbols_inject_2: forall id b,
kept id -> Genv.find_symbol ge id = Some b ->
exists b', Genv.find_symbol tge id = Some b' /\ f b = Some(b', 0);
symbols_inject_3: forall id b',
Genv.find_symbol tge id = Some b' ->
exists b, Genv.find_symbol ge id = Some b /\ f b = Some(b', 0);
defs_inject: forall b b' delta gd,
f b = Some(b', delta) -> Genv.find_def ge b = Some gd ->
Genv.find_def tge b' = Some gd /\ delta = 0 /\
(forall id, ref_def gd id -> kept id);
defs_rev_inject: forall b b' delta gd,
f b = Some(b', delta) -> Genv.find_def tge b' = Some gd ->
Genv.find_def ge b = Some gd /\ delta = 0
}.
Definition init_meminj : meminj :=
fun b =>
match Genv.invert_symbol ge b with
| Some id =>
match Genv.find_symbol tge id with
| Some b' => Some (b', 0)
| None => None
end
| None => None
end.
Remark init_meminj_eq:
forall id b b',
Genv.find_symbol ge id = Some b -> Genv.find_symbol tge id = Some b' ->
init_meminj b = Some(b', 0).
Remark init_meminj_invert:
forall b b' delta,
init_meminj b = Some(b', delta) ->
delta = 0 /\ exists id, Genv.find_symbol ge id = Some b /\ Genv.find_symbol tge id = Some b'.
(** Semantic preservation *)
Definition regset_inject (f: meminj) (rs rs': regset): Prop :=
forall r, Val.inject f rs#r rs'#r.
Inductive match_stacks (j: meminj):
list stackframe -> list stackframe -> block -> block -> Prop :=
| match_stacks_nil: forall bound tbound,
meminj_preserves_globals j ->
Ple (Genv.genv_next ge) bound -> Ple (Genv.genv_next tge) tbound ->
match_stacks j nil nil bound tbound
| match_stacks_cons: forall res f sp pc rs s tsp trs ts bound tbound
(STACKS: match_stacks j s ts sp tsp)
(KEPT: forall id, ref_function f id -> kept id)
(SPINJ: j sp = Some(tsp, 0))
(REGINJ: regset_inject j rs trs)
(BELOW: Plt sp bound)
(TBELOW: Plt tsp tbound),
match_stacks j (Stackframe res f (Vptr sp Ptrofs.zero) pc rs :: s)
(Stackframe res f (Vptr tsp Ptrofs.zero) pc trs :: ts)
bound tbound.
Inductive match_states: state -> state -> Prop :=
| match_states_regular: forall s f sp pc rs m ts tsp trs tm j
(STACKS: match_stacks j s ts sp tsp)
(KEPT: forall id, ref_function f id -> kept id)
(SPINJ: j sp = Some(tsp, 0))
(REGINJ: regset_inject j rs trs)
(MEMINJ: Mem.inject j m tm),
match_states (State s f (Vptr sp Ptrofs.zero) pc rs m)
(State ts f (Vptr tsp Ptrofs.zero) pc trs tm)
| match_states_call: forall s fd args m ts targs tm j
(STACKS: match_stacks j s ts (Mem.nextblock m) (Mem.nextblock tm))
(KEPT: forall id, ref_fundef fd id -> kept id)
(ARGINJ: Val.inject_list j args targs)
(MEMINJ: Mem.inject j m tm),
match_states (Callstate s fd args m)
(Callstate ts fd targs tm)
| match_states_return: forall s res m ts tres tm j
(STACKS: match_stacks j s ts (Mem.nextblock m) (Mem.nextblock tm))
(RESINJ: Val.inject j res tres)
(MEMINJ: Mem.inject j m tm),
match_states (Returnstate s res m)
(Returnstate ts tres tm).

Lemma external_call_inject:
forall ef vargs m1 t vres m2 f m1' vargs',
meminj_preserves_globals f ->
external_call ef ge vargs m1 t vres m2 ->
Mem.inject f m1 m1' ->
Val.inject_list f vargs vargs' ->
exists f', exists vres', exists m2',
external_call ef tge vargs' m1' t vres' m2'
/\ Val.inject f' vres vres'
/\ Mem.inject f' m2 m2'
/\ Mem.unchanged_on (loc_unmapped f) m1 m2
/\ Mem.unchanged_on (loc_out_of_reach f m1) m1' m2'
/\ inject_incr f f'
/\ inject_separated f f' m1 m1'.