Skip to content

Commit 167e756

Browse files
polytypicpolytypic
committed
Use adaptive backoff in mpmcq
1 parent cd68168 commit 167e756

File tree

4 files changed

+97
-70
lines changed

4 files changed

+97
-70
lines changed

‎.ocamlformat‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
11
profile = default
2-
version = 0.27.0
2+
version = 0.28.1
33

44
exp-grouping=preserve

‎lib/picos_aux.mpmcq/adaptive_backoff.ml‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
let n = 128 * 4
2+
let counters = Array.init n (fun _ -> Atomic.make 0)
3+
4+
let[@inline never] once ~random_key ~log_scale =
5+
let i = random_key land (n - 1) in
6+
let counter = Array.unsafe_get counters i in
7+
let n_contending_threads = Atomic.fetch_and_add counter 1 + 1 in
8+
let n = ref (Random.int ((n_contending_threads lsl log_scale) + 0)) in
9+
while 0 <= !n do
10+
Domain.cpu_relax ();
11+
decr n
12+
done;
13+
Atomic.decr counter

‎lib/picos_aux.mpmcq/adaptive_backoff.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
val once : random_key:int -> log_scale:int -> unit

‎lib/picos_aux.mpmcq/picos_aux_mpmcq.ml‎

Lines changed: 82 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,10 @@
11
module Atomic = Multicore_magic.Transparent_atomic
22

3-
type 'a t = { head : 'a head Atomic.t; tail : 'a tail Atomic.t }
3+
type 'a t = {
4+
random_key : int;
5+
head : 'a head Atomic.t;
6+
tail : 'a tail Atomic.t;
7+
}
48

59
and ('a, _) tdt =
610
| Cons : {
@@ -27,14 +31,15 @@ and 'a head = H : ('a, [< `Cons | `Head ]) tdt -> 'a head [@@unboxed]
2731
and 'a tail = T : ('a, [< `Snoc | `Tail ]) tdt -> 'a tail [@@unboxed]
2832

2933
let create ?padded () =
34+
let random_key = Int64.to_int (Random.bits64 ()) in
3035
let head =
3136
Atomic.make (H (Head { counter = 1 })) |> Multicore_magic.copy_as ?padded
3237
in
3338
let tail =
3439
Atomic.make (T (Tail { counter = 0; move = Used }))
3540
|> Multicore_magic.copy_as ?padded
3641
in
37-
Multicore_magic.copy_as ?padded { head; tail }
42+
Multicore_magic.copy_as ?padded { random_key; head; tail }
3843

