Section SpinLocks.
Context {Sem : Semantics}
{SemAxioms: SemAxioms}
{initU: seq nat}.
Variable EM: ClassicalFacts.excluded_middle.
Existing Instance OrdinalPool.OrdinalThreadPool.
Existing Instance DryHybridMachine.DryHybridMachineSig.
Existing Instance dryFineMach.
Existing Instance bareMach.
Existing Instance FineDilMem.
Open Scope nat.
(** True if two events access at least one common byte*)
Definition sameLocation ev1 ev2 :=
match Events.location ev1, Events.location ev2 with
| Some (b1, ofs1, size1), Some (b2, ofs2, size2) =>
b1 = b2 /\ exists ofs, Intv.In ofs (ofs1, (ofs1 + Z.of_nat size1)%Z) /\
Intv.In ofs (ofs2, (ofs2 + Z.of_nat size2)%Z)
| _,_ => False
end.
(** Competing Events *)
(** Actions that may compete*)
Definition caction (ev : Events.machine_event) :=
match ev with
| internal _ (event_semantics.Write _ _ _) => Some Write
| internal _ (event_semantics.Read _ _ _ _) => Some Read
| internal _ (event_semantics.Alloc _ _ _) => None
| internal _ (event_semantics.Free _) => None
| external _ (release _ _) => Some Release
| external _ (acquire _ _) => Some Acquire
| external _ (mklock _) => Some Mklock
| external _ (freelock _) => Some Freelock
| external _ (spawn _ _ _) => None
| external _ (failacq _) => Some Failacq
end.
(** Two events compete if they access the same location, from a different thread. *)
(*this definition allows reads and writes to compete with release/acq - wrong*)
(*Definition competes (ev1 ev2 : Events.machine_event) : Prop := thread_id ev1 <> thread_id ev2 /\ sameLocation ev1 ev2 /\ caction ev1 /\ caction ev2 /\ (caction ev1 = Some Write \/ caction ev2 = Some Write \/ caction ev1 = Some Mklock \/ caction ev2 = Some Mklock \/ caction ev1 = Some Freelock \/ caction ev2 = Some Freelock). *)
(* this definition allows makelock/freelock to compete with freelock/makelock, that's probably desired*)
Definition competes (ev1 ev2 : Events.machine_event) : Prop :=
thread_id ev1 <> thread_id ev2 /\ (* different threads*)
sameLocation ev1 ev2 /\ (* same location *)
caction ev1 /\ (* both are competing type*)
caction ev2 /\
(is_internal ev1 ->
is_internal ev2 ->
(** if they are both internal, at least one of them is a Write*)
action ev1 = Write \/ action ev2 =  Write) /\
(is_external ev1 \/ is_external ev2 ->
(** if one of them is external, then at least one of them is a Mklock or freelock*)
action ev1 = Mklock \/ action ev1 = Freelock
\/ action ev2 = Mklock \/ action ev2 = Freelock).
(** Spinlock well synchronized*)
Definition spinlock_synchronized (tr : event_trace) :=
forall (i j : nat) ev1 ev2,
i < j ->
List.nth_error tr i = Some ev1 ->
List.nth_error tr j = Some ev2 ->
competes ev1 ev2 ->
(exists u v eu ev,
i <= u < v /\ v < j /\
List.nth_error tr u = Some eu /\
List.nth_error tr v = Some ev /\
action eu = Release /\ action ev = Acquire /\
location eu = location ev) \/
(** we also consider spawn operations to be synchronizing*)
(exists u eu,
i < u < j /\
List.nth_error tr u = Some eu /\
action eu = Spawn).
(** Spinlock clean*)
Definition spinlock_clean (tr : event_trace) :=
forall i j evi evj
(Hij: i < j)
(Hi: List.nth_error tr i = Some evi)
(Hj: List.nth_error tr j = Some evj)
(Hmklock: action evi = Mklock)
(Hfreelock: forall u evu, i < u < j ->
List.nth_error tr u = Some evu ->
action evu <> Freelock \/
location evu <> location evi)
(Hlocation: sameLocation evj evi),
action evj <> Write /\ action evj <> Read.
Notation fstep := ((corestep (AsmContext.fine_semantics initU))).
Opaque containsThread getThreadR getThreadC t lockRes.
Notation multi_fstep := (@multi_step Sem FineDilMem _ DryHybridMachine.DryHybridMachineSig).
(** Actions that require a [Readable] permission*)
Inductive raction ev : Prop :=
| read: action ev = Read ->
raction ev
| acq: action ev = Acquire ->
raction ev
| rel: action ev = Release ->
raction ev
| facq: action ev = Failacq ->
raction ev.
(** Actions that require a [Writable] permission*)
Inductive waction ev : Prop:=
| write: action ev = Write ->
waction ev
| mk: action ev = Mklock ->
waction ev
| fl: action ev = Freelock ->
waction ev.

Lemma fstep_ev_perm:
forall U tr tp m U' tr_pre tr_post tp' m' ev
(Hstep: fstep (U, tr, tp) m (U', tr ++ tr_pre ++ [:: ev] ++ tr_post , tp') m'),
(waction ev ->
forall (cnt: containsThread tp (thread_id ev)) (cnt': containsThread tp' (thread_id ev)),
match location ev with
| Some (b, ofs, sz) =>
forall ofs', Intv.In ofs' (ofs, ofs + Z.of_nat sz)%Z ->
(Mem.valid_block m b ->
Mem.perm_order'' ((getThreadR cnt).1 !! b ofs') (Some Writable) \/
Mem.perm_order'' ((getThreadR cnt).2 !! b ofs') (Some Writable)) /\
((Mem.perm_order'' ((getThreadR cnt').1 !! b ofs') (Some Writable) \/
Mem.perm_order'' ((getThreadR cnt').2 !! b ofs') (Some Writable)) \/
deadLocation tp' m' b ofs')
| None => False
end) /\
(caction ev ->
forall (cnt: containsThread tp (thread_id ev)) (cnt': containsThread tp' (thread_id ev)),
match location ev with
| Some (b, ofs, sz) =>
forall ofs', Intv.In ofs' (ofs, ofs + Z.of_nat sz)%Z ->
(Mem.valid_block m b ->
Mem.perm_order'' ((getThreadR cnt).1 !! b ofs') (Some Readable) \/
Mem.perm_order'' ((getThreadR cnt).2 !! b ofs') (Some Readable)) /\
((Mem.perm_order'' ((getThreadR cnt').1 !! b ofs') (Some Readable) \/
Mem.perm_order'' ((getThreadR cnt').2 !! b ofs') (Some Readable)) \/
(tr_pre = [::] /\ tr_post = [::] /\ action ev = Release /\
(exists rmap, sz = lksize.LKSIZE_nat /\
lockRes tp' (b, ofs) = Some rmap /\
(Mem.perm_order'' (rmap.1 !! b ofs') (Some Readable) \/
Mem.perm_order'' (rmap.2 !! b ofs') (Some Readable)))) \/
deadLocation tp' m' b ofs')
| None => False
end).