Section SCErasure.
Context {Sem: Semantics}
{SemAxioms: SemAxioms}
{SemD: SemDet}
{CE: CoreErasure}
{initU: seq.seq nat}.
Existing Instance OrdinalPool.OrdinalThreadPool.
Existing Instance DryHybridMachine.dryResources.
Existing Instance DryHybridMachine.DryHybridMachineSig.
Existing Instance dryFineMach.
Existing Instance FineDilMem.
Existing Instance HybridFineMachine.scheduler.
Existing Instance BareMachine.resources.
Existing Instance BareMachine.BareMachineSig.
Existing Instance BareDilMem.
Existing Instance bareMach.
Notation syncStepF := (@syncStep DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation syncStepE := (@syncStep BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation start_threadF := (@start_thread DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation start_threadE := (@start_thread BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation resume_threadF := (@resume_thread DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation resume_threadE := (@resume_thread BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation suspend_threadF := (@suspend_thread DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation suspend_threadE := (@suspend_thread BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation threadStepF := (@threadStep DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig).
Notation threadStepE := (@threadStep BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig).
Notation fstep := (corestep (@fine_semantics _ initU)).
Notation scstep := (corestep (@bare_semantics _ initU)).
Notation fsafe := (@HybridFineMachine.fsafe DryHybridMachine.dryResources _ OrdinalPool.OrdinalThreadPool
DryHybridMachine.DryHybridMachineSig FineDilMem).
Notation sc_safe := (@HybridFineMachine.fsafe BareMachine.resources _ OrdinalPool.OrdinalThreadPool
BareMachine.BareMachineSig BareDilMem).
Notation fexecution := (@fine_execution _ FineDilMem DryHybridMachine.dryResources).
Notation sc_execution := (@fine_execution _ BareDilMem BareMachine.resources).
(** ** Simulation for syncStep, startStep, resumeStep, suspendStep *)
Hint Resolve mem_erasure_restr : erased.
Proof with eauto with val_erasure erased.
intros.
inversion HerasePool as [Hnum Hthreads].
specialize (Hthreads _ cnti cnti').
inversion Hstep; subst;
match goal with
| [H: ctl_erasure ?Expr1 ?Expr2, H1: ?Expr1 = _ |- _] =>
rewrite H1 in H; destruct Expr2 eqn:?; simpl in H
end; try (by exfalso);
try match goal with
| [H: Mem.load _ _ _ _ = Some _ |- _] =>
eapply mem_load_erased in H; eauto with val_erasure erased;
destruct Hload as [? [Hload ?]]
end;
try match goal with
| [H: Mem.store _ _ _ _ _ = Some _ |- _] =>
eapply mem_store_erased in H; eauto with val_erasure erased;
destruct Hstore as [m2' [Hstore Hmem_erasure']]
end;
try match goal with
| [|- _ <> Vundef] => intro Hcontra; discriminate
end;
match goal with
| [H: at_external _ _ (restrPermMap ?E1) = _, H1: core_erasure _ _   |- _] =>
pose proof (at_external_erase _ _ H1 (mem_erasure_restr E1 Hmem_erasure) H) as Hat_external';
destruct Hat_external' as [vs' [Hat_external' Hval_erasure]]
end;
repeat match goal with
| [H: _ /\ _ |- _] => destruct H
| [H: val_erasure_list _ _ |- _] =>
inv H
| [H: val_erasure (Vptr _ _) _ |- _] => inv H
| [H:val_erasure (Vint _) _ |- _] => inv H
end; subst.
- exists (updThreadC cnti' (Kresume s Vundef)), m2'.
split; [econstructor; eauto | split; eauto].
constructor. simpl; eauto.
intros j cntj cntj'.
rewrite gLockSetCode.
destruct (i == j) eqn:Hij; move/eqP:Hij=>Hij.
+ subst.
rewrite gssThreadCode.
rewrite gssThreadCC.
simpl;
now auto.
+ rewrite gsoThreadCode; auto.
assert (cntj0' := cntUpdateC' _ _ cntj').
erewrite <- @gsoThreadCC with (cntj := cntj0')
by eauto.
inversion HerasePool;
now eauto.
- exists (updThreadC cnti' (Kresume s Vundef)), m2'.
split; [econstructor; eauto | split; eauto].
constructor. simpl; eauto.
intros j cntj cntj'.
rewrite gLockSetCode.
destruct (i == j) eqn:Hij; move/eqP:Hij=>Hij.
+ subst.
rewrite gssThreadCode.
rewrite gssThreadCC.
simpl;
now auto.
+ rewrite gsoThreadCode; auto.
assert (cntj0' := cntUpdateC' _ _ cntj').
erewrite <- @gsoThreadCC with (cntj := cntj0')
by eauto.
inversion HerasePool;
now eauto.
- exists (addThread
(updThreadC cnti' (Kresume s Vundef))
(Vptr b ofs) v'0 tt), m1'.
split; [econstructor; eauto | split; eauto].
eapply erased_addThread; eauto...
eapply erased_updThread; eauto...
simpl;
split;
now eauto...
- exists (updThreadC cnti' (Kresume s Vundef)), m2'.
split; [econstructor; eauto | split; eauto].
constructor. simpl; eauto.
intros j cntj cntj'.
rewrite gLockSetCode.
destruct (i == j) eqn:Hij; move/eqP:Hij=>Hij.
+ subst.
rewrite gssThreadCode.
rewrite gssThreadCC.
simpl; auto.
+ rewrite gsoThreadCode; auto.
assert (cntj0' := cntUpdateC' _ _ cntj').
erewrite <- @gsoThreadCC with (cntj := cntj0')
by eauto.
inversion HerasePool; eauto.
- exists (updThreadC cnti' (Kresume s Vundef)), m1'.
split; [econstructor; eauto | split; eauto].
constructor. simpl; eauto.
intros j cntj cntj'.
rewrite gRemLockSetCode.
destruct (i == j) eqn:Hij; move/eqP:Hij=>Hij.
+ subst.
rewrite gssThreadCode.
rewrite gssThreadCC.
simpl; auto.
+ rewrite gsoThreadCode; auto.
assert (cntj0' := cntUpdateC' _ _ cntj').
erewrite <- @gsoThreadCC with (cntj := cntj0')
by eauto.
inversion HerasePool; eauto.
- exists tp1', m1'.
split; [econstructor; eauto | split; eauto].
Qed.
Ltac pf_cleanup :=
repeat match goal with
| [H1: invariant ?X, H2: invariant ?X |- _] =>
assert (H1 = H2) by (by eapply proof_irr);
subst H2
| [H1: mem_compatible ?TP ?M, H2: mem_compatible ?TP ?M |- _] =>
assert (H1 = H2) by (by eapply proof_irr);
subst H2
| [H1: is_true (leq ?X ?Y), H2: is_true (leq ?X ?Y) |- _] =>
assert (H1 = H2) by (by eapply proof_irr); subst H2
| [H1: containsThread ?TP ?M, H2: containsThread ?TP ?M |- _] =>
assert (H1 = H2) by (by eapply proof_irr); subst H2
| [H1: containsThread ?TP ?M,
H2: containsThread (@updThreadC _ ?TP _ _) ?M |- _] =>
apply cntUpdateC' in H2;
assert (H1 = H2) by (by eapply cnt_irr); subst H2
| [H1: containsThread ?TP ?M,
H2: containsThread (@updThread _ ?TP _ _ _) ?M |- _] =>
apply cntUpdate' in H2;
assert (H1 = H2) by (by eapply cnt_irr); subst H2
end.
Proof with eauto with trace_erasure mem_erasure.
intros.
inversion Hfstep; subst;
inv HschedN;
try match goal with
| [H: containsThread _ ?I |- _ ] =>
assert (containsThread tp1' I)
by (eapply erasedPool_contains; simpl in *; subst; eauto)
end;
assert (Hcomp1' : mem_compatible tp1' m1')
by (simpl; unfold BareMachine.mem_compatible; auto).
- (* start thread case *)
assert (Hstep' := startStep_erasure HerasePool Hmem_erasure H Hcomp1' Htstep).
destruct Hstep' as [tp2' [m2' [Hstart' [HerasePool' Herasemem']]]].
exists tp2', (@diluteMem BareDilMem m2'), tr1'.
split. econstructor 1; simpl; eauto.
simpl in *; subst.
split; eauto...
- assert (Hstep' := resumeStep_erasure HerasePool Hmem_erasure H Hcomp1' Htstep).
destruct Hstep' as [tp2' [Hstart' HerasePool']].
exists tp2', m1', tr1'.
split. econstructor 2; simpl; eauto.
simpl in *; subst.
split; now eauto.
- assert (Htstep' := threadStep_erase HerasePool H Hmem_erasure Hcomp1' Htstep).
destruct Htstep' as (tp2' & m2' & ev' & Htstep' & HerasePool'
& Hmem_erasure' & Htr_erasure').
exists tp2', (@diluteMem BareDilMem m2'), (tr1' ++ map [eta Events.internal tid] ev').
split.
assert (Hsched: U = @yield HybridFineMachine.scheduler (tid :: U)) by reflexivity.
rewrite Hsched.
eapply thread_step; eauto.
split...
simpl in *; subst.
split...
- assert (Hstep' := suspendStep_erasure HerasePool Hmem_erasure H Hcomp1' Htstep).
destruct Hstep' as [tp2' [Hstart' HerasePool']].
exists tp2', m1', tr1'.
split. econstructor 4; simpl; eauto.
simpl in *; subst.
split; now eauto.
- assert (Hstep' := syncStep_erase HerasePool H Hmem_erasure Hcomp1' Htstep).
destruct Hstep' as (tp2' & m2' & Hstep' & HerasePool' & Hmem_erasure').
exists tp2', m2', (tr1' ++ [:: Events.external tid (eraseSyncEvent ev)]).
split.
eapply sync_step; eauto.
simpl in *; subst.
split...
- assert (~ containsThread tp1' tid).
{ intros Hcontra.
destruct HerasePool as [Hnum _].
unfold containsThread in *.
simpl in *; subst.
rewrite <- Hnum in Hcontra.
auto.
}
exists tp1', m1',tr1'.
split.
econstructor 6; simpl; eauto.
simpl in *; subst.
split; now eauto.
Qed.
Proof with eauto.
intros U.
induction U.
- intros.
inversion Hexec; subst.
exists tpsc, msc, trsc.
split.
econstructor 1. simpl; auto.
split...
- intros.
inversion Hexec; subst.
+ simpl in H5; by exfalso.
+ eapply sc_sim with (tr1' := trsc) in H8; eauto.
destruct H8 as (tpsc0 & msc0 & tr0 & Hstep0 & HerasedPool0
& Hmem_erasure0 & Htrace_erasure0).
specialize (IHU _ _ _ _ _ _ _ _ _ tr0 H9 HerasedPool0
Hmem_erasure0).
destruct IHU as (tpsc2' & msc2' & trsc2' & Hsexec & HerasedPool'
& Hmem_erasure' & Htrace_erasure2').
exists tpsc2', msc2', trsc2'.
split...
pose proof (step_trace_monotone Hstep0) as Htr0.
destruct Htr0 as [trsc' Htrsc'];
subst.
pose proof (fine_execution_schedule Hsexec); subst.
pose proof (fine_execution_multi_step Hsexec).
eapply multi_step_trace_monotone in H.
destruct H as [tr''' ?].
subst.
rewrite <- catA.
rewrite <- catA in Hsexec.
econstructor; simpl in *;
now eauto.
Qed.
Proof with eauto.
intros.
assert (HpoolErase := init_erasure HinitSC HinitF).
assert (HmemErase : mem_erasure (@diluteMem FineDilMem m') (@diluteMem BareDilMem m')).
{ eapply mem_erasure_dilute_1.
econstructor; eauto.
intros.
assert (Hvalid: Mem.valid_block m' b)
by (unfold Mem.valid_block, diluteMem, erasePerm in *;
simpl in *; auto).
assert (Hperm:= erasePerm_V ofs k Hvalid).
unfold permission_at in Hperm; auto.
simpl.
intros.
eapply memval_erasure_refl.
}
split; first by (intros n; eapply fsafe_implies_scsafe; eauto).
intros.
eapply execution_sim with (trsc := [::]) in H; eauto.
destruct H as (? & ? & ? & ?& ?& ? & Htrace_erasure).
specialize (Htrace_erasure ltac:(by constructor)).
do 3 eexists; split...
Qed.

Corollary init_fsafe_implies_scsafe:
forall f arg tpsc tpf m m'
(HinitSC: bare_init initU m (initU, [::], tpsc) m' f arg)
(HinitF: tpf_init initU m (initU, [::], tpf) m' f arg)
(HsafeF: forall n, fsafe tpf (@diluteMem FineDilMem m') initU n),
forall n, sc_safe tpsc (@diluteMem BareDilMem m') initU n.