(* H0 : concur_match cd mu st1 m1 st2 m2 *)
intros ?? st1 m1 tid st2 mu m2 Htid1 Htid2 AT virtue1 Hcmpt1 Hcmpt2 injmem A.
replace  (snd (getMaxPerm m2)) with
(PTree.map (fun _ a => a)  (snd (getMaxPerm m2))) by eapply trivial_map.
unfold tree_map_inject_over_mem, tree_map_inject_over_tree.
pose proof (@strong_tree_leq_map') as HHH.
specialize (HHH _ (Z -> option AT)
(fun (b : positive) _ =>
build_function_for_a_block mu b (PTree.elements virtue1))
(fun (_ : positive) a => a)
(snd (getMaxPerm m2))
bounded_maps.fun_leq
).
unfold bounded_maps.sub_map.
eapply HHH; eauto; try constructor.
clear HHH.
intros; simpl. intros p HH.
pose proof (PTree.elements_complete virtue1).
remember (PTree.elements virtue1) as Velmts.
clear HeqVelmts.
induction Velmts as [|[b0 fb]]; try solve[inversion HH].
simpl in HH.
destruct (mu b0) as [[b1 delt]|] eqn:Hinj.
* unfold merge_func in HH.
destruct (PMap.elt_eq p0 b1); subst.
destruct (fb (p-delt)%Z) eqn:Hfbp.
-- specialize (H0 b0 fb ltac:(left; auto)).
clear HH.
cbv beta zeta iota delta[fst] in A.
pose proof (strong_tree_leq_spec
bounded_maps.fun_leq
ltac:(simpl; auto)
virtue1 (snd (getMaxPerm m1)) A b0).
rewrite H0 in H1.
unfold bounded_maps.fun_leq in H1.
destruct ((snd (getMaxPerm m1)) ! b0) eqn:Heqn;
try solve[inversion H1].
specialize (H1 (p - delt)%Z ltac:(rewrite Hfbp; auto)).
eapply Mem.mi_perm in Hinj; try apply injmem.
2: {
clear IHVelmts Velmts Hinj.
clear Hfbp A a b1 H.
instantiate (2:= Max).
instantiate (2:= (p - delt)%Z).
instantiate (1:= Nonempty).
unfold Mem.perm.
pose proof restrPermMap_Max as H3.
unfold permission_at in H3.
rewrite H3; clear H3.
unfold PMap.get.
rewrite Heqn.
destruct (o (p - delt)%Z); try solve[inversion H1].
destruct p; try constructor.
}
unfold Mem.perm in Hinj.
pose proof restrPermMap_Max as H2.
unfold permission_at in H2.
rewrite H2 in Hinj.
unfold PMap.get in Hinj.
rewrite H in Hinj.
replace (p - delt + delt)%Z with p in Hinj by omega.
destruct (a p); inversion Hinj; auto.
-- eapply IHVelmts in HH; auto.
intros; eapply H0; right.
auto.
-- eapply IHVelmts in HH; auto.
intros; eapply H0.
right; auto.
* (* mu b0 = None *)
eapply IHVelmts in HH; auto.
intros; eapply H0.
right; auto.
Qed.
eapply inject_virtue_sub_map;
try eapply matchmem; eauto.
- eapply inject_virtue_sub_map; eauto.
}
* unfold HybridMachineSig.isCoarse, HybridMachineSig.HybridCoarseMachine.scheduler.
move HboundedLP at bottom.
destruct HboundedLP as (?&?&?).
eapply (proj1 (Logic.and_assoc _ _ _)).
split.
(*Easy ones: the default is trivial: bounded_maps.map_empty_def *)
subst virtueLP2.
unfold virtueLP_inject,
bounded_maps.map_empty_def, access_map_inject;
simpl.
split; auto.
assert (HboundedLP':
bounded_maps.sub_map (snd (fst virtueLP)) (snd (getMaxPerm m1)) /\
bounded_maps.sub_map (snd (snd virtueLP)) (snd (getMaxPerm m1))
) by assumption.
subst virtueLP2.
destruct virtueLP as (virtueLP_fst, virtueLP_snd).
revert HboundedLP'.
unfold virtueLP_inject, access_map_inject.
simpl (fst _).
simpl (snd _) at 3 6 9.
eapply self_simulation.minject in matchmem.
intros (Hl & Hr); split;
eapply inject_virtue_sub_map;
try eapply Hinj; eauto.
* clean_cnt.
eapply Hat_external2.
* (* Prove I can read the lock. *)
move Haccess at bottom.
(* missing from concur relation: matching of thread permissions.   *)
clean_cmpt.
assert (Hperm_range:=Hinj_lock).
eapply Mem.range_perm_inject in Hperm_range; eauto.
simpl.
clean_cnt.
erewrite Mem.address_inject; try eapply Hinj_lock; eauto.
2: {
specialize(Haccess (unsigned ofs)).
eapply Haccess.
unfold unsigned; split; try omega.
eapply Z.lt_add_pos_r.
unfold LKSIZE.
rewrite size_chunk_Mptr.
destruct Archi.ptr64; omega.
}
unfold unsigned; eauto.
replace (intval ofs + delt + LKSIZE)%Z with (intval ofs + LKSIZE + delt)%Z
by omega.
eassumption.
* (* Prove the load succeeds. *)
move Hload at bottom.
clean_cmpt.
eapply Mem.load_inject in Hload; eauto.
destruct Hload as (v2& Hload & Hval_inj).
simpl.
inversion Hval_inj; subst.
eauto.
erewrite Mem.address_inject; try eapply Hinj_lock; eauto.
{
specialize(Haccess (unsigned ofs)).
eapply Haccess.
unfold unsigned; split; try omega.
eapply Z.lt_add_pos_r.
unfold LKSIZE.
rewrite size_chunk_Mptr.
destruct Archi.ptr64; omega.
}
* move Hstore2 at bottom.
assert(Heq: intval (add ofs (repr delt)) = (intval ofs + delt)%Z ).
{
unfold add.
admit. (*using Mem.mi_representable you get delta>= 0 and
(unsigned ofs + delt) < max_unsigned.*)
}
match goal with
| [  |- context[restrPermMap ?X] ] =>
replace (restrPermMap X) with (restrPermMap Hlt2')
end.
-- rewrite Heq; assumption.
--  (* Set Printing Implicit. *)
admit. (* dependet type mess *)
* intros; simpl.
move Hrmap at bottom.
unfold access_map_inject; simpl.
admit. (* Property of access_map_inject. *)
* (* Claims the transfered resources join in the appropriate way *)
simpl. move Hangel1 at bottom.
(* Sketch: Should follow from the constructions of the transfered permissions and Hangel1. *)
admit.
* (* Claims the transfered resources join in the appropriate way *)
simpl. move Hangel2 at bottom.
(* Sketch: Should follow from the constructions of the transfered permissions and Hangel2. *)
admit.
Admitted.
pose proof (mtch_target _ _ _ _ _ _ CMatch _ l Htid (contains12 CMatch Htid)) as match_thread.
simpl in Hcode; exploit_match.
inversion H3.
(*Destruct the values of the self simulation *)
pose proof (self_simulation.minject _ _ _ matchmem) as Hinj.
assert (Hinj':=Hinj).
pose proof (self_simulation.ssim_external _ _ Aself_simulation) as sim_atx.
eapply sim_atx in Hinj'; eauto.
2: { clean_cmpt.
eauto.
}
clear sim_atx.
destruct Hinj' as (b' & delt & Hinj_b & Hat_external2); eauto.
edestruct release_step_diagram_target as
(e' & m2' & Htid2' & mu' & Hcode_inj & matchmem' & Htrace_inj & external_step)
; eauto; simpl; try eassumption.
{ (* invariant st2 *)
eapply CMatch. }
{ (*at external *)
clean_cmpt; assumption. }
{ (* Mem.inject mu restrict restrict*)
eapply CMatch.
}
exists e'. eexists. exists m2', cd, mu'.
split ; [|split].
+ (* reestablish concur *)
admit.
+ eassumption.
+ eassumption.
(** *tid = hb*)
- subst tid.
(* Retrieve the match relation for this thread *)
pose proof (mtch_compiled _ _ _ _ _ _ CMatch _ ltac:(reflexivity)
Htid (contains12 CMatch Htid)) as Hmatch.
simpl in Hcode; rewrite Hcode in Hmatch.
destruct Hmatch as (ind&?&Hmatch_thread); subst cd.
inversion Hmatch_thread; subst.
rename H1 into Hcode'.
assert (FirstTheSourceExecution:= True).
move H3 at bottom; move Hcode' at bottom.
inversion H3. subst cd j s1 m0 s4 m5.
clear H3.
(* Invert Clight_match *)
assert (HH:=H).
inversion H as (Clight_cinject & Clight_matchmem); clear H.
(*Destruct the values of the self simulation *)
pose proof (self_simulation.minject _ _ _ Clight_matchmem) as Hinj.
assert (Hinj':=Hinj).
pose proof (self_simulation.ssim_external _ _ Cself_simulation) as sim_atx.
eapply sim_atx in Hinj'; eauto.
2: { clean_cmpt.
eauto.
}
clear sim_atx.
destruct Hinj' as (b1' & delt1 & Hinj_b1 & Hat_external1'); eauto.
(* Rename things according to the diagram  << st1, m1 -------------> st1', m1' |                      | | j1    Diagram No.1   | j1' |                      | st2, m2 -------------> st2', m2' |                      | |                      | | j2    Diagram No.2   | j2' |                      | |                      | st3, m3 -------------> st3', m3' |                      | | j3    Diagram No.3   | j3' |                      | st4, m4 -------------> st4', m4'  >> *)
clean_cnt.
clean_cmpt.
rename m2 into m_temp.
rename m3 into m2.
rename m4 into m3.
rename m_temp into m4.
rename Htid into Htid1.
rename st2 into st4.
rename Hcmpt1 into Hcmpt4.
rename Hcnt into Hcnt4.
rename code2 into code4.
move code4 at bottom.
rename s2 into code2.
rename s3 into code3.
(** *Diagram No. 1*)
(*Fill in*)
(** *Diagram No. 2*)
(* The diagram looks like an execution of external step, where the memory changes but the state only becomes Kresume  *)
(** *Diagram No. 3*)
(* Temporary placeholders. *)
evar (b4': positive).
evar (virtueThread3 : (delta_map * delta_map)%type).
remember (virtueThread_inject m4 j3 (virtueThread3))  as virtueThread4.
evar (virtueLP4 : (access_map * access_map)%type).
evar (m4' : Mem.mem).
do 5 eexists; split; [|split].
+ (*reestablish the concur match. *)
admit.
+ (* Traces inject. *)
admit.
+ (* step in the compiled thread. *)
econstructor; eauto.
eapply step_release with
(b0:= b4')
(virtueThread0:=virtueThread4)
(virtueLP0:=virtueLP4)
(m':=m4'); eauto; try reflexivity;
try unfold HybridMachineSig.isCoarse,
HybridMachineSig.HybridCoarseMachine.scheduler.
* (* bounded_maps.sub_map *)
subst virtueThread4.
unfold virtueThread_inject.
destruct virtueThread3 as (virtue1, virtue2).
cbv iota beta delta[fst] in *.
split.
-- (* eapply inject_virtue_sub_map.
inversion H1. *)
admit.
-- admit.
* (* bounded_maps.sub_map *)
admit.
* (*invariant st4 *)
admit.
* (* at_external for code 4. *)
admit.
* (* Mem.range_perm *)
(* Can read the lock *)
admit.
* (* The load. *)
admit.
* (* the store *)
admit.
* (* content of lockres*)
(* ThreadPool.lockRes st4 (b4', ofs4') *)
(* NOTE: why is it rmap? It should be an injection of rmap *)
admit.
* (* permissions join FST*)
admit.
* (* permissions join SND *)
admit.
- admit.
Admitted.

Lemma Create_step_diagram:
forall (U : list nat) (tr1 tr2 : HybridMachineSig.event_trace)
(st1 : ThreadPool (Some hb)) (m1' : mem)
(tid : nat) (cd : option compiler_index)
(st2 : ThreadPool (Some (S hb))) (mu : meminj)
(m2 : mem) (Htid : ThreadPool.containsThread st1 tid)
(c : semC) (b : block) (ofs : Integers.Ptrofs.int)
(arg : val)
(virtue1
virtue2 : PTree.t (BinNums.Z -> option (option permission)) *
PTree.t (BinNums.Z -> option (option permission)))
(threadPerm' newThreadPerm : access_map * access_map),
HybridMachineSig.schedPeek U = Some tid ->
forall Hcmpt : mem_compatible st1 m1',
concur_match cd mu st1 m1' st2 m2 ->
List.Forall2 (inject_mevent mu) tr1 tr2 ->
bounded_maps.sub_map (fst virtue2) (snd (getMaxPerm m1')) /\
bounded_maps.sub_map (snd virtue2) (snd (getMaxPerm m1')) ->
bounded_maps.sub_map (fst virtue1) (snd (getMaxPerm m1')) /\
bounded_maps.sub_map (snd virtue1) (snd (getMaxPerm m1')) ->
invariant st1 ->
ThreadPool.getThreadC Htid = Kblocked c ->
Val.inject (Mem.flat_inj (Mem.nextblock m1')) arg arg ->
semantics.at_external
(semantics.csem (event_semantics.msem semSem)) c
(restrPermMap (fst (ssrfun.pair_of_and (Hcmpt tid Htid)))) =
Some (CREATE, (Vptr b ofs :: arg :: nil)%list) ->
permMapJoin (fst newThreadPerm) (fst threadPerm')
(fst (ThreadPool.getThreadR Htid)) ->
permMapJoin (snd newThreadPerm) (snd threadPerm')
(snd (ThreadPool.getThreadR Htid)) ->
exists
e' (st2' : t) (m2' : mem) (cd' : option compiler_index)
(mu' : meminj),
concur_match cd' mu'
(ThreadPool.addThread
(ThreadPool.updThread Htid (Kresume c Vundef) threadPerm')
(Vptr b ofs) arg newThreadPerm) m1' st2' m2' /\
List.Forall2 (inject_mevent mu')
(seq.cat tr1
(Events.external tid
(Events.spawn
(b, Integers.Ptrofs.intval ofs)
(Some (build_delta_content (fst virtue1) m1'))
(Some (build_delta_content (fst virtue2) m1'))) :: nil))
(seq.cat tr2 (Events.external tid e' :: nil)) /\
HybridMachineSig.external_step
(scheduler:=HybridMachineSig.HybridCoarseMachine.scheduler)
U tr2 st2 m2 (HybridMachineSig.schedSkip U)
(seq.cat tr2
(Events.external tid e' :: nil)) st2' m2'.