Opaque OrdinalPool.containsThread.
(** *** Safety and simulation lemmas *)

(* Specifications: *)
(** If some state is [csafe] then it can take a [cmachine_step]*)
Lemma csafe_internal_step:
forall tp tr m i (cnti: containsThread tp i) U n
(Hn: n > 0)
(Hcmpt: mem_compatible tp m),
let mrestr := restrPermMap ((compat_th _ _ Hcmpt cnti).1) in
forall (Hinternal: cnti$mrestr @ I)
(Hsafe: csafe ((i :: U),tr,tp) m n),
exists tp' tr' m', cmachine_step ((i :: U), tr, tp) m
((i :: U), tr ++ tr', tp') m'.
(** Proof of simulation for internal steps*)
Lemma sim_internal : sim_internal_def.
Opaque containsThread getThreadC getThreadR.
(** ** Proof of simulation for stop steps *)
Lemma suspend_step_inverse:
forall i U U' tpc trc tpc' trc' mc mc'
(cnt: containsThread tpc i)
(Hcompc: mem_compatible tpc mc),
let mrestr := restrPermMap (((compat_th _ _ Hcompc) cnt).1) in
forall (Hsuspend: cnt$mrestr @ S)
(Hstep: cmachine_step (i :: U, trc, tpc) mc (U', trc', tpc') mc'),
U = U' /\ mc = mc' /\ trc = trc' /\ mem_compatible tpc mc /\
suspend_thread mc cnt tpc'.
Lemma mem_obs_eq_step:
forall tp1 tp2 tp1' m1 m2 m1' j f fg
(pf1j: containsThread tp1 j)
(pf1j': containsThread tp1' j)
(Hcomp1: mem_compatible tp1 m1)
(Hcomp1': mem_compatible tp1' m1')
(Hinv: invariant tp1')
(Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2)
(Hge_wd: ge_wd fg the_ge)
(Hge_incr: ren_incr fg f)
(Hvalid_mem: valid_mem m1)
(Hcode_eq: ctl_inj f (getThreadC pf1j) (getThreadC pf1j'))
(Hmem_obs_eq: mem_obs_eq f (restrPermMap (compat_th _ _ Hcomp1 pf1j).1)
(restrPermMap (compat_th _ _ Hcomp1' pf1j').1))
(Hstep: internal_step pf1j Hcomp1 tp2 m2),
exists tp2' m2' f',
internal_step pf1j' Hcomp1' tp2' m2' /\
ren_incr f f' /\
ren_separated f f' m1 m1' /\
((exists p, ((Mem.nextblock m2 = Mem.nextblock m1 + p)%positive /\
(Mem.nextblock m2' = Mem.nextblock m1' + p)%positive))
\/ ((Mem.nextblock m2 = Mem.nextblock m1) /\
(Mem.nextblock m2' = Mem.nextblock m1'))) /\
(forall b,
Mem.valid_block m2' b ->
~ Mem.valid_block m1' b ->
let bz := ((Zpos b) - ((Zpos (Mem.nextblock m1')) -
(Zpos (Mem.nextblock m1))))%Z in
f' (Z.to_pos bz) = Some b /\
f (Z.to_pos bz) = None) /\
(exists (pf2j: containsThread tp2 j)
(pf2j': containsThread tp2' j)
(Hcomp2: mem_compatible tp2 m2)
(Hcomp2': mem_compatible tp2' m2'),
ctl_inj f' (getThreadC pf2j) (getThreadC pf2j') /\
mem_obs_eq f' (restrPermMap (compat_th _ _ Hcomp2 pf2j).1)
(restrPermMap (compat_th _ _ Hcomp2' pf2j').1)) /\
(Mem.nextblock m1 = Mem.nextblock m1' ->
(forall b1 b2 : block, f b1 = Some b2 -> b1 = b2) ->
forall b1 b2 : block, f' b1 = Some b2 -> b1 = b2).
Lemma mem_obs_eq_execution:
forall tp1 tp2 tp1' m1 m2 m1' j xs f fg
(pf1j: containsThread tp1 j)
(pf1j': containsThread tp1' j)
(Hcomp1: mem_compatible tp1 m1)
(Hcomp1': mem_compatible tp1' m1')
(Hinv: invariant tp1')
(Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2)
(Hge_wd: ge_wd fg the_ge)
(Hge_incr: ren_incr fg f)
(Hvalid_mem: valid_mem m1)
(Htp_wd: tp_wd f tp1)
(Hcode_eq: ctl_inj f (getThreadC pf1j) (getThreadC pf1j'))
(Hmem_obs_eq: mem_obs_eq f (restrPermMap (compat_th _ _ Hcomp1 pf1j).1)
(restrPermMap (compat_th _ _ Hcomp1' pf1j').1))
(Hexec: internal_execution [seq x <- xs | x == j] tp1 m1 tp2 m2),
exists tp2' m2' f',
internal_execution [seq x <- xs | x == j] tp1' m1' tp2' m2' /\
ren_incr f f' /\
ren_separated f f' m1 m1' /\
((exists p, ((Mem.nextblock m2 = Mem.nextblock m1 + p)%positive /\
(Mem.nextblock m2' = Mem.nextblock m1' + p)%positive))
\/ ((Mem.nextblock m2 = Mem.nextblock m1) /\
(Mem.nextblock m2' = Mem.nextblock m1'))) /\
(forall b,
Mem.valid_block m2' b ->
~ Mem.valid_block m1' b ->
let bz := ((Zpos b) - ((Zpos (Mem.nextblock m1')) -
(Zpos (Mem.nextblock m1))))%Z in
f' (Z.to_pos bz) = Some b /\
f (Z.to_pos bz) = None) /\
(exists (pf2j: containsThread tp2 j)
(pf2j': containsThread tp2' j)
(Hcomp2: mem_compatible tp2 m2)
(Hcomp2': mem_compatible tp2' m2'),
ctl_inj f' (getThreadC pf2j) (getThreadC pf2j') /\
mem_obs_eq f' (restrPermMap (compat_th _ _ Hcomp2 pf2j).1)
(restrPermMap (compat_th _ _ Hcomp2' pf2j').1)) /\
(Mem.nextblock m1 = Mem.nextblock m1' ->
(forall b1 b2 : block, f b1 = Some b2 -> b1 = b2) ->
forall b1 b2 : block, f' b1 = Some b2 -> b1 = b2).
(*TODO: this is a stronger version of the above, I should reuse the above proof as much as possible, but for now I am just copy-pasting*)
Lemma strong_tsim_step:
forall tp1 tp2 tp1' m1 m2 m1' j f fg
(pf1j: containsThread tp1 j)
(pf1j': containsThread tp1' j)
(Hcomp1: mem_compatible tp1 m1)
(Hcomp1': mem_compatible tp1' m1')
(Hinv: invariant tp1')
(Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2)
(Hge_wd: ge_wd fg the_ge)
(Hge_incr: ren_incr fg f)
(Hvalid_mem: valid_mem m1)
(Hsim: strong_tsim f pf1j pf1j' Hcomp1 Hcomp1')
(Hstep: internal_step pf1j Hcomp1 tp2 m2),
exists tp2' m2' f',
internal_step pf1j' Hcomp1' tp2' m2' /\
ren_incr f f' /\
ren_separated f f' m1 m1' /\
((exists p, ((Mem.nextblock m2 = Mem.nextblock m1 + p)%positive /\
(Mem.nextblock m2' = Mem.nextblock m1' + p)%positive))
\/ ((Mem.nextblock m2 = Mem.nextblock m1) /\
(Mem.nextblock m2' = Mem.nextblock m1'))) /\
(forall b,
Mem.valid_block m2' b ->
~ Mem.valid_block m1' b ->
let bz := ((Zpos b) - ((Zpos (Mem.nextblock m1')) -
(Zpos (Mem.nextblock m1))))%Z in
f' (Z.to_pos bz) = Some b /\
f (Z.to_pos bz) = None) /\
(exists (pf2j: containsThread tp2 j)
(pf2j': containsThread tp2' j)
(Hcomp2: mem_compatible tp2 m2)
(Hcomp2': mem_compatible tp2' m2'),
strong_tsim f' pf2j pf2j' Hcomp2 Hcomp2') /\
(Mem.nextblock m1 = Mem.nextblock m1' ->
(forall b1 b2 : block, f b1 = Some b2 -> b1 = b2) ->
forall b1 b2 : block, f' b1 = Some b2 -> b1 = b2).
Lemma strong_tsim_execution:
forall tp1 tp2 tp1' m1 m2 m1' j xs f fg
(pf1j: containsThread tp1 j)
(pf1j': containsThread tp1' j)
(Hcomp1: mem_compatible tp1 m1)
(Hcomp1': mem_compatible tp1' m1')
(Hinv: invariant tp1')
(Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2)
(Hge_wd: ge_wd fg the_ge)
(Hge_incr: ren_incr fg f)
(Hvalid_mem: valid_mem m1)
(Htp_wd: tp_wd f tp1)
(Hsim: strong_tsim f pf1j pf1j' Hcomp1 Hcomp1')
(Hexec: internal_execution [seq x <- xs | x == j] tp1 m1 tp2 m2),
exists tp2' m2' f',
internal_execution [seq x <- xs | x == j] tp1' m1' tp2' m2' /\
ren_incr f f' /\
ren_separated f f' m1 m1' /\
((exists p, ((Mem.nextblock m2 = Mem.nextblock m1 + p)%positive /\
(Mem.nextblock m2' = Mem.nextblock m1' + p)%positive))
\/ ((Mem.nextblock m2 = Mem.nextblock m1) /\
(Mem.nextblock m2' = Mem.nextblock m1'))) /\
(forall b,
Mem.valid_block m2' b ->
~ Mem.valid_block m1' b ->
let bz := ((Zpos b) - ((Zpos (Mem.nextblock m1')) -
(Zpos (Mem.nextblock m1))))%Z in
f' (Z.to_pos bz) = Some b /\
f (Z.to_pos bz) = None) /\
(exists (pf2j: containsThread tp2 j)
(pf2j': containsThread tp2' j)
(Hcomp2: mem_compatible tp2 m2)
(Hcomp2': mem_compatible tp2' m2'),
strong_tsim f' pf2j pf2j' Hcomp2 Hcomp2') /\
(Mem.nextblock m1 = Mem.nextblock m1' ->
(forall b1 b2 : block, f b1 = Some b2 -> b1 = b2) ->
forall b1 b2 : block, f' b1 = Some b2 -> b1 = b2).
Lemma strong_tsim_stop:
forall tpc trc tpc' trc' tpf mc mc' mf i fi fg
(pfc: containsThread tpc i) (pff: containsThread tpf i)
(Hcompc: mem_compatible tpc mc) (Hcompf: mem_compatible tpf mf)
(Hfg: forall b1 b2, fg b1 = Some b2 -> b1 = b2)
(Hge_wd: ge_wd fg the_ge)
(Hge_incr: ren_incr fg fi)
(HinvF: invariant tpf)
(Hstrong_sim: strong_tsim fi pfc pff Hcompc Hcompf)
(Hmem_wd: valid_mem mc)
(Hstep: cmachine_step ([:: i], trc, tpc) mc ([::], trc', tpc') mc'),
let mrestr := restrPermMap ((compat_th _ _ Hcompc pfc).1) in
forall (Hsuspend: pfc$mrestr @ S),
exists tpf',
suspend_thread mf pff tpf' /\
forall (Hcompc': mem_compatible tpc' mc') (Hcompf' : mem_compatible tpf' mf)
(pfc': containsThread tpc' i) (pff': containsThread tpf' i),
strong_tsim fi pfc' pff' Hcompc' Hcompf'.