(** * Correctness of stack allocation of local variables *)
(** This section shows the correctness of the translation of Csharpminor local variables as sub-blocks of the Cminor stack data.  This is the most difficult part of the proof. *)
Definition cenv_remove (cenv: compilenv) (vars: list (ident * Z)) : compilenv :=
fold_right (fun id_lv ce => PTree.remove (fst id_lv) ce) cenv vars.
Remark cenv_remove_gso:
forall id vars cenv,
~In id (map fst vars) ->
PTree.get id (cenv_remove cenv vars) = PTree.get id cenv.
Remark cenv_remove_gss:
forall id vars cenv,
In id (map fst vars) ->
PTree.get id (cenv_remove cenv vars) = None.
Definition cenv_compat (cenv: compilenv) (vars: list (ident * Z)) (tsz: Z) : Prop :=
forall id sz,
In (id, sz) vars ->
exists ofs,
PTree.get id cenv = Some ofs
/\ Mem.inj_offset_aligned ofs sz
/\ 0 <= ofs
/\ ofs + Zmax 0 sz <= tsz.
Definition cenv_separated (cenv: compilenv) (vars: list (ident * Z)) : Prop :=
forall id1 sz1 ofs1 id2 sz2 ofs2,
In (id1, sz1) vars -> In (id2, sz2) vars ->
PTree.get id1 cenv = Some ofs1 -> PTree.get id2 cenv = Some ofs2 ->
id1 <> id2 ->
ofs1 + sz1 <= ofs2 \/ ofs2 + sz2 <= ofs1.
Definition cenv_mem_separated (cenv: compilenv) (vars: list (ident * Z)) (f: meminj) (sp: block) (m: mem) : Prop :=
forall id sz ofs b delta ofs' k p,
In (id, sz) vars -> PTree.get id cenv = Some ofs ->
f b = Some (sp, delta) ->
Mem.perm m b ofs' k p ->
ofs <= ofs' + delta < sz + ofs -> False.

(* Specifications: *)
Lemma match_callstack_alloc_variables_rec:
forall tm sp tf cenv le te lo cs,
Mem.valid_block tm sp ->
fn_stackspace tf <= Int.max_unsigned ->
(forall ofs k p, Mem.perm tm sp ofs k p -> 0 <= ofs < fn_stackspace tf) ->
(forall ofs k p, 0 <= ofs < fn_stackspace tf -> Mem.perm tm sp ofs k p) ->
forall e1 m1 vars e2 m2,
alloc_variables e1 m1 vars e2 m2 ->
forall f1,
list_norepet (map fst vars) ->
cenv_compat cenv vars (fn_stackspace tf) ->
cenv_separated cenv vars ->
cenv_mem_separated cenv vars f1 sp m1 ->
(forall id sz, In (id, sz) vars -> e1!id = None) ->
match_callstack f1 m1 tm
(Frame (cenv_remove cenv vars) tf e1 le te sp lo (Mem.nextblock m1) :: cs)
(Mem.nextblock m1) (Mem.nextblock tm) ->
Mem.inject f1 m1 tm ->
exists f2,
match_callstack f2 m2 tm
(Frame cenv tf e2 le te sp lo (Mem.nextblock m2) :: cs)
(Mem.nextblock m2) (Mem.nextblock tm)
/\ Mem.inject f2 m2 tm
/\ (*LENB: THIS IS NEW*) inject_incr f1 f2.
Lemma match_callstack_alloc_variables:
forall tm1 sp tm2 m1 vars e m2 cenv f1 cs fn le te,
Mem.alloc tm1 0 (fn_stackspace fn) = (tm2, sp) ->
fn_stackspace fn <= Int.max_unsigned ->
alloc_variables empty_env m1 vars e m2 ->
list_norepet (map fst vars) ->
cenv_compat cenv vars (fn_stackspace fn) ->
cenv_separated cenv vars ->
(forall id ofs, cenv!id = Some ofs -> In id (map fst vars)) ->
Mem.inject f1 m1 tm1 ->
match_callstack f1 m1 tm1 cs (Mem.nextblock m1) (Mem.nextblock tm1) ->
match_temps f1 le te ->
exists f2,
match_callstack f2 m2 tm2 (Frame cenv fn e le te sp (Mem.nextblock m1) (Mem.nextblock m2) :: cs)
(Mem.nextblock m2) (Mem.nextblock tm2)
/\ Mem.inject f2 m2 tm2
/\ (*LENB: THIS IS NEW*) inject_incr f1 f2.
Lemma match_callstack_alloc_variables_rec:
forall tm sp tf cenv le te lo cs,
Mem.valid_block tm sp ->
fn_stackspace tf <= Int.max_unsigned ->
(forall ofs k p, Mem.perm tm sp ofs k p -> 0 <= ofs < fn_stackspace tf) ->
(forall ofs k p, 0 <= ofs < fn_stackspace tf -> Mem.perm tm sp ofs k p) ->
forall e1 m1 vars e2 m2,
alloc_variables e1 m1 vars e2 m2 ->
forall f1,
list_norepet (map fst vars) ->
cenv_compat cenv vars (fn_stackspace tf) ->
cenv_separated cenv vars ->
cenv_mem_separated cenv vars f1 sp m1 ->
(forall id sz, In (id, sz) vars -> e1!id = None) ->
match_callstack f1 m1 tm
(Frame (cenv_remove cenv vars) tf e1 le te sp lo (Mem.nextblock m1) :: cs)
(Mem.nextblock m1) (Mem.nextblock tm) ->
Mem.inject f1 m1 tm ->
exists f2,
match_callstack f2 m2 tm
(Frame cenv tf e2 le te sp lo (Mem.nextblock m2) :: cs)
(Mem.nextblock m2) (Mem.nextblock tm)
/\ Mem.inject f2 m2 tm.
Lemma match_callstack_alloc_variables:
forall tm1 sp tm2 m1 vars e m2 cenv f1 cs fn le te,
Mem.alloc tm1 0 (fn_stackspace fn) = (tm2, sp) ->
fn_stackspace fn <= Int.max_unsigned ->
alloc_variables empty_env m1 vars e m2 ->
list_norepet (map fst vars) ->
cenv_compat cenv vars (fn_stackspace fn) ->
cenv_separated cenv vars ->
(forall id ofs, cenv!id = Some ofs -> In id (map fst vars)) ->
Mem.inject f1 m1 tm1 ->
match_callstack f1 m1 tm1 cs (Mem.nextblock m1) (Mem.nextblock tm1) ->
match_temps f1 le te ->
exists f2,
match_callstack f2 m2 tm2 (Frame cenv fn e le te sp (Mem.nextblock m1) (Mem.nextblock m2) :: cs)
(Mem.nextblock m2) (Mem.nextblock tm2)
/\ Mem.inject f2 m2 tm2.