Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
E
examples_rdcss_old
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Gaurav Parthasarathy
examples_rdcss_old
Commits
34205ce9
Commit
34205ce9
authored
Jun 20, 2019
by
Gaurav Parthasarathy
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
rdcss only allocates one descriptor now (using inner recursive function)
parent
52a034af
Pipeline
#17828
canceled with stage
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Sidebyside
Showing
1 changed file
with
53 additions
and
47 deletions
+53
47
theories/logatom/rdcss/rdcss.v
theories/logatom/rdcss/rdcss.v
+53
47
No files found.
theories/logatom/rdcss/rdcss.v
View file @
34205ce9
...
...
@@ 80,45 +80,52 @@ Definition get : val :=
let p := NewProph in
let l_descr := ref (l_m, m1, n1, n2, p) in
let r := CAS(l_n, InjL n1, InjR l_descr) in
match r with
InjL n =>
if n = n1 then
complete(l_descr, l_m, l_n, m1, n1, n2, p) ;; #true
else
(* CAS failed, hence we could linearize at the CAS *)
#false
 InjR l_descr =>
let (l_m', m1', n1', n2', p') := !l_descr in
complete(l_descr, l_m', l_n, m1', n1', n2', p') ;;
rdcss(l_m, l_n, m1, n1, n2)
end.
(rec: rdcss_inner(l_descr, l_m, l_n, m1, n1, n2)
match r with
InjL n =>
if n = n1 then
complete(l_descr, l_m, l_n, m1, n1, n2, p) ;; #true
else
(* CAS failed, hence we could linearize at the CAS *)
#false
 InjR l_descr =>
let (l_m', m1', n1', n2', p') := !l_descr in
complete(l_descr, l_m', l_n, m1', n1', n2', p') ;;
rdcss(l_m, l_n, m1, n1, n2)
end
)(l_descr, l_m, l_n, m1, n1, n2)
*)
Definition
rdcss
:
val
:
=
rec
:
"rdcss"
"l_m"
"l_n"
"m1"
"n1"
"n2"
:
=
λ
:
"l_m"
"l_n"
"m1"
"n1"
"n2"
,
(* allocate fresh descriptor *)
let
:
"p"
:
=
NewProph
in
let
:
"l_descr"
:
=
ref
(
"l_m"
,
"m1"
,
"n1"
,
"n2"
,
"p"
)
in
let
:
"r"
:
=
(
CAS
"l_n"
(
InjL
"n1"
)
(
InjR
"l_descr"
))
in
match
:
"r"
with
InjL
"n"
=>
(* nondescriptor value read, check if CAS was successful *)
if
:
"n"
=
"n1"
then
(* CAS was successful, finish operation *)
complete
"l_descr"
"l_m"
"l_n"
"m1"
"n1"
"n2"
"p"
;;
#
true
else
(* CAS failed, hence we could linearize at the CAS *)
#
false

InjR
"l_descr"
=>
(* a descriptor from a different operation was read, try to help and then restart *)
let
:
"data"
:
=
!
"l_descr"
in
(* data = (l_m', m1', n1', n2', p') *)
let
:
"l_m'"
:
=
Fst
(
Fst
(
Fst
(
Fst
(
"data"
))))
in
let
:
"m1'"
:
=
Snd
(
Fst
(
Fst
(
Fst
(
"data"
))))
in
let
:
"n1'"
:
=
Snd
(
Fst
(
Fst
(
"data"
)))
in
let
:
"n2'"
:
=
Snd
(
Fst
(
"data"
))
in
let
:
"p'"
:
=
Snd
(
"data"
)
in
complete
"l_descr"
"l_m'"
"l_n"
"m1'"
"n1'"
"n2'"
"p'"
;;
"rdcss"
"l_m"
"l_n"
"m1"
"n1"
"n2"
end
.
(* start rdcss computation with allocated descriptor *)
(
rec
:
"rdcss_inner"
"l_descr"
"l_m"
"l_n"
"m1"
"n1"
"n2"
:
=
let
:
"r"
:
=
(
CAS
"l_n"
(
InjL
"n1"
)
(
InjR
"l_descr"
))
in
match
:
"r"
with
InjL
"n"
=>
(* nondescriptor value read, check if CAS was successful *)
if
:
"n"
=
"n1"
then
(* CAS was successful, finish operation *)
complete
"l_descr"
"l_m"
"l_n"
"m1"
"n1"
"n2"
"p"
;;
#
true
else
(* CAS failed, hence we could linearize at the CAS *)
#
false

InjR
"l_descr_other"
=>
(* a descriptor from a different operation was read, try to help and then restart *)
let
:
"data"
:
=
!
"l_descr_other"
in
(* data = (l_m', m1', n1', n2', p') *)
let
:
"l_m'"
:
=
Fst
(
Fst
(
Fst
(
Fst
(
"data"
))))
in
let
:
"m1'"
:
=
Snd
(
Fst
(
Fst
(
Fst
(
"data"
))))
in
let
:
"n1'"
:
=
Snd
(
Fst
(
Fst
(
"data"
)))
in
let
:
"n2'"
:
=
Snd
(
Fst
(
"data"
))
in
let
:
"p'"
:
=
Snd
(
"data"
)
in
complete
"l_descr_other"
"l_m'"
"l_n"
"m1'"
"n1'"
"n2'"
"p'"
;;
"rdcss_inner"
"l_descr"
"l_m"
"l_n"
"m1"
"n1"
"n2"
end
)
"l_descr"
"l_m"
"l_n"
"m1"
"n1"
"n2"
.
(** ** Proof setup *)
...
...
@@ 182,13 +189,6 @@ Section rdcss.

Updating
ld
lm
m1
n1
n2
p
=>
InjRV
#
ld
end
.
(*
Global Instance state_to_val_inj : Inj (=) (=) state_to_val.
Proof.
intros [] []; simpl; intros Hv; inversion_clear Hv; done.
Qed.
*)
Definition
own_token
γ
:
=
(
own
γ
(
Excl
()))%
I
.
Definition
pending_state
P
(
n1
:
Z
)
(
proph_winner
:
option
loc
)
l_ghost_winner
(
γ
_n
:
gname
)
:
=
...
...
@@ 507,13 +507,18 @@ Section rdcss.
<<<
gc_mapsto
l_m
#
m
∗
rdcss_content
γ
_n
(
if
decide
(
m
=
m1
∧
n
=
n1
)
then
n2
else
n
),
RET
#(
bool_decide
(
n
=
n1
))
>>>.
Proof
.
iIntros
(
Hdisj
)
"#InvC #GC #InvGC"
.
iDestruct
"InvC"
as
(
l_n
)
"[Heq InvC]"
.
iDestruct
"Heq"
as
%>.
iIntros
(
Φ
)
"AU"
.
iL
ö
b
as
"IH"
.
iDestruct
"Heq"
as
%>.
iIntros
(
Φ
)
"AU"
.
(* allocate fresh descriptor *)
wp_lam
.
wp_pures
.
wp_apply
wp_new_proph
;
first
done
.
iIntros
(
proph_values
p'
)
"Hp'"
.
wp_let
.
wp_alloc
l_descr
as
"Hld"
.
wp_let
.
wp_pures
.
wp_bind
(
CAS
_
_
_
)%
E
.
wp_let
.
(* invoke inner recursive function [rdcss_inner] *)
(* FIXME: would be nice to put iLöb here to avoid another
wp_pures tactic at the end *)
wp_pures
.
iL
ö
b
as
"IH"
.
wp_bind
(
CAS
_
_
_
)%
E
.
(* open outer invariant for the CAS *)
iInv
rdcssN
as
(
s
)
"(>Hln & Hrest)"
.
destruct
s
as
[
n

l_descr'
lm'
m1'
n1'
n2'
p
].
...
...
@@ 565,14 +570,15 @@ Section rdcss.
iModIntro
.
(* extract state invariant *)
iDestruct
"Hrest"
as
(
q
P
Q
l_ghost
γ
_t
γ
_s
)
"([Hld1 [Hld2 Hld3]] & #InvS & #P_AU & #P_GC)"
.
iSplitR
"AU Hld2"
.
iSplitR
"AU Hld2
Hld Hp'
"
.
(* close invariant, retain some permission to l_descr', so that we can read it later *)
{
iModIntro
.
iExists
(
Updating
l_descr'
lm'
m1'
n1'
n2'
p
).
iFrame
.
eauto
12
with
iFrame
.
}
wp_let
.
wp_match
.
wp_bind
(!
_
)%
E
.
(*
read l_descr
*)
(*
read l_descr
*)
wp_load
.
wp_pures
.
wp_apply
complete_spec
;
[
done
..].
iIntros
"_"
.
wp_seq
.
by
iApply
"IH"
.
iIntros
"_"
.
wp_seq
.
wp_pures
.
iApply
(
"IH"
with
"AU Hp' Hld"
).
Qed
.
(** ** Proof of [new_rdcss] *)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment