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.
Definition lock_coherence' tp PHI m (mcompat : mem_compatible_with tp m PHI) :=
lock_coherence
(lset tp) PHI
(restrPermMap
(mem_compatible_locks_ltwritable
(mem_compatible_forget mcompat))).
Definition env_coherence {Z} Jspec (ge : genv) (Gamma : funspecs) PHI :=
matchfunspecs ge Gamma PHI /\
exists prog CS V,
@semax_prog {|OK_ty := Z; OK_spec := Jspec|} CS prog V Gamma /\
ge = globalenv prog /\
app_pred
(funassert (Delta_types V Gamma (Tpointer Tvoid noattr :: nil))
(empty_environ ge)) PHI.
Definition maxedmem (m: mem) :=
restrPermMap (mem_max_lt_max m).
Definition mem_wellformed (m: mem) :=
Mem.inject_neutral (Mem.nextblock m) (maxedmem m) /\
Ple (Genv.genv_next ge) (Mem.nextblock m).
Inductive state_invariant Gamma (n : nat) : cm_state -> Prop :=
| state_invariant_c
(m : mem) (tr : event_trace) (sch : schedule) (tp : jstate ge) (PHI : rmap)
(lev : level PHI = n)
(envcoh : env_coherence Jspec ge Gamma PHI)
(mwellformed: mem_wellformed m)
(mcompat : mem_compatible_with tp m PHI)
(extcompat : joins (ghost_of PHI) (Some (ext_ref tt, NoneP) :: nil))
(lock_sparse : lock_sparsity (lset tp))
(lock_coh : lock_coherence' tp PHI m mcompat)
(safety : threads_safety m tp PHI mcompat n)
(wellformed : threads_wellformed tp)
(uniqkrun :  unique_Krun tp sch)
: state_invariant Gamma n (m, (tr, sch, tp)).
Definition blocked_at_external (state : cm_state) (ef : external_function) :=
match state with
(m, (tr, sch, tp)) =>
exists j cntj sch' c args,
sch = j :: sch' /\
@getThreadC _ _ _ j tp cntj = Kblocked c /\
cl_at_external c = Some (ef, args)
end.
Definition state_bupd P (state : cm_state) := let '(m, (tr, sch, tp)) := state in
tp_bupd (fun tp' => P (m, (tr, sch, tp'))) tp.

(* Ghost update only affects safety; the rest of the invariant is preserved. *)
Lemma state_inv_upd : forall Gamma (n : nat)
(m : mem) (tr : event_trace) (sch : schedule) (tp : jstate ge) (PHI : rmap)
(lev : level PHI = n)
(envcoh : env_coherence Jspec ge Gamma PHI)
(mwellformed: mem_wellformed m)
(mcompat : mem_compatible_with tp m PHI)
(extcompat : joins (ghost_of PHI) (Some (ext_ref tt, NoneP) :: nil))
(lock_sparse : lock_sparsity (lset tp))
(lock_coh : lock_coherence' tp PHI m mcompat)
(safety : forall C, join_sub (Some (ext_ref tt, NoneP) :: nil) C ->
joins (ghost_of PHI) (ghost_fmap (approx (level PHI)) (approx (level PHI)) C) ->
exists tp' PHI' (Hupd : tp_update tp PHI tp' PHI'),
joins (ghost_of PHI') (ghost_fmap (approx (level PHI)) (approx (level PHI)) C) /\
threads_safety m tp' PHI' (mem_compatible_upd _ _ _ _ _ mcompat Hupd) n)
(wellformed : threads_wellformed tp)
(uniqkrun :  unique_Krun tp sch),
state_bupd (state_invariant Gamma n) (m, (tr, sch, tp)).