Skip to content

Commit 01ceafe

Browse files
polytypicpolytypic
committed
Use adaptive backoff in mpmcq
1 parent cd68168 commit 01ceafe

File tree

4 files changed

+100
-70
lines changed

4 files changed

+100
-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: 85 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,157 @@ 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[@inline] backoff_head t =
59+
Adaptive_backoff.once ~random_key:(t.random_key + 16) ~log_scale:8
60+
61+
let rec push t value = function
5162
| T (Snoc snoc_r) as prefix ->
5263
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)
64+
if not (Atomic.compare_and_set t.tail prefix (T after)) then begin
65+
backoff_tail t;
66+
push t value (Atomic.fenceless_get t.tail)
67+
end
5668
| T (Tail tail_r) as prefix -> begin
5769
match tail_r.move with
5870
| Used ->
5971
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)
72+
if not (Atomic.compare_and_set t.tail prefix (T after)) then begin
73+
backoff_tail t;
74+
push t value (Atomic.fenceless_get t.tail)
75+
end
6376
| 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
77+
begin match Atomic.get t.head with
78+
| H (Head head_r as head) when head_r.counter < move_r.counter ->
79+
let after = rev move in
80+
if Atomic.fenceless_get t.head == H head then
81+
if Atomic.compare_and_set t.head (H head) (H after) then
82+
tail_r.move <- Used
83+
else backoff_head t
84+
| _ -> tail_r.move <- Used
7385
end;
74-
push t value backoff (Atomic.get t.tail)
86+
push t value (Atomic.get t.tail)
7587
end
7688

7789
exception Empty
7890

79-
let rec pop t backoff = function
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 begin
105+
backoff_tail t;
106+
pop t (Atomic.fenceless_get t.head)
107+
end
92108
else
93109
let (Tail tail_r as tail : (_, [ `Tail ]) tdt) =
94110
Tail { counter = snoc_r.counter; move }
95111
in
96112
let new_head = Atomic.get t.head in
97-
if new_head != H head then pop t backoff new_head
113+
if new_head != H head then pop t new_head
98114
else if Atomic.compare_and_set t.tail (T move) (T tail) then
99115
let (Cons cons_r) = rev move in
100116
let after = cons_r.suffix in
101117
let new_head = Atomic.get t.head in
102-
if new_head != H head then pop t backoff new_head
118+
if new_head != H head then pop t new_head
103119
else if Atomic.compare_and_set t.head (H head) after then begin
104120
tail_r.move <- Used;
105121
cons_r.value
106122
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)
123+
else begin
124+
backoff_head t;
125+
pop t (Atomic.fenceless_get t.head)
126+
end
127+
else pop t (Atomic.fenceless_get t.head)
111128
| T (Tail tail_r) -> begin
112129
match tail_r.move with
113130
| Used ->
114131
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
132+
if new_head != H head then pop t new_head else raise_notrace Empty
117133
| Snoc move_r as move ->
118134
if head_r.counter < move_r.counter then
119135
let (Cons cons_r) = rev move in
120136
let after = cons_r.suffix in
121137
let new_head = Atomic.get t.head in
122-
if new_head != H head then pop t backoff new_head
138+
if new_head != H head then pop t new_head
123139
else if Atomic.compare_and_set t.head (H head) after then begin
124140
tail_r.move <- Used;
125141
cons_r.value
126142
end
127-
else
128-
let backoff = Backoff.once backoff in
129-
pop t backoff (Atomic.fenceless_get t.head)
143+
else begin
144+
backoff_head t;
145+
pop t (Atomic.fenceless_get t.head)
146+
end
130147
else
131148
let new_head = Atomic.get t.head in
132-
if new_head != H head then pop t backoff new_head
149+
if new_head != H head then pop t new_head
133150
else raise_notrace Empty
134151
end
135152
end
136153

137-
let rec push_head t value backoff =
154+
let rec push_head t value =
138155
match Atomic.get t.head with
139156
| H (Cons cons_r) as suffix ->
140157
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)
158+
if not (Atomic.compare_and_set t.head suffix (H after)) then begin
159+
backoff_head t;
160+
push_head t value
161+
end
143162
| H (Head head_r) as head -> begin
144163
match Atomic.get t.tail with
145164
| T (Snoc snoc_r as move) ->
146-
if Atomic.get t.head != head then push_head t value backoff
165+
if Atomic.get t.head != head then push_head t value
147166
else if head_r.counter = snoc_r.counter then begin
148167
let prefix = T (Snoc { snoc_r with value }) in
149168
let after =
150169
Snoc { snoc_r with counter = snoc_r.counter + 1; prefix }
151170
in
152-
if not (Atomic.compare_and_set t.tail (T move) (T after)) then
153-
push_head t value (Backoff.once backoff)
171+
if not (Atomic.compare_and_set t.tail (T move) (T after)) then begin
172+
backoff_tail t;
173+
push_head t value
174+
end
154175
end
155-
else
176+
else begin
156177
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
178+
if not (Atomic.compare_and_set t.tail (T move) (T tail)) then
179+
backoff_tail t;
180+
push_head t value
181+
end
162182
| T (Tail tail_r) as prefix -> begin
163183
match tail_r.move with
164184
| Used ->
165185
if Atomic.get t.head == head then begin
166186
let tail =
167187
Snoc { counter = tail_r.counter + 1; value; prefix }
168188
in
169-
if not (Atomic.compare_and_set t.tail prefix (T tail)) then
170-
push_head t value (Backoff.once backoff)
189+
if not (Atomic.compare_and_set t.tail prefix (T tail)) then begin
190+
backoff_tail t;
191+
push_head t value
192+
end
171193
end
172-
else push_head t value backoff
194+
else push_head t value
173195
| 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
196+
begin match Atomic.get t.head with
197+
| H (Head head_r as head) when head_r.counter < move_r.counter ->
198+
let after = rev move in
199+
if Atomic.fenceless_get t.head == H head then
200+
if Atomic.compare_and_set t.head (H head) (H after) then
201+
tail_r.move <- Used
202+
else backoff_head t
203+
| _ -> tail_r.move <- Used
184204
end;
185-
push_head t value backoff
205+
push_head t value
186206
end
187207
end
188208

@@ -207,9 +227,5 @@ let[@inline] length t =
207227
tail_at - head_at + 1
208228

209229
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
230+
let[@inline] pop_exn t = pop t (Atomic.fenceless_get t.head)
231+
let[@inline] push t value = push t value (Atomic.fenceless_get t.tail)

0 commit comments

Comments
 (0)