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 *)
(*Hangel_bound: sub_map_virtue angel (getMaxPerm m1')*)
(*Hinj_b : mu b1 = Some (b2, delt)*)
(*Hangel_bound: sub_map_virtue angel (getMaxPerm m1')*)
(*HH2: set_new_mems b2 (unsigned ofs+delt) (getThreadR Hcnt2) LKSIZE_nat new_perms2*)
(** *Full Machine diagrams *)
Definition compat_restr {Sem tpool m} perms {st} Hlt Hcmpt:=
@mem_compat_restrPermMap Sem tpool m perms st Hlt Hcmpt.
(*Hangel_bound: sub_map_virtue angel (getMaxPerm m1)*)

Lemma make_step_diagram:
let hybrid_sem:= (sem_coresem (HybridSem (Some hb))) in
forall (m1 m1' m2 : mem) (tid : nat) cd (mu : meminj)
(st1 : ThreadPool (Some hb)) cnt1
(st2 : ThreadPool (Some (S hb))) cnt2
(Hsame_sch: same_cnt tid st1 st2 cnt1 cnt2)
(c : semC) (b : block) (ofs : int) new_perms
(Hthread_mem1: access_map_equiv (thread_perms _ _ cnt1) (getCurPerm m1))
(Hthread_mem2: access_map_equiv (thread_perms _ _ cnt2) (getCurPerm m2))
(CMatch: concur_match cd mu st1 m1 st2 m2)
(Hcode: getThreadC cnt1 = Kblocked c)
(Hat_external: semantics.at_external hybrid_sem c m1 =
Some (MKLOCK, (Vptr b ofs :: nil)%list))
(Hset_block: set_new_mems b (unsigned ofs) (getThreadR cnt1) LKSIZE_nat new_perms)
(Hlock_update_mem_strict: lock_update_mem_strict b (unsigned ofs) m1 m1' vzero),
lockRes st1 (b, unsigned ofs) = None ->
exists evnt2 (st2' : t) (m2' : mem),
let evnt:= Events.mklock (b, unsigned ofs) in
let st1':= fullThreadUpdate st1 tid cnt1 (Kresume c Vundef)
(new_perms, pair0 empty_map) (b, unsigned ofs) in
concur_match cd mu st1' m1' st2' m2' /\
inject_sync_event mu evnt evnt2 /\
let Hcmpt2:= memcompat2 CMatch in
syncStep(Sem:=HybridSem (Some (S hb)))
true cnt2 Hcmpt2 st2' m2' evnt2.