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 free_step_diagram_compiled:
let hybrid_sem:= (sem_coresem (HybridSem (Some hb))) in
forall (m1 m1' m1'': mem) (cd : compiler_index) mu pdata
(st1 : ThreadPool (Some hb))  new_perms1
(st2 : ThreadPool (Some (S hb))) (m2' : mem) Hcnt1 Hcnt2
(Hsame_cnt: same_cnt hb st1 st2 Hcnt1 Hcnt2)
b1 ofs (code1 : semC)  (code2 : Asm.state) lock_data
(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')
(Hcode1: getThreadC Hcnt1 = Kblocked (SST code1))
(Hcode2 : getThreadC Hcnt2 = Kblocked (TST code2))
(Hat_external1': semantics.at_external hybrid_sem (SST code1) m1' =
Some (FREE_LOCK, (Vptr b1 ofs :: nil)%list))
(Hlock_update_mem_strict: lock_update_mem_strict b1 (unsigned ofs) m1' m1'' vzero)
(Hlock_map: lockRes st1 (b1, Integers.Ptrofs.unsigned ofs) = Some lock_data)
(Hempty_lock: forall b ofs, pair1 (fun map => map !! b ofs) lock_data = pair0 None)
(HlocksLt: permMapLt (lock_perms _ _ Hcnt1) (getMaxPerm m1') )
(Hrange_perm: perm_interval (restrPermMap HlocksLt)
b1 (unsigned ofs) LKSIZE Cur Writable)
(HH: forall i, 0 <= (Z.of_nat i) < LKSIZE ->
Mem.perm_order'' (pdata (S i)) (Some Writable))
(Hstrict: strict_evolution_diagram cd mu code1 m1 m1' code2 m2'),
let new_perms2:=
setPermBlock_var_pair b1 (unsigned ofs) LKSIZE_nat
(pdata, fun _:nat => None) (getThreadR Hcnt1) in
exists evnt2 (st2' : t) (m2'' : mem),
let evnt:= (Events.freelock (b1, unsigned ofs)) in
let st1':= remLockfFullUpdate st1 hb Hcnt1
(Kresume (SST code1) Vundef) new_perms1
(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.