3944
let rec rev (suffix : (_, [< `Cons ]) tdt) = function
4045
| T (Snoc { counter; prefix; value }) ->
@@ -47,142 +52,154 @@ let rev = function
4752
(Cons { counter; value; suffix = H (Head { counter = counter + 1 }) })
4853
prefix
4954

50-
let rec push t value backoff = function
55+
let[@inline] backoff_tail t =
56+
Adaptive_backoff.once ~random_key:(t.random_key + 0) ~log_scale:8
57+
58+
let rec push t value = function
5159
| T (Snoc snoc_r) as prefix ->
5260
let after = Snoc { counter = snoc_r.counter + 1; prefix; value } in
53-
if not (Atomic.compare_and_set t.tail prefix (T after)) then
54-
let backoff = Backoff.once backoff in
55-
push t value backoff (Atomic.fenceless_get t.tail)
61+
if not (Atomic.compare_and_set t.tail prefix (T after)) then begin
62+
backoff_tail t;
63+
push t value (Atomic.fenceless_get t.tail)
64+
end
5665
| T (Tail tail_r) as prefix -> begin
5766
match tail_r.move with
5867
| Used ->
5968
let after = Snoc { counter = tail_r.counter + 1; prefix; value } in
60-
if not (Atomic.compare_and_set t.tail prefix (T after)) then
61-
let backoff = Backoff.once backoff in
62-
push t value backoff (Atomic.fenceless_get t.tail)
69+
if not (Atomic.compare_and_set t.tail prefix (T after)) then begin
70+
backoff_tail t;
71+
push t value (Atomic.fenceless_get t.tail)
72+
end
6373
| Snoc move_r as move ->
64-
begin
65-
match Atomic.get t.head with
66-
| H (Head head_r as head) when head_r.counter < move_r.counter ->
67-
let after = rev move in
68-
if
69-
Atomic.fenceless_get t.head == H head
70-
&& Atomic.compare_and_set t.head (H head) (H after)
71-
then tail_r.move <- Used
72-
| _ -> tail_r.move <- Used
74+
begin match Atomic.get t.head with
75+
| H (Head head_r as head) when head_r.counter < move_r.counter ->
76+
let after = rev move in
77+
if
78+
Atomic.fenceless_get t.head == H head
79+
&& Atomic.compare_and_set t.head (H head) (H after)
80+
then tail_r.move <- Used
81+
| _ -> tail_r.move <- Used
7382
end;
74-
push t value backoff (Atomic.get t.tail)
83+
push t value (Atomic.get t.tail)
7584
end
7685

7786
exception Empty
7887

79-
let rec pop t backoff = function
88+
let[@inline] backoff_head t =
89+
Adaptive_backoff.once ~random_key:(t.random_key + 0) ~log_scale:8
90+
91+
let rec pop t = function
8092
| H (Cons cons_r as cons) ->
8193
if Atomic.compare_and_set t.head (H cons) cons_r.suffix then cons_r.value
82-
else
83-
let backoff = Backoff.once backoff in
84-
pop t backoff (Atomic.fenceless_get t.head)
94+
else begin
95+
backoff_head t;
96+
pop t (Atomic.fenceless_get t.head)
97+
end
8598
| H (Head head_r as head) -> begin
8699
match Atomic.get t.tail with
87100
| T (Snoc snoc_r as move) ->
88101
if head_r.counter = snoc_r.counter then
89102
if Atomic.compare_and_set t.tail (T move) snoc_r.prefix then
90103
snoc_r.value
91-
else pop t backoff (Atomic.fenceless_get t.head)
104+
else pop t (Atomic.fenceless_get t.head)
92105
else
93106
let (Tail tail_r as tail : (_, [ `Tail ]) tdt) =
94107
Tail { counter = snoc_r.counter; move }
95108
in
96109
let new_head = Atomic.get t.head in
97-
if new_head != H head then pop t backoff new_head
110+
if new_head != H head then pop t new_head
98111
else if Atomic.compare_and_set t.tail (T move) (T tail) then
99112
let (Cons cons_r) = rev move in
100113
let after = cons_r.suffix in
101114
let new_head = Atomic.get t.head in
102-
if new_head != H head then pop t backoff new_head
115+
if new_head != H head then pop t new_head
103116
else if Atomic.compare_and_set t.head (H head) after then begin
104117
tail_r.move <- Used;
105118
cons_r.value
106119
end
107-
else
108-
let backoff = Backoff.once backoff in
109-
pop t backoff (Atomic.fenceless_get t.head)
110-
else pop t backoff (Atomic.fenceless_get t.head)
120+
else begin
121+
backoff_head t;
122+
pop t (Atomic.fenceless_get t.head)
123+
end
124+
else pop t (Atomic.fenceless_get t.head)
111125
| T (Tail tail_r) -> begin
112126
match tail_r.move with
113127
| Used ->
114128
let new_head = Atomic.get t.head in
115-
if new_head != H head then pop t backoff new_head
116-
else raise_notrace Empty
129+
if new_head != H head then pop t new_head else raise_notrace Empty
117130
| Snoc move_r as move ->
118131
if head_r.counter < move_r.counter then
119132
let (Cons cons_r) = rev move in
120133
let after = cons_r.suffix in
121134
let new_head = Atomic.get t.head in
122-
if new_head != H head then pop t backoff new_head
135+
if new_head != H head then pop t new_head
123136
else if Atomic.compare_and_set t.head (H head) after then begin
124137
tail_r.move <- Used;
125138
cons_r.value
126139
end
127-
else
128-
let backoff = Backoff.once backoff in
129-
pop t backoff (Atomic.fenceless_get t.head)
140+
else begin
141+
backoff_head t;
142+
pop t (Atomic.fenceless_get t.head)
143+
end
130144
else
131145
let new_head = Atomic.get t.head in
132-
if new_head != H head then pop t backoff new_head
146+
if new_head != H head then pop t new_head
133147
else raise_notrace Empty
134148
end
135149
end
136150

