(** * DryConc to FineConc simulation*)
From mathcomp.ssreflect Require Import ssreflect ssrbool ssrnat ssrfun eqtype seq fintype finfun.
Set Implicit Arguments.
(*NOTE: because of redefinition of [val], these imports must appear after Ssreflect eqtype.*)
Set Bullet Behavior "None".
Set Bullet Behavior "Strict Subproofs".
HybridMachine DryHybridMachine HybridMachineSig.
(** Step Type Imports*)
(** Memory Imports*)
Module SimDefs.
Section SimDefs.
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 dryCoarseMach.
(* Machine and Context Imports*)
(* Import Machine DryMachine ThreadPool AsmContext HybridMachine.Concur.mySchedule. *)
(* Machine and Context Imports*)
Notation Sch := schedule.
Notation CoarseSem := coarse_semantics.
Notation threadStep := (HybridMachineSig.threadStep the_ge).
Notation cmachine_step := ((corestep (AsmContext.coarse_semantics initU))).
Notation fmachine_step := ((corestep (AsmContext.fine_semantics initU))).
(** *** Simulations between individual threads. *)
(* Consider hiding thread_pool completely *)
(** The weak simulation is required to prove the correctness of concurrent calls. In particular, suppose that a thread executes an external call, this thread will be "synchronized" meaning that its permissions will be equal between the two machines. When the angel provides a new permission map for this thread we still need to show that it is compatible with the other threads, hence we need to know something about those threads as well. The fact that the permissions of the coarse grained machine are above the ones on the fine is enough to establish non-interference for the fine grained machine *)
Record weak_tsim {tpc tpf : t} (mc mf : Mem.mem)
{i} (f: memren) (pfc : containsThread tpc i)
(pff : containsThread tpf i) (compc: mem_compatible tpc mc)
(compf: mem_compatible tpf mf) : Prop :=
{ weak_tsim_data:
weak_mem_obs_eq f (restrPermMap (((compat_th _ _ compc) pfc).1))
(restrPermMap (((compat_th _ _ compf) pff).1));
weak_tsim_locks:
weak_mem_obs_eq f (restrPermMap (((compat_th _ _ compc) pfc).2))
(restrPermMap (((compat_th _ _ compf) pff).2))}.
Record strong_tsim {tpc tpf : threadPool.ThreadPool.t} (mc mf : Mem.mem) {i}
(f: memren) (pfc : containsThread tpc i)
(pff : containsThread tpf i) (compc: mem_compatible tpc mc)
(compf: mem_compatible tpf mf) : Prop :=
{ code_eq: ctl_inj f (getThreadC pfc) (getThreadC pff);
obs_eq_data: mem_obs_eq f (restrPermMap ((fst (compc i pfc))))
(restrPermMap (fst (compf i pff)));
obs_eq_locks: mem_obs_eq f (restrPermMap ((snd (compc i pfc))))
(restrPermMap (snd (compf i pff)));
}.
(** *** Simulation between events *)
Definition pmap_inj f (pmap1 pmap2 : access_map) :=
(forall b1 b2,
f b1 = Some b2 ->
Maps.PMap.get b1 pmap1 = Maps.PMap.get b2 pmap2) /\
(forall b1, f b1 = None ->
Maps.PMap.get b1 pmap1 = fun _ => None) /\
(forall b2, (exists ofs, Maps.PMap.get b2 pmap2 ofs <> None) ->
exists b1, f b1 = Some b2).
Definition isProjection (f : memren) (deltaMap deltaMap' : delta_map) : Prop :=
(forall b b',
f b = Some b' ->
Maps.PTree.get b deltaMap = Maps.PTree.get b' deltaMap').
Definition delta_inj (f : memren) (deltaMap deltaMap' : delta_map) : Prop :=
(forall b b',
f b = Some b' ->
match Maps.PTree.get b deltaMap, Maps.PTree.get b' deltaMap' with
| Some d1, Some d2 => d1 = d2
| Some d1, None => forall ofs, d1 ofs = None \/ d1 ofs = Some None
| None, None => True
| _, _ => False
end) /\
(forall b, f b = None ->
match Maps.PTree.get b deltaMap with
| None => True
| Some d => forall ofs, d ofs = None \/ d ofs = Some None
end ) /\
(forall b', (~exists b, f b = Some b') ->
Maps.PTree.get b' deltaMap' = None).
Definition delta_content_inj (f : memren) (deltaMap deltaMap' : delta_content) : Prop :=
(forall b b',
f b = Some b' ->
match Maps.PTree.get b deltaMap, Maps.PTree.get b' deltaMap' with
| Some d1, Some d2 => forall ofs, match d1 ofs, d2 ofs with
| Some mv1, Some mv2 =>
memval_obs_eq f mv1 mv2
| None, None => True
| _, _ => False
end
| None, None => True
| Some d1, None => forall ofs, d1 ofs = None
| None, Some d2 => False
end) /\
(forall b, f b = None ->
match Maps.PTree.get b deltaMap with
| None => True
| Some d => forall ofs, d ofs = None
end ) /\
(forall b', (~exists b, f b = Some b') ->
Maps.PTree.get b' deltaMap' = None).
Inductive event_sim (f:memren) : Events.machine_event -> Events.machine_event -> Prop :=
| ReleaseSim : forall i b1 b2 ofs dc1 dc2
(Hf: f b1 = Some b2)
(Hdelta_inj: delta_content_inj f dc1 dc2),
event_sim f (Events.external i (Events.release (b1,ofs) (Some dc1)))
(Events.external i (Events.release (b2,ofs) (Some dc2)))
| AcquireSim : forall i b1 b2 ofs dc1 dc2
(Hf: f b1 = Some b2)
(Hpmap1_inj: delta_content_inj f dc1 dc2),
event_sim f (Events.external i (Events.acquire (b1,ofs) (Some dc1)))
(Events.external i (Events.acquire (b2,ofs) (Some dc2)))
| MkLockSim : forall i b1 b2 ofs
(Hf: f b1 = Some b2),
event_sim f (Events.external i (Events.mklock (b1,ofs)))
(Events.external i (Events.mklock (b2, ofs)))
| FreeLockSim : forall i b1 b2 ofs
(Hf: f b1 = Some b2),
event_sim f (Events.external i (Events.freelock (b1,ofs)))
(Events.external i (Events.freelock (b2, ofs)))
| SpawnSim : forall i b1 b2 ofs dc1a dc2a dc1b dc2b
(Hf: f b1 = Some b2)
(Hinj1: delta_content_inj f dc1a dc2a)
(Hinj2: delta_content_inj f dc1b dc2b),
event_sim f (Events.external i (Events.spawn (b1, ofs) (Some dc1a) (Some dc1b)))
(Events.external i (Events.spawn (b2, ofs) (Some dc2a) (Some dc2b)))
| FAcqSim: forall i b1 b2 ofs
(Hf: f b1 = Some b2),
event_sim f (Events.external i (Events.failacq (b1,ofs)))
(Events.external i (Events.failacq (b2, ofs))).
Inductive trace_sim (f:memren) : event_trace -> event_trace -> Prop :=
| TraceEmpty : trace_sim f [::] [::]
| TraceCons : forall ev ev' tr tr'
(Hev: event_sim f ev ev')
(Htr: trace_sim f tr tr'),
trace_sim f (tr ++ [:: ev]) (tr' ++ [:: ev']).
(** *** Simulation between the two machines *)
(* simStrong now maintains the extra invariant that any new blocks from the internal execution are owned by thread tid. This is needed for the suspend_sim proof. Note that it's not possible to prove it just by the fact that only thread tid executes because 1. some location may be allocated and then freed in this multistep execution and 2. our relation only strongly relates the final state of the execution not in-between states. *)
Definition fpool tpc : Type :=
forall i (cnti: containsThread tpc i), memren.
Definition max_inv mf := forall b ofs, Mem.valid_block mf b ->
permission_at mf b ofs Max = Some Freeable.
(** Simulation relation between DryConc and FineConc: - The two machines have exactly the same threads. - The state of the DryConc machine is compatible with it's memory. - The same for FineConc. - The DryConc machine is safe for all schedules - There is a weak simulation ([weak_tsim]) between threads with the same id in the two machines - Blocks that are not yet committed (in the sense that the global renaming [f : memren] does not map these blocks) are mapped in different blocks by distinct thread renamings. - Every thread in the DryConc machine can be stepped as mandated by the delta [xs] until the DryCo   nc machine reaches a state for which this thread is in [strong_tsim] between the two machines. - Lock resources are related by the global renaming and the two machines have equivalent [lockRes] for mapped blocks - The [invariant] holds for the FineConc machine - The [Max] permissions on the memory of the FineConc machine are always set to [Freeable] - The state, memory, and genv of DryConc are well-formed (no dangling pointers) - the delta list [xs] contains only valid thread ids. *)
Record sim tpc trc mc tpf (trf : event_trace) mf (xs : seq nat) (f fg: memren) (fp: fpool tpc) fuelF : Prop :=
{ numThreads : forall i, containsThread tpc i <-> containsThread tpf i;
mem_compc: mem_compatible tpc mc;
mem_compf: mem_compatible tpf mf;
safeCoarse: forall sched tr,
HybridCoarseMachine.csafe (sched,tr,tpc) mc (fuelF + size xs);
simWeak:
forall tid
(pfc: containsThread tpc tid)
(pff: containsThread tpf tid),
weak_tsim f pfc pff mem_compc mem_compf;
fpSeperate: forall i j
(cnti: containsThread tpc i)
(cntj: containsThread tpc j)
(Hij: i <> j) b b' b2 b2'
(Hfb: f b = None)
(Hfb': f b' = None)
(Hfib: (fp _ cnti) b = Some b2)
(Hfjb': (fp _ cntj) b' = Some b2'),
b2 <> b2';
simStrong:
forall tid (pfc: containsThread tpc tid) (pff: containsThread tpf tid),
exists tpc' mc', ren_incr f (fp _ pfc) /\
([seq x <- xs | x == tid] = nil -> f = (fp _ pfc)) /\
internal_execution ([seq x <- xs | x == tid])
tpc mc tpc' mc' /\
(forall (pfc': containsThread tpc' tid)
(mem_compc': mem_compatible tpc' mc'),
strong_tsim (fp _ pfc) pfc' pff mem_compc' mem_compf) /\
(forall tid2 (pff2: containsThread tpf tid2)
(Hneq: tid <> tid2) b1 b2 ofs,
(fp _ pfc) b1 = Some b2 ->
f b1 = None ->
(getThreadR pff2).1 # b2 ofs = None /\ (getThreadR pff2).2 # b2 ofs = None) /\
(forall bl ofsl rmap b1 b2 ofs,
(fp _ pfc) b1 = Some b2 ->
f b1 = None ->
lockRes tpf (bl,ofsl) = Some rmap ->
rmap.1 # b2 ofs = None /\ rmap.2 # b2 ofs = None) /\
(forall b2, (~exists b1, fp _ pfc b1 = Some b2) ->
forall ofs, (getThreadR pff).1 # b2 ofs = None /\
(getThreadR pff).2 # b2 ofs = None);
simLockRes: (forall bl1 bl2 ofs rmap1 rmap2
(Hf: f bl1 = Some bl2)
(Hl1: lockRes tpc (bl1,ofs) = Some rmap1)
(Hl2: lockRes tpf (bl2,ofs) = Some rmap2),
strong_mem_obs_eq f (restrPermMap (fst ((compat_lp _ _ mem_compc) _ _ Hl1)))
(restrPermMap (fst ((compat_lp _ _ mem_compf) _ _ Hl2))) /\
strong_mem_obs_eq f (restrPermMap (snd ((compat_lp _ _ mem_compc) _ _ Hl1)))
(restrPermMap (snd ((compat_lp _ _ mem_compf) _ _ Hl2)))) /\
(forall bl2 ofs,
lockRes tpf (bl2, ofs) ->
exists bl1, f bl1 = Some bl2) /\
(forall bl1 bl2 ofs,
f bl1 = Some bl2 ->
lockRes tpc (bl1, ofs) <-> lockRes tpf (bl2, ofs));
unmappedRes:
forall bl ofsl rmap,
lockRes tpf (bl, ofsl) = Some rmap ->
forall b2, (~exists b1, f b1 = Some b2) ->
forall ofs, rmap.1 # b2 ofs = None /\
rmap.2 # b2 ofs = None;
invF: invariant tpf;
maxF: max_inv mf;
memc_wd: valid_mem mc;
tpc_wd: tp_wd f tpc;
thege_wd: ge_wd fg the_ge;
fg_spec: ren_incr fg f /\ forall b b', fg b = Some b' -> b = b';
xs_wd: forall i, List.In i xs -> containsThread tpc i;
(* traceWD: trace_wd f trc; *)
traceSim: trace_sim f trc trf
}.
Arguments sim : clear implicits.
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).
(** *** Simulations Diagrams *)
Definition sim_internal_def :=
forall tpc trc tpf trf (mc mf : Mem.mem) fuelF
(xs : Sch) (f fg : memren) (fp : fpool tpc) (i : NatTID.tid)
(pff: containsThread tpf i)
(Hsim: sim tpc trc mc tpf trf mf xs f fg fp (S (S fuelF))),
let mrestr := restrPermMap (((compat_th _ _ (mem_compf Hsim)) pff).1) in
forall (Hinternal: pff$mrestr @ I),
exists tpf' mf' fp' tr',
(forall U, fmachine_step (i :: U, trf, tpf) mf (U, tr', tpf') mf') /\
sim tpc trc mc tpf' trf mf' (i :: xs) f fg fp' (S fuelF).
Definition sim_external_def :=
forall tpc trc tpf trf (mc mf : Mem.mem) fuelF
(xs : Sch) (f fg : memren) (fp : fpool tpc) (i : NatTID.tid)
(pff: containsThread tpf i)
(Hsynced: ~ List.In i xs)
(Hsim: sim tpc trc mc tpf trf mf xs f fg fp (S (S fuelF))),
let mrestr := restrPermMap (((compat_th _ _ (mem_compf Hsim)) pff).1) in
forall (Hexternal: pff$mrestr @ E),
exists tpc' trc' mc' tpf' mf' f' fp' tr',
(forall U, fmachine_step (i :: U, trf, tpf) mf (U, tr', tpf') mf') /\
sim tpc' trc' mc' tpf' tr' mf' xs f' fg fp' (S fuelF).
(** When we reach a suspend step, we can ``synchronize'' the two machines by executing on the coarse machine the internal steps of the thread that reached the suspend step. The injection of this thread will now serve as the new injection. *)
Definition sim_suspend_def :=
forall tpc trc tpf trf (mc mf : Mem.mem) fuelF
(xs : Sch) (f fg : memren) (fp : fpool tpc) (i : NatTID.tid)
(pff: containsThread tpf i)
(Hsim: sim tpc trc mc tpf trf mf xs f fg fp (S (S fuelF))),
let mrestr := restrPermMap (((compat_th _ _ (mem_compf Hsim)) pff).1) in
forall (Hsuspend: pff$mrestr @ S),
exists tpc' trc' mc' tpf' mf' f' fp' tr',
(forall U, fmachine_step (i :: U, trf, tpf) mf (U, tr', tpf') mf') /\
sim tpc' (trc ++ trc') mc' tpf' trf mf' [seq x <- xs | x != i] f' fg fp'
(S fuelF).
Definition sim_fail_def :=
forall tpc trc tpf trf (mc mf : Mem.mem) fuelF
(xs : Sch) (f fg : memren) (fp : fpool tpc) (i : NatTID.tid)
(pff: ~ containsThread tpf i)
(Hsim: sim tpc trc mc tpf trf mf xs f fg fp (S (S fuelF))),
exists tr',
(forall U, fmachine_step (i :: U, trf, tpf) mf (U, tr', tpf) mf) /\
sim tpc trc mc tpf trf mf xs f fg fp (S fuelF).
End SimDefs.
Arguments sim {asmSem} {CI} tpc trc mc tpf trf mf xs f fg fp fuelF.
End SimDefs.
(** ** Proofs *)
Module SimProofs.
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 _).

(* Specifications: *)
(** Its proof of correctness under the assumption that f is injective *)
Lemma projectAngel_correct:
forall (f:memren) deltaMap
(Hf_injective: forall b1 b1' b2,
f b1 = Some b2 ->
f b1' = Some b2 ->
b1 = b1'),
isProjection f deltaMap (projectAngel f deltaMap).
Lemma projectAngel_correct_2:
forall (f:memren) deltaMap b'
(Hf: ~ exists b, f b = Some b'),
Maps.PTree.get b' (projectAngel f deltaMap) = None.
Lemma computeMap_projection_1:
forall (mc mf : mem) f
pmap pmapF
(Hlt: permMapLt pmap (getMaxPerm mc))
(HltF: permMapLt pmapF (getMaxPerm mf))
(virtue : delta_map)
(Hobs_eq: mem_obs_eq f (restrPermMap Hlt)
(restrPermMap HltF))
b1 b2
(Hf: f b1 = Some b2),
(computeMap pmapF (projectAngel f virtue)) # b2 =
(computeMap pmap virtue) # b1.
Lemma computeMap_projection_2:
forall f pmap
(virtue : delta_map) b2
(Hb1: ~ (exists b1 : block, f b1 = Some b2)),
(computeMap pmap (projectAngel f virtue)) # b2 =
pmap # b2.
Lemma computeMap_projection_3 :
forall  (f : memren) (virtue : delta_map) b1 b2
(Hf: f b1 = Some b2)
(Hinjective : forall b1 b1' b2 : block,
f b1 = Some b2 -> f b1' = Some b2 -> b1 = b1'),
(computeMap empty_map (projectAngel f virtue)) # b2 =
(computeMap empty_map virtue) # b1.