(*FreshS/T: fresh blocks in src/tgt language*)
Definition sm_add_intern (mu: SM_Injection) j FreshS FreshT : SM_Injection :=
Build_SM_Injection (fun b => locBlocksSrc mu b || FreshS b)
(fun b => locBlocksTgt mu b || FreshT b)
(pubBlocksSrc mu) (pubBlocksTgt mu)
(join (local_of mu) (fun b => match extern_of mu b with
None => j b | Some _ => None end))
(extBlocksSrc mu) (extBlocksTgt mu)
(frgnBlocksSrc mu) (frgnBlocksTgt mu) (extern_of mu).

(* Specifications: *)
Lemma sm_add_intern_wd: forall mu j FreshS FreshT (WD: SM_wd mu)
(HFreshS: forall b, FreshS b =true -> DomSrc mu b = false)
(HFreshT: forall b, FreshT b =true -> DomTgt mu b = false)
(JDomTgt: forall b1 b2 d, j b1 = Some (b2,d) ->
as_inj mu b1 = Some(b2,d) \/
(FreshS b1 = true /\ FreshT b2 = true)),
SM_wd (sm_add_intern mu j FreshS FreshT).
Lemma sm_add_intern_incr: forall mu j FreshS FreshT
(INC : inject_incr (as_inj mu) j) mu'
(Heqmu' : mu' = sm_add_intern mu j FreshS FreshT),
intern_incr mu mu'.
Lemma sm_add_intern_as_inj: forall mu j FreshS FreshT,
as_inj (sm_add_intern mu j FreshS FreshT) =
join (as_inj mu) (fun b => match extern_of mu b with
None => j b | Some _ => None end).
Lemma sm_add_intern_incr2: forall mu j FreshS FreshT
(INC : inject_incr (as_inj mu) j) mu'
(Heqmu' : mu' = sm_add_intern mu j FreshS FreshT),
inject_incr j (as_inj mu').
Lemma sm_add_intern_DomSrc: forall mu j FreshS FreshT,
DomSrc (sm_add_intern mu j FreshS FreshT) = fun b => DomSrc mu b || FreshS b.
Lemma sm_add_intern_DomTgt: forall mu j FreshS FreshT,
DomTgt (sm_add_intern mu j FreshS FreshT) = fun b => DomTgt mu b || FreshT b.
Lemma sm_add_intern_sep: forall mu j FreshS FreshT
(HFreshS: forall b, FreshS b =true -> DomSrc mu b = false)
(HFreshT: forall b, FreshT b =true -> DomTgt mu b = false)
(JDomTgt: forall b1 b2 d, j b1 = Some (b2,d) ->
as_inj mu b1 = Some(b2,d) \/
(FreshS b1 = true /\ FreshT b2 = true))
mu'
(Heqmu' : mu' = sm_add_intern mu j FreshS FreshT)
m1 m2 (WD: SM_wd mu)
(HFreshSm1: forall b, FreshS b =true -> ~Mem.valid_block m1 b)
(HFreshTm2: forall b, FreshT b =true -> ~Mem.valid_block m2 b),
sm_inject_separated mu mu' m1 m2.
Lemma sm_add_localloc: forall mu j m1 m2 m1' m2' mu'
(Heqmu' : mu' = sm_add_intern mu j (freshloc m1 m1') (freshloc m2 m2')),
sm_locally_allocated mu mu' m1 m2 m1' m2'.
Lemma Match_corestep: forall (GDE : genvs_domain_eq ge tge)
st1 m1 st1' m1' (CS: corestep cmin_eff_sem ge st1 m1 st1' m1')
st2 mu m2 (MC: Match_cores st1 mu st1 m1 st2 m2)
(R: list_norepet (map fst (prog_defs prog))),
exists st2' m2',
(corestep_plus cminsel_eff_sem tge st2 m2 st2' m2' \/
(measure st1' < measure st1)%nat /\
corestep_star cminsel_eff_sem tge st2 m2 st2' m2')
/\ exists mu',
intern_incr mu mu' /\
sm_inject_separated mu mu' m1 m2 /\
sm_locally_allocated mu mu' m1 m2 m1' m2' /\
Match_cores st1' mu' st1' m1' st2' m2' /\
SM_wd mu' /\
sm_valid mu' m1' m2'.
Lemma Match_init_cores: forall (v1 v2 : val) (sig : signature) entrypoints
(EP: In (v1, v2, sig) entrypoints)
(entry_points_ok : forall (v1 v2 : val) (sig : signature),
In (v1, v2, sig) entrypoints ->
exists
(b : Values.block) (f1 : Cminor.fundef) (f2 : fundef),
v1 = Vptr b Int.zero /\
v2 = Vptr b Int.zero /\
Genv.find_funct_ptr ge b = Some f1 /\
Genv.find_funct_ptr tge b = Some f2)
(vals1 : list val) (c1 : CMin_core) (m1 : mem) (j : meminj)
(vals2 : list val) (m2 : mem) (DomS DomT : Values.block -> bool)
(CSM_Ini :initial_core cmin_eff_sem ge v1 vals1 = Some c1)
(Inj: Mem.inject j m1 m2)
(VInj: Forall2 (val_inject j) vals1 vals2)
(PG: meminj_preserves_globals ge j)
(R : list_norepet (map fst (prog_defs prog)))
(J: forall b1 b2 d, j b1 = Some (b2, d) ->
DomS b1 = true /\ DomT b2 = true)
(RCH: forall b, REACH m2
(fun b' : Values.block => isGlobalBlock tge b' || getBlocks vals2 b') b =
true -> DomT b = true)
(InitMem : exists m0 : mem, Genv.init_mem prog = Some m0
/\ Ple (Mem.nextblock m0) (Mem.nextblock m1)
/\ Ple (Mem.nextblock m0) (Mem.nextblock m2))
(GDE: genvs_domain_eq ge tge)
(HDomS: forall b : Values.block, DomS b = true -> Mem.valid_block m1 b)
(HDomT: forall b : Values.block, DomT b = true -> Mem.valid_block m2 b),
exists c2 : CMinSel_core,
initial_core cminsel_eff_sem tge v2 vals2 = Some c2 /\
Match_cores c1
(initial_SM DomS DomT
(REACH m1
(fun b : Values.block => isGlobalBlock ge b || getBlocks vals1 b))
(REACH m2
(fun b : Values.block => isGlobalBlock tge b || getBlocks vals2 b))
j) c1 m1 c2 m2.
Lemma Match_eff_diagram_strong_perm:
forall (GDE : genvs_domain_eq ge tge)
st1 m1 st1' m1' (U1 : block -> Z -> bool)
(CS: effstep cmin_eff_sem ge U1 st1 m1 st1' m1')
st2 mu m2
(EffSrc: forall b ofs, U1 b ofs = true ->
Mem.valid_block m1 b -> vis mu b = true)
(MC: Match_cores st1 mu st1 m1 st2 m2)
(R: list_norepet (map fst (prog_defs prog))),
exists st2' m2' (U2 : block -> Z -> bool),
(effstep_plus cminsel_eff_sem tge U2 st2 m2 st2' m2' \/
(measure st1' < measure st1)%nat /\
effstep_star cminsel_eff_sem tge U2 st2 m2 st2' m2')
/\ exists mu',
intern_incr mu mu' /\
sm_inject_separated mu mu' m1 m2 /\
sm_locally_allocated mu mu' m1 m2 m1' m2' /\
Match_cores st1' mu' st1' m1' st2' m2' /\
SM_wd mu' /\
sm_valid mu' m1' m2' /\
(forall b2 ofs,
U2 b2 ofs = true ->
Mem.valid_block m2 b2 /\
(locBlocksTgt mu b2 = false ->
exists (b1 : block) (delta1 : Z),
foreign_of mu b1 = Some (b2, delta1) /\
U1 b1 (ofs - delta1) = true /\
Mem.perm m1 b1 (ofs - delta1) Max Nonempty)).
Lemma Match_AfterExternal:
forall mu st1 st2 m1 e vals1 m2 ef_sig vals2 e' ef_sig'
(MemInjMu : Mem.inject (as_inj mu) m1 m2)
(MatchMu : Match_cores st1 mu st1 m1 st2 m2)
(AtExtSrc : at_external cmin_eff_sem st1 = Some (e, ef_sig, vals1))
(AtExtTgt : at_external cminsel_eff_sem st2 = Some (e', ef_sig', vals2))
(ValInjMu : Forall2 (val_inject (restrict (as_inj mu) (vis mu))) vals1 vals2)
(pubSrc' : Values.block -> bool)
(pubSrcHyp : pubSrc' =
(fun b : Values.block =>
locBlocksSrc mu b && REACH m1 (exportedSrc mu vals1) b))
(pubTgt' : Values.block -> bool)
(pubTgtHyp : pubTgt' =
(fun b : Values.block =>
locBlocksTgt mu b && REACH m2 (exportedTgt mu vals2) b))
nu
(NuHyp : nu = replace_locals mu pubSrc' pubTgt')
nu' ret1 m1' ret2 m2'
(INC : extern_incr nu nu')
(SEP : sm_inject_separated nu nu' m1 m2)
(WDnu' : SM_wd nu')
(SMvalNu' : sm_valid nu' m1' m2')
(MemInjNu' : Mem.inject (as_inj nu') m1' m2')
(RValInjNu' : val_inject (as_inj nu') ret1 ret2)
(FwdSrc : mem_forward m1 m1')
(FwdTgt : mem_forward m2 m2')
(frgnSrc' : Values.block -> bool)
(frgnSrcHyp : frgnSrc' =
(fun b : Values.block =>
DomSrc nu' b &&
(negb (locBlocksSrc nu' b) &&
REACH m1' (exportedSrc nu' (ret1 :: nil)) b)))
(frgnTgt' : Values.block -> bool)
(frgnTgtHyp : frgnTgt' =
(fun b : Values.block =>
DomTgt nu' b &&
(negb (locBlocksTgt nu' b) &&
REACH m2' (exportedTgt nu' (ret2 :: nil)) b)))
mu'
(Mu'Hyp : mu' = replace_externs nu' frgnSrc' frgnTgt')
(UnchPrivSrc : Mem.unchanged_on
(fun (b : Values.block) (_ : Z) =>
locBlocksSrc nu b = true /\ pubBlocksSrc nu b = false) m1
m1')
(UnchLOOR : Mem.unchanged_on (local_out_of_reach nu m1) m2 m2'),
exists (st1' : CMin_core) (st2' : CMinSel_core),
after_external cmin_eff_sem (Some ret1) st1 = Some st1' /\
after_external cminsel_eff_sem (Some ret2) st2 = Some st2' /\
Match_cores st1' mu' st1' m1' st2' m2'.
(*program structure not yet updated to module*)
Theorem transl_program_correct:
forall (TRANSL: sel_program prog = OK tprog)
(R: list_norepet (map fst (prog_defs prog)))
entrypoints
(entry_points_ok :
forall v1 v2 sig,
In (v1, v2, sig) entrypoints ->
exists b f1 f2,
v1 = Vptr b Int.zero
/\ v2 = Vptr b Int.zero
/\ Genv.find_funct_ptr ge b = Some f1
/\ Genv.find_funct_ptr tge b = Some f2)
(init_mem: exists m0, Genv.init_mem prog = Some m0),
SM_simulation.SM_simulation_inject cmin_eff_sem
cminsel_eff_sem ge tge entrypoints.