(* messaging system function specs *)
Definition initialize_channels_spec :=
DECLARE _initialize_channels
WITH sh1 : share, shs : list share, gv: globals
PRE [ ]
PROP (Zlength shs = N; sepalg_list.list_join sh1 shs Ews)
LOCAL (gvars gv)
SEP (data_at_ Ews (tarray (tptr tint) N) (gv _comm); data_at_ Ews (tarray (tptr tlock) N) (gv _lock);
data_at_ Ews (tarray (tptr tbuffer) B) (gv _bufs);
data_at_ Ews (tarray (tptr tint) N) (gv _reading); data_at_ Ews (tarray (tptr tint) N) (gv _last_read);
mem_mgr gv)
POST [ tvoid ]
EX comms : list val, EX locks : list val, EX bufs : list val, EX reads : list val, EX lasts : list val,
EX g : list gname, EX g0 : list gname, EX g1 : list gname, EX g2 : list gname,
PROP (Forall isptr comms; Zlength g = N; Zlength g0 = N; Zlength g1 = N; Zlength g2 = N)
LOCAL ()
SEP (data_at Ews (tarray (tptr tint) N) comms (gv _comm);
data_at Ews (tarray (tptr tlock) N) locks (gv _lock);
data_at Ews (tarray (tptr tbuffer) B) bufs (gv _bufs);
data_at Ews (tarray (tptr tint) N) reads (gv _reading);
data_at Ews (tarray (tptr tint) N) lasts (gv _last_read);
fold_right sepcon emp (map (fun r =>
comm_loc Ews (Znth r locks) (Znth r comms) (Znth r g) (Znth r g0)
(Znth r g1) (Znth r g2) bufs (Znth r shs) gsh2 empty_map) (upto (Z.to_nat N)));
fold_right sepcon emp (map (ghost_hist(hist_el := AE_hist_el) Ish empty_map) g);
fold_right sepcon emp (map (ghost_var gsh1 (vint 1)) g0);
fold_right sepcon emp (map (ghost_var gsh1 (vint 0)) g1);
fold_right sepcon emp (map (ghost_var gsh1 (vint 1)) g2);
fold_right sepcon emp (map (malloc_token Ews tint) comms);
fold_right sepcon emp (map (malloc_token Ews tlock) locks);
fold_right sepcon emp (map (malloc_token Ews tbuffer) bufs);
fold_right sepcon emp (map (malloc_token Ews tint) reads);
fold_right sepcon emp (map (malloc_token Ews tint) lasts);
data_at sh1 tbuffer (vint 0) (Znth 0 bufs);
fold_right sepcon emp (map (data_at Ews tbuffer (vint 0)) (sublist 1 (Zlength bufs) bufs));
fold_right sepcon emp (map (data_at_ Ews tint) reads);
fold_right sepcon emp (map (data_at_ Ews tint) lasts);
mem_mgr gv).
(* All the communication channels are now inside locks. Buffer 0 also starts distributed among the channels. *)
Definition initialize_reader_spec :=
DECLARE _initialize_reader
WITH r : Z, reads : list val, lasts : list val, sh : share, gv: globals
PRE [ _r OF tint ]
PROP (readable_share sh)
LOCAL (temp _r (vint r); gvars gv)
SEP (data_at sh (tarray (tptr tint) N) reads (gv _reading); data_at sh (tarray (tptr tint) N) lasts (gv _last_read);
data_at_ Ews tint (Znth r reads); data_at_ Ews tint (Znth r lasts))
POST [ tvoid ]
PROP ()
LOCAL ()
SEP (data_at sh (tarray (tptr tint) N) reads (gv _reading); data_at sh (tarray (tptr tint) N) lasts (gv _last_read);
data_at Ews tint Empty (Znth r reads); data_at Ews tint (vint 1) (Znth r lasts)).
Definition latest_read (h : hist) v :=
(* initial condition *)
((forall t r w, h t = Some (AE r w) -> w = Empty -> r = Empty) /\ v = vint 1) \/
v <> Empty /\ exists n, h n = Some (AE v Empty) /\
forall t r w, h t = Some (AE r w) -> w = Empty -> r <> Empty -> (t <= n)%nat.
(* last_read retains the last buffer read, while reading is reset to Empty. *)
Definition start_read_spec :=
DECLARE _start_read
WITH r : Z, reads : list val, lasts : list val,
locks : list val, comms : list val, bufs : list val, sh : share, sh1 : share, sh2 : share, b0 : Z,
g : gname, g0 : gname, g1 : gname, g2 : gname, h : hist, gv: globals
PRE [ _r OF tint ]
PROP (0 <= b0 < B; readable_share sh; readable_share sh1; readable_share sh2; isptr (Znth r comms); latest_read h (vint b0))
LOCAL (temp _r (vint r); gvars gv)
SEP (data_at sh1 (tarray (tptr tint) N) reads (gv _reading); data_at sh1 (tarray (tptr tint) N) lasts (gv _last_read);
data_at sh1 (tarray (tptr tint) N) comms (gv _comm); data_at sh1 (tarray (tptr tlock) N) locks (gv _lock);
data_at_ Ews tint (Znth r reads); data_at Ews tint (vint b0) (Znth r lasts);
comm_loc sh2 (Znth r locks) (Znth r comms) g g0 g1 g2 bufs sh gsh2 h;
EX v : Z, data_at sh tbuffer (vint v) (Znth b0 bufs);
ghost_var gsh1 (vint b0) g0)
POST [ tint ]
EX b : Z, EX t : nat, EX v0 : val, EX v : Z,
PROP (0 <= b < B; if eq_dec v0 Empty then b = b0 else v0 = vint b;
latest_read (map_upd h t (AE v0 Empty)) (vint b))
LOCAL (temp ret_temp (vint b))
SEP (data_at sh1 (tarray (tptr tint) N) reads (gv _reading); data_at sh1 (tarray (tptr tint) N) lasts (gv _last_read);
data_at sh1 (tarray (tptr tint) N) comms (gv _comm); data_at sh1 (tarray (tptr tlock) N) locks (gv _lock);
data_at Ews tint (vint b) (Znth r reads); data_at Ews tint (vint b) (Znth r lasts);
comm_loc sh2 (Znth r locks) (Znth r comms) g g0 g1 g2 bufs sh gsh2 (map_upd h t (AE v0 Empty));
data_at sh tbuffer (vint v) (Znth b bufs);
ghost_var gsh1 (vint b) g0).
(* And bufs[b] is the most recent buffer completed by finish_write. *)
Definition finish_read_spec :=
DECLARE _finish_read
WITH r : Z, reads : list val, sh : share, gv: globals
PRE [ _r OF tint ]
PROP (readable_share sh)
LOCAL (temp _r (vint r); gvars gv)
SEP (data_at sh (tarray (tptr tint) N) reads (gv _reading); data_at_ Ews tint (Znth r reads))
POST [ tvoid ]
PROP ()
LOCAL ()
SEP (data_at sh (tarray (tptr tint) N) reads (gv _reading); data_at Ews tint Empty (Znth r reads)).
Definition initialize_writer_spec :=
DECLARE _initialize_writer
WITH gv: globals
PRE [ ]
PROP ()
LOCAL (gvars gv)
SEP (data_at_ Ews tint (gv _writing); data_at_ Ews tint (gv _last_given);
data_at_ Ews (tarray tint N) (gv _last_taken))
POST [ tvoid ]
PROP ()
LOCAL ()
SEP (data_at Ews tint Empty (gv _writing); data_at Ews tint (vint 0) (gv _last_given);
data_at Ews (tarray tint N) (repeat (vint 1) (Z.to_nat N)) (gv _last_taken)).
Definition start_write_spec :=
DECLARE _start_write
WITH b0 : Z, lasts : list Z, gv: globals
PRE [ ]
PROP (0 <= b0 < B; Forall (fun x => 0 <= x < B) lasts)
LOCAL (gvars gv)
SEP (data_at_ Ews tint (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
data_at Ews (tarray tint N) (map (fun x => vint x) lasts) (gv _last_taken))
POST [ tint ]
EX b : Z,
PROP (0 <= b < B; b <> b0; ~In b lasts)
LOCAL (temp ret_temp (vint b))
SEP (data_at Ews tint (vint b) (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
data_at Ews (tarray tint N) (map (fun x => vint x) lasts) (gv _last_taken)).
(* And b is not in use by any reader. This follows from the property on lasts. *)
(* make_shares returns the elements of shs for which the corresponding element of lasts is not i. *)
Fixpoint make_shares shs (lasts : list Z) i : list share :=
match lasts with
| [] => []
| b :: rest => if eq_dec b i then make_shares (tl shs) rest i
else hd Share.bot shs :: make_shares (tl shs) rest i
end.
Definition finish_write_spec :=
DECLARE _finish_write
WITH comms : list val, locks : list val, bufs : list val, b : Z, b0 : Z, lasts : list Z,
sh1 : share, lsh : share, shs : list share, g : list gname, g0 : list gname, g1 : list gname, g2 : list gname,
h : list hist, sh0 : share, gv: globals
PRE [ ]
PROP (0 <= b < B; 0 <= b0 < B; Forall (fun x => 0 <= x < B) lasts; Zlength h = N; Zlength shs = N;
readable_share sh1; readable_share lsh; Forall readable_share shs;
sepalg_list.list_join sh0 shs Ews; Forall isptr comms; b <> b0; ~In b lasts; ~In b0 lasts)
LOCAL (gvars gv)
SEP (data_at Ews tint (vint b) (gv _writing); data_at Ews tint (vint b0) (gv _last_given);
data_at Ews (tarray tint N) (map (fun x => vint x) lasts) (gv _last_taken);
data_at sh1 (tarray (tptr tint) N) comms (gv _comm);
data_at sh1 (tarray (tptr tlock) N) locks (gv _lock);
fold_right sepcon emp (map (fun r =>
comm_loc lsh (Znth r locks) (Znth r comms) (Znth r g) (Znth r g0)
(Znth r g1) (Znth r g2) bufs (Znth r shs) gsh2 (Znth r h)) (upto (Z.to_nat N)));
fold_right sepcon emp (map (fun r => ghost_var gsh1 (vint b0) (Znth r g1) *
ghost_var gsh1 (vint (@Znth Z (-1) r lasts)) (Znth r g2)) (upto (Z.to_nat N)));
fold_right sepcon emp (map (fun i => EX sh : share,
!!(if eq_dec i b0 then sh = sh0 else sepalg_list.list_join sh0 (make_shares shs lasts i) sh) &&
EX v : Z, data_at sh tbuffer (vint v) (Znth i bufs)) (upto (Z.to_nat B))))
POST [ tvoid ]
EX lasts' : list Z, EX h' : list hist,
PROP (Forall (fun x => 0 <= x < B) lasts';
Forall2 (fun h1 h2 => exists t v, h2 = map_upd h1 t (AE v (vint b))) h h';
~In b lasts')
LOCAL ()
SEP (data_at Ews tint Empty (gv _writing); data_at Ews tint (vint b) (gv _last_given);
data_at Ews (tarray tint N) (map (fun x => vint x) lasts') (gv _last_taken);
data_at sh1 (tarray (tptr tint) N) comms (gv _comm);
data_at sh1 (tarray (tptr tlock) N) locks (gv _lock);
fold_right sepcon emp (map (fun r =>
comm_loc lsh (Znth r locks) (Znth r comms) (Znth r g) (Znth r g0)
(Znth r g1) (Znth r g2) bufs (Znth r shs) gsh2 (Znth r h')) (upto (Z.to_nat N)));
fold_right sepcon emp (map (fun r => ghost_var gsh1 (vint b) (Znth r g1) *
ghost_var gsh1 (vint (@Znth Z (-1) r lasts')) (Znth r g2)) (upto (Z.to_nat N)));
fold_right sepcon emp (map (fun i => EX sh : share,
!!(if eq_dec i b then sh = sh0 else sepalg_list.list_join sh0 (make_shares shs lasts' i) sh) &&
EX v : Z, data_at sh tbuffer (vint v) (Znth i bufs)) (upto (Z.to_nat B)))).
(* client function specs *)
Definition reader_spec :=
DECLARE _reader
WITH arg : val, x : Z * list val * list val * list val * list val * list val *
share * share * share * gname * gname * gname * gname * globals
PRE [ _arg OF tptr tvoid ]
let '(r, reads, lasts, locks, comms, bufs, sh1, sh2, sh, g, g0, g1, g2, gv) := x in
PROP (readable_share sh; readable_share sh1; readable_share sh2; isptr (Znth r comms))
LOCAL (temp _arg arg; gvars gv)
SEP (data_at Ews tint (vint r) arg; malloc_token Ews tint arg;
data_at sh1 (tarray (tptr tint) N) reads (gv _reading); data_at sh1 (tarray (tptr tint) N) lasts (gv _last_read);
data_at sh1 (tarray (tptr tint) N) comms (gv _comm); data_at sh1 (tarray (tptr tlock) N) locks (gv _lock);
data_at_ Ews tint (Znth r reads); data_at_ Ews tint (Znth r lasts);
data_at sh1 (tarray (tptr tbuffer) B) bufs (gv _bufs);
comm_loc sh2 (Znth r locks) (Znth r comms) g g0 g1 g2 bufs sh gsh2 empty_map;
EX v : Z, data_at sh tbuffer (vint v) (Znth 1 bufs);
ghost_var gsh1 (vint 1) g0)
POST [ tptr tvoid ] PROP () LOCAL () SEP ().
Definition writer_spec :=
DECLARE _writer
WITH arg : val, x : list val * list val * list val * share * share *
share * list share * list gname * list gname * list gname * list gname * globals
PRE [ _arg OF tptr tvoid ]
let '(locks, comms, bufs, sh1, lsh, sh0, shs, g, g0, g1, g2, gv) := x in
PROP (Zlength shs = N; readable_share sh1; readable_share lsh; Forall readable_share shs;
sepalg_list.list_join sh0 shs Ews; Zlength g1 = N; Zlength g2 = N; Forall isptr comms)
LOCAL (temp _arg arg; gvars gv)
SEP (data_at_ Ews tint (gv _writing); data_at_ Ews tint (gv _last_given); data_at_ Ews (tarray tint N) (gv _last_taken);
data_at sh1 (tarray (tptr tint) N) comms (gv _comm);
data_at sh1 (tarray (tptr tlock) N) locks (gv _lock);
data_at sh1 (tarray (tptr tbuffer) B) bufs (gv _bufs);
fold_right sepcon emp (map (fun r =>
comm_loc lsh (Znth r locks) (Znth r comms) (Znth r g) (Znth r g0)
(Znth r g1) (Znth r g2) bufs (Znth r shs) gsh2 empty_map) (upto (Z.to_nat N)));
fold_right sepcon emp (map (ghost_var gsh1 (vint 0)) g1);
fold_right sepcon emp (map (ghost_var gsh1 (vint 1)) g2);
fold_right sepcon emp (map (fun i => EX sh : share,
!!(if eq_dec i 0 then sh = sh0 else if eq_dec i 1 then sh = sh0 else sh = Ews) &&
EX v : Z, data_at sh tbuffer (vint v) (Znth i bufs)) (upto (Z.to_nat B))))
POST [ tptr tvoid ] PROP () LOCAL () SEP ().
Definition main_spec :=
DECLARE _main
WITH gv: globals
PRE  [] main_pre prog [] gv
POST [ tint ] main_post prog [] gv.
(* Create the environment containing all function specs. *)
Definition Gprog : funspecs := ltac:(with_library prog [release_spec; makelock_spec; spawn_spec;
surely_malloc_spec; memset_spec; atomic_exchange_spec; initialize_channels_spec; initialize_reader_spec;
start_read_spec; finish_read_spec; initialize_writer_spec; start_write_spec; finish_write_spec;
reader_spec; writer_spec; main_spec]).
(*Ltac cancel_for_forward_call ::= repeat (rewrite ?sepcon_andp_prop', ?sepcon_andp_prop); repeat (apply andp_right; [auto; apply prop_right; auto|]); fast_cancel.*)

Lemma make_shares_out : forall b lasts shs
(Hb : ~In b lasts) (Hlen : Zlength lasts = Zlength shs), make_shares shs lasts b = shs.