Section Proofs.
Definition makelock_spec := DECLARE _makelock (makelock_spec _).
Definition freelock2_spec := DECLARE _freelock2 (freelock2_spec _).
Definition acquire_spec := DECLARE _acquire acquire_spec.
Definition release2_spec := DECLARE _release2 release2_spec.
Definition spawn_spec := DECLARE _spawn spawn_spec.
Definition load_SC_spec := DECLARE _load_SC load_SC_spec.
Definition store_SC_spec := DECLARE _store_SC store_SC_spec.
Definition CAS_SC_spec := DECLARE _CAS_SC CAS_SC_spec.
Definition surely_malloc_spec :=
DECLARE _surely_malloc
WITH t : type, gv : globals
PRE [ _n OF tuint ]
PROP (0 <= sizeof t <= Int.max_unsigned; complete_legal_cosu_type t = true;
natural_aligned natural_alignment t = true)
LOCAL (temp _n (Vint (Int.repr (sizeof t))); gvars gv)
SEP (mem_mgr gv)
POST [ tptr tvoid ] EX p:_,
PROP ()
LOCAL (temp ret_temp p)
SEP (mem_mgr gv; malloc_token Ews t p; data_at_ Ews t p).
Definition integer_hash_spec :=
DECLARE _integer_hash
WITH i : Z
PRE [ _i OF tint ]
PROP () LOCAL (temp _i (vint i)) SEP ()
POST [ tint ]
PROP () LOCAL (temp ret_temp (vint (i * 654435761))) SEP ().
(* One might think it should just return an unknown number, but in fact it needs to follow a known hash function at the logic level to be useful. *)
Definition tentry := Tstruct _entry noattr.
(* Having size as a large known constant tends to make everything slow, so here's a hack. *)
Definition has_size : {x : Z | x = 16384}.
Instance hf1 : hash_fun := { size := proj1_sig has_size; hash i := (i * 654435761) mod (proj1_sig has_size) }.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
(* Read the most recently written value. *)
Program Definition get_item_spec := DECLARE _get_item atomic_spec
(ConstType (Z * globals * share * list (val * val) * gname * list gname))
[(_key, tint)] tint
[fun _ '(k, p, sh, entries, g, lg) => temp _key (vint k);
fun _ '(k, gv, sh, entries, g, lg) => gvars gv]
(fun _ '(k, gv, sh, entries, g, lg) => !!(readable_share sh /\ repable_signed k /\ k <> 0 /\
Forall (fun '(pk, pv) => isptr pk /\ isptr pv) entries /\ Zlength lg = size) &&
data_at sh (tarray tentry size) entries (gv _m_entries))
(fun _ '(k, p, sh, entries, g, lg) H => hashtable H g lg entries)
0 [fun _ _ v => temp ret_temp (vint v)]
(fun _ '(k, gv, sh, entries, g, lg) H v => data_at sh (tarray tentry size) entries (gv _m_entries) *
(!!(if eq_dec v 0 then H k = None else H k = Some v) && hashtable H g lg entries))
(Empty_set _) (Full_set _) _ _ _ _ _.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Program Definition add_item_spec := DECLARE _add_item atomic_spec
(ConstType (Z * Z * globals * share * list (val * val) * gname * list gname))
[(_key, tint); (_value, tint)] tint
[fun _ '(k, v, p, sh, entries, g, lg) => temp _key (vint k);
fun _ '(k, v, p, sh, entries, g, lg) => temp _value (vint v);
fun _ '(k, v, gv, sh, entries, g, lg) => gvars gv]
(fun _ '(k, v, gv, sh, entries, g, lg) => !!(readable_share sh /\ repable_signed k /\ repable_signed v /\
k <> 0 /\ v <> 0 /\ Forall (fun '(pk, pv) => isptr pk /\ isptr pv) entries /\ Zlength lg = size) &&
data_at sh (tarray tentry size) entries (gv _m_entries))
(fun _ '(k, v, p, sh, entries, g, lg) H => hashtable H g lg entries)
true [fun _ _ b => temp ret_temp (Val.of_bool b)]
(fun _ '(k, v, gv, sh, entries, g, lg) H b => data_at sh (tarray tentry size) entries (gv _m_entries) *
(!!(H k = None <-> b = true) && hashtable (if b then map_upd H k v else H) g lg entries))
(Empty_set _) (Full_set _) _ _ _ _ _.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Next Obligation.
Definition init_table_spec :=
DECLARE _init_table
WITH gv : globals
PRE [ ]
PROP ()
LOCAL (gvars gv)
SEP (mem_mgr gv; data_at_ Ews (tarray tentry size) (gv _m_entries))
POST [ tvoid ]
EX entries : list (val * val), EX g : gname, EX lg : list gname,
PROP (Forall (fun '(pk, pv) => isptr pk /\ isptr pv) entries; Zlength lg = size)
LOCAL ()
SEP (mem_mgr gv; data_at Ews (tarray tentry size) entries (gv _m_entries); fold_right sepcon emp (map (fun '(pk, pv) =>
malloc_token Ews tint pk * malloc_token Ews tint pv) entries);
hashtable empty_map g lg entries).
Inductive hashtable_hist_el :=
| HSet (k : Z) (v : Z) | HGet (k : Z) (v : Z) | HAdd (k : Z) (v : Z) (r : bool).
Notation hist := (nat -> option hashtable_hist_el).
Fixpoint apply_hist H h :=
match h with
| [] => Some H
| HSet k v :: h' => apply_hist (map_upd H k v) h'
| HGet k v :: h' => match H k with Some v' => if eq_dec v' v then apply_hist H h' else None
| None => if eq_dec v 0 then apply_hist H h' else None end
| HAdd k v r :: h' => match H k with None => if r then apply_hist (map_upd H k v) h' else None
| Some _ => if r then None else apply_hist H h' end
end.
Definition hashtable_inv gh g lg entries := EX H : _, hashtable H g lg entries *
EX hr : _, !!(apply_hist empty_map hr = Some H) && ghost_ref hr gh.
Definition f_lock_inv sh gsh entries gh p t locksp lockt resultsp res gv :=
EX b1 : bool, EX b2 : bool, EX b3 : bool, EX h : _,
!!(add_events empty_map [HAdd 1 1 b1; HAdd 2 1 b2; HAdd 3 1 b3] h) && ghost_hist gsh h gh *
data_at sh (tarray tentry size) entries p *
data_at sh (tarray (tptr tlock) 3) (upd_Znth t (repeat Vundef 3) lockt) locksp *
data_at sh (tarray (tptr tint) 3) (upd_Znth t (repeat Vundef 3) res) resultsp *
data_at Ews tint (vint (Zlength (filter id [b1; b2; b3]))) res * mem_mgr gv.
Definition f_lock_pred tsh sh gsh entries gh p t locksp lockt resultsp res gv :=
selflock (f_lock_inv sh gsh entries gh p t locksp lockt resultsp res gv) tsh lockt.
Definition f_spec :=
DECLARE _f
WITH tid : val, x : share * share * share * list (val * val) * iname * gname * gname * list gname * globals * Z * val *
val * val * val * invG
PRE [ _arg OF (tptr tvoid) ]
let '(sh, gsh, tsh, entries, i, gh, g, lg, gv, t, locksp, lockt, resultsp, res, inv_names) := x in
PROP (0 <= t < 3; isptr lockt; readable_share sh; readable_share tsh; gsh <> Share.bot;
Forall (fun '(pk, pv) => isptr pk /\ isptr pv) entries; Zlength lg = size)
LOCAL (temp _arg tid; gvars gv)
SEP (mem_mgr gv; data_at sh (tarray tentry size) entries (gv _m_entries);
invariant i (hashtable_inv gh g lg entries);
ghost_hist(hist_el := hashtable_hist_el) gsh empty_map gh;
data_at Ews tint (vint t) tid; malloc_token Ews tint tid;
data_at sh (tarray (tptr tlock) 3) (upd_Znth t (repeat Vundef 3) lockt) (gv _thread_locks);
data_at sh (tarray (tptr tint) 3) (upd_Znth t (repeat Vundef 3) res) (gv _results);
data_at_ Ews tint res;
lock_inv tsh lockt (f_lock_pred tsh sh gsh entries gh (gv _m_entries) t
(gv _thread_locks) lockt (gv _results) res gv))
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.
Definition Gprog : funspecs := ltac:(with_library prog [makelock_spec; freelock2_spec; acquire_spec;
release2_spec; spawn_spec; surely_malloc_spec; load_SC_spec; store_SC_spec; CAS_SC_spec;
integer_hash_spec; set_item_spec; get_item_spec; add_item_spec; init_table_spec; f_spec; main_spec]).
Opaque upto.
Arguments size : simpl never.
Arguments hash : simpl never.
Opaque Znth.
Hint Resolve f_pred_exclusive.

Lemma apply_hist_app : forall h1 h2 H, apply_hist H (h1 ++ h2) =
match apply_hist H h1 with Some H' => apply_hist H' h2 | None => None end.