Section TRANSLATION.
Variable prog: Csharpminor.program.
Variable tprog: program.
Hypothesis TRANSL: transl_program prog = OK tprog.
Let ge : Csharpminor.genv := Genv.globalenv prog.
Let tge: genv := Genv.globalenv tprog.
Proof (Genv.find_symbol_transf_partial transl_fundef _ TRANSL).
Proof (Genv.find_funct_ptr_transf_partial transl_fundef _ TRANSL).
Proof (Genv.find_funct_transf_partial transl_fundef _ TRANSL).
Proof (Genv.find_var_info_transf_partial transl_fundef _ TRANSL).
(** * Derived properties of memory operations *)
(** * Correspondence between C#minor's and Cminor's environments and memory states *)
(** In C#minor, every variable is stored in a separate memory block. In the corresponding Cminor code, these variables become sub-blocks of the stack data block.  We capture these changes in memory via a memory injection [f]: [f b = Some(b', ofs)] means that C#minor block [b] corresponds to a sub-block of Cminor block [b] at offset [ofs].  A memory injection [f] defines a relation [val_inject f] between values and a relation [Mem.inject f] between memory states.  These relations will be used intensively in our proof of simulation between C#minor and Cminor executions. *)
(** ** Matching between Cshaprminor's temporaries and Cminor's variables *)
Definition match_temps (f: meminj) (le: Csharpminor.temp_env) (te: env) : Prop :=
forall id v, le!id = Some v -> exists v', te!(id) = Some v' /\ val_inject f v v'.
(** ** Matching between C#minor's variable environment and Cminor's stack pointer *)
Inductive match_var (f: meminj) (sp: block): option (block * Z) -> option Z -> Prop :=
| match_var_local: forall b sz ofs,
val_inject f (Vptr b Int.zero) (Vptr sp (Int.repr ofs)) ->
match_var f sp (Some(b, sz)) (Some ofs)
| match_var_global:
match_var f sp None None.
(** Matching between a C#minor environment [e] and a Cminor stack pointer [sp]. The [lo] and [hi] parameters delimit the range of addresses for the blocks referenced from [te]. *)
Record match_env (f: meminj) (cenv: compilenv)
(e: Csharpminor.env) (sp: block)
(lo hi: block) : Prop :=
mk_match_env {
(** C#minor local variables match sub-blocks of the Cminor stack data block. *)
me_vars:
forall id, match_var f sp (e!id) (cenv!id);
(** [lo, hi] is a proper interval. *)
me_low_high:
Ple lo hi;
(** Every block appearing in the C#minor environment [e] must be in the range [lo, hi]. *)
me_bounded:
forall id b sz, PTree.get id e = Some(b, sz) -> Ple lo b /\ Plt b hi;
(** All blocks mapped to sub-blocks of the Cminor stack data must be images of variables from the C#minor environment [e] *)
me_inv:
forall b delta,
f b = Some(sp, delta) ->
exists id, exists sz, PTree.get id e = Some(b, sz);
(** All C#minor blocks below [lo] (i.e. allocated before the blocks referenced from [e]) must map to blocks that are below [sp] (i.e. allocated before the stack data for the current Cminor function). *)
me_incr:
forall b tb delta,
f b = Some(tb, delta) -> Plt b lo -> Plt tb sp
}.
Ltac geninv x :=
let H := fresh in (generalize x; intro H; inv H).
(** [match_env] and external calls *)
Remark inject_incr_separated_same:
forall f1 f2 m1 m1',
inject_incr f1 f2 -> inject_separated f1 f2 m1 m1' ->
forall b, Mem.valid_block m1 b -> f2 b = f1 b.
Remark inject_incr_separated_same':
forall f1 f2 m1 m1',
inject_incr f1 f2 -> inject_separated f1 f2 m1 m1' ->
forall b b' delta,
f2 b = Some(b', delta) -> Mem.valid_block m1' b' -> f1 b = Some(b', delta).
(** [match_env] and allocations *)
(** The sizes of blocks appearing in [e] are respected. *)
Definition match_bounds (e: Csharpminor.env) (m: mem) : Prop :=
forall id b sz ofs p,
PTree.get id e = Some(b, sz) -> Mem.perm m b ofs Max p -> 0 <= ofs < sz.
(** ** Permissions on the Cminor stack block *)
(** The parts of the Cminor stack data block that are not images of C#minor local variable blocks remain freeable at all times. *)
Inductive is_reachable_from_env (f: meminj) (e: Csharpminor.env) (sp: block) (ofs: Z) : Prop :=
| is_reachable_intro: forall id b sz delta,
e!id = Some(b, sz) ->
f b = Some(sp, delta) ->
delta <= ofs < delta + sz ->
is_reachable_from_env f e sp ofs.
Definition padding_freeable (f: meminj) (e: Csharpminor.env) (tm: mem) (sp: block) (sz: Z) : Prop :=
forall ofs,
0 <= ofs < sz -> Mem.perm tm sp ofs Cur Freeable \/ is_reachable_from_env f e sp ofs.
(** Decidability of the [is_reachable_from_env] predicate. *)
(** * Correspondence between global environments *)
(** Global environments match if the memory injection [f] leaves unchanged the references to global symbols and functions. *)
Inductive match_globalenvs (f: meminj) (bound: block): Prop :=
| mk_match_globalenvs
(DOMAIN: forall b, Plt b bound -> f b = Some(b, 0))
(IMAGE: forall b1 b2 delta, f b1 = Some(b2, delta) -> Plt b2 bound -> b1 = b2)
(SYMBOLS: forall id b, Genv.find_symbol ge id = Some b -> Plt b bound)
(FUNCTIONS: forall b fd, Genv.find_funct_ptr ge b = Some fd -> Plt b bound)
(VARINFOS: forall b gv, Genv.find_var_info ge b = Some gv -> Plt b bound).
Remark inj_preserves_globals:
forall f hi,
match_globalenvs f hi ->
meminj_preserves_globals ge f.
(** * Invariant on abstract call stacks  *)
(** Call stacks represent abstractly the execution state of the current C#minor and Cminor functions, as well as the states of the calling functions.  A call stack is a list of frames, each frame collecting information on the current execution state of a C#minor function and its Cminor translation. *)
Inductive frame : Type :=
Frame(cenv: compilenv)
(tf: Cminor.function)
(e: Csharpminor.env)
(le: Csharpminor.temp_env)
(te: Cminor.env)
(sp: block)
(lo hi: block).
Definition callstack : Type := list frame.
(** Matching of call stacks imply: - matching of environments for each of the frames - matching of the global environments - separation conditions over the memory blocks allocated for C#minor local variables; - separation conditions over the memory blocks allocated for Cminor stack data; - freeable permissions on the parts of the Cminor stack data blocks that are not images of C#minor local variable blocks. *)
Inductive match_callstack (f: meminj) (m: mem) (tm: mem):
callstack -> block -> block -> Prop :=
| mcs_nil:
forall hi bound tbound,
match_globalenvs f hi ->
Ple hi bound -> Ple hi tbound ->
match_callstack f m tm nil bound tbound
| mcs_cons:
forall cenv tf e le te sp lo hi cs bound tbound
(BOUND: Ple hi bound)
(TBOUND: Plt sp tbound)
(MTMP: match_temps f le te)
(MENV: match_env f cenv e sp lo hi)
(BOUND: match_bounds e m)
(PERM: padding_freeable f e tm sp tf.(fn_stackspace))
(MCS: match_callstack f m tm cs lo sp),
match_callstack f m tm (Frame cenv tf e le te sp lo hi :: cs) bound tbound.
(** [match_callstack] implies [match_globalenvs]. *)
(** Invariance properties for [match_callstack]. *)
(** Assigning a temporary variable. *)
(** Preservation of [match_callstack] by freeing all blocks allocated for local variables at function entry (on the C#minor side) and simultaneously freeing the Cminor stack data block. *)
(** Preservation of [match_callstack] by external calls. *)
(** [match_callstack] and allocations *)
(** * 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.
(** Properties of the compilation environment produced by [build_compilenv] *)
Remark block_alignment_pos:
forall sz, block_alignment sz > 0.
Remark assign_variable_incr:
forall id sz cenv stksz cenv' stksz',
assign_variable (cenv, stksz) (id, sz) = (cenv', stksz') -> stksz <= stksz'.
Remark assign_variables_incr:
forall vars cenv sz cenv' sz',
assign_variables (cenv, sz) vars = (cenv', sz') -> sz <= sz'.
Remark inj_offset_aligned_block:
forall stacksize sz,
Mem.inj_offset_aligned (align stacksize (block_alignment sz)) sz.
Remark inj_offset_aligned_block':
forall stacksize sz,
Mem.inj_offset_aligned (align stacksize (block_alignment sz)) (Zmax 0 sz).
Remark permutation_norepet:
forall (A: Type) (l l': list A), Permutation l l' -> list_norepet l -> list_norepet l'.
(** Initialization of C#minor temporaries and Cminor local variables. *)
Fixpoint set_params' (vl: list val) (il: list ident) (te: Cminor.env) : Cminor.env :=
match il, vl with
| i1 :: is, v1 :: vs => set_params' vs is (PTree.set i1 v1 te)
| i1 :: is, nil => set_params' nil is (PTree.set i1 Vundef te)
| _, _ => te
end.
(** The main result in this section. *)
(** * Properties of compile-time approximations of values *)
Definition val_match_approx (a: approx) (v: val) : Prop :=
match a with
| Int1 => v = Val.zero_ext 1 v
| Int7 => v = Val.zero_ext 8 v /\ v = Val.sign_ext 8 v
| Int8u => v = Val.zero_ext 8 v
| Int8s => v = Val.sign_ext 8 v
| Int15 => v = Val.zero_ext 16 v /\ v = Val.sign_ext 16 v
| Int16u => v = Val.zero_ext 16 v
| Int16s => v = Val.sign_ext 16 v
| Float32 => v = Val.singleoffloat v
| Any => True
end.
Remark undef_match_approx: forall a, val_match_approx a Vundef.
(** * Compatibility of evaluation functions with respect to memory injections. *)
Remark val_inject_val_of_bool:
forall f b, val_inject f (Val.of_bool b) (Val.of_bool b).
Remark val_inject_val_of_optbool:
forall f ob, val_inject f (Val.of_optbool ob) (Val.of_optbool ob).
Ltac TrivialExists :=
match goal with
| [ |- exists y, Some ?x = Some y /\ val_inject _ _ _ ] =>
exists x; split; [auto | try(econstructor; eauto)]
| [ |- exists y, _ /\ val_inject _ (Vint ?x) _ ] =>
exists (Vint x); split; [eauto with evalexpr | constructor]
| [ |- exists y, _ /\ val_inject _ (Vfloat ?x) _ ] =>
exists (Vfloat x); split; [eauto with evalexpr | constructor]
| [ |- exists y, _ /\ val_inject _ (Vlong ?x) _ ] =>
exists (Vlong x); split; [eauto with evalexpr | constructor]
| _ => idtac
end.
(** Compatibility of [eval_unop] with respect to [val_inject]. *)
(** Compatibility of [eval_binop] with respect to [val_inject]. *)
(** * Correctness of Cminor construction functions *)
(** Correctness of [make_store]. *)
Inductive val_lessdef_upto (m: int): val -> val -> Prop :=
| val_lessdef_upto_base:
forall v1 v2, Val.lessdef v1 v2 -> val_lessdef_upto m v1 v2
| val_lessdef_upto_int:
forall n1 n2, Int.and n1 m = Int.and n2 m -> val_lessdef_upto m (Vint n1) (Vint n2).
Hint Resolve val_lessdef_upto_base.
Remark val_lessdef_upto_and:
forall m v1 v2 p,
val_lessdef_upto m v1 v2 -> Int.and p m = m ->
val_lessdef_upto m (Val.and v1 (Vint p)) v2.
Remark val_lessdef_upto_zero_ext:
forall m v1 v2 p,
val_lessdef_upto m v1 v2 -> Int.and (Int.repr (two_p p - 1)) m = m -> 0 < p < 32 ->
val_lessdef_upto m (Val.zero_ext p v1) v2.
Remark val_lessdef_upto_sign_ext:
forall m v1 v2 p,
val_lessdef_upto m v1 v2 -> Int.and (Int.repr (two_p p - 1)) m = m -> 0 < p < 32 ->
val_lessdef_upto m (Val.sign_ext p v1) v2.
Remark val_lessdef_upto_shru:
forall m v1 v2 p,
val_lessdef_upto (Int.shl m p) v1 v2 -> Int.shru (Int.shl m p) p = m ->
val_lessdef_upto m (Val.shru v1 (Vint p)) (Val.shru v2 (Vint p)).
Remark val_lessdef_upto_shr:
forall m v1 v2 p,
val_lessdef_upto (Int.shl m p) v1 v2 -> Int.shru (Int.shl m p) p = m ->
val_lessdef_upto m (Val.shr v1 (Vint p)) (Val.shr v2 (Vint p)).
Inductive val_lessdef_upto_single: val -> val -> Prop :=
| val_lessdef_upto_single_base:
forall v1 v2, Val.lessdef v1 v2 -> val_lessdef_upto_single v1 v2
| val_lessdef_upto_single_float:
forall n1 n2, Float.singleoffloat n1 = Float.singleoffloat n2 -> val_lessdef_upto_single (Vfloat n1) (Vfloat n2).
Hint Resolve val_lessdef_upto_single_base.
Inductive val_content_inject (f: meminj): memory_chunk -> val -> val -> Prop :=
| val_content_inject_8_signed:
forall n1 n2, Int.sign_ext 8 n1 = Int.sign_ext 8 n2 ->
val_content_inject f Mint8signed (Vint n1) (Vint n2)
| val_content_inject_8_unsigned:
forall n1 n2, Int.zero_ext 8 n1 = Int.zero_ext 8 n2 ->
val_content_inject f Mint8unsigned (Vint n1) (Vint n2)
| val_content_inject_16_signed:
forall n1 n2, Int.sign_ext 16 n1 = Int.sign_ext 16 n2 ->
val_content_inject f Mint16signed (Vint n1) (Vint n2)
| val_content_inject_16_unsigned:
forall n1 n2, Int.zero_ext 16 n1 = Int.zero_ext 16 n2 ->
val_content_inject f Mint16unsigned (Vint n1) (Vint n2)
| val_content_inject_single:
forall n1 n2, Float.singleoffloat n1 = Float.singleoffloat n2 ->
val_content_inject f Mfloat32 (Vfloat n1) (Vfloat n2)
| val_content_inject_base:
forall chunk v1 v2, val_inject f v1 v2 ->
val_content_inject f chunk v1 v2.
Hint Resolve val_content_inject_base.
(** Correctness of [make_unop]. *)
(** Correctness of the variable accessor [var_addr] *)
(** * Semantic preservation for the translation *)
(** The proof of semantic preservation uses simulation diagrams of the following form: << e, m1, s ----------------- sp, te1, tm1, ts |                                | t|                                |t v                                v e, m2, out --------------- sp, te2, tm2, tout >> where [ts] is the Cminor statement obtained by translating the C#minor statement [s].  The left vertical arrow is an execution of a C#minor statement.  The right vertical arrow is an execution of a Cminor statement.  The precondition (top vertical bar) includes a [mem_inject] relation between the memory states [m1] and [tm1], and a [match_callstack] relation for any callstack having [e], [te1], [sp] as top frame.  The postcondition (bottom vertical bar) is the existence of a memory injection [f2] that extends the injection [f1] we started with, preserves the [match_callstack] relation for the transformed callstack at the final state, and validates a [outcome_inject] relation between the outcomes [out] and [tout]. *)
(** ** Semantic preservation for expressions *)
Remark bool_of_val_inject:
forall f v tv b,
Val.bool_of_val v b -> val_inject f v tv -> Val.bool_of_val tv b.
(** ** Semantic preservation for statements and functions *)
Inductive match_cont: Csharpminor.cont -> Cminor.cont -> compilenv -> exit_env -> callstack -> Prop :=
| match_Kstop: forall cenv xenv,
match_cont Csharpminor.Kstop Kstop cenv xenv nil
| match_Kseq: forall s k ts tk cenv xenv cs,
transl_stmt cenv xenv s = OK ts ->
match_cont k tk cenv xenv cs ->
match_cont (Csharpminor.Kseq s k) (Kseq ts tk) cenv xenv cs
| match_Kseq2: forall s1 s2 k ts1 tk cenv xenv cs,
transl_stmt cenv xenv s1 = OK ts1 ->
match_cont (Csharpminor.Kseq s2 k) tk cenv xenv cs ->
match_cont (Csharpminor.Kseq (Csharpminor.Sseq s1 s2) k)
(Kseq ts1 tk) cenv xenv cs
| match_Kblock: forall k tk cenv xenv cs,
match_cont k tk cenv xenv cs ->
match_cont (Csharpminor.Kblock k) (Kblock tk) cenv (true :: xenv) cs
| match_Kblock2: forall k tk cenv xenv cs,
match_cont k tk cenv xenv cs ->
match_cont k (Kblock tk) cenv (false :: xenv) cs
| match_Kcall: forall optid fn e le k tfn sp te tk cenv xenv lo hi cs sz cenv',
transl_funbody cenv sz fn = OK tfn ->
match_cont k tk cenv xenv cs ->
match_cont (Csharpminor.Kcall optid fn e le k)
(Kcall optid tfn (Vptr sp Int.zero) te tk)
cenv' nil
(Frame cenv tfn e le te sp lo hi :: cs).
Inductive match_states: Csharpminor.state -> Cminor.state -> Prop :=
| match_state:
forall fn s k e le m tfn ts tk sp te tm cenv xenv f lo hi cs sz
(TRF: transl_funbody cenv sz fn = OK tfn)
(TR: transl_stmt cenv xenv s = OK ts)
(MINJ: Mem.inject f m tm)
(MCS: match_callstack f m tm
(Frame cenv tfn e le te sp lo hi :: cs)
(Mem.nextblock m) (Mem.nextblock tm))
(MK: match_cont k tk cenv xenv cs),
match_states (Csharpminor.State fn s k e le m)
(State tfn ts tk (Vptr sp Int.zero) te tm)
| match_state_seq:
forall fn s1 s2 k e le m tfn ts1 tk sp te tm cenv xenv f lo hi cs sz
(TRF: transl_funbody cenv sz fn = OK tfn)
(TR: transl_stmt cenv xenv s1 = OK ts1)
(MINJ: Mem.inject f m tm)
(MCS: match_callstack f m tm
(Frame cenv tfn e le te sp lo hi :: cs)
(Mem.nextblock m) (Mem.nextblock tm))
(MK: match_cont (Csharpminor.Kseq s2 k) tk cenv xenv cs),
match_states (Csharpminor.State fn (Csharpminor.Sseq s1 s2) k e le m)
(State tfn ts1 tk (Vptr sp Int.zero) te tm)
| match_callstate:
forall fd args k m tfd targs tk tm f cs cenv
(TR: transl_fundef fd = OK tfd)
(MINJ: Mem.inject f m tm)
(MCS: match_callstack f m tm cs (Mem.nextblock m) (Mem.nextblock tm))
(MK: match_cont k tk cenv nil cs)
(ISCC: Csharpminor.is_call_cont k)
(ARGSINJ: val_list_inject f args targs),
match_states (Csharpminor.Callstate fd args k m)
(Callstate tfd targs tk tm)
| match_returnstate:
forall v k m tv tk tm f cs cenv
(MINJ: Mem.inject f m tm)
(MCS: match_callstack f m tm cs (Mem.nextblock m) (Mem.nextblock tm))
(MK: match_cont k tk cenv nil cs)
(RESINJ: val_inject f v tv),
match_states (Csharpminor.Returnstate v k m)
(Returnstate tv tk tm).
Remark val_inject_function_pointer:
forall bound v fd f tv,
Genv.find_funct ge v = Some fd ->
match_globalenvs f bound ->
val_inject f v tv ->
tv = v.
(** Properties of [switch] compilation *)
Remark switch_table_shift:
forall n sl base dfl,
switch_target n (S dfl) (switch_table sl (S base)) =
S (switch_target n dfl (switch_table sl base)).
Remark length_switch_table:
forall sl base1 base2,
length (switch_table sl base1) = length (switch_table sl base2).
Inductive transl_lblstmt_cont(cenv: compilenv) (xenv: exit_env): lbl_stmt -> cont -> cont -> Prop :=
| tlsc_default: forall s k ts,
transl_stmt cenv (switch_env (LSdefault s) xenv) s = OK ts ->
transl_lblstmt_cont cenv xenv (LSdefault s) k (Kblock (Kseq ts k))
| tlsc_case: forall i s ls k ts k',
transl_stmt cenv (switch_env (LScase i s ls) xenv) s = OK ts ->
transl_lblstmt_cont cenv xenv ls k k' ->
transl_lblstmt_cont cenv xenv (LScase i s ls) k (Kblock (Kseq ts k')).

Lemma transl_lblstmt_suffix:
forall n cenv xenv ls body ts,
transl_lblstmt cenv (switch_env ls xenv) ls body = OK ts ->
let ls' := select_switch n ls in
exists body', exists ts',
transl_lblstmt cenv (switch_env ls' xenv) ls' body' = OK ts'.