Commit e8b99bd7 authored by Robbert Krebbers's avatar Robbert Krebbers

Remove CAS loop in release of ticket_lock.

parent 6bb6f29d
From iris.program_logic Require Export weakestpre.
From iris.heap_lang Require Export lang.
From iris.program_logic Require Import auth.
From iris.proofmode Require Import invariants.
From iris.heap_lang Require Import proofmode notation.
From iris.algebra Require Import gset.
From iris.algebra Require Import auth gset.
From iris.heap_lang.lib Require Export lock.
Import uPred.
......@@ -23,53 +22,44 @@ Definition acquire : val :=
then wait_loop "n" "lock"
else "acquire" "lock".
Definition release : val :=
rec: "release" "lock" :=
let: "o" := !(Fst "lock") in
if: CAS (Fst "lock") "o" ("o" + #1)
then #()
else "release" "lock".
Definition release : val := λ: "lock",
(Fst "lock") <- !(Fst "lock") + #1.
Global Opaque newlock acquire release wait_loop.
(** The CMRAs we need. *)
Class tlockG Σ := TlockG {
tlock_G :> authG Σ (gset_disjUR nat);
tlock_exclG :> inG Σ (exclR unitC)
}.
Class tlockG Σ :=
tlock_G :> inG Σ (authR (prodUR (optionUR (exclR natC)) (gset_disjUR nat))).
Definition tlockΣ : gFunctors :=
#[authΣ (gset_disjUR nat); GFunctor (constRF (exclR unitC))].
#[ GFunctor (constRF (authR (prodUR (optionUR (exclR natC)) (gset_disjUR nat)))) ].
Instance subG_tlockΣ {Σ} : subG tlockΣ Σ tlockG Σ.
Proof. intros [? [?%subG_inG _]%subG_inv]%subG_inv. split; apply _. Qed.
Proof. by intros ?%subG_inG. Qed.
Section proof.
Context `{!heapG Σ, !tlockG Σ} (N : namespace).
Definition tickets_inv (n: nat) (gs: gset_disjUR nat) : iProp Σ :=
(gs = GSet (seq_set 0 n))%I.
Definition lock_inv (γ1 γ2: gname) (lo ln: loc) (R : iProp Σ) : iProp Σ :=
( (o n: nat),
lo #o ln #n
auth_inv γ1 (tickets_inv n)
((own γ2 (Excl ()) R) auth_own γ1 (GSet {[ o ]})))%I.
Definition lock_inv (γ : gname) (lo ln : loc) (R : iProp Σ) : iProp Σ :=
( o n : nat,
lo #o ln #n
own γ ( (Excl' o, GSet (seq_set 0 n)))
((own γ ( (Excl' o, )) R) own γ ( (, GSet {[ o ]}))))%I.
Definition is_lock (γs: gname * gname) (l: val) (R: iProp Σ) : iProp Σ :=
( (lo ln: loc),
Definition is_lock (γ : gname) (lk : val) (R : iProp Σ) : iProp Σ :=
( lo ln : loc,
heapN N heap_ctx
l = (#lo, #ln)%V inv N (lock_inv (fst γs) (snd γs) lo ln R))%I.
lk = (#lo, #ln)%V inv N (lock_inv γ lo ln R))%I.
Definition issued (γs: gname * gname) (l : val) (x: nat) (R : iProp Σ) : iProp Σ :=
( (lo ln: loc),
Definition issued (γ : gname) (lk : val) (x : nat) (R : iProp Σ) : iProp Σ :=
( lo ln: loc,
heapN N heap_ctx
l = (#lo, #ln)%V inv N (lock_inv (fst γs) (snd γs) lo ln R)
auth_own (fst γs) (GSet {[ x ]}))%I.
lk = (#lo, #ln)%V inv N (lock_inv γ lo ln R)
own γ ( (, GSet {[ x ]})))%I.
Definition locked (γs: gname * gname) : iProp Σ := own (snd γs) (Excl ())%I.
Definition locked (γ : gname) : iProp Σ := ( o, own γ ( (Excl' o, )))%I.
Global Instance lock_inv_ne n γ1 γ2 lo ln :
Proper (dist n ==> dist n) (lock_inv γ1 γ2 lo ln).
Global Instance lock_inv_ne n γs lo ln :
Proper (dist n ==> dist n) (lock_inv γs lo ln).
Proof. solve_proper. Qed.
Global Instance is_lock_ne γs n l : Proper (dist n ==> dist n) (is_lock γs l).
Proof. solve_proper. Qed.
......@@ -78,47 +68,41 @@ Section proof.
Global Instance locked_timeless γs : TimelessP (locked γs).
Proof. apply _. Qed.
Lemma locked_exclusive (γs: gname * gname) : (locked γs locked γs False)%I.
Proof. rewrite /locked -own_op own_valid. by iIntros (?). Qed.
Lemma locked_exclusive (γ : gname) : (locked γ locked γ False)%I.
Proof.
iIntros "[H1 H2]". iDestruct "H1" as (o1) "H1". iDestruct "H2" as (o2) "H2".
iCombine "H1" "H2" as "H". iDestruct (own_valid with "H") as %[[] _].
Qed.
Lemma newlock_spec (R : iProp Σ) Φ :
heapN N
heap_ctx R ( lk γs, is_lock γs lk R - Φ lk) WP newlock #() {{ Φ }}.
heap_ctx R ( lk γ, is_lock γ lk R - Φ lk) WP newlock #() {{ Φ }}.
Proof.
iIntros (HN) "(#Hh & HR & HΦ)". rewrite /newlock /=.
wp_seq. wp_alloc lo as "Hlo". wp_alloc ln as "Hln".
iVs (own_alloc (Excl ())) as (γ2) "Hγ2"; first done.
iVs (own_alloc_strong (Auth (Excl' ) ) {[ γ2 ]}) as (γ1) "[% Hγ1]"; first done.
iVs (inv_alloc N _ (lock_inv γ1 γ2 lo ln R) with "[-HΦ]").
- iNext. rewrite /lock_inv.
iExists 0%nat, 0%nat.
iFrame.
iSplitL "Hγ1".
+ rewrite /auth_inv.
iExists (GSet ).
by iFrame.
+ iLeft. by iFrame.
- iVsIntro.
iApply ("HΦ" $! (#lo, #ln)%V (γ1, γ2)).
iExists lo, ln.
iSplit; by eauto.
iVs (own_alloc ( (Excl' 0%nat, ) (Excl' 0%nat, ))) as (γ) "[Hγ Hγ']".
{ by rewrite -auth_both_op. }
iVs (inv_alloc _ _ (lock_inv γ lo ln R) with "[-HΦ]").
{ iNext. rewrite /lock_inv.
iExists 0%nat, 0%nat. iFrame. iLeft. by iFrame. }
iVsIntro. iApply ("HΦ" $! (#lo, #ln)%V γ). iExists lo, ln. eauto.
Qed.
Lemma wait_loop_spec γs l x R (Φ : val iProp Σ) :
issued γs l x R (locked γs - R - Φ #()) WP wait_loop #x l {{ Φ }}.
Lemma wait_loop_spec γ l x R (Φ : val iProp Σ) :
issued γ l x R (locked γ - R - Φ #()) WP wait_loop #x l {{ Φ }}.
Proof.
iIntros "[Hl HΦ]". iDestruct "Hl" as (lo ln) "(% & #? & % & #? & Ht)".
iLöb as "IH". wp_rec. subst. wp_let. wp_proj. wp_bind (! _)%E.
iInv N as (o n) "[Hlo [Hln Ha]]" "Hclose".
iInv N as (o n) "(Hlo & Hln & Ha)" "Hclose".
wp_load. destruct (decide (x = o)) as [->|Hneq].
- iDestruct "Ha" as "[Hainv [[Ho HR] | Haown]]".
+ iVs ("Hclose" with "[Hlo Hln Hainv Ht]").
+ iVs ("Hclose" with "[Hlo Hln Hainv Ht]") as "_".
{ iNext. iExists o, n. iFrame. eauto. }
iVsIntro. wp_let. wp_op=>[_|[]] //.
wp_if. iVsIntro.
iApply ("HΦ" with "[-HR] HR"). eauto.
iApply ("HΦ" with "[-HR] HR"). rewrite /locked; eauto.
+ iExFalso. iCombine "Ht" "Haown" as "Haown".
iDestruct (auth_own_valid with "Haown") as % ?%gset_disj_valid_op.
iDestruct (own_valid with "Haown") as % [_ ?%gset_disj_valid_op].
set_solver.
- iVs ("Hclose" with "[Hlo Hln Ha]").
{ iNext. iExists o, n. by iFrame. }
......@@ -126,64 +110,72 @@ Section proof.
wp_if. iApply ("IH" with "Ht"). by iExact "HΦ".
Qed.
Lemma acquire_spec γs l R (Φ : val iProp Σ) :
is_lock γs l R (locked γs - R - Φ #()) WP acquire l {{ Φ }}.
Lemma acquire_spec γ l R (Φ : val iProp Σ) :
is_lock γ l R (locked γ - R - Φ #()) WP acquire l {{ Φ }}.
Proof.
iIntros "[Hl HΦ]". iDestruct "Hl" as (lo ln) "(% & #? & % & #?)".
iLöb as "IH". wp_rec. wp_bind (! _)%E. subst. wp_proj.
iInv N as (o n) "[Hlo [Hln Ha]]" "Hclose".
wp_load. iVs ("Hclose" with "[Hlo Hln Ha]").
wp_load. iVs ("Hclose" with "[Hlo Hln Ha]") as "_".
{ iNext. iExists o, n. by iFrame. }
iVsIntro. wp_let. wp_proj. wp_op.
wp_bind (CAS _ _ _).
iInv N as (o' n') "[Hlo' [Hln' [Hainv Haown]]]" "Hclose".
iInv N as (o' n') "(>Hlo' & >Hln' & >Hauth & Haown)" "Hclose".
destruct (decide (#n' = #n))%V as [[= ->%Nat2Z.inj] | Hneq].
- wp_cas_suc.
iDestruct "Hainv" as (s) "[Ho %]"; subst.
iVs (own_update with "Ho") as "Ho".
{ eapply auth_update_no_frag, (gset_disj_alloc_empty_local_update n).
rewrite elem_of_seq_set; omega. }
iDestruct "Ho" as "[Hofull Hofrag]".
iVs ("Hclose" with "[Hlo' Hln' Haown Hofull]").
{ rewrite gset_disj_union; last by apply (seq_set_S_disjoint 0).
rewrite -(seq_set_S_union_L 0).
iNext. iExists o', (S n)%nat.
rewrite Nat2Z.inj_succ -Z.add_1_r.
iFrame. iExists (GSet (seq_set 0 (S n))). by iFrame. }
iVs (own_update with "Hauth") as "Hauth".
{ eapply (auth_update_no_frag _ (, _)), prod_local_update,
(gset_disj_alloc_empty_local_update n); [done|].
rewrite elem_of_seq_set. omega. }
rewrite pair_op left_id_L. iDestruct "Hauth" as "[Hauth Hofull]".
rewrite gset_disj_union; last by apply (seq_set_S_disjoint 0).
rewrite -(seq_set_S_union_L 0).
iVs ("Hclose" with "[Hlo' Hln' Haown Hauth]") as "_".
{ iNext. iExists o', (S n).
rewrite Nat2Z.inj_succ -Z.add_1_r. by iFrame. }
iVsIntro. wp_if.
iApply (wait_loop_spec γs (#lo, #ln)).
iSplitR "HΦ"; last by auto.
rewrite /issued /auth_own; eauto 10.
iApply (wait_loop_spec γ (#lo, #ln)).
iFrame "HΦ". rewrite /issued; eauto 10.
- wp_cas_fail.
iVs ("Hclose" with "[Hlo' Hln' Hainv Haown]").
iVs ("Hclose" with "[Hlo' Hln' Hauth Haown]").
{ iNext. iExists o', n'. by iFrame. }
iVsIntro. wp_if. by iApply "IH".
Qed.
Lemma release_spec γs l R (Φ : val iProp Σ):
is_lock γs l R locked γs R Φ #() WP release l {{ Φ }}.
Lemma release_spec γ l R (Φ : val iProp Σ):
is_lock γ l R locked γ R Φ #() WP release l {{ Φ }}.
Proof.
iIntros "(Hl & Hγ & HR & HΦ)". iDestruct "Hl" as (lo ln) "(% & #? & % & #?)".
iLöb as "IH". wp_rec. subst. wp_proj. wp_bind (! _)%E.
iInv N as (o n) "[Hlo [Hln Hr]]" "Hclose".
wp_load. iVs ("Hclose" with "[Hlo Hln Hr]").
iIntros "(Hl & Hγ & HR & HΦ)".
iDestruct "Hl" as (lo ln) "(% & #? & % & #?)"; subst.
iDestruct "Hγ" as (o) "Hγo".
rewrite /release. wp_let. wp_proj. wp_proj. wp_bind (! _)%E.
iInv N as (o' n) "(>Hlo & >Hln & >Hauth & Haown)" "Hclose".
wp_load.
iAssert (o' = o)%I with "[#]" as "%"; subst.
{ iCombine "Hγo" "Hauth" as "Hγo".
by iDestruct (own_valid with "Hγo") (* FIXME: this is horrible *)
as %[[[[?|] ?] [=]%leibniz_equiv_iff] ?]%auth_valid_discrete. }
iVs ("Hclose" with "[Hlo Hln Hauth Haown]") as "_".
{ iNext. iExists o, n. by iFrame. }
iVsIntro. wp_let. wp_bind (CAS _ _ _ ).
wp_proj. wp_op.
iInv N as (o' n') "[Hlo' [Hln' Hr]]" "Hclose".
destruct (decide (#o' = #o))%V as [[= ->%Nat2Z.inj ] | Hneq].
- wp_cas_suc.
iDestruct "Hr" as "[Hainv [[Ho _] | Hown]]".
+ iExFalso. iCombine "Hγ" "Ho" as "Ho".
iDestruct (own_valid with "#Ho") as %[].
+ iVs ("Hclose" with "[Hlo' Hln' HR Hγ Hainv]").
{ iNext. iExists (o + 1)%nat, n'%nat.
iFrame. rewrite Nat2Z.inj_add.
iFrame. iLeft; by iFrame. }
iVsIntro. by wp_if.
- wp_cas_fail. iVs ("Hclose" with "[Hlo' Hln' Hr]").
{ iNext. iExists o', n'. by iFrame. }
iVsIntro. wp_if. by iApply ("IH" with "Hγ HR").
iVsIntro. wp_op.
iInv N as (o' n') "(>Hlo & >Hln & >Hauth & Haown)" "Hclose".
wp_store.
iAssert (o' = o)%I with "[#]" as "%"; subst.
{ iCombine "Hγo" "Hauth" as "Hγo".
by iDestruct (own_valid with "Hγo")
as %[[[[?|] ?] [=]%leibniz_equiv_iff] ?]%auth_valid_discrete. }
iDestruct "Haown" as "[[Hγo' _]|?]".
{ iCombine "Hγo" "Hγo'" as "Hγo".
iDestruct (own_valid with "#Hγo") as %[[] ?]. }
iCombine "Hauth" "Hγo" as "Hauth".
iVs (own_update with "Hauth") as "Hauth".
{ rewrite pair_split_L. apply: (auth_update _ _ (Excl' (S o), _)). (* FIXME: apply is slow *)
apply prod_local_update, reflexivity; simpl.
by apply option_local_update, exclusive_local_update. }
rewrite -pair_split_L. iDestruct "Hauth" as "[Hauth Hγo]".
iVs ("Hclose" with "[Hlo Hln Hauth Haown Hγo HR]") as "_"; last auto.
iNext. iExists (S o), n'.
rewrite Nat2Z.inj_succ -Z.add_1_r. iFrame. iLeft. by iFrame.
Qed.
End proof.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment