Section SyncCallsDiagrams.
Context (hb: nat).
(*Instantiate definitions in Concur with the current hybridbound*)
Notation concur_match:= (concur_match hb).
Notation match_thread:= (match_thread hb).
Notation match_thread_source:= (match_thread_source hb).
Notation match_thread_target:= (match_thread_target hb).
Notation memcompat2:= (memcompat2 hb).
Notation memcompat1:= (memcompat1 hb).
Notation contains12:= (contains12 hb).
Notation mtch_target:= (mtch_target hb).
Notation mtch_compiled:= (mtch_compiled hb).
Notation mtch_source:= (mtch_source hb).
Notation thread_perms st i cnt:= (fst (@getThreadR _ _ st i cnt)).
Notation lock_perms st i cnt:= (snd (@getThreadR  _ _ st i cnt)).
(* Thread states *)
(* angel,lock permissions and new thread permissions *)
(*Hangel_bound: sub_map_virtue angel (getMaxPerm m1)*)
(* Thread states *)
(* angel, lock permissions and new thread permissions *)
(* Thread states *)
(* The following two things are not needed *)
(* angel, lock permissions and new thread permissions *)
(* Thread states *)
(* angel, lock permissions and new thread permissions *)
(* Thread states *)
(* angel,lock permissions and new thread permissions *)
(** *Compiled diagrams*)
(*TODO: 1. Find a better name 2. Simplify / Clean it? *)
Ltac unify_at_ext:=
repeat match goal with
[H: semantics.at_external _ _ _ = Some _ |- _] =>
simpl in H
end;
match goal with
[H1: Clight.at_external ?X = _,
H2: Clight.at_external ?X = _ |- _] =>
rewrite H1 in H2; invert H2
end.
Ltac inj_args_inv:=
match goal with
[Hinj_args: Val.inject_list ?f (Vptr ?b1 ?ofs :: nil) _  |- _ ]=>
invert Hinj_args;
match goal with
| [ Hinj_ptr: Val.inject _ (Vptr b1 ofs) _,
Hinj_nil: Val.inject_list _ nil _ |- _ ] =>
invert Hinj_ptr; invert Hinj_nil;
match goal with
| [Hinj_b_badname: f b1 = Some _ |- _ ] =>
let Hinj_b:= fresh "Hinj_b" in rename Hinj_b_badname into Hinj_b;
try (let Hinj_b':= fresh "Hinj_b'" in
eapply evolution_inject_incr in Hinj_b as Hinj_b';
eauto; [idtac] (*check only one goal left.*) )
end
end
end.
Ltac inject_lock_update_mem_strict_load:=
lazymatch goal with
[CMatch: concur_match _ ?mu ?st1 ?m1' ?st2 ?m2',
Hlock: lock_update_mem_strict_load _ _ _ _ _ _ _ |- _ ] =>
let Hlock_update_mem_strict_load1:= fresh "Hlock_update_mem_strict_load1" in
dup Hlock as Hlock_update_mem_strict_load1;
let m2'':=fresh "m2''" in
let Hlock_update_mem_strict_load2:=fresh "Hlock_update_mem_strict_load2" in
let Hinj2:=fresh "Hinj2" in
eapply lock_update_mem_strict_load_inject in Hlock
as (m2''&Hlock_update_mem_strict_load2&Hinj2);
eauto; try (eapply CMatch; eauto); [idtac]
end.
Ltac get_injection_thread_mem:=
match goal with
[CMatch: concur_match _ ?mu ?st1 ?m1' ?st2 ?m2' |- _ ] =>
let Hinj':= fresh "Hinj'" in
assert (Hinj': Mem.inject mu m1' m2') by
(rewrite <- (cur_equiv_restr_mem_equiv m1') by eassumption;
rewrite <- (cur_equiv_restr_mem_equiv m2') by eassumption;
eapply INJ_threads; eauto)
end.
Ltac use_retroactive_int_diagram_atx:=
match goal with
[Hstrict: strict_evolution_diagram _ _ _ _ _ _ _  |- _] =>
eapply retroactive_int_diagram_atx in Hstrict;
eauto; [idtac]; (* This checks there is only one goal left! *)
inversion Hstrict; unify_at_ext
end.
Ltac inject_lock_update_mem_strict:=
lazymatch goal with
[CMatch: concur_match _ ?mu ?st1 ?m1' ?st2 ?m2',
Hlock: lock_update_mem_strict _ _ _ _ _ |- _ ] =>
let Hlock_update_mem_strict1:= fresh "Hlock_update_mem_strict1" in
dup Hlock as Hlock_update_mem_strict1;
let m2'':=fresh "m2''" in
let Hlock_update_mem_strict2:=fresh "Hlock_update_mem_strict2" in
let Hinj2:=fresh "Hinj2" in
eapply lock_update_mem_strict_inject in Hlock
as (m2''&Hlock_update_mem_strict2&Hinj2);
eauto; try (eapply CMatch; eauto); [ ]
end.
Ltac left_diagram:=
(* 1. Set up the injection*)
get_injection_thread_mem;
(* 2. Now we expand the diagram backwards *)
use_retroactive_int_diagram_atx;
inj_args_inv;
(* There are different types of left diagram. `            each case is a different type. *)
first
[inject_lock_update_mem_strict_load
| inject_lock_update_mem_strict].
(*+ tactics to push mem_compat forward (in diagrams) *)
Ltac unfold_state_forward:=
match goal with
| H:?st' = fullThUpd_comp ?st _ _ _ _ (?b, ?ofs)
|- _ => unfold fullThUpd_comp, fullThreadUpdate in H
| H:= fullThUpd_comp ?st _ _ _ _ (?b, ?ofs)
|- _ => unfold fullThUpd_comp, fullThreadUpdate in H
| H:?st' = fullThreadUpdate ?st _ _ _ _ (?b, ?ofs)
|- _ => unfold fullThreadUpdate in H
| H:= fullThreadUpdate ?st _ _ _ _ (?b, ?ofs)
|- _ => unfold fullThreadUpdate in H
end.
(*permMapLt_pair (@getThreadR _ _ i st2 cnt2) (getMaxPerm m2) -> *)
(* Line: 5877 *)
(* Lines: 5877 - 5367 = 510 *)
(* angel,lock permissions and new thread permissions *)

Lemma acquire_step_diagram_compiled:
let hybrid_sem:= (sem_coresem (HybridSem (Some hb))) in
forall (angel: virtue) (cd : compiler_index)
mu (*tr2*)
st1 (m1 m1' m1'' : mem) Hcnt1
st2 (m2' : mem) Hcnt2
(Hsame_cnt: same_cnt hb st1 st2 Hcnt1 Hcnt2)
b1 ofs lock_perms (code1 : semC)  (code2 : Asm.state)
(Hthread_mem1: access_map_equiv (thread_perms hb st1 Hcnt1) (getCurPerm m1'))
(Hthread_mem2: access_map_equiv (thread_perms hb st2 Hcnt2) (getCurPerm m2'))
(CMatch: concur_match (Some cd) mu st1 m1' st2 m2')
(Hangel_bound: pair21_prop sub_map (virtueThread angel)
(snd (getMaxPerm m1')))
(Hcode1: getThreadC Hcnt1 = Kblocked (SST code1))
(Hcode2 : getThreadC Hcnt2 = Kblocked (TST code2))
(Hat_external1': semantics.at_external hybrid_sem (SST code1) m1' =
Some (LOCK, (Vptr b1 ofs :: nil)%list))
(Hlock_update_mem_strict_load:
lock_update_mem_strict_load b1 (unsigned ofs)  (snd (getThreadR Hcnt1))
m1' m1'' vone vzero)
(HisLock: lockRes st1 (b1, unsigned ofs) = Some lock_perms),
let newThreadPerm1:= (computeMap_pair (getThreadR Hcnt1) (virtueThread angel)) in
let new_perms:= Build_virtue (virtueThread angel) (empty_map, empty_map) in
forall (Hjoin_angel: permMapJoin_pair lock_perms (getThreadR Hcnt1) newThreadPerm1)
(Hlt_new: permMapLt_pair newThreadPerm1 (getMaxPerm m1'))
(Hlt1 : permMapLt (thread_perms _ _ Hcnt1) (getMaxPerm m1'))
(Hlt2 : permMapLt (thread_perms _ _ Hcnt2) (getMaxPerm m2'))
(Hstrict: strict_evolution_diagram cd mu code1 m1 m1' code2 m2'),
exists evnt2 (st2' : t) (m2'' : mem),
let evnt:= build_acquire_event (b1, unsigned ofs) (fst (virtueThread angel)) m1'' in
let st1':= fullThUpd_comp st1 hb Hcnt1 (Kresume (SST code1) Vundef) new_perms (b1, unsigned ofs)  in
concur_match (Some cd) mu st1' m1'' st2' m2'' /\
inject_sync_event mu evnt evnt2 /\
let Hcmpt2:= memcompat2 CMatch in
syncStep(Sem:=HybridSem (Some (S hb)))
true Hcnt2 Hcmpt2 st2' m2'' evnt2.