Definition MA_spec i P (R : Z -> mpred) Q := view_shift P (R i * (weak_precise_mpred (R i) && emp) * Q).
Definition MA_type := ProdType (ProdType (ProdType (ConstType Z) Mpred) (ArrowType (ConstType Z) Mpred)) Mpred.
Program Definition make_atomic_spec := DECLARE _make_atomic TYPE MA_type
WITH i : Z, P : mpred, R : Z -> mpred, Q : mpred
PRE [ _i OF tint ]
PROP (MA_spec i P R Q; repable_signed i)
LOCAL (temp _i (vint i))
SEP (P)
POST [ tptr tatomic ]
EX p : val,
PROP ()
LOCAL (temp ret_temp p)
SEP (atomic_loc Tsh p R; Q).
Next Obligation.
Next Obligation.
Program Definition free_atomic_spec := DECLARE _free_atomic
TYPE ProdType (ConstType val) (ArrowType (ConstType Z) Mpred)
WITH p : val, R : Z -> mpred
PRE [ _tgt OF tptr tatomic ]
PROP ()
LOCAL (temp _tgt p)
SEP (atomic_loc Tsh p R)
POST [ tint ]
EX v : Z,
PROP (repable_signed v)
LOCAL (temp ret_temp (vint v))
SEP (R v).
Next Obligation.
Next Obligation.
Definition AL_spec P (R : Z -> mpred) Q := forall vx, repable_signed vx -> view_shift (R vx * P) (R vx * Q vx).
Definition AL_type := ProdType (ProdType (ProdType (ConstType (share * val))
Mpred) (ArrowType (ConstType Z) Mpred)) (ArrowType (ConstType Z) Mpred).
(* One obvious restriction on this rule that might be needed for soundness (but maybe not for SC?) is that the footprint of P be empty, and vice versa for store. *)
(* For this to work with load_acquire, Q needs to be somehow future-proof: it should be okay even if v wasn't actually the latest value of tgt. For instance, Q might only get a history that's some prefix of the latest state. *)
Program Definition load_SC_spec := DECLARE _load_SC TYPE AL_type
WITH sh : share, tgt : val, P : mpred, R : Z -> mpred, Q : Z -> mpred
PRE [ _tgt OF tptr tatomic ]
PROP (AL_spec P R Q; readable_share sh)
LOCAL (temp _tgt tgt)
SEP (atomic_loc sh tgt R; P)
POST [ tint ]
EX v : Z,
PROP (repable_signed v)
LOCAL (temp ret_temp (vint v))
SEP (atomic_loc sh tgt R; Q v).
Next Obligation.
Next Obligation.
Definition AS_spec v P (R : Z -> mpred) Q := forall vx, repable_signed vx ->
view_shift (R vx * P)
(R v * (weak_precise_mpred (R v) && emp) * Q).
Definition AS_type := ProdType (ProdType (ProdType
(ConstType (share * val * Z)) Mpred) (ArrowType (ConstType Z) Mpred)) Mpred.
Program Definition store_SC_spec := DECLARE _store_SC
TYPE AS_type WITH sh : share, tgt : val, v : Z, P : mpred, R : Z -> mpred, Q : mpred
PRE [ _tgt OF tptr tatomic, _v OF tint ]
PROP (AS_spec v P R Q; readable_share sh; repable_signed v)
LOCAL (temp _tgt tgt; temp _v (vint v))
SEP (atomic_loc sh tgt R; P)
POST [ tvoid ]
PROP ()
LOCAL ()
SEP (atomic_loc sh tgt R; Q).
Next Obligation.
Next Obligation.
Definition ACAS_spec c v P (R Q : Z -> mpred) := forall vx, repable_signed vx ->
view_shift (R vx * P)
(R (if eq_dec c vx then v else vx) * (weak_precise_mpred (R (if eq_dec c vx then v else vx)) && emp) * Q vx).
Definition ACAS_type := ProdType (ProdType (ProdType
(ConstType (share * val * Z * Z)) Mpred)
(ArrowType (ConstType Z) Mpred))
(ArrowType (ConstType Z) Mpred).
Program Definition CAS_SC_spec := DECLARE _CAS_SC
TYPE ACAS_type WITH sh : share, tgt : val, c : Z, v : Z, P : mpred, R : Z -> mpred, Q : Z -> mpred
PRE [ _tgt OF tptr tatomic, _c OF tint, _v OF tint ]
PROP (ACAS_spec c v P R Q; readable_share sh; repable_signed c; repable_signed v)
LOCAL (temp _tgt tgt; temp _c (vint c); temp _v (vint v))
SEP (atomic_loc sh tgt R; P)
POST [ tint ]
EX v' : Z,
PROP (repable_signed v')
LOCAL (temp ret_temp (if eq_dec c v' then vint 1 else vint 0))
SEP (atomic_loc sh tgt R; Q v').
Next Obligation.
Next Obligation.
Definition Gprog : funspecs := ltac:(with_library prog [acquire_spec; release_spec; makelock_spec; freelock_spec;
surely_malloc_spec; make_atomic_spec; free_atomic_spec; load_SC_spec; store_SC_spec; CAS_SC_spec]).

(* Specifications: *)
Lemma body_surely_malloc: semax_body Vprog Gprog f_surely_malloc surely_malloc_spec.
Lemma A_inv_positive : forall x l R, positive_mpred (A_inv x l R).
Hint Resolve A_inv_positive.
Lemma A_inv_precise : forall x l R,
predicates_hered.derives TT (weak_precise_mpred (A_inv x l R)).
Lemma body_make_atomic : semax_body Vprog Gprog f_make_atomic make_atomic_spec.
Lemma body_free_atomic : semax_body Vprog Gprog f_free_atomic free_atomic_spec.
Lemma body_load_SC : semax_body Vprog Gprog f_load_SC load_SC_spec.
Lemma body_store_SC : semax_body Vprog Gprog f_store_SC store_SC_spec.
Lemma body_CAS_SC : semax_body Vprog Gprog f_CAS_SC CAS_SC_spec.
Lemma atomic_loc_isptr : forall sh p R, atomic_loc sh p R = !!isptr p && atomic_loc sh p R.
Hint Resolve atomic_loc_isptr : saturate_local.
Lemma atomic_loc_precise : forall sh p R, readable_share sh -> precise (atomic_loc sh p R).
Lemma atomic_loc_join : forall sh1 sh2 sh p R (Hjoin : sepalg.join sh1 sh2 sh)
(Hsh1 : readable_share sh1) (Hsh2 : readable_share sh2),
atomic_loc sh1 p R * atomic_loc sh2 p R = atomic_loc sh p R.