Section ConcurMatch. (* 360 *)
Record concur_match (ocd: option compiler_index)
(j:meminj) (cstate1: ThreadPool (Some hb)) (m1: Mem.mem) (cstate2: ThreadPool(Some (S hb))) (m2: mem):=
{ same_length: num_threads cstate1 = num_threads cstate2
; full_inj: Events.injection_full j m1 (* this is needed until we can prove
permission transfer is not deleted*)
; memcompat1: mem_compatible cstate1 m1
; memcompat2: mem_compatible cstate2 m2
(*; INJ: Mem.inject j m1 m2 *)
; lock_perm_preimage:
forall i (cnt1: ThreadPool.containsThread cstate1 i)
(cnt2: ThreadPool.containsThread cstate2 i),
perm_surj j (lock_perms _ _ cnt1) (lock_perms _ _  cnt2)
; INJ_threads:
forall i (cnt1: ThreadPool.containsThread cstate1 i)
(cnt2: ThreadPool.containsThread cstate2 i)
Hlt1 Hlt2,
Mem.inject j
(@restrPermMap (fst (ThreadPool.getThreadR cnt1)) m1 Hlt1)
(@restrPermMap (fst (ThreadPool.getThreadR cnt2)) m2 Hlt2)
; INJ_locks:
forall i (cnt1: ThreadPool.containsThread cstate1 i)
(cnt2: ThreadPool.containsThread cstate2 i)
Hlt1 Hlt2,
Mem.inject j
(@restrPermMap (snd (ThreadPool.getThreadR cnt1)) m1 Hlt1)
(@restrPermMap (snd (ThreadPool.getThreadR cnt2)) m2 Hlt2)
; INJ_lock_permissions:
forall b b' delt opt_rmap,
j b = Some (b', delt) ->
forall ofs, lockRes cstate1 (b, unsigned ofs) = opt_rmap ->
lockRes cstate2 (b', unsigned (add ofs (repr delt))) =
(option_map (virtueLP_inject m2 j) opt_rmap)
; INJ_lock_content:
forall b ofs rmap,
lockRes cstate1 (b, ofs) = Some rmap ->
inject_lock j b ofs m1 m2
; source_invariant: invariant cstate1
; target_invariant: invariant cstate2
; mtch_source:
forall (i:nat),
(i > hb)%nat ->
forall  (cnt1: ThreadPool.containsThread cstate1 i)
(cnt2: ThreadPool.containsThread cstate2 i)
Hlt1 Hlt2,
match_thread_source j
(getThreadC cnt1)
(@restrPermMap (fst (ThreadPool.getThreadR cnt1)) m1 Hlt1)
(getThreadC cnt2)
(@restrPermMap (fst (ThreadPool.getThreadR cnt2)) m2 Hlt2)
; mtch_target:
forall (i:nat),
(i < hb)%nat ->
forall (cnt1: ThreadPool.containsThread cstate1 i)
(cnt2: ThreadPool.containsThread cstate2 i)
Hlt1 Hlt2,
match_thread_target  j
(getThreadC cnt1)
(@restrPermMap (fst (ThreadPool.getThreadR cnt1)) m1 Hlt1)
(getThreadC cnt2)
(@restrPermMap (fst (ThreadPool.getThreadR cnt2)) m2 Hlt2)
; mtch_compiled:
forall (i:nat),
(i = hb)%nat ->
forall (cnt1: ThreadPool.containsThread cstate1 i)
(cnt2: ThreadPool.containsThread cstate2 i)
Hlt1 Hlt2,
match_thread_compiled ocd j
(getThreadC cnt1)
(@restrPermMap (fst (ThreadPool.getThreadR cnt1)) m1 Hlt1)
(getThreadC cnt2)
(@restrPermMap (fst (ThreadPool.getThreadR cnt2)) m2 Hlt2) }.
Arguments INJ_locks {ocd j cstate1 m1 cstate2 m2}.
Arguments memcompat1 {ocd j cstate1 m1 cstate2 m2}.
Arguments memcompat2 {ocd j cstate1 m1 cstate2 m2}.
Inductive state_indicator:=
| Krun_indi
| Kblocked_indi
| Kresume_indi
| Kinit_indi.
Definition get_indicator {T: Type} (st:@ctl T): state_indicator:=
match st with
| Krun _ => Krun_indi
| Kblocked _ => Kblocked_indi
| Kresume _ _ => Kresume_indi
| Kinit _ _ => Kinit_indi
end.
Definition thread_indicator {Res Sem} i st cnt:=
get_indicator (@getThreadC Res Sem i st cnt).
Inductive individual_match i:
(option compiler_index) -> meminj -> ctl -> mem -> ctl -> mem -> Prop:=
|individual_mtch_source:
(i > hb)%nat ->
forall j s1 m1 s2 m2 cd,
match_thread_source j s1 m1 s2 m2 ->
individual_match i cd j s1 m1 s2 m2
|individual_mtch_target:
(i < hb)%nat ->
forall j s1 m1 s2 m2 cd,
match_thread_target j s1 m1 s2 m2 ->
individual_match  i cd j s1 m1 s2 m2
| individual_mtch_compiled:
(i = hb)%nat ->
forall cd j s1 m1 s2 m2,
match_thread_compiled cd j s1 m1 s2 m2 ->
individual_match i cd j s1 m1 s2 m2.
Inductive lock_update {hb}: nat -> ThreadPool hb -> Address.address ->
(Pair access_map) -> lock_info -> _ -> ThreadPool hb -> Prop:=
| Build_lock_update:
forall st st' i add th_perms lock_perms c
(cnt : containsThread st i),
st' = updLockSet
(updThread(resources:=dryResources) cnt c th_perms)
add lock_perms ->
@lock_update hb i st add th_perms lock_perms c st'.
Notation sstate:= (state_sum (@semC CSem) (@semC AsmSem)).
Inductive one_thread_match  (hb i:nat): option compiler_index ->
meminj -> @ctl sstate -> mem -> @ctl sstate -> mem -> Prop:=
| build_match_source:
forall ocd f c1 m1 c2 m2,
(i > hb)%nat ->
match_thread_source f c1 m1 c2 m2 ->
one_thread_match hb i ocd f c1 m1 c2 m2
| build_match_target:
forall ocd f c1 m1 c2 m2,
(i < hb)%nat ->
match_thread_target f c1 m1 c2 m2 ->
one_thread_match hb i ocd f c1 m1 c2 m2
| build_match_compiled:
forall ocd f c1 m1 c2 m2,
(i = hb)%nat ->
match_thread_compiled ocd f c1 m1 c2 m2 ->
one_thread_match hb i ocd f c1 m1 c2 m2.
Inductive lock_update' {hb}:
nat -> ThreadPool hb -> Address.address ->
(Pair access_map) -> @lock_info dryResources -> _ -> ThreadPool hb -> Prop:=
| Build_lock_update':
forall (st st': ThreadPool hb)
i add th_perms th_lock_perms lk_perms c
(* contains *)
(Hcnt_iff: forall i, ThreadPool.containsThread st i ->
ThreadPool.containsThread st' i)
(Hcnt_iff': forall i, ThreadPool.containsThread st' i ->
ThreadPool.containsThread st i)
(* Code  *)
(gcs: forall (cnt':ThreadPool.containsThread st' i),
ThreadPool.getThreadC cnt' = c )
(gco: forall j (cnt:ThreadPool.containsThread st j) (cnt':ThreadPool.containsThread st' j),
j<>i -> ThreadPool.getThreadC cnt' = ThreadPool.getThreadC cnt)
(* Thread Perms and Thread lock perms *)
(gts: forall (cnt':ThreadPool.containsThread st' i),
ThreadPool.getThreadR(resources:=dryResources) cnt' = (th_perms,th_lock_perms))
(gto: forall j (cnt:ThreadPool.containsThread st j) (cnt':ThreadPool.containsThread st' j),
j<>i -> ThreadPool.getThreadR cnt' = ThreadPool.getThreadR cnt)
(* Thread Perms *)
(gtts: forall (cnt':ThreadPool.containsThread st' i),
fst (ThreadPool.getThreadR(resources:=dryResources) cnt') = th_perms)
(gtto: forall j (cnt:ThreadPool.containsThread st j) (cnt':ThreadPool.containsThread st' j),
j<>i -> fst (ThreadPool.getThreadR cnt') = fst  (ThreadPool.getThreadR cnt))
(* Thread lock Perms*)
(gtls: forall (cnt':ThreadPool.containsThread st' i),
snd (ThreadPool.getThreadR(resources:=dryResources) cnt') = th_lock_perms)
(gtlo: forall j (cnt:ThreadPool.containsThread st j) (cnt':ThreadPool.containsThread st' j),
j<>i -> snd (ThreadPool.getThreadR cnt') = snd (ThreadPool.getThreadR cnt))
(* Lock perms *)
(gls: ThreadPool.lockRes st' add  = Some lk_perms)
(glo: forall add', add<>add' -> ThreadPool.lockRes st' add' = ThreadPool.lockRes st add'),
@lock_update' hb i st add (th_perms,th_lock_perms) lk_perms  c st'.
Definition same_content_in m m' ofs b:=
ZMap.get ofs (Mem.mem_contents m') !! b =
ZMap.get ofs (Mem.mem_contents m) !! b.
Definition content_almost_same m m' adr:=
forall  b ofs,
(* b <> fst adr \/ ~ Intv.In ofs (snd adr,snd adr+ LKSIZE) -> *)
(b, ofs) <> adr ->  same_content_in m m' ofs b.
Definition contnet_same_intval m m' adr SIZE:=
forall b ofs,
b = fst adr /\ Intv.In ofs (snd adr, snd adr + SIZE) ->
same_content_in m m' ofs b.
Definition get_val_at (m:mem) (adr: block * Z):=
(ZMap.get (snd adr) (Mem.mem_contents m) !! (fst adr)).
Inductive lock_update_mem: mem -> Address.address -> memval -> mem -> Prop:=
| Build_lock_update_mem:
forall m m' adr v
(Hcontent_almost_equiv: content_almost_same m m' adr)
(Hnew_val: get_val_at m' adr = v)
(Hcur_equiv: Cur_equiv m m')
(Hmax_equiv: Max_equiv m m')
(Hmax_wrt: Mem.perm m (fst adr) (snd adr) Max Writable)
(Hnb_equiv: Mem.nextblock m = Mem.nextblock m'),
lock_update_mem m adr v m'.
Instance content_almost_same_proper:
Proper (content_equiv ==> content_equiv ==> Logic.eq ==> iff)
content_almost_same.
Ltac destruct_lock_update_getters:=
match goal with
| [ H: lock_update _ _ _ _ _ _ _ |- _ ] =>
apply lock_update_getters in H; inv H
| [H: lock_update_mem _ _ _ _ |- _ ] => inv H
end.
Ltac lock_update_contains:=
match goal with
| [ H: containsThread ?st ?i  |- _ ] =>
match goal with
| [ H: forall x,  ThreadPool.containsThread st ?j ->
ThreadPool.containsThread ?st' _ |- _ ] =>
match goal with
| [ H: ThreadPool.containsThread st' i  |- _ ] => fail 1
| [ H: containsThread st' i  |- _ ] => fail 1
| _ => let cnt:=fresh "cnt" in
assert (cnt:containsThread st' i); try eapply H; auto;
simpl in cnt
end
end
end.
Ltac super_rewrite:=
match goal with
| [ H: _ |- _ ] => erewrite H by solve[eauto]
end.
Ltac lock_update_rewrite:=
repeat lock_update_contains;
simpl in *;
unshelve (repeat (super_rewrite)); try eassumption.
Definition meminj_no_overlap_one (f: meminj) (m: mem) (adr1 adr2: block * Z) :=
forall delta1 b1 delta2 ofs1,
f (fst adr1) = Some (fst adr2, delta1) ->
f b1 = Some (fst adr2, delta2) ->
Mem.perm m b1 ofs1 Max Nonempty ->
ofs1 + delta2 = (snd adr1) + delta1 ->
b1 = (fst adr1).

Lemma concur_match_update_lock:
forall i f ocd st1 m1 st2 m2,
concur_match ocd f st1 m1 st2 m2 ->
forall ocd' (st1':t) m1' st2' m2' b_lock1 b_lock2 ofs_lock delta,
forall th_perms1 th_perms2 v1 v2
(Hupdate_mem1: lock_update_mem m1 (b_lock1, ofs_lock) v1 m1')
(Hupdate_mem2: lock_update_mem m2 (b_lock2, ofs_lock+delta) v2 m2')
(Hlt1 : permMapLt th_perms1 (getMaxPerm m1'))
(Hlt2 : permMapLt th_perms2 (getMaxPerm m2'))
(Hinj_perms:
Mem.inject f (restrPermMap Hlt1) (restrPermMap Hlt2))
(Hinv1: invariant(tpool:=OrdinalThreadPool) st1')
(Hinv2: invariant(tpool:=OrdinalThreadPool) st2')
(Hmem_compat1: mem_compatible(tpool:=OrdinalThreadPool) st1' m1')
(Hmem_compat2: mem_compatible(tpool:=OrdinalThreadPool) st2' m2')
th_lock_perms1 th_lock_perms2
(Hlock_ppimage: perm_surj f th_lock_perms1 th_lock_perms2)
(Hlt_lock1 : permMapLt th_lock_perms1 (getMaxPerm m1'))
(Hlt_lock2 : permMapLt th_lock_perms2 (getMaxPerm m2'))
(Hinj_locks: Mem.inject f (restrPermMap Hlt_lock1) (restrPermMap Hlt_lock2))
(Hinj_lock: f b_lock1 = Some (b_lock2, delta)) c1 c2
(Hthread_match: one_thread_match hb i ocd f
c1 (restrPermMap Hlt1)
c2 (restrPermMap Hlt2))
(Hval_inj: memval_inject f v1 v2),
forall lock_perms1
(cnt1 : containsThread st1 i)
(cnt2 : containsThread st2 i),
lock_update i st1 (b_lock1,ofs_lock) (th_perms1,th_lock_perms1)
lock_perms1 c1 st1' ->
lock_update i st2 (b_lock2,ofs_lock+delta) (th_perms2,th_lock_perms2)
(virtueLP_inject m2' f lock_perms1) c2 st2' ->
concur_match ocd' f st1' m1' st2' m2'.