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.

(** Spinlock clean for a single step*)
Lemma fstep_clean:
forall U U' tp m addr tr pre ev post tp' m' tidi
(Hlock: lockRes tp addr)
(HisLock: isLock tp addr)
(Hlocation: sameLocation ev (external tidi (mklock addr)))
(Hstep: fstep (U, tr, tp) m
(U', tr ++ pre ++ [:: ev] ++ post, tp') m'),
action ev <> Write /\ action ev <> Read.