Set Bullet Behavior "Strict Subproofs".
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.
Definition load_SC_spec := DECLARE _load_SC load_SC_spec.
Definition store_SC_spec := DECLARE _store_SC store_SC_spec.
Definition tnode := Tstruct _node noattr.
Opaque upto.
Existing Instances fmap_PCM fmap_order.
Definition node_entry sh v vs locs lg i := EX v' : Z, EX log : Z -> option Z, EX d : Z,
!!(repable_signed d /\ (if Z.even v then v' = v /\ d = Znth i vs 0 else v' >= v - 1) /\ log_latest log v' d) &&
ghost (sh, log) (Znth i lg Vundef) * data_at sh tint (vint d) (Znth i locs Vundef).
Existing Instances max_PCM max_order.
Definition node_state sh v vs version locs g lg := !!(repable_signed v /\
Forall repable_signed vs /\ Zlength vs = Zlength locs /\ Zlength lg = Zlength locs) &&
ghost (sh, v) g * data_at sh tint (vint v) version *
fold_right sepcon emp (map (node_entry sh v vs locs lg) (upto (length locs))).
Definition node_inv v vs version locs g lg := EX v' : Z, !!(Z.even v = true /\ (v' = v \/ v' = v + 1)) &&
node_state gsh2 v' vs version locs g lg.
Program Definition read_spec := DECLARE _read atomic_spec
(ConstType (val * val * share * val * list val * val * list val * Z * list Z)) (0, [])
[(_n, tptr tnode); (_out, tptr tint)] tvoid
[fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) => temp _n n;
fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) => temp _out out]
(fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) => !!(readable_share sh /\ isptr version /\
Forall isptr locs /\ Zlength locs = 8) &&
data_at sh tnode (version, locs) n * data_at_ Tsh (tarray tint 8) out)
(fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) '(v, vs) => node_inv v vs version locs g lg)
tt []
(fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) '(v, vs) _ =>
data_at sh tnode (version, locs) n * data_at Tsh (tarray tint 8) (map (fun x => vint x) vs) out)
(fun _ '(n, out, sh, version, locs, g, lg, v0, vs0) '(v, vs) _ => node_inv v vs version locs g lg)
_ _ _ _ _ _.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
(* The gsh1 share of the node state acts as the write permission. *)
Program Definition write_spec := DECLARE _write atomic_spec
(ConstType (val * val * share * val * list val * list Z * val * list val * Z * list Z)) (0, [])
[(_n, tptr tnode); (_in, tptr tint)] tvoid
[fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) => temp _n n;
fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) => temp _in input]
(fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) => !!(readable_share sh /\ isptr version /\
Forall isptr locs /\ Zlength locs = 8 /\ Forall repable_signed vals /\ Z.even v0 = true) &&
data_at sh tnode (version, locs) n * data_at Tsh (tarray tint 8) (map (fun x => vint x) vals) input *
node_state gsh1 v0 vs0 version locs g lg)
(fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) '(v, vs) => node_inv v vs version locs g lg)
tt []
(fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) '(v, vs) _ =>
data_at sh tnode (version, locs) n * data_at Tsh (tarray tint 8) (map (fun x => vint x) vals) input *
node_state gsh1 (v0 + 2) vals version locs g lg)
(fun _ '(n, input, sh, version, locs, vals, g, lg, v0, vs0) '(v, vs) _ =>
node_inv (v0 + 2) vals version locs g lg)
_ _ _ _ _ _.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Definition Gprog : funspecs := ltac:(with_library prog [load_SC_spec; store_SC_spec; read_spec; write_spec]).

(* Specifications: *)
Lemma land_1 : forall i, Z.land i 1 = i mod 2.
Lemma singleton_snap : forall (x : Z -> option Z) p v1 v2, x v1 = Some v2 ->
view_shift (ghost_snap x p) (ghost_snap (singleton v1 v2) p).
Lemma body_read : semax_body Vprog Gprog f_read read_spec.
Lemma dirty_entry : forall sh v vs locs lg i, Z.even v = true ->
node_entry sh v vs locs lg i |-- node_entry sh (v + 1) vs locs lg i.
Lemma clean_entry : forall v vs locs lg i vs', Z.even v = false ->
node_entry gsh1 (v + 1) vs' locs lg i * node_entry gsh2 v vs locs lg i |--
node_entry gsh1 (v + 1) vs' locs lg i * node_entry gsh2 (v + 1) vs' locs lg i.
Corollary clean_entries : forall v vs locs lg vs', Z.even v = false ->
fold_right sepcon emp (map (node_entry gsh1 (v + 1) vs' locs lg) (upto 8)) *
fold_right sepcon emp (map (node_entry gsh2 v vs locs lg) (upto 8)) |--
fold_right sepcon emp (map (node_entry gsh1 (v + 1) vs' locs lg) (upto 8)) *
fold_right sepcon emp (map (node_entry gsh2 (v + 1) vs' locs lg) (upto 8)).
Lemma body_write : semax_body Vprog Gprog f_write write_spec.