Opaque lockRes.

(* Specifications: *)
(** Stepping on thread i with internal steps and then a suspend step retains a strong simulation with the id injection on all other threads*)
Lemma strong_tsim_id :
forall tp tp' tp'' m m' i j xs f fg
(Hij: i <> j)
(pfj: containsThread tp j)
(pfj': containsThread tp' j)
(pfj'': containsThread tp'' j)
(pfi': containsThread tp' i)
(Hmem_wd: valid_mem m)
(Hdomain: domain_memren f m)
(Htp_wd: tp_wd f tp)
(Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2)
(Hge_wd: ge_wd fg the_ge)
(Hcomp: mem_compatible tp m)
(Hcomp'': mem_compatible tp'' m')
(Hsuspend: suspend_thread m' pfi' tp'')
(Hexec: internal_execution [seq x <- xs | x == i] tp m tp' m'),
strong_tsim (id_ren m) pfj pfj'' Hcomp Hcomp''.
Lemma csafe_pop_step :
forall (tp : thread_pool) tr (m : mem) i (cnti : containsThread tp i)
U n
(Hcomp: mem_compatible tp m),
let mrestr := restrPermMap ((compat_th _ _ Hcomp cnti).1) in
forall (Hpop: cnti$mrestr @ E \/ cnti$mrestr @ S)
(Hsafe: csafe ((i :: U),tr,tp) m (S n)),
exists (tp' : thread_pool) tr' (m' : mem),
(cnti$mrestr @ S -> tr' = [::]) /\
cmachine_step ((i :: U), tr,tp) m (U, tr++tr',tp') m' /\
forall U'', csafe (U'',tr ++ tr',tp') m' n.
Lemma sim_suspend : sim_suspend_def.
(** ** Proofs about external steps*)
Lemma external_step_inverse :
forall U U' tp tr m tp' tr' m' i (cnti: containsThread tp i)
(Hcomp: mem_compatible tp m),
let mrestr := restrPermMap (((compat_th _ _ Hcomp) cnti).1) in
forall (Hexternal: cnti$mrestr @ E)
(Hstep: MachStep (i :: U, tr, tp) m (U', tr ++ tr', tp') m'),
U = U' /\ exists ev, syncStep true cnti Hcomp tp' m' ev /\ tr' = [:: external i ev].
(** Performing a store on some disjoint (coherent) part of the memory, retains a [mem_obs_eq] for data and [ctl_inj], using the id injection, for threads*)
Lemma strong_tsim_store_id:
forall tp tp' m m' i b ofs v pmap
(pfi: containsThread tp i)
(pfi': containsThread tp' i)
(Hresi: getThreadR pfi' = getThreadR pfi)
(Hcodei: getThreadC pfi' = getThreadC pfi)
(Hcomp: mem_compatible tp m)
(Hcomp': mem_compatible tp' m')
(Hlt: permMapLt pmap (getMaxPerm m))
(Hno_race: permMapCoherence (getThreadR pfi).1 pmap \/
permMapsDisjoint (getThreadR pfi).1 pmap)
(Hmem_wd: valid_mem m)
(Htp_wd: tp_wd (id_ren m) tp)
(Hstore: Mem.store Mint32 (restrPermMap Hlt) b ofs v = Some m'),
(ctl_inj (id_ren m) (getThreadC pfi) (getThreadC pfi')) /\
(mem_obs_eq (id_ren m) (restrPermMap (compat_th _ _ Hcomp pfi).1)
(restrPermMap ((compat_th _ _ Hcomp' pfi').1))) /\
(Mem.nextblock m = Mem.nextblock m').
Lemma strong_tsim_id_trans:
forall (tp1 tp1' tp2 : thread_pool) (m1 m1' m2 : mem)
(f : memren) i
(pf1 : containsThread tp1 i)
(pf1' : containsThread tp1' i)
(pf2 : containsThread tp2 i)
(Hcomp1 : mem_compatible tp1 m1)
(Hcomp1' : mem_compatible tp1' m1')
(Hcomp2 : mem_compatible tp2 m2)
(Hvalid: forall b, Mem.valid_block m1 b <-> Mem.valid_block m1' b)
(Hctl_id: ctl_inj (id_ren m1) (getThreadC pf1) (getThreadC pf1'))
(Hobs_eq_id: mem_obs_eq (id_ren m1) (restrPermMap (compat_th _ _ Hcomp1 pf1).1)
(restrPermMap (compat_th _ _ Hcomp1' pf1').1))
(Hctl_eq: ctl_inj f (getThreadC pf1) (getThreadC pf2))
(Hmem_obs_eq: mem_obs_eq f (restrPermMap (compat_th _ _ Hcomp1 pf1).1)
(restrPermMap (compat_th _ _ Hcomp2 pf2).1)),
ctl_inj f (getThreadC pf1') (getThreadC pf2) /\
mem_obs_eq f (restrPermMap (compat_th _ _ Hcomp1' pf1').1) (restrPermMap (compat_th _ _ Hcomp2 pf2).1).
(** If the [invariant] holds for the DryConc machine then it also holds for the FineConc machine provided that the two machines are related by a renaming relation*)
Lemma invariant_project:
forall (tpc tpf : thread_pool) (mc mf : mem) f rmap1 b1 b2 ofs
i (pff : containsThread tpf i) (pfc : containsThread tpc i)
(HmemCompC : mem_compatible tpc mc)
(HmemCompF : mem_compatible tpf mf)
(Hcanonical: isCanonical rmap1.1)
(Hcanonical2: isCanonical rmap1.2)
virtue c cf
(HinvF: invariant tpf)
(Hf: f b1 = Some b2),
let tpc' := updLockSet
(updThread pfc c (computeMap (getThreadR pfc)#1 virtue#1,
computeMap (getThreadR pfc)#2 virtue#2))
(b1, ofs) rmap1 in
let tpf' := updLockSet (updThread pff cf
(computeMap (getThreadR pff).1
(projectAngel f virtue.1),
computeMap (getThreadR pff).2
(projectAngel f virtue.2))) (b2, ofs)
(projectMap f rmap1.1, projectMap f rmap1.2) in
forall
(HinvC': invariant tpc')
(HsimWeak: forall tid (pfc0 : containsThread tpc tid)
(pff0 : containsThread tpf tid),
weak_tsim f pfc0 pff0 HmemCompC HmemCompF)
(Htsim: mem_obs_eq f (restrPermMap (compat_th _ _ HmemCompC pfc).1)
(restrPermMap (compat_th _ _ HmemCompF pff).1))
(HtsimL: mem_obs_eq f (restrPermMap (compat_th _ _ HmemCompC pfc).2)
(restrPermMap (compat_th _ _ HmemCompF pff).2))
(Hlocks: 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))
(Hlock_if: forall (bl1 bl2 : block) (ofs : Z),
f bl1 = Some bl2 ->
lockRes tpc (bl1, ofs) <-> lockRes tpf (bl2, ofs))
(HnumThreads: forall i, containsThread tpc i <-> containsThread tpf i),
invariant tpf'.
Lemma gss_mem_obs_eq_lock:
forall mc mf mc' mf' rmap rmapF bl1 bl2 ofsl f v
rmap' rmapF' virtue
(Hlt: permMapLt rmap (getMaxPerm mc))
(HltF: permMapLt rmapF (getMaxPerm mf))
(Hlt': permMapLt rmap' (getMaxPerm mc))
(HltF': permMapLt rmapF' (getMaxPerm mf))
(Hlt2: permMapLt (computeMap rmap virtue) (getMaxPerm mc'))
(Hlt2F: permMapLt (computeMap rmapF (projectAngel f virtue)) (getMaxPerm mf'))
(Hf: f bl1 = Some bl2)
(Hobs_eq: mem_obs_eq f (restrPermMap Hlt) (restrPermMap HltF))
(Hobs_eq': strong_mem_obs_eq f (restrPermMap Hlt') (restrPermMap HltF'))
(Hstore: Mem.mem_contents mc' = PMap.set bl1 (Mem.setN (encode_val Mint32 (Vint v)) ofsl (Mem.mem_contents mc) # bl1)
(Mem.mem_contents mc))
(HstoreF: Mem.mem_contents mf' = PMap.set bl2 (Mem.setN (encode_val Mint32 (Vint v)) ofsl (Mem.mem_contents mf) # bl2)
(Mem.mem_contents mf))
(Hvb: forall b, Mem.valid_block mc b <-> Mem.valid_block mc' b)
(HvbF: forall b, Mem.valid_block mf b <-> Mem.valid_block mf' b)
(Hjoin: permMapJoin rmap' rmap (computeMap rmap virtue)),
mem_obs_eq f (restrPermMap Hlt2) (restrPermMap Hlt2F).
Lemma gss_mem_obs_eq_unlock:
forall mc mf mc' mf' rmap rmapF bl1 bl2 ofsl f v
rmap' rmapF' rmap2 rmap2F
(Hlt': permMapLt rmap' (getMaxPerm mc'))
(HltF': permMapLt rmapF' (getMaxPerm mf'))
(Hlt2: permMapLt rmap2 (getMaxPerm mc))
(Hlt2F: permMapLt rmap2F (getMaxPerm mf))
(Hf: f bl1 = Some bl2)
(Hobs_eq2: mem_obs_eq f (restrPermMap Hlt2) (restrPermMap Hlt2F))
(Hstore: Mem.mem_contents mc' = PMap.set bl1 (Mem.setN (encode_val Mint32 (Vint v)) ofsl (Mem.mem_contents mc) # bl1)
(Mem.mem_contents mc))
(HstoreF: Mem.mem_contents mf' = PMap.set bl2 (Mem.setN (encode_val Mint32 (Vint v)) ofsl (Mem.mem_contents mf) # bl2)
(Mem.mem_contents mf))
(Hvb: forall b, Mem.valid_block mc b <-> Mem.valid_block mc' b)
(HvbF: forall b, Mem.valid_block mf b <-> Mem.valid_block mf' b)
(Hjoin: permMapJoin rmap' rmap rmap2)
(HpmapF: forall b, (~exists b', f b' = Some b) ->
forall ofs, (rmapF # b ofs = None /\ rmap2F # b ofs = rmapF' # b ofs) \/
(rmapF' # b ofs = None /\ rmap2F # b ofs = rmapF # b ofs))
(Hrmap': forall b1 b2 ofs, f b1 = Some b2 -> (rmap' # b1) ofs = (rmapF' # b2) ofs)
(Hrmap': forall b1 b2 ofs, f b1 = Some b2 -> (rmap # b1) ofs = (rmapF # b2) ofs),
mem_obs_eq f (restrPermMap Hlt') (restrPermMap HltF').
Lemma store_compatible:
forall tpf mf pmap chunk b ofs v mf' (Hlt: permMapLt pmap (getMaxPerm mf))
(Hcomp: mem_compatible tpf mf)
(Hstore: Mem.store chunk (restrPermMap Hlt) b ofs v = Some mf'),
mem_compatible tpf mf'.
Lemma mem_compatible_sync:
forall tpf mf cf virtue1 virtue2 f bl1 bl2 ofsl i
(pff: containsThread tpf i)
(Hcanonical1: isCanonical virtue2.1)
(Hcanonical2: isCanonical virtue2.2)
(Hf: f bl1 = Some bl2)
(HmaxF: max_inv mf)
(HmemCompF: mem_compatible tpf mf)
(Hcodomain_valid : forall b1 b2 : block,
f b1 = Some b2 -> Mem.valid_block mf b2),
let newPermMap := (computeMap (getThreadR pff).1 (projectAngel f virtue1.1),
computeMap (getThreadR pff).2 (projectAngel f virtue1.2)) in
let newLockMap := (projectMap f virtue2.1, projectMap f virtue2.2) in
mem_compatible (updLockSet (updThread pff cf newPermMap)
(bl2, ofsl) newLockMap) mf.
Lemma mem_compatible_spawn :
forall (tpf : thread_pool) (mf : mem) (cf : ctl)
virtue1 virtue2 (f : block -> option block)
vf args i (pff : containsThread tpf i)
(Hmax_inv: max_inv mf)
(HmemCompF: mem_compatible tpf mf)
(Hcodomain: forall b1 b2 : block, f b1 = Some b2 -> Mem.valid_block mf b2),
mem_compatible
(addThread
(updThread pff cf
(computeMap (getThreadR pff).1 (projectAngel f virtue1.1),
computeMap (getThreadR pff).2 (projectAngel f virtue1.2)))
vf args (computeMap empty_map (projectAngel f virtue2.1),
computeMap empty_map (projectAngel f virtue2.2))) mf.
(** [permMapJoin] is preserved through block renamings*)
Lemma permMapJoin_project:
forall (f : memren)
pmap pmapF pmap' pmapF' pmapR pmapRF
(HpmapF: forall b, (~exists b', f b' = Some b) ->
forall ofs, (pmapF # b ofs = None /\ pmapRF # b ofs = pmapF' # b ofs) \/
(pmapF' # b ofs = None /\ pmapRF # b ofs = pmapF # b ofs))
(Hangel: permMapJoin pmap pmap' pmapR)
(Hpmap: forall b1 b2 ofs, f b1 = Some b2 -> (pmap # b1) ofs = (pmapF # b2) ofs)
(Hpmap': forall b1 b2 ofs, f b1 = Some b2 -> (pmap' # b1) ofs = (pmapF' # b2) ofs)
(HpmapR: forall b1 b2 ofs, f b1 = Some b2 -> (pmapR # b1) ofs = (pmapRF # b2) ofs),
permMapJoin pmapF pmapF' pmapRF.
Lemma invariant_mklock:
forall tp c b ofs  i (cnti: containsThread tp i)
(Hinv: invariant tp)
(Hperm: forall ofs', Intv.In ofs' (ofs, ofs + Z.of_nat lksize.LKSIZE_nat)%Z ->
Mem.perm_order' ((getThreadR cnti)#1 # b ofs') Writable),
let tp' := (updThread cnti c
(setPermBlock (Some Nonempty) b ofs (getThreadR cnti)#1 lksize.LKSIZE_nat,
setPermBlock (Some Writable) b ofs
(getThreadR cnti)#2 lksize.LKSIZE_nat)) in
invariant tp'.
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).
Lemma invariant_freelock:
forall tpc tpf mc mf f c cf b1 b2 ofs pdata i
(Hf: f b1 = Some b2)
(pfc: containsThread tpc i)
(pff: containsThread tpf i),
let tpc' := remLockSet
(updThread pfc c
(setPermBlock_var pdata b1 ofs (getThreadR pfc)#1 lksize.LKSIZE_nat,
setPermBlock None b1 ofs
(getThreadR pfc)#2 lksize.LKSIZE_nat)) (b1,ofs) in
let tpf' := remLockSet (updThread pff cf
(setPermBlock_var pdata b2 ofs (getThreadR pff)#1 lksize.LKSIZE_nat,
setPermBlock None b2 ofs
(getThreadR pff)#2 lksize.LKSIZE_nat)) (b2, ofs) in
forall
(HinvF: invariant tpf)
(HinvC': invariant tpc')
(HmemCompC: mem_compatible tpc mc)
(HmemCompF: mem_compatible tpf mf)
(HsimWeak: forall tid (pfc0 : containsThread tpc tid)
(pff0 : containsThread tpf tid),
weak_tsim f pfc0 pff0 HmemCompC HmemCompF)
(Htsim: mem_obs_eq f (restrPermMap (compat_th _ _ HmemCompC pfc).1)
(restrPermMap (compat_th _ _ HmemCompF pff).1))
(HtsimL: mem_obs_eq f (restrPermMap (compat_th _ _ HmemCompC pfc).2)
(restrPermMap (compat_th _ _ HmemCompF pff).2))
(Hneq_perms: forall i,
(0 <= Z.of_nat i < lksize.LKSIZE)%Z ->
Mem.perm_order'' (pdata (S i)) (Some Writable)
)
(Hlocks: 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))
(Hlock_if: forall (bl1 bl2 : block) (ofs : Z),
f bl1 = Some bl2 ->
lockRes tpc (bl1, ofs) <-> lockRes tpf (bl2, ofs))
(HnumThreads: forall i, containsThread tpc i <-> containsThread tpf i),
invariant tpf'.
Lemma sim_external: sim_external_def.
End SimProofs.
Lemma gsoLockRes_fstepI :
forall tp tp' (m m' : mem) i tr tr'
U (pfi : containsThread tp i)
(Hcomp: mem_compatible tp m),
let mrestr := restrPermMap (((compat_th _ _ Hcomp) pfi).1) in
forall (Hinternal: pfi$mrestr @ I)
(Hstep: fmachine_step (i :: U,tr, tp) m (U, tr', tp') m'),
lockRes tp' = lockRes tp.
Lemma fmachine_step_disjoint_val :
forall tp tp' m m' i j U tr tr'
(Hneq: i <> j)
(pfi: containsThread tp i)
(pfj: containsThread tp j)
(pfj': containsThread tp' j)
(Hcomp: mem_compatible tp m)
(Hcomp': mem_compatible tp' m'),
let mrestr := restrPermMap (((compat_th _ _ Hcomp) pfi).1) in
forall (Hinternal: pfi$mrestr @ I)
(Hstep: fmachine_step (i :: U, tr, tp) m (U,tr', tp') m') b ofs
(Hreadable:
Mem.perm (restrPermMap (Hcomp _ pfj).1) b ofs Cur Readable \/
Mem.perm (restrPermMap (Hcomp _ pfj).2) b ofs Cur Readable),
Maps.ZMap.get ofs (Mem.mem_contents m) # b =
Maps.ZMap.get ofs (Mem.mem_contents m') # b.
Lemma fstep_valid_block:
forall tpf tpf' mf mf' i U b tr tr'
(Hvalid: Mem.valid_block mf b)
(Hstep: fmachine_step (i :: U, tr, tpf) mf (U, tr',tpf') mf'),
Mem.valid_block mf' b.