137-
let rec push_head t value backoff =
151+
let rec push_head t value =
138152
match Atomic.get t.head with
139153
| H (Cons cons_r) as suffix ->
140154
let after = Cons { counter = cons_r.counter - 1; value; suffix } in
141-
if not (Atomic.compare_and_set t.head suffix (H after)) then
142-
push_head t value (Backoff.once backoff)
155+
if not (Atomic.compare_and_set t.head suffix (H after)) then begin
156+
backoff_head t;
157+
push_head t value
158+
end
143159
| H (Head head_r) as head -> begin
144160
match Atomic.get t.tail with
145161
| T (Snoc snoc_r as move) ->
146-
if Atomic.get t.head != head then push_head t value backoff
162+
if Atomic.get t.head != head then push_head t value
147163
else if head_r.counter = snoc_r.counter then begin
148164
let prefix = T (Snoc { snoc_r with value }) in
149165
let after =
150166
Snoc { snoc_r with counter = snoc_r.counter + 1; prefix }
151167
in
152-
if not (Atomic.compare_and_set t.tail (T move) (T after)) then
153-
push_head t value (Backoff.once backoff)
168+
if not (Atomic.compare_and_set t.tail (T move) (T after)) then begin
169+
backoff_head t;
170+
push_head t value
171+
end
154172
end
155-
else
173+
else begin
156174
let tail = Tail { counter = snoc_r.counter; move } in
157-
let backoff =
158-
if Atomic.compare_and_set t.tail (T move) (T tail) then backoff
159-
else Backoff.once backoff
160-
in
161-
push_head t value backoff
175+
if not (Atomic.compare_and_set t.tail (T move) (T tail)) then
176+
backoff_head t;
177+
push_head t value
178+
end
162179
| T (Tail tail_r) as prefix -> begin
163180
match tail_r.move with
164181
| Used ->
165182
if Atomic.get t.head == head then begin
166183
let tail =
167184
Snoc { counter = tail_r.counter + 1; value; prefix }
168185
in
169-
if not (Atomic.compare_and_set t.tail prefix (T tail)) then
170-
push_head t value (Backoff.once backoff)
186+
if not (Atomic.compare_and_set t.tail prefix (T tail)) then begin
187+
backoff_head t;
188+
push_head t value
189+
end
171190
end
172-
else push_head t value backoff
191+
else push_head t value
173192
| Snoc move_r as move ->
174-
begin
175-
match Atomic.get t.head with
176-
| H (Head head_r as head) when head_r.counter < move_r.counter
177-
->
178-
let after = rev move in
179-
if
180-
Atomic.fenceless_get t.head == H head
181-
&& Atomic.compare_and_set t.head (H head) (H after)
182-
then tail_r.move <- Used
183-
| _ -> tail_r.move <- Used
193+
begin match Atomic.get t.head with
194+
| H (Head head_r as head) when head_r.counter < move_r.counter ->
195+
let after = rev move in
196+
if
197+
Atomic.fenceless_get t.head == H head
198+
&& Atomic.compare_and_set t.head (H head) (H after)
199+
then tail_r.move <- Used
200+
| _ -> tail_r.move <- Used
184201
end;
185-
push_head t value backoff
202+
push_head t value
186203
end
187204
end
188205

@@ -207,9 +224,5 @@ let[@inline] length t =
207224
tail_at - head_at + 1
208225

209226
let[@inline] is_empty t = length t == 0
210-
let[@inline] pop_exn t = pop t Backoff.default (Atomic.fenceless_get t.head)
211-
212-
let[@inline] push t value =
213-
push t value Backoff.default (Atomic.fenceless_get t.tail)
214-
215-
let[@inline] push_head t value = push_head t value Backoff.default
227+
let[@inline] pop_exn t = pop t (Atomic.fenceless_get t.head)
228+
let[@inline] push t value = push t value (Atomic.fenceless_get t.tail)

0 commit comments

Comments
 (0)