(*! Instantiation of modules *)
Export THE_JUICY_MACHINE.
Export OrdinalPool ThreadPool.
Export Concur.
Set Bullet Behavior "Strict Subproofs".
Ltac cleanup :=
simpl in *;
unfold OrdinalPool.lockRes in *;
unfold OrdinalPool.lockGuts in *; unfold OrdinalPool.lockSet in *;
simpl lock_info in *; simpl res in *.
Ltac join_level_tac :=
try
match goal with
cnti : containsThread ?tp _,
compat : mem_compatible_with ?tp ?m ?Phi |- _ =>
assert (join_sub (getThreadR cnti) Phi) by (apply compatible_threadRes_sub, compat)
end;
repeat match goal with H : join_sub _ _ |- _ => apply join_sub_level in H end;
repeat match goal with H : join _ _ _ |- _ => apply join_level in H; destruct H end;
cleanup;
try congruence.
Notation event_trace := (seq.seq machine_event).
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.

Lemma far_range ofs ofs' z :
(0 <= z < LKSIZE)%Z ->
far ofs ofs' ->
~(ofs <= ofs' + z < ofs + LKSIZE)%Z.