Section Machine.
Context {ZT : Type} (Jspec : juicy_ext_spec ZT) {ge : genv}.
(*+ Description of the invariant *)
Definition cm_state := (Mem.mem * (event_trace * schedule * jstate ge))%type.
Inductive state_step : cm_state -> cm_state -> Prop :=
| state_step_empty_sched m tr jstate :
state_step
(m, (tr, nil, jstate))
(m, (tr, nil, jstate))
| state_step_c m m' tr tr' sch sch' jstate jstate':
@JuicyMachine.machine_step _ (Clight_newSem ge) _ HybridCoarseMachine.DilMem JuicyMachineShell HybridMachineSig.HybridCoarseMachine.scheduler sch tr jstate m sch' tr' jstate' m' ->
state_step
(m, (tr, sch, jstate))
(m',(tr', sch', jstate')).
(*! Coherence between locks in dry/wet memories and lock pool *)
Inductive cohere_res_lock : forall (resv : option (option rmap)) (wetv : resource) (dryv : memval), Prop :=
| cohere_notlock wetv dryv:
(forall sh sh' z P, wetv <> YES sh sh' (LK z 0) P) ->
cohere_res_lock None wetv dryv
| cohere_locked R wetv :
islock_pred R wetv ->
cohere_res_lock (Some None) wetv (Byte (Integers.Byte.zero))
| cohere_unlocked R phi wetv :
islock_pred R wetv ->
R phi ->
cohere_res_lock (Some (Some phi)) wetv (Byte (Integers.Byte.one)).
Definition load_at m loc := Mem.load Mint32 m (fst loc) (snd loc).
Definition lock_coherence (lset : AMap.t (option rmap)) (phi : rmap) (m : mem) : Prop :=
forall loc : address,
match AMap.find loc lset with
(* not a lock *)
| None => ~isLK (phi @ loc) (* /\ ~isCT (phi @ loc) *)
(* locked lock *)
| Some None =>
load_at m loc = Some (Vint Int.zero) /\
(4 | snd loc) /\
(snd loc + LKSIZE < Ptrofs.modulus)%Z /\
exists R, lkat R loc phi
(* unlocked lock *)
| Some (Some lockphi) =>
load_at m loc = Some (Vint Int.one) /\
(4 | snd loc) /\
(snd loc + LKSIZE < Ptrofs.modulus)%Z /\
exists (R : mpred),
lkat R loc phi /\
(app_pred R (age_by 1 lockphi) \/ level phi = O)
(*/\ match age1 lockphi with | Some p => app_pred R p | None => Logic.True end*)
end.
Definition far (ofs1 ofs2 : Z) := (Z.abs (ofs1 - ofs2) >= LKSIZE)%Z.
Definition lock_sparsity {A} (lset : AMap.t A) : Prop :=
forall loc1 loc2,
AMap.find loc1 lset <> None ->
AMap.find loc2 lset <> None ->
loc1 = loc2 \/
fst loc1 <> fst loc2 \/
(fst loc1 = fst loc2 /\ far (snd loc1) (snd loc2)).
Definition lset_same_support {A} (lset1 lset2 : AMap.t A) :=
forall loc,
AMap.find loc lset1 = None <->
AMap.find loc lset2 = None.
(*! Joinability and coherence *)
(*! Invariant (= above properties + safety + uniqueness of Krun) *)
Definition jsafe_phi ge n ora c phi :=
forall jm,
m_phi jm = phi ->
@semax.jsafeN ZT Jspec ge n ora c jm.
Definition jsafe_phi_bupd ge n ora c phi :=
forall jm,
m_phi jm = phi ->
jm_bupd ora (@semax.jsafeN ZT Jspec ge n ora c) jm.
Definition threads_safety m (tp : jstate ge) PHI (mcompat : mem_compatible_with tp m PHI) n :=
forall i (cnti : containsThread tp i) (ora : ZT),
match getThreadC cnti with
| Krun c => semax.jsafeN Jspec ge n ora c (jm_ cnti mcompat)
| Kblocked c =>
(* The dry memory will change, so when we prove safety after an external we must only inspect the rmap m_phi part of the juicy memory.  This means more proof for each of the synchronisation primitives. *)
jsafe_phi ge n ora c (getThreadR cnti)
| Kresume c v =>
forall c',
(* [v] is not used here. The problem is probably coming from the definition of JuicyMachine.resume_thread'. *)
cl_after_external None c = Some c' ->
(* same quantification as in Kblocked *)
jsafe_phi_bupd ge n ora c' (getThreadR cnti)
| Kinit v1 v2 =>
val_inject (Mem.flat_inj (Mem.nextblock m)) v2 v2 /\
exists q_new,
cl_initial_core ge v1 (v2 :: nil) q_new /\
jsafe_phi ge n ora q_new (getThreadR cnti)
end.
Definition threads_wellformed (tp : jstate ge) :=
forall i (cnti : containsThread tp i),
match getThreadC cnti with
| Krun q => Logic.True
| Kblocked q => cl_at_external q <> None
| Kresume q v => cl_at_external q <> None /\ v = Vundef
| Kinit _ _ => Logic.True
end.
(* Havent' move this, but it's already defined in the concurrent_machien... * Probably in the wrong part... * SC: I had to change unique_Krun to include ~ Halted. Because halted * threads are still in Krun. (Although, ass you know right now there are no Hatled * threads...)  *)
Definition unique_Krun (tp : jstate ge) sch :=
(lt 1 tp.(num_threads).(pos.n) -> forall i cnti q,
@getThreadC _ _ _ i tp cnti = Krun q ->
exists sch', sch = i :: sch').
Definition no_Krun (tp : jstate ge) :=
forall i cnti q, @getThreadC _ _ _ i tp cnti <> Krun q.

Lemma unique_Krun_age_tp_to n tp sch :
unique_Krun (age_tp_to n tp) sch <-> unique_Krun tp sch.