Section SimProofs.
Context {asmSem : Semantics}
{semAxioms : SemAxioms}
{semDet : SemDet}
{CI: CoreInj}
{initU : seq nat}.
Existing Instance OrdinalPool.OrdinalThreadPool.
Existing Instance DryHybridMachine.DryHybridMachineSig.
Existing Instance dryFineMach.
Existing Instance FineDilMem.
Existing Instance dryCoarseMach.
Existing Instance HybridFineMachine.scheduler.
Existing Instance HybridCoarseMachine.scheduler.
Existing Instance FineDilMem.
Existing Instance HybridCoarseMachine.DilMem.
Notation csafe := (HybridCoarseMachine.csafe).
Notation sim_fail_def := (@sim_fail_def _ _ initU).
Notation threadStep := (HybridMachineSig.threadStep).
Notation cmachine_step := ((corestep (AsmContext.coarse_semantics initU))).
Notation fmachine_step := ((corestep (AsmContext.fine_semantics initU))).
Notation "cnt '$' m '@'  'I'" := (getStepType cnt m Internal) (at level 80).
Notation "cnt '$' m '@'  'E'" := (getStepType cnt m Concurrent) (at level 80).
Notation "cnt '$' m '@'  'S'" := (getStepType cnt m Suspend) (at level 80).
Notation internal_step := (internal_step).
Notation internal_execution := (internal_execution).
Notation fyield := (@yield HybridFineMachine.scheduler).
Notation fdiluteMem := (@diluteMem FineDilMem).
Notation sim_internal_def := (@sim_internal_def _ _ initU).
Notation sim_suspend_def := (@sim_suspend_def _ _ initU).
Notation sim_external_def := (@sim_external_def _ _ initU).
(** NOTE: this is only needed to find out if a block is in the codomain of f, which is decidable *)
Hypothesis em : excluded_middle.
(** Function that projects the angel through a memory injection to compute a new angel *)
Definition projectAngel (f : memren) (deltaMap : delta_map) : delta_map :=
Maps.PTree.fold (fun acc b bperm =>
match f b with
| Some b' =>
Maps.PTree.set b' bperm acc
| None =>
acc end)
deltaMap (Maps.PTree.empty _).
(* Blocks that are not mapped by f are set to empty permission. This makes the invariant preservation easier. *)
Definition projectMap (f : memren) (pmap : access_map) : access_map :=
(pmap#1, Maps.PTree.fold (fun acc b bperm =>
match f b with
| Some b' =>
Maps.PTree.set b' bperm acc
| None =>
acc end)
pmap.2 (Maps.PTree.empty _)).
(** Proofs about [internal_execution] and [internal_step] *)
Existing Instance HybridCoarseMachine.DilMem.
Existing Instance HybridCoarseMachine.scheduler.
Notation corestepN := (corestepN (AsmContext.coarse_semantics initU)).
(*NOTE: how can we have tactics inside sections? *)
(** Solves absurd cases from fine-grained internal steps *)
Ltac absurd_internal Hstep :=
inversion Hstep; try inversion Htstep; subst; simpl in *; Tactics.pf_cleanup;
try match goal with
| [H: Some _ = Some _ |- _] => inversion H; subst
end; Tactics.pf_cleanup;
repeat match goal with
| [H: OrdinalPool.getThreadC ?Pf = _, Hint: ?Pf$_ @ I |- _] =>
unfold getStepType, ctlType in Hint; simpl in *;
rewrite H in Hint; simpl in Hint
| [H: getThreadC ?Pf = _, Hint: ?Pf$_ @ I |- _] =>
unfold getStepType, ctlType in Hint; simpl in *;
rewrite H in Hint; simpl in Hint
| [H1: match ?Expr with _ => _ end = _,
H2: ?Expr = _ |- _] => rewrite H2 in H1
(*     | [H1: is_true (isSome (halted ?Sem ?C)), H2: match at_external _ _ _ with _ => _ end = _ |- _] => destruct (at_external_halted_excl Sem C) as [Hext | Hcontra]; [rewrite Hext in H2; destruct (halted Sem C) eqn:Hh; [discriminate | by exfalso] | rewrite Hcontra in H1; by exfalso]*)
end; try discriminate; try (exfalso; by auto).
(** Starting from a well-defined state, an internal execution retains the well-definedeness for any injection that corresponds to the domain of the new memory. *)
(** Profs about [mem_obs_eq] and [weak_mem_obs_eq] *)
(** ** Proofs of internal step safety and simulation*)
(** *** Lemmas about renaming pools [fpool]*)
Definition updateFP {tpc i} (cnti: containsThread tpc i)
(fp: fpool tpc) (f' : memren) :=
fun j cntj => if i == j then f' else fp j cntj.
Definition addFP {tp} (fp: fpool tp) (f': memren) vf arg pmap :
fpool (addThread tp vf arg pmap).
Opaque OrdinalPool.containsThread.
(** *** Safety and simulation lemmas *)
Opaque containsThread getThreadC getThreadR.
Opaque lockRes.
(** ** Proofs about external steps*)

Lemma invariant_spawn:
forall (tpc tpf : thread_pool) (mc mf : mem) f
i (pff : containsThread tpf i) (pfc : containsThread tpc i)
(HmemCompC : mem_compatible tpc mc)
(HmemCompF : mem_compatible tpf mf)
virtue1 virtue2  c cf vf vff arg arg',
let threadPerm' := (computeMap (getThreadR pfc).1 virtue1.1,
computeMap (getThreadR pfc).2 virtue1.2) in
let threadPermF' := (computeMap (getThreadR pff).1 (projectAngel f virtue1.1),
computeMap (getThreadR pff).2 (projectAngel f virtue1.2)) in
let newThreadPerm := (computeMap empty_map virtue2#1, computeMap empty_map virtue2#2) in
let newThreadPermF := (computeMap empty_map (projectAngel f virtue2#1),
computeMap empty_map (projectAngel f virtue2#2)) in
forall
(HinvF: invariant tpf)
(HinvC': invariant
(addThread
(updThread pfc c threadPerm') vf arg newThreadPerm))
(HsimWeak: forall tid (pfc0 : containsThread tpc tid)
(pff0 : containsThread tpf tid),
weak_tsim f pfc0 pff0 HmemCompC HmemCompF)
(Htsim_data: mem_obs_eq f (restrPermMap (compat_th _ _ HmemCompC pfc).1)
(restrPermMap (compat_th _ _ HmemCompF pff).1))
(Htsim_locks: mem_obs_eq f (restrPermMap (compat_th _ _ HmemCompC pfc).2)
(restrPermMap (compat_th _ _ HmemCompF pff).2))
(HnumThreads: forall i, containsThread tpc i <-> containsThread tpf i)
(Hlock_mapped: forall (bl2 : block) (ofs : Z),
lockRes tpf (bl2, ofs) ->
exists bl1 : block, f bl1 = Some bl2)
(HsimRes:
forall (bl1 bl2 : block) (ofs : Z)
rmap1 rmap2,
f bl1 = Some bl2 ->
forall (Hl1 : lockRes tpc (bl1, ofs) = Some rmap1)
(Hl2 : lockRes tpf (bl2, ofs) = Some rmap2),
strong_mem_obs_eq f
(restrPermMap (compat_lp _ _ HmemCompC (bl1, ofs) _ Hl1).1)
(restrPermMap (compat_lp _ _ HmemCompF (bl2, ofs) _ Hl2).1) /\
strong_mem_obs_eq f
(restrPermMap (compat_lp _ _ HmemCompC (bl1, ofs) _ Hl1).2)
(restrPermMap (compat_lp _ _ HmemCompF (bl2, ofs) _ Hl2).2))
(Hunmapped_res: forall (bl : block) (ofsl : Z) rmap,
lockRes tpf (bl, ofsl) = Some rmap ->
forall b2 : block,
~ (exists b1 : block, f b1 = Some b2) ->
forall ofs : Z,
(rmap#1) # b2 ofs = None /\ (rmap#2) # b2 ofs = None)
(Hlock_if: forall (bl1 bl2 : block) (ofs : Z),
f bl1 = Some bl2 ->
lockRes tpc (bl1, ofs) <-> lockRes tpf (bl2, ofs)),
invariant
(addThread
(updThread pff cf threadPermF') vff arg'
newThreadPermF).