(*IM using proof irrelevance!*)
(* The concurrent machinery*)
(*Require Import VST.concurrency.common.juicy_machine. Import Concur.*)
(*Semantics*)
(*Require Import VST.veric.Clight_sim.*)
(*SSReflect*)
From mathcomp.ssreflect Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.
Set Bullet Behavior "Strict Subproofs".
Module Clight_newMachine.
Module DMS.
Section DMS.
Context {ge : Clight.genv}.
Existing Instance OrdinalPool.OrdinalThreadPool.
Instance DSem : Semantics := Clight_newSem ge.
(* First construct the Clight machine and the two projections: - ClightMachineSem (i.e.  MachineSemantics) - ClightConcurSem (i.e. ConcurMachineSemantics) *)
Definition ClightMachine :=(HybridCoarseMachine.HybridCoarseMachine
(machineSig := DryHybridMachine.DryHybridMachineSig)).
Definition ClightMachineSem := (MachineSemantics(HybridMachine := ClightMachine)).
Definition ClightConcurSem := (ConcurMachineSemantics(HybridMachine := ClightMachine)).
End DMS.
End DMS.
End Clight_newMachine.
Module ClightMachine.
Module DMS.
Section DMS.
Context {ge : Clight.genv}.
Existing Instance OrdinalPool.OrdinalThreadPool.
Instance DSem : Semantics := ClightSem ge.
(* First construct the Clight machine and the two projections: - ClightMachineSem (i.e.  MachineSemantics) - ClightConcurSem (i.e. ConcurMachineSemantics) *)
Definition ClightMachine :=(HybridCoarseMachine.HybridCoarseMachine
(machineSig := DryHybridMachine.DryHybridMachineSig)).
Definition ClightMachineSem := (MachineSemantics(HybridMachine := ClightMachine)).
Definition ClightConcurSem := (ConcurMachineSemantics(HybridMachine := ClightMachine)).
End DMS.
End DMS.
End ClightMachine.
Module FiniteBranching.
(** *Finite Branching*)
(* Probably need to assume something about memory. Such as: 1. Next block increases at most by one 2. semantics is deterministic, so we know all possible changes to memory. 3. it's finitely branching *)
(*    Lemma schedule_not_halted: forall y i, SCH.schedPeek y = Some i -> forall ge tr dm m y' tr' dm' m', DMS.DryConc.sem_with_halt ge (y, tr, dm) m (y', tr', dm') m' -> DMS.DryConc.MachStep ge (y, tr, dm) m (y', tr', dm') m'. Lemma no_thread_halted: forall i ds cnti, ~ @DMS.DryMachine.threadHalted i ds cnti.  (*    Lemma finite_branching_sync: forall ds ge i cnti c, getThreadC i ds.1.2 cnti = Kblocked c -> safety.finite_on_x (@safety.possible_image DMS.DryConc.new_state DMS.DryConc.Sch (fun x y x' => exists y', (DMS.DryConc.new_step ge x y x' y')) (fun st y => schedPeek y = Some i /\ DMS.DryConc.new_valid_bound st y) ds).  pose (is_syncStep:= is_syncStep ge tr dm m i cnti c Hcmpt KRES).  (*It most be at_external *)
destruct (at_external DMS.DryMachine.ThreadPool.SEM.Sem ge c m) eqn:AtExt.
2:{
exists 0%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H'; inversion H'; subst c
end; congruence.
}
(*the arguments can't be empty*)
destruct p as [FUN ARGS].
pose (the_args_dec:= exists b ofs ARGS', ARGS = Vptr b ofs :: ARGS').
destruct (Classical_Prop.classic the_args_dec) as [Hargs|NHargs].
2:{
exists 0%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK.
rewrite PEEK => VAL [] y' /(schedule_not_halted y i PEEK) STEP.
inversion STEP; simpl in *; try subst; (*Lets go through all possible steps*)
match goal with
| [ H: SCH.schedPeek ?Y = Some _ ,
H': SCH.schedPeek ?Y = Some _  |- _ ] =>
rewrite H in H'; inversion H'; subst
end; simpl in *; try subst;
try (inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = _ ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
replace cnt2 with cnt1 in H' by apply proof_irrelevance;
rewrite H in H'; inversion H'
end; subst);
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (FUN, ARGS),
H' : at_external ?SEM _ ?c _ = Some (_, ((Vptr ?b ?ofs):: ?ARGS')) |- _ ] =>
exfalso; apply NHargs; exists b, ofs, ARGS';
rewrite H in H'; inversion H'; auto; pose (2)
| [ H: at_external ?SEM _ ?c _ = _ ,
H' : at_external ?SEM _ ?c' _ =  _  |- _ ] =>
pose (NNNN:= c); pose (NNNNN:= c'); pose (3)
end).
- exfalso; eapply no_thread_halted; eassumption.
- exfalso; apply Htid; assumption.
}
move: Hargs => [] b [] ofs [] ARGS' HH.
subst ARGS. clear the_args_dec.
(** *MKLOCK case*)
destruct (extfunct_eqdec FUN (EF_external "makelock" UNLOCK_SIG)) as [? | notMKLOCK].
{
subst.
(*must be able to store*)
pose (m1:= restrPermMap (DMS.DryMachine.compat_th Hcmpt cnti).1).
destruct (Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.zero)) as [m'|] eqn:Hstore'.
2:{
exists 0%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK.
rewrite PEEK => VAL [] y' /(schedule_not_halted y i PEEK) STEP.
inversion STEP; simpl in *; try subst; (*Lets go through all possible steps*)
match goal with
| [ H: SCH.schedPeek ?Y = Some _ ,
H': SCH.schedPeek ?Y = Some _  |- _ ] =>
rewrite H in H'; inversion H'; subst
end; simpl in *; try subst;
try (inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = _ ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
replace cnt2 with cnt1 in H' by apply proof_irrelevance;
rewrite H in H'; inversion H'
end; subst);
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
try solve[ rewrite H in H'; inversion H']
| [ H: at_external ?SEM _ ?c _ = Some (?FUN, _),
H' : at_external ?SEM _ ?c _ = Some (?FUN', _ ) |- _ ] =>
pose (NNNN:= FUN); pose (NNNNN:= FUN'); pose (3)
end);
try solve[ exfalso; eapply no_thread_halted; eassumption];
try solve[ exfalso; apply Htid; assumption].
rewrite AtExt in Hat_external; inversion Hat_external; subst.
unfold m1 in Hstore'.
replace Hcmpt0 with Hcmpt in Hstore by apply proof_irrelevance.
replace Htid with cnti in Hstore by apply proof_irrelevance.
clear - Hstore Hstore'.
rewrite Hstore' in Hstore; inversion Hstore.
}
pose (pmap_tid'0:= (setPermBlock (Some Nonempty) b
(Ptrofs.intval ofs)
(DMS.DryMachine.ThreadPool.getThreadR cnti).1
LKSIZE_nat,
setPermBlock (Some Writable) b
(Ptrofs.intval ofs)
(DMS.DryMachine.ThreadPool.getThreadR cnti).2
LKSIZE_nat)).
pose (tp'0:= DMS.DryMachine.ThreadPool.updThread cnti
(Kresume c Vundef) pmap_tid'0).
pose (tp''0 :=
DMS.DryMachine.ThreadPool.updLockSet tp'0
(b, Ptrofs.intval ofs) (empty_map, empty_map)).
exists 1%nat, (fun _ => ([::], tp''0, m')).
move=> x y [] [] PEEK.
rewrite PEEK => VAL [] y' /(schedule_not_halted y i PEEK) STEP.
inversion STEP; simpl in *; try subst; (*Lets go through all possible steps*)
match goal with
| [ H: SCH.schedPeek ?Y = Some _ ,
H': SCH.schedPeek ?Y = Some _  |- _ ] =>
rewrite H in H'; inversion H'; subst
end; simpl in *; try subst;
try (inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = _ ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
replace cnt2 with cnt1 in H' by apply proof_irrelevance;
rewrite H in H'; inversion H'
end; subst);
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; inversion H'
| [ H: at_external ?SEM _ ?c _ = Some (?FUN, _),
H' : at_external ?SEM _ ?c _ = Some (?FUN', _ ) |- _ ] =>
pose (NNNN:= FUN); pose (NNNNN:= FUN'); pose (3)
end);
try solve[ exfalso; eapply no_thread_halted; eassumption];
try solve[ exfalso; apply Htid; assumption].
exists 0%nat; split; auto.
destruct x as [[? ?] ?]; simpl in *; subst.
repeat f_equal.
- rewrite /tp''0 /tp'0; repeat f_equal;
try apply proof_irrelevance.
destruct pmap_tid'; simpl in *; subst.
rewrite /pmap_tid'0.
repeat f_equal; apply proof_irrelevance.
- simpl in *; subst.
unfold m1 in Hstore'.
replace Hcmpt0 with Hcmpt in Hstore by apply proof_irrelevance.
replace Htid with cnti in Hstore by apply proof_irrelevance.
clear - Hstore Hstore'.
rewrite Hstore' in Hstore; inversion Hstore.
auto.
}
(*Compute the bounds*)
assert (Hbound':=Hbound).
eapply bounded_maps.finite_sub_maps
in Hbound as bounded_delta_map.
eapply bounded_maps.finite_sub_maps_simpl
in Hbound' as bounded_access_map.
pose (virtue_bound:= konig.finite_product bounded_delta_map bounded_delta_map).
pose (otherLP_bound:= konig.finite_product bounded_access_map bounded_access_map).
(** *ACQUIRE and ACQFAIL cases*)
destruct (extfunct_eqdec FUN LOCK).
{ (* **acquire AND acquire fail case*)
subst.
pose (m1:= restrPermMap (DMS.DryMachine.compat_th Hcmpt cnti).2).
(*Check if can acquire*)
pose (load_one_dec:=
Mem.load Mint32 m1 b (Ptrofs.intval ofs) = Some (Vint Int.one)).
destruct (Classical_Prop.classic load_one_dec) as [Hone_zero| Nload].
(*ACQFAIL*)
2:{
exists 1%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK.
rewrite PEEK => VAL [] y' /(schedule_not_halted y i PEEK) STEP.
inversion STEP; simpl in *; try subst; (*Lets go through all possible steps*)
match goal with
| [ H: SCH.schedPeek ?Y = Some _ ,
H': SCH.schedPeek ?Y = Some _  |- _ ] =>
rewrite H in H'; inversion H'; subst
end; simpl in *; try subst;
try (inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = _ ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
replace cnt2 with cnt1 in H' by apply proof_irrelevance;
rewrite H in H'; inversion H'
end; subst);
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; inversion H'
| [ H: at_external ?SEM _ ?c _ = Some (?FUN, _),
H' : at_external ?SEM _ ?c _ = Some (?FUN', _ ) |- _ ] =>
pose (NNNN:= FUN); pose (NNNNN:= FUN'); pose (3)
end);
try solve[ exfalso; eapply no_thread_halted; eassumption];
try solve[ exfalso; apply Htid; assumption].
- subst. exfalso; apply Nload.
rewrite /load_one_dec /m1.
replace Hcmpt with Hcmpt0 by apply proof_irrelevance.
replace cnti with Htid by apply proof_irrelevance.
auto.
- exists 0%nat; split; auto.
destruct x as [[? ?] ?]; simpl in *; subst; auto.
}
pose (pmap_tid'0:=
setPermBlock (Some Writable) b
(Ptrofs.intval ofs)
(DMS.DryMachine.ThreadPool.getThreadR cnti).2 LKSIZE_nat).
pose (Hlt_dec:= permMapLt pmap_tid'0 (getMaxPerm m)).
destruct (Classical_Prop.classic Hlt_dec) as [Hlt| NHlt].
2:{
exists 0%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H';  inversion H'; subst c
end;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; pose (NN:= H'); inversion H'
end; simpl in *; try subst).
- exfalso; apply NHlt; auto.
- exfalso. subst. clear - AtExt  Hat_external. congruence.
- rewrite Hone_zero in Hload; inversion Hload.
}
(*must be able to store*)
pose (m2:= restrPermMap Hlt).
destruct (Mem.store Mint32 m2 b (Ptrofs.intval ofs) (Vint Int.zero)) as [m'|] eqn:Hstore'.
2:{
exists 0%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H'; inversion H'; subst c
end; try congruence; simpl in *; subst;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; inversion H'
end; simpl in *; try subst);
try solve[rewrite Hone_zero in Hload; inversion Hload].
- clear - Hstore Hstore'.
replace Hlt' with Hlt in Hstore by apply proof_irrelevance.
rewrite Hstore' in Hstore; inversion Hstore.
}
destruct virtue_bound as [N [virtue_generator virtue_gen_spec] ].
pose (newThreadPerm v :=
(computeMap
(DMS.DryMachine.ThreadPool.getThreadR cnti).1
v.1,
computeMap (DMS.DryMachine.ThreadPool.getThreadR cnti).2
v.2)).
(*pose (newThreadPerm (v:PTree.t (Z -> option permission)*PTree.t (Z -> option permission)) := (((DMS.DTP.getThreadR cnti).1.1, v.1), ((DMS.DTP.getThreadR cnti).2.1, v.2))). *)
pose( tp'0 v:=
DMS.DryMachine.ThreadPool.updThread cnti
(Kresume c Vundef) (newThreadPerm v)).
pose (tp''0 v:=
DMS.DryMachine.ThreadPool.updLockSet (tp'0 v)
(b, Ptrofs.intval ofs) (empty_map, empty_map)).
exists N.
exists (fun n => (nil,
tp''0 (virtue_generator n),
m')).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H'; inversion H'; subst c
end; try congruence;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; inversion H'
end; simpl in *; try subst);
try solve[rewrite Hone_zero in Hload; inversion Hload].
unfold tp''0, tp'0.
assert (H: bounded_maps.sub_map virtueThread.1 (getMaxPerm m).2 /\
bounded_maps.sub_map virtueThread.2 (getMaxPerm m).2).
{ auto. }
move: H => /virtue_gen_spec [] j [] /ltP ineq vg_spec.
exists j; split; auto.
rewrite vg_spec.
destruct x as [[ ? ?] ?]; simpl in *; subst.
repeat f_equal.
clear -Hstore Hstore'.
replace Hlt' with Hlt in Hstore by apply proof_irrelevance.
rewrite Hstore' in Hstore; inversion Hstore.
auto.
}
(** *RELEASE cases*)
destruct (extfunct_eqdec FUN UNLOCK).
{ (* **Release case*)
subst.
pose (m0:= restrPermMap (DMS.DryMachine.compat_th Hcmpt cnti).2).
(*Most be acquired*)
pose (load_one_dec:=
Mem.load Mint32 m0 b (Ptrofs.intval ofs) = Some (Vint Int.zero)).
destruct (Classical_Prop.classic load_one_dec) as [Hone_zero| Nload].
2:{
exists 0%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H';  inversion H'; subst c
end; try congruence;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; pose (NN:= H'); inversion H'
end; simpl in *; try subst).
- exfalso; apply Nload.
apply Hload.
}
pose (pmap_tid'0:=
setPermBlock (Some Writable) b
(Ptrofs.intval ofs)
(DMS.DryMachine.ThreadPool.getThreadR cnti).2 LKSIZE_nat).
pose (Hlt_dec:= permMapLt pmap_tid'0 (getMaxPerm m)).
destruct (Classical_Prop.classic Hlt_dec) as [Hlt| NHlt].
2:{
exists 0%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H';  inversion H'; subst c
end; try congruence;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; pose (NN:= H'); inversion H'
end; simpl in *; try subst).
- exfalso; apply NHlt. auto.
}
(*must be able to store*)
pose (m1:= restrPermMap Hlt).
destruct (Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.one)) as [m'|] eqn:Hstore'.
2:{
exists 0%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H'; inversion H'; subst c
end; try congruence;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; inversion H'
end; simpl in *; try subst).
- clear - Hstore Hstore'.
replace Hlt' with Hlt in Hstore by apply proof_irrelevance.
rewrite Hstore' in Hstore; inversion Hstore.
}
pose (virtueXother_bound:= konig.finite_product virtue_bound otherLP_bound).
destruct virtueXother_bound as [N [virtue_generator virtue_gen_spec] ].
pose (newThreadPerm v :=
(computeMap
(DMS.DryMachine.ThreadPool.getThreadR cnti).1
v.1,
computeMap (DMS.DryMachine.ThreadPool.getThreadR cnti).2
v.2)).
pose (virtueLP (ov: PTree.t (Z -> option permission) *
PTree.t (Z -> option permission)) :=
((fun _ :Z => @None permission, ov.1),(fun _ :Z => @None permission, ov.2))).
pose( tp'0 v:=
DMS.DryMachine.ThreadPool.updThread cnti
(Kresume c Vundef) (newThreadPerm v)).
pose (tp''0 v:=
DMS.DryMachine.ThreadPool.updLockSet (tp'0 v.1)
(b, Ptrofs.intval ofs) (virtueLP v.2)).
exists N.
exists (fun n => (nil,
tp''0 (virtue_generator n),
m')).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H'; inversion H'; subst c
end; try congruence;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; inversion H'
end; simpl in *; try subst);
try solve[rewrite Hone_zero in Hload; inversion Hload].
unfold tp''0, tp'0.
assert (H: bounded_maps.sub_map virtueThread.1 (getMaxPerm m).2 /\
bounded_maps.sub_map virtueThread.2 (getMaxPerm m).2).
{ auto. }
assert (H': bounded_maps.sub_map virtueLP0.1.2 (getMaxPerm m).2 /\
bounded_maps.sub_map virtueLP0.2.2 (getMaxPerm m).2).
{ move: HboundedLP => [] A [] B //. }
assert (HH: (bounded_maps.sub_map (virtueThread,(virtueLP0.1.2, virtueLP0.2.2)).1.1 (getMaxPerm m).2 /\
bounded_maps.sub_map (virtueThread,(virtueLP0.1.2, virtueLP0.2.2)).1.2 (getMaxPerm m).2) /\
(bounded_maps.sub_map (virtueThread,(virtueLP0.1.2, virtueLP0.2.2)).2.1 (getMaxPerm m).2 /\
bounded_maps.sub_map (virtueThread,(virtueLP0.1.2, virtueLP0.2.2)).2.2 (getMaxPerm m).2)).
{ split; auto. }
move virtue_gen_spec at bottom.
move: HH => /virtue_gen_spec [] j [] /ltP ineq vg_spec.
exists j; split; auto.
rewrite vg_spec.
destruct x as [[ ? ?] ?]; simpl in *; subst.
repeat f_equal.
- rewrite /virtueLP.
destruct virtueLP0 as [[LP11 LP12][LP21 LP22]]; simpl.
f_equal.
move: HboundedLP.
rewrite /bounded_maps.map_empty_def => /= [] [] -> [] -> _.
reflexivity.
- clear -Hstore Hstore'.
replace Hlt' with Hlt in Hstore by apply proof_irrelevance.
rewrite Hstore' in Hstore; inversion Hstore.
auto.
}
(** *CREATE cases*)
destruct (extfunct_eqdec FUN CREATE).
{ (* **CREATE/SPAWN  case*)
subst.
(*get a pair of virtues*)
pose (virtueXvirtue_bound:= konig.finite_product virtue_bound virtue_bound).
destruct virtueXvirtue_bound as [N [virtue_generator virtue_gen_spec] ].
pose (threadPerm' virtue1 := (computeMap
(DMS.DryMachine.ThreadPool.getThreadR cnti).1
virtue1.1,
computeMap
(DMS.DryMachine.ThreadPool.getThreadR cnti).2
virtue1.2)).
pose (newThreadPerm virtue2 :=
(computeMap empty_map virtue2.1,
computeMap empty_map virtue2.2)).
pose (tp_upd0 v:=
DMS.DryMachine.ThreadPool.updThread cnti
(Kresume c Vundef) (threadPerm' v)).
pose (arg:= match ARGS' with
| arg::_ => arg
| _ => Vundef
end ).
pose (tp'0 v :=
DMS.DryMachine.ThreadPool.addThread (tp_upd0 v.1)
(Vptr b ofs) arg (newThreadPerm v.2)).
exists N.
exists (fun n => (nil,
tp'0 (virtue_generator n),
m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H'; inversion H'; subst c
end; try congruence;
(*          try (match goal with | [ H: at_external ?SEM _ ?c _ = Some (_, _), H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] => rewrite H in H'; inversion H' end; simpl in *; try subst); *)
try solve[rewrite Hone_zero in Hload; inversion Hload].
unfold tp'0, tp_upd0. subst.
rewrite AtExt in Hat_external. inv Hat_external.
assert (H: bounded_maps.sub_map virtue1.1 (getMaxPerm x.2).2 /\
bounded_maps.sub_map virtue1.2 (getMaxPerm x.2).2).
{ auto. }
assert (H': bounded_maps.sub_map virtue2.1 (getMaxPerm x.2).2 /\
bounded_maps.sub_map virtue2.2 (getMaxPerm x.2).2).
{ auto.  }
assert (HH: (bounded_maps.sub_map (virtue1,virtue2).1.1 (getMaxPerm x.2).2 /\
bounded_maps.sub_map (virtue1,virtue2).1.2 (getMaxPerm x.2).2) /\
(bounded_maps.sub_map (virtue1,virtue2).2.1 (getMaxPerm x.2).2 /\
bounded_maps.sub_map (virtue1,virtue2).2.2 (getMaxPerm x.2).2)).
{ split; auto. } clear H H'.
move virtue_gen_spec at bottom.
move: HH => /virtue_gen_spec [] j [] /ltP ineq vg_spec.
exists j; split; auto.
rewrite vg_spec.
destruct x as [[ ? ?] ?]; simpl in *; subst.
repeat f_equal.
}
(** *CREATE cases*)
destruct (extfunct_eqdec FUN CREATE).
{ (* **CREATE/SPAWN  case*)
subst.
(*get a pair of virtues*)
pose (virtueXvirtue_bound:= konig.finite_product virtue_bound virtue_bound).
destruct virtueXvirtue_bound as [N [virtue_generator virtue_gen_spec] ].
pose (threadPerm' virtue1 := (computeMap
(DMS.DryMachine.ThreadPool.getThreadR cnti).1
virtue1.1,
computeMap
(DMS.DryMachine.ThreadPool.getThreadR cnti).2
virtue1.2)).
pose (newThreadPerm virtue2 :=
(computeMap empty_map virtue2.1,
computeMap empty_map virtue2.2)).
pose (tp_upd0 v:=
DMS.DryMachine.ThreadPool.updThread cnti
(Kresume c Vundef) (threadPerm' v)).
pose (arg:= match ARGS' with
| arg::_ => arg
| _ => Vundef
end ).
pose (tp'0 v :=
DMS.DryMachine.ThreadPool.addThread (tp_upd0 v.1)
(Vptr b ofs) arg (newThreadPerm v.2)).
exists N.
exists (fun n => (nil,
tp'0 (virtue_generator n),
m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H'; inversion H'; subst c
end; subst;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; inversion H'
end; simpl in *; try subst);
try solve[rewrite Hone_zero in Hload; inversion Hload].
unfold tp'0, tp_upd0.
assert (H: bounded_maps.sub_map virtue1.1 (getMaxPerm x.2).2 /\
bounded_maps.sub_map virtue1.2 (getMaxPerm x.2).2).
{ auto. }
assert (H': bounded_maps.sub_map virtue2.1 (getMaxPerm x.2).2 /\
bounded_maps.sub_map virtue2.2 (getMaxPerm x.2).2).
{ auto.  }
assert (HH: (bounded_maps.sub_map (virtue1,virtue2).1.1 (getMaxPerm x.2).2 /\
bounded_maps.sub_map (virtue1,virtue2).1.2 (getMaxPerm x.2).2) /\
(bounded_maps.sub_map (virtue1,virtue2).2.1 (getMaxPerm x.2).2 /\
bounded_maps.sub_map (virtue1,virtue2).2.2 (getMaxPerm x.2).2)).
{ split; auto. } clear H H'.
move virtue_gen_spec at bottom.
move: HH => /virtue_gen_spec [] j [] /ltP ineq vg_spec.
exists j; split; auto.
rewrite vg_spec.
destruct x as [[ ? ?] ?]; simpl in *; subst.
repeat f_equal.
}
(** *FREELOCK cases*)
destruct (extfunct_eqdec FUN FREE_LOCK).
{ (* **FREE LOCK  case*)
subst.
destruct (bounded_maps.finite_bounded_nat_func_simpl LKSIZE_nat )
as [N [virtue_generator virtue_gen_spec] ].
(*get a pair of virtues*)
pose (pmap_tid'0 pd:=
(setPermBlock_var pd b (Ptrofs.intval ofs)
(DMS.DryMachine.ThreadPool.getThreadR cnti).1
LKSIZE_nat,
setPermBlock None b (Ptrofs.intval ofs)
(DMS.DryMachine.ThreadPool.getThreadR cnti).2
LKSIZE_nat)).
pose (tp'0 pd:=
DMS.DryMachine.ThreadPool.updThread cnti
(Kresume c Vundef) (pmap_tid'0 pd)).
pose (tp''0 pd:=
DMS.DryMachine.ThreadPool.remLockSet (tp'0 pd)
(b, Ptrofs.intval ofs)).
exists N.
exists (fun n => (nil,
tp''0 (virtue_generator n),
m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H'; inversion H'; subst c
end; try congruence;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; inversion H'
end; simpl in *; try subst);
try solve[rewrite Hone_zero in Hload; inversion Hload].
unfold tp''0, tp'0.
assert (H: bounded_maps.bounded_nat_func' pdata LKSIZE_nat).
{ auto. }
move virtue_gen_spec at bottom.
move: H => /virtue_gen_spec [] j [] /ltP ineq vg_spec.
exists j; split; auto.
rewrite vg_spec; clear vg_spec.
destruct x as [[ ? ?] ?]; simpl in *; subst.
repeat f_equal.
unfold pmap_tid'0; destruct pmap_tid'; simpl in *; subst.
auto.
}
(*That's it folks it can't be anything else*)
exists 0%nat, (fun _ => (tr, dm, m)).
move=> x y [] [] PEEK VAL [] y' /(schedule_not_halted y i PEEK).
move => /(is_syncStep y PEEK VAL) [] TR [] _ [] SKIP [] ev Htstep.
inversion Htstep;
match goal with
| [ H: DMS.DTP.getThreadC ?cnt1 = Kblocked c ,
H': DMS.DTP.getThreadC ?cnt2 = _  |- _ ] =>
rewrite H in H'; inversion H'; subst c
end; subst;
try (match goal with
| [ H: at_external ?SEM _ ?c _ = Some (_, _),
H' : at_external ?SEM _ ?c _ = Some (_, _ ) |- _ ] =>
rewrite H in H'; inversion H'
end; simpl in *; try subst);
try (match goal with
| [ H: ?FUN_NAME <> ?FUN_NAME |- _ ] =>
exfalso; apply H; reflexivity
end).
Qed.

Lemma finite_branching: forall ds ge,
safety.finite_on_x
(@safety.possible_image
DMS.DryConc.new_state
DMS.DryConc.Sch
(fun x y x' => exists y', (DMS.DryConc.new_step ge x y x' y'))
DMS.DryConc.new_valid_bound ds).