From mathcomp.ssreflect Require Import ssreflect seq ssrbool ssrfun.
Require Export VST.concurrency.common.semantics.
Require Export VST.concurrency.common.lksize.
(*Require Import VST.concurrency.common.safety. Require Import VST.concurrency.common.coinductive_safety.*)
(* Require Import VST.veric.res_predicates. *)
(* Require Import VST.veric.Clight_new. *)
(* Require Import VST.concurrency.CoreSemantics_sum. *)
Module DryHybridMachine.
Instance dryResources: Resources:=
{| res := access_map * access_map;
lock_info := access_map * access_map |}.
Section DryHybridMachine.
(** Assume some threadwise semantics *)
Context {Sem: Semantics}
{tpool : @ThreadPool.ThreadPool dryResources Sem}.
Notation C:= (@semC Sem).
Notation G:= (@semG Sem).
Notation semSem:= (@semSem Sem).
Notation thread_pool := (@t dryResources Sem).
(** Memories*)
Definition richMem: Type:= mem.
Definition dryMem: richMem -> mem:= fun x => x.
(** The state respects the memory*)
Record mem_compatible (tp: thread_pool) m : Prop :=
{ compat_th :> forall {tid} (cnt: containsThread tp tid),
permMapLt (getThreadR cnt).1 (getMaxPerm m) /\
permMapLt (getThreadR cnt).2 (getMaxPerm m);
compat_lp : forall l pmaps, lockRes tp l = Some pmaps ->
permMapLt pmaps.1 (getMaxPerm m) /\
permMapLt pmaps.2 (getMaxPerm m);
lockRes_blocks: forall l rmap, lockRes tp l = Some rmap ->
Mem.valid_block m l.1}.
(* should there be something that says that if something is a lock then someone has at least readable permission on it?*)
Record invariant (tp: thread_pool) :=
{ no_race_thr :
forall i j (cnti: containsThread tp i) (cntj: containsThread tp j)
(Hneq: i <> j),
permMapsDisjoint2 (getThreadR cnti)
(getThreadR cntj); (*thread's resources are disjoint *)
no_race_lr:
forall laddr1 laddr2 rmap1 rmap2
(Hneq: laddr1 <> laddr2)
(Hres1: lockRes tp laddr1 = Some rmap1)
(Hres2: lockRes tp laddr2 = Some rmap2),
permMapsDisjoint2 rmap1 rmap2; (*lock's resources are disjoint *)
no_race:
forall i laddr (cnti: containsThread tp i) rmap
(Hres: lockRes tp laddr = Some rmap),
permMapsDisjoint2 (getThreadR cnti) rmap; (*resources are disjoint
between threads and locks*)
(* if an address is a lock then there can be no data permission above non-empty for this address*)
thread_data_lock_coh:
forall i (cnti: containsThread tp i),
(forall j (cntj: containsThread tp j),
permMapCoherence (getThreadR cntj).1 (getThreadR cnti).2) /\
(forall laddr rmap,
lockRes tp laddr = Some rmap ->
permMapCoherence rmap.1 (getThreadR cnti).2);
locks_data_lock_coh:
forall laddr rmap
(Hres: lockRes tp laddr = Some rmap),
(forall j (cntj: containsThread tp j),
permMapCoherence (getThreadR cntj).1 rmap.2) /\
(forall laddr' rmap',
lockRes tp laddr' = Some rmap' ->
permMapCoherence rmap'.1 rmap.2);
lockRes_valid: lr_valid (lockRes tp) (*well-formed locks*)
}.
(** Steps*)
Inductive dry_step {tid0 tp m} (cnt: containsThread tp tid0)
(Hcompatible: mem_compatible tp m) :
thread_pool -> mem -> seq.seq mem_event -> Prop :=
| step_dry :
forall (tp':thread_pool) c m1 m' (c' : C) ev
(** Instal the permission's of the thread on non-lock locations*)
(Hrestrict_pmap: restrPermMap (Hcompatible tid0 cnt).1 = m1)
(Hinv: invariant tp)
(Hcode: getThreadC cnt = Krun c)
(Hcorestep: ev_step semSem c m1 ev c' m')
(** the new data resources of the thread are the ones on the memory, the lock ones are unchanged by internal steps*)
(Htp': tp' = updThread cnt (Krun c') (getCurPerm m', (getThreadR cnt).2)),
dry_step cnt Hcompatible tp' m' ev.
Definition option_function {A B} (opt_f: option (A -> B)) (x:A): option B:=
match opt_f with
Some f => Some (f x)
| None => None
end.
Infix "??" := option_function (at level 80, right associativity).
Definition build_delta_content (dm: delta_map) (m:mem): delta_content :=
PTree.map (fun b dm_f =>
fun ofs =>
match dm_f ofs with
| None | Some (None)
| Some (Some Nonempty) => None
| Some _ => Some (ZMap.get ofs (Maps.PMap.get b (Mem.mem_contents m)))
end) dm.
Inductive ext_step {isCoarse:bool} {tid0 tp m}
(cnt0:containsThread tp tid0)(Hcompat:mem_compatible tp m):
thread_pool -> mem -> sync_event -> Prop :=
| step_acquire :
forall (tp' tp'':thread_pool) marg m0 m1 c m' b ofs
(pmap : lock_info)
(pmap_tid' : access_map)
(virtueThread : delta_map * delta_map)
(Hbounded: if isCoarse then
( sub_map virtueThread.1 (getMaxPerm m).2 /\
sub_map virtueThread.2 (getMaxPerm m).2)
else
True ),
let newThreadPerm := (computeMap (getThreadR cnt0).1 virtueThread.1,
computeMap (getThreadR cnt0).2 virtueThread.2) in
forall
(Hinv : invariant tp)
(Hcode: getThreadC cnt0 = Kblocked c)
(* To check if the machine is at an external step and load its arguments install the thread data permissions*)
(Hrestrict_pmap_arg: restrPermMap (Hcompat tid0 cnt0).1 = marg)
(Hat_external: semantics.at_external semSem c marg = Some (LOCK, Vptr b ofs::nil))
(** install the thread's permissions on lock locations*)
(Hrestrict_pmap0: restrPermMap (Hcompat tid0 cnt0).2 = m0)
(** To acquire the lock the thread must have [Readable] permission on it*)
(Haccess: Mem.range_perm m0 b (Ptrofs.intval ofs) ((Ptrofs.intval ofs) + LKSIZE) Cur Readable)
(** check if the lock is free*)
(Hload: Mem.load Mint32 m0 b (Ptrofs.intval ofs) = Some (Vint Int.one))
(** set the permissions on the lock location equal to the max permissions on the memory*)
(Hset_perm: setPermBlock (Some Writable)
b (Ptrofs.intval ofs) ((getThreadR cnt0).2) LKSIZE_nat = pmap_tid')
(Hlt': permMapLt pmap_tid' (getMaxPerm m))
(Hrestrict_pmap: restrPermMap Hlt' = m1)
(** acquire the lock*)
(Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.zero) = Some m')
(HisLock: lockRes tp (b, Ptrofs.intval ofs) = Some pmap)
(Hangel1: permMapJoin pmap.1 (getThreadR cnt0).1 newThreadPerm.1)
(Hangel2: permMapJoin pmap.2 (getThreadR cnt0).2 newThreadPerm.2)
(Htp': tp' = updThread cnt0 (Kresume c Vundef) newThreadPerm)
(** acquiring the lock leaves empty permissions at the resource pool*)
(Htp'': tp'' = updLockSet tp' (b, Ptrofs.intval ofs) (empty_map, empty_map)),
ext_step cnt0 Hcompat tp'' m'
(acquire (b, Ptrofs.intval ofs)
(Some (build_delta_content (fst virtueThread) m')))
| step_release :
forall (tp' tp'':thread_pool) marg m0 m1 c m' b ofs virtueThread virtueLP pmap_tid' rmap
(Hbounded: if isCoarse then
( sub_map virtueThread.1 (getMaxPerm m).2 /\
sub_map virtueThread.2 (getMaxPerm m).2)
else
True )
(HboundedLP: if isCoarse then
( map_empty_def virtueLP.1 /\
map_empty_def virtueLP.2 /\
sub_map virtueLP.1.2 (getMaxPerm m).2 /\
sub_map virtueLP.2.2 (getMaxPerm m).2)
else
True ),
let newThreadPerm := (computeMap (getThreadR cnt0).1 virtueThread.1,
computeMap (getThreadR cnt0).2 virtueThread.2) in
forall
(Hinv : invariant tp)
(Hcode: getThreadC cnt0 = Kblocked c)
(* To check if the machine is at an external step and load its arguments install the thread data permissions*)
(Hrestrict_pmap_arg: restrPermMap (Hcompat tid0 cnt0).1 = marg)
(Hat_external: semantics.at_external semSem c marg =
Some (UNLOCK, Vptr b ofs::nil))
(** install the thread's permissions on lock locations *)
(Hrestrict_pmap0: restrPermMap (Hcompat tid0 cnt0).2 = m0)
(** To release the lock the thread must have [Readable] permission on it*)
(Haccess: Mem.range_perm m0 b (Ptrofs.intval ofs) ((Ptrofs.intval ofs) + LKSIZE) Cur Readable)
(Hload: Mem.load Mint32 m0 b (Ptrofs.intval ofs) = Some (Vint Int.zero))
(** set the permissions on the lock location equal to [Writable]*)
(Hset_perm: setPermBlock (Some Writable)
b (Ptrofs.intval ofs) ((getThreadR cnt0).2) LKSIZE_nat = pmap_tid')
(Hlt': permMapLt pmap_tid' (getMaxPerm m))
(Hrestrict_pmap: restrPermMap Hlt' = m1)
(** release the lock *)
(Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.one) = Some m')
(HisLock: lockRes tp (b, Ptrofs.intval ofs) = Some rmap)
(Hrmap: forall b ofs, rmap.1 !! b ofs = None /\ rmap.2 !! b ofs = None)
(Hangel1: permMapJoin newThreadPerm.1 virtueLP.1 (getThreadR cnt0).1)
(Hangel2: permMapJoin newThreadPerm.2 virtueLP.2 (getThreadR cnt0).2)
(Htp': tp' = updThread cnt0 (Kresume c Vundef)
(computeMap (getThreadR cnt0).1 virtueThread.1,
computeMap (getThreadR cnt0).2 virtueThread.2))
(Htp'': tp'' = updLockSet tp' (b, Ptrofs.intval ofs) virtueLP),
ext_step cnt0 Hcompat tp'' m'
(release (b, Ptrofs.intval ofs)
(Some (build_delta_content (fst virtueThread) m')))
| step_create :
forall (tp_upd tp':thread_pool) c marg b ofs arg virtue1 virtue2
(Hbounded: if isCoarse then
( sub_map virtue1.1 (getMaxPerm m).2 /\
sub_map virtue1.2 (getMaxPerm m).2)
else
True )
(Hbounded_new: if isCoarse then
( sub_map virtue2.1 (getMaxPerm m).2 /\
sub_map virtue2.2 (getMaxPerm m).2)
else
True ),
let threadPerm' := (computeMap (getThreadR cnt0).1 virtue1.1,
computeMap (getThreadR cnt0).2 virtue1.2) in
let newThreadPerm := (computeMap empty_map virtue2.1,
computeMap empty_map virtue2.2) in
forall
(Hinv : invariant tp)
(Hcode: getThreadC cnt0 = Kblocked c)
(* To check if the machine is at an external step and load its arguments install the thread data permissions*)
(Hrestrict_pmap_arg: restrPermMap (Hcompat tid0 cnt0).1 = marg)
(Hat_external: semantics.at_external semSem c marg = Some (CREATE, Vptr b ofs::arg::nil))
(Harg: Val.inject (Mem.flat_inj (Mem.nextblock m)) arg arg)
(** we do not need to enforce the almost empty predicate on thread spawn as long as it's considered a synchronizing operation *)
(Hangel1: permMapJoin newThreadPerm.1 threadPerm'.1 (getThreadR cnt0).1)
(Hangel2: permMapJoin newThreadPerm.2 threadPerm'.2 (getThreadR cnt0).2)
(Htp_upd: tp_upd = updThread cnt0 (Kresume c Vundef) threadPerm')
(Htp': tp' = addThread tp_upd (Vptr b ofs) arg newThreadPerm),
ext_step cnt0 Hcompat tp' m
(spawn (b, Ptrofs.intval ofs)
(Some (build_delta_content (fst virtue1) m))
(Some (build_delta_content (fst virtue2) m)))
| step_mklock :
forall  (tp' tp'': thread_pool) marg m1 c m' b ofs pmap_tid',
let: pmap_tid := getThreadR cnt0 in
forall
(Hinv : invariant tp)
(Hcode: getThreadC cnt0 = Kblocked c)
(* To check if the machine is at an external step and load its arguments install the thread data permissions*)
(Hrestrict_pmap_arg: restrPermMap (Hcompat tid0 cnt0).1 = marg)
(Hat_external: semantics.at_external semSem c marg = Some (MKLOCK, Vptr b ofs::nil))
(** install the thread's data permissions*)
(Hrestrict_pmap: restrPermMap (Hcompat tid0 cnt0).1 = m1)
(** To create the lock the thread must have [Writable] permission on it*)
(Hfreeable: Mem.range_perm m1 b (Ptrofs.intval ofs) ((Ptrofs.intval ofs) + LKSIZE) Cur Writable)
(** lock is created in acquired state*)
(Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.zero) = Some m')
(** The thread's data permissions are set to Nonempty*)
(Hdata_perm: setPermBlock
(Some Nonempty)
b
(Ptrofs.intval ofs)
pmap_tid.1
LKSIZE_nat = pmap_tid'.1)
(** thread lock permission is increased *)
(Hlock_perm: setPermBlock
(Some Writable)
b
(Ptrofs.intval ofs)
pmap_tid.2
LKSIZE_nat = pmap_tid'.2)
(** Require that [(b, Ptrofs.intval ofs)] was not a lock*)
(HlockRes: lockRes tp (b, Ptrofs.intval ofs) = None)
(Htp': tp' = updThread cnt0 (Kresume c Vundef) pmap_tid')
(** the lock has no resources initially *)
(Htp'': tp'' = updLockSet tp' (b, Ptrofs.intval ofs) (empty_map, empty_map)),
ext_step cnt0 Hcompat tp'' m' (mklock (b, Ptrofs.intval ofs))
| step_freelock :
forall  (tp' tp'': thread_pool) c marg b ofs pmap_tid' m1 pdata rmap
(Hbounded: if isCoarse then
( bounded_maps.bounded_nat_func' pdata LKSIZE_nat)
else
True ),
let: pmap_tid := getThreadR cnt0 in
forall
(Hinv: invariant tp)
(Hcode: getThreadC cnt0 = Kblocked c)
(* To check if the machine is at an external step and load its arguments install the thread data permissions*)
(Hrestrict_pmap_arg: restrPermMap (Hcompat tid0 cnt0).1 = marg)
(Hat_external: semantics.at_external semSem c marg = Some (FREE_LOCK, Vptr b ofs::nil))
(** If this address is a lock*)
(His_lock: lockRes tp (b, (Ptrofs.intval ofs)) = Some rmap)
(** And the lock is taken *)
(Hrmap: forall b ofs, rmap.1 !! b ofs = None /\ rmap.2 !! b ofs = None)
(** Install the thread's lock permissions*)
(Hrestrict_pmap: restrPermMap (Hcompat tid0 cnt0).2 = m1)
(** To free the lock the thread must have at least Writable on it*)
(Hfreeable: Mem.range_perm m1 b (Ptrofs.intval ofs) ((Ptrofs.intval ofs) + LKSIZE) Cur Writable)
(** lock permissions of the thread are dropped to empty *)
(Hlock_perm: setPermBlock
None
b
(Ptrofs.intval ofs)
pmap_tid.2
LKSIZE_nat = pmap_tid'.2)
(** data permissions are computed in a non-deterministic way *)
(Hneq_perms: forall i,
(0 <= Z.of_nat i < LKSIZE)%Z ->
Mem.perm_order'' (pdata (S i)) (Some Writable)
)
(*Hpdata: perm_order pdata Writable*)
(Hdata_perm: setPermBlock_var (*=setPermBlockfunc*)
pdata
b
(Ptrofs.intval ofs)
pmap_tid.1
LKSIZE_nat = pmap_tid'.1)
(Htp': tp' = updThread cnt0 (Kresume c Vundef) pmap_tid')
(Htp'': tp'' = remLockSet tp' (b, Ptrofs.intval ofs)),
ext_step cnt0 Hcompat  tp'' m (freelock (b, Ptrofs.intval ofs))
| step_acqfail :
forall  c b ofs marg m1
(Hinv : invariant tp)
(Hcode: getThreadC cnt0 = Kblocked c)
(* To check if the machine is at an external step and load its arguments install the thread data permissions*)
(Hrestrict_pmap_arg: restrPermMap (Hcompat tid0 cnt0).1 = marg)
(Hat_external: semantics.at_external semSem c marg = Some (LOCK, Vptr b ofs::nil))
(** Install the thread's lock permissions*)
(Hrestrict_pmap: restrPermMap (Hcompat tid0 cnt0).2 = m1)
(** To acquire the lock the thread must have [Readable] permission on it*)
(Haccess: Mem.range_perm m1 b (Ptrofs.intval ofs) ((Ptrofs.intval ofs) + LKSIZE) Cur Readable)
(** Lock is already acquired.*)
(Hload: Mem.load Mint32 m1 b (Ptrofs.intval ofs) = Some (Vint Int.zero)),
ext_step cnt0 Hcompat tp m (failacq (b, Ptrofs.intval ofs)).
Definition threadStep: forall {tid0 ms m},
containsThread ms tid0 -> mem_compatible ms m ->
thread_pool -> mem -> seq.seq mem_event -> Prop:=
@dry_step.

(* Specifications: *)
Lemma threadStep_at_Krun:
forall i tp m cnt cmpt tp' m' tr,
@threadStep i tp m cnt cmpt tp' m' tr ->
(exists q, @getThreadC _ _ _ i tp cnt = Krun q).
Lemma threadStep_equal_run:
forall i tp m cnt cmpt tp' m' tr,
@threadStep i tp m cnt cmpt tp' m' tr ->
forall j,
(exists cntj q, @getThreadC _ _ _ j tp cntj = Krun q) <->
(exists cntj' q', @getThreadC _ _ _ j tp' cntj' = Krun q').