Inductive juicy_step  {tid0 tp m} (cnt: containsThread tp tid0)
(Hcompatible: mem_compatible tp m) : thread_pool -> mem -> list mem_event -> Prop :=
| step_juicy :
forall (tp':thread_pool) c jm jm' m' (c' : C),
forall (Hpersonal_perm:
personal_mem (thread_mem_compatible Hcompatible cnt) = jm)
(Hinv : invariant tp)
(Hthread: getThreadC cnt = Krun c)
(Hcorestep: corestep juicy_sem c jm c' jm')
(Htp': tp' = @updThread _ _ _ tid0 (age_tp_to (level jm') tp) (cnt_age' cnt) (Krun c') (m_phi jm'))
(Hm': m_dry jm' = m'),
juicy_step  cnt Hcompatible tp' m' [::].
Definition pack_res_inv (R: pred rmap) := SomeP rmaps.Mpred (fun _ => R) .
Notation Kblocked := (threadPool.Kblocked).
Open Scope Z_scope.
(* This differs from juicy_machine.syncStep' in two ways: 1) The lockRes tracks the invariant associated with each lock. 2) The release and acquire events include the permission changes involved. This should allow us to show that events are preserved by erasure, and that they are consistent with the associated invariants. *)
Inductive syncStep' {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'' tp''':thread_pool) c m0 m1 b ofs d_phi phi phi' m' pmap_tid',
forall
(Hinv : invariant tp)
(Hthread: getThreadC cnt0 = Kblocked c)
(Hat_external: at_external the_sem c m =
Some (LOCK, Vptr b ofs::nil))
(Hcompatible: mem_compatible tp m)
(*Hpersonal_perm: personal_mem cnt0 Hcompatible = jm*)
(Hpersonal_juice: getThreadR cnt0 = phi)
(sh:Share.t)psh(R:pred rmap)
(HJcanwrite: phi@(b, Ptrofs.intval ofs) = YES sh psh (LK LKSIZE) (pack_res_inv R))
(Hrestrict_map0: juicyRestrict_locks
(mem_compat_thread_max_cohere Hcompat cnt0) = m0)
(Hload: Mem.load Mint32 m0 b (Ptrofs.intval ofs) = Some (Vint Int.one))
(*Hrestrict_pmap: permissions.restrPermMap (mem_compatible_locks_ltwritable Hcompatible) = m1*)
(Hset_perm: setPermBlock (Some Writable)
b (Ptrofs.intval ofs) (juice2Perm_locks phi m) LKSIZE_nat = pmap_tid')
(Hlt': permMapLt pmap_tid' (getMaxPerm m))
(* This following condition is not needed: It should follow from the mem_compat statement... somehow... *)
(Hrestrict_pmap: restrPermMap Hlt' = m1)
(Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.zero) = Some m')
(His_unlocked: lockRes tp (b, Ptrofs.intval ofs) = Some (R, Some d_phi))
(Hadd_lock_res: join phi d_phi phi')
(Htp': tp' = updThread cnt0 (Kresume c Vundef) phi')
(Htp'': tp'' = updLockSet tp' (b, Ptrofs.intval ofs) (R, None) )
(Htp''': tp''' = age_tp_to (level phi - 1)%coq_nat tp'')
(virtueThread : delta_map * delta_map)
(Hcompute: juice2Perm phi' m' = computeMap (juice2Perm phi m) virtueThread.1 /\
juice2Perm_locks phi' m' = computeMap (juice2Perm_locks phi m) virtueThread.1),
syncStep' cnt0 Hcompat tp''' m'
(acquire (b, Ptrofs.intval ofs) (Some virtueThread))
| step_release :
forall  (tp' tp'' tp''':thread_pool) c m0 m1 b ofs  (phi d_phi :rmap) (R: pred rmap) phi' m' pmap_tid',
forall
(Hinv : invariant tp)
(Hthread: getThreadC cnt0 = Kblocked c)
(Hat_external: at_external the_sem c m =
Some (UNLOCK, Vptr b ofs::nil))
(Hcompatible: mem_compatible tp m)
(* Hpersonal_perm: personal_mem cnt0 Hcompatible = jm *)
(Hpersonal_juice: getThreadR cnt0 = phi)
(sh:Share.t) psh
(HJcanwrite: phi@(b, Ptrofs.intval ofs) = YES sh psh (LK LKSIZE) (pack_res_inv R))
(Hrestrict_map0: juicyRestrict_locks
(mem_compat_thread_max_cohere Hcompat cnt0) = m0)
(Hload: Mem.load Mint32 m0 b (Ptrofs.intval ofs) = Some (Vint Int.zero))
(*Hrestrict_pmap: permissions.restrPermMap (mem_compatible_locks_ltwritable Hcompatible) = m1*)
(Hset_perm: setPermBlock (Some Writable)
b (Ptrofs.intval ofs) (juice2Perm_locks phi m) LKSIZE_nat = pmap_tid')
(Hlt': permMapLt pmap_tid' (getMaxPerm m))
(* This following condition is not needed: It should follow from the mem_compat statement... somehow... *)
(Hrestrict_pmap: restrPermMap Hlt' = m1)
(Hstore: Mem.store Mint32 m1 b (Ptrofs.intval ofs) (Vint Int.one) = Some m')
(His_locked: lockRes tp (b, Ptrofs.intval ofs) = Some (R, None) )
(Hsat_lock_inv: R (age_by 1 d_phi))
(Hrem_lock_res: join d_phi phi' phi)
(Htp': tp' = updThread cnt0 (Kresume c Vundef) phi')
(Htp'': tp'' =
updLockSet tp' (b, Ptrofs.intval ofs) (R, Some d_phi))
(Htp''': tp''' = age_tp_to (level phi - 1)%coq_nat tp''),
syncStep' cnt0 Hcompat tp''' m' (release (b, Ptrofs.intval ofs) (Some (juice2Perm d_phi m, juice2Perm_locks d_phi m)))
| step_create :
forall  (tp_upd tp':thread_pool) c vf arg jm (d_phi phi': rmap) b ofs (* P Q *),
forall
(Hinv : invariant tp)
(Hthread: getThreadC cnt0 = Kblocked c)
(Hat_external: at_external the_sem c m =
Some (CREATE, vf::arg::nil))
(Hfun_sepc: vf = Vptr b ofs)
(Hcompatible: mem_compatible tp m)
(Hpersonal_perm:
personal_mem (thread_mem_compatible Hcompatible cnt0) = jm)
(Hrem_fun_res: join d_phi phi' (m_phi jm))
(Htp': tp_upd = updThread cnt0 (Kresume c Vundef) phi')
(Htp'': tp' = age_tp_to (level (m_phi jm) - 1)%coq_nat (addThread tp_upd vf arg d_phi)),
syncStep' cnt0 Hcompat tp' m (spawn (b, Ptrofs.intval ofs) None None)
| step_mklock :
forall  (tp' tp'': thread_pool)  jm c b ofs R ,
let: phi := m_phi jm in
forall
phi' m'
(Hinv : invariant tp)
(Hthread: getThreadC cnt0 = Kblocked c)
(Hat_external: at_external the_sem c m =
Some (MKLOCK, Vptr b ofs::nil))
(Hcompatible: mem_compatible tp m)
(*Hright_juice:  m = m_dry jm*)
(Hpersonal_perm:
personal_mem (thread_mem_compatible Hcompatible cnt0) = jm)
(Hpersonal_juice: getThreadR cnt0 = phi)
(*Check I have the right permission to mklock and the right value (i.e. 0) *)
(*Haccess: address_mapsto LKCHUNK (Vint Int.zero) sh Share.top (b, Ptrofs.intval ofs) phi*)
(Hstore:
Mem.store Mint32 (m_dry jm) b (Ptrofs.intval ofs) (Vint Int.zero) = Some m')
(* [Hrmap] replaced: [Hct], [Hlock], [Hj_forward] and [levphi']. This says that phi and phi' coincide everywhere except in adr_range, and specifies how phi and phi' should differ in adr_range (in particular, they have equal shares, pointwise) *)
(Hrmap : rmap_makelock phi phi' (b, Ptrofs.unsigned ofs) R LKSIZE)
(Htp': tp' = updThread cnt0 (Kresume c Vundef) phi')
(Htp'': tp'' = age_tp_to (level phi - 1)%coq_nat
(updLockSet tp' (b, Ptrofs.intval ofs) (R, None) )),
syncStep' cnt0 Hcompat tp'' m' (mklock (b, Ptrofs.intval ofs))
| step_freelock :
forall  (tp' tp'': thread_pool) c b ofs phi R phi',
forall
(Hinv : invariant tp)
(Hthread: getThreadC cnt0 = Kblocked c)
(Hat_external: at_external the_sem c m =
Some (FREE_LOCK, Vptr b ofs::nil))
(Hcompatible: mem_compatible tp m)
(Hpersonal_juice: getThreadR cnt0 = phi)
(*First check the lock is acquired:*)
(His_acq: lockRes tp (b, (Ptrofs.intval ofs)) = Some (R, None))
(*Relation between rmaps:*)
(Hrmap : rmap_freelock phi phi' m (b, Ptrofs.unsigned ofs) R LKSIZE)
(Htp': tp' = updThread cnt0 (Kresume c Vundef) phi')
(Htp'': tp'' = age_tp_to (level phi - 1)%coq_nat
(remLockSet tp' (b, Ptrofs.intval ofs) )),
syncStep' cnt0 Hcompat  tp'' m (freelock (b, Ptrofs.intval ofs))
| step_acqfail :
forall  c b ofs jm m1,
let: phi := m_phi jm in
forall
(Hinv : invariant tp)
(Hthread: getThreadC cnt0 = Kblocked c)
(Hat_external: at_external the_sem c m =
Some (LOCK, Vptr b ofs::nil))
(Hcompatible: mem_compatible tp m)
(Hpersonal_perm:
personal_mem (thread_mem_compatible Hcompatible cnt0) = jm)
(Hrestrict_map: juicyRestrict_locks
(mem_compat_thread_max_cohere Hcompat cnt0) = m1)
(sh:Share.t) psh(R:pred rmap)
(HJcanwrite: phi@(b, Ptrofs.intval ofs) = YES sh psh (LK LKSIZE) (pack_res_inv R))
(Hload: Mem.load Mint32 m1 b (Ptrofs.intval ofs) = Some (Vint Int.zero)),
syncStep' 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 -> list mem_event -> Prop:=
@juicy_step.

(* Specifications: *)
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').