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.

Lemma match_stacks_incr:
forall j j', inject_incr j j' ->
forall s ts bound tbound, match_stacks j s ts bound tbound ->
(forall b1 b2 delta,
j b1 = None -> j' b1 = Some(b2, delta) -> Ple bound b1 /\ Ple tbound b2) ->
match_stacks j' s ts bound tbound.