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)*)
(*Hangel_bound: sub_map_virtue angel (getMaxPerm m1')*)
(*  unify_injection. rename b0 into b2. set (ofs2:= add ofs (repr delta)). set (st2':= fullThreadUpdate st2 hb Hcnt2 (Kresume (TST code2) Vundef) (new_perms2, pair0 empty_map) (b2, unsigned ofs2)). remember (fullThreadUpdate st1 hb Hcnt1 (Kresume (SST code1) Vundef) (new_perms1, pair0 empty_map) (b1, unsigned ofs)) as st1'.  assert (H: ThreadPool (Some (S hb)) = @t dryResources (HybridSem (@Some nat (S hb)))). { reflexivity. } dependent rewrite <- H in st2'. clear H.  repeat pose_max_equiv. forward_cmpt_all. rename Hcmpt_mem_fwd into Hcmpt2'. rename Hcmpt_mem_fwd0 into Hcmpt1'.  (** * 4. Finally we proceed with the goal: existentials. *)
set (evnt2:= (Events.mklock (b2, unsigned ofs2))).
exists evnt2, st2', m2''.
split; [|split].
- eapply concur_match_update_lock; eauto; try solve[subst st1'; eauto].
+ !context_goal lock_update_mem.
eapply lock_update_mem_strict_mem_update.
eapply Hlock_update_mem_strict1.
+ !context_goal (lock_update_mem).
eapply lock_update_mem_strict_mem_update.
eapply Hlock_update_mem_strict2.
+ !context_goal Mem.inject.
rewrite RPM.
instantiate(2:=fst new_perms2);
instantiate(3:=fst new_perms1).
apply inject_restr; auto.
* !goal (mi_perm_perm mu _ _).
admit.
* !goal (mi_memval_perm mu _ _ _).
admit.
* !goal (mi_perm_inv_perm mu _ _ _).
admit.
+ !goal (@invariant (HybridSem _) _ _). admit.
+ !goal (invariant st2'). admit.
+ !goal(perm_surj mu _ _).
instantiate(1:=snd new_perms2); instantiate(1:=snd new_perms1).
simpl in *. admit.
+ !goal (Mem.inject mu _ _).
apply inject_restr; auto.
* !goal (mi_perm_perm mu (snd new_perms1) (snd new_perms2)).
admit.
* !goal (mi_memval_perm mu (snd new_perms1)
(Mem.mem_contents m1'') (Mem.mem_contents m2'')).
admit.
* !goal (mi_perm_inv_perm mu (snd new_perms1) (snd new_perms2) m1'').
admit.
+  (* Proof of match goes after the comment *)
{ !context_goal one_thread_match.
eapply build_match_compiled; auto.
admit.
}
+ constructor; constructor.
+ simpl in *. econstructor.
subst st1'; destruct new_perms1; reflexivity.
+ simpl in *. econstructor.
subst st2' ofs2; destruct new_perms2. repeat f_equal.
!goal (unsigned (add ofs (repr delta)) = unsigned ofs + delta).
admit.
!goal (pair0 empty_map = virtueLP_inject _ _ (pair0 empty_map)).
admit.
- subst evnt2. replace (unsigned ofs2) with (unsigned ofs + delta).
repeat econstructor; eassumption.
admit.
- split; [admit|].
assert (Hofs2: intval ofs2 = unsigned ofs + delta).
{ admit. }
rewrite <- Hofs2 in *.
eapply step_mklock;
eauto; try reflexivity;
try unfold HybridMachineSig.isCoarse,
HybridMachineSig.HybridCoarseMachine.scheduler.
+ !goal (@invariant (HybridSem _) _ st2).
eapply CMatch.
+ (* at_external for code 4. *)
move Hat_external2' at bottom.
match goal with
|- context [restrPermMap ?Hlt]=>
pose proof (cur_equiv_restr_mem_equiv _ _ Hlt Hthread_mem2)
end.
pose proof (Asm_at_external_proper Asm_g code2 _ eq_refl _ _ H).
simpl in H0; simpl. unfold Asm_g in H0.
rewrite H0. eauto.
+ (* Mem.range_perm *)
(* Can write the lock *) simpl. !goal(Mem.range_perm _ _ _ (intval ofs2 + LKSIZE) Cur Writable). inversion Hlock_update_mem_strict2; subst vstore. rewrite Hofs2. eapply range_perm_mem_equiv_Cur; try apply eq_refl; eauto. * eapply Cur_equiv_restr; reflexivity. * eapply permMapLt_range_mem. admit. (*by injecting from above*)
+ (* the store *)
inversion Hlock_update_mem_strict2; subst vstore.
rewrite (mem_is_restr_eq m2') in Hstore.
erewrite restrPermMap_equiv_eq; eauto.
+ simpl; inv HH0; auto.
+ simpl; inv HH0; auto.
+ !goal (lockRes _ (b2,_) = None).
eapply INJ_lock_permissions_None; eauto.
Admitted.*) (* free_step_diagram_compiled *)

Lemma free_step_diagram:
let hybrid_sem:= (sem_coresem (HybridSem(Some hb))) in
forall (m1 m2: mem) tid 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 : Pair access_map)
(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)
(pdata : nat -> option permission) (lock_data : lock_info)
(Hnone_beyond: bounded_nat_func' pdata LKSIZE_nat)
(Hcode: getThreadC cnt1 = Kblocked c)
(Hat_external: semantics.at_external hybrid_sem c m1  =
Some (FREE_LOCK, (Vptr b ofs :: nil)%list))
(Hlock_map: lockRes st1 (b, 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 _ _ cnt1) (getMaxPerm m1) )
(Hrange_perm: perm_interval (restrPermMap HlocksLt)
b (unsigned ofs) LKSIZE Cur Writable)
(HsetPerms:
setPermBlock_var_pair b (unsigned ofs) LKSIZE_nat
(pdata, fun _:nat => None) (getThreadR cnt1) = new_perms)
(HH: forall i, 0 <= (Z.of_nat i) < LKSIZE ->
Mem.perm_order'' (pdata (S i)) (Some Writable)),
exists evnt2 (st2' : t) (m2' : mem),
let evnt:= (Events.freelock (b, unsigned ofs)) in
let st1':= remLockfFullUpdate st1 tid cnt1
(Kresume c Vundef) new_perms (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.