Skip to content

Commit efb15d8

Browse files
polytypicpolytypic
committed
Inline Atomic and Ref ops and unroll
This should give more accurate results such that it should be possible to match results with other more accurate benchmark results such as a benchmark of an optimized lock using `fetch_and_add`.
1 parent d2dcd9f commit efb15d8

File tree

2 files changed

+228
-52
lines changed

2 files changed

+228
-52
lines changed

‎bench/bench_atomic.ml‎

Lines changed: 114 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -10,44 +10,132 @@ module Atomic = struct
1010
modify ~backoff:(Backoff.once backoff) x f
1111
end
1212

13-
type t = Op : string * int * 'a * ('a Atomic.t -> _) * ('a Atomic.t -> _) -> t
13+
type _ op =
14+
| Get : int op
15+
| Incr : int op
16+
| Push_and_pop : int list op
17+
| Cas_int : int op
18+
| Xchg_int : int op
19+
| Swap : (int * int) op
20+
21+
let run_one (type a) ~budgetf ?(n_iter = 500 * Util.iter_factor) (op : a op) =
22+
let name, extra, (value : a) =
23+
match op with
24+
| Get -> ("get", 10, 42)
25+
| Incr -> ("incr", 1, 0)
26+
| Push_and_pop -> ("push & pop", 2, [])
27+
| Cas_int -> ("cas int", 1, 0)
28+
| Xchg_int -> ("xchg int", 1, 0)
29+
| Swap -> ("swap", 1, (4, 2))
30+
in
1431

15-
let run_one ~budgetf ?(n_iter = 500 * Util.iter_factor)
16-
(Op (name, extra, value, op1, op2)) =
1732
let n_iter = n_iter * extra in
1833

1934
let loc = Atomic.make value in
2035

2136
let init _ = () in
2237
let work _ () =
23-
let rec loop i =
24-
if i > 0 then begin
25-
op1 loc |> ignore;
26-
op2 loc |> ignore;
27-
loop (i - 2)
28-
end
29-
in
30-
loop n_iter
38+
match op with
39+
| Get ->
40+
let rec loop i =
41+
if i > 0 then begin
42+
let a =
43+
Atomic.get (Sys.opaque_identity loc)
44+
land Atomic.get (Sys.opaque_identity loc)
45+
and b =
46+
Atomic.get (Sys.opaque_identity loc)
47+
land Atomic.get (Sys.opaque_identity loc)
48+
and c =
49+
Atomic.get (Sys.opaque_identity loc)
50+
land Atomic.get (Sys.opaque_identity loc)
51+
and d =
52+
Atomic.get (Sys.opaque_identity loc)
53+
land Atomic.get (Sys.opaque_identity loc)
54+
in
55+
loop (i - 8 + (a - b) + (c - d))
56+
end
57+
in
58+
loop n_iter
59+
| Incr ->
60+
let rec loop i =
61+
if i > 0 then begin
62+
Atomic.incr loc;
63+
Atomic.incr loc;
64+
Atomic.incr loc;
65+
Atomic.incr loc;
66+
Atomic.incr loc;
67+
Atomic.incr loc;
68+
loop (i - 6)
69+
end
70+
in
71+
loop n_iter
72+
| Push_and_pop ->
73+
let[@inline] push x = Atomic.modify x (fun xs -> 101 :: xs)
74+
and[@inline] pop x =
75+
Atomic.modify x (function [] -> [] | _ :: xs -> xs)
76+
in
77+
let rec loop i =
78+
if i > 0 then begin
79+
push loc;
80+
pop loc |> ignore;
81+
push loc;
82+
pop loc |> ignore;
83+
loop (i - 4)
84+
end
85+
in
86+
loop n_iter
87+
| Cas_int ->
88+
let rec loop i =
89+
if i > 0 then begin
90+
Atomic.compare_and_set loc 0 1 |> ignore;
91+
Atomic.compare_and_set loc 1 0 |> ignore;
92+
Atomic.compare_and_set loc 0 1 |> ignore;
93+
Atomic.compare_and_set loc 1 0 |> ignore;
94+
Atomic.compare_and_set loc 0 1 |> ignore;
95+
Atomic.compare_and_set loc 1 0 |> ignore;
96+
loop (i - 6)
97+
end
98+
in
99+
loop n_iter
100+
| Xchg_int ->
101+
let rec loop i =
102+
if i > 0 then begin
103+
Atomic.exchange loc 1 |> ignore;
104+
Atomic.exchange loc 0 |> ignore;
105+
Atomic.exchange loc 1 |> ignore;
106+
Atomic.exchange loc 0 |> ignore;
107+
Atomic.exchange loc 1 |> ignore;
108+
Atomic.exchange loc 0 |> ignore;
109+
loop (i - 6)
110+
end
111+
in
112+
loop n_iter
113+
| Swap ->
114+
let[@inline] swap x = Atomic.modify x (fun (x, y) -> (y, x)) in
115+
let rec loop i =
116+
if i > 0 then begin
117+
swap loc;
118+
swap loc;
119+
swap loc;
120+
swap loc;
121+
swap loc;
122+
swap loc;
123+
loop (i - 6)
124+
end
125+
in
126+
loop n_iter
31127
in
32128

33129
Times.record ~budgetf ~n_domains:1 ~init ~work ()
34130
|> Times.to_thruput_metrics ~n:n_iter ~singular:"op" ~config:name
35131

36132
let run_suite ~budgetf =
37133
[
38-
(let get x = Atomic.get x in
39-
Op ("get", 10, 42, get, get));
40-
(let incr x = Atomic.incr x in
41-
Op ("incr", 1, 0, incr, incr));
42-
(let push x = Atomic.modify x (fun xs -> 101 :: xs)
43-
and pop x = Atomic.modify x (function [] -> [] | _ :: xs -> xs) in
44-
Op ("push & pop", 2, [], push, pop));
45-
(let cas01 x = Atomic.compare_and_set x 0 1
46-
and cas10 x = Atomic.compare_and_set x 1 0 in
47-
Op ("cas int", 1, 0, cas01, cas10));
48-
(let xchg1 x = Atomic.exchange x 1 and xchg0 x = Atomic.exchange x 0 in
49-
Op ("xchg int", 1, 0, xchg1, xchg0));
50-
(let swap x = Atomic.modify x (fun (x, y) -> (y, x)) in
51-
Op ("swap", 2, (4, 2), swap, swap));
134+
run_one ~budgetf Get;
135+
run_one ~budgetf Incr;
136+
run_one ~budgetf Push_and_pop;
137+
run_one ~budgetf Cas_int;
138+
run_one ~budgetf Xchg_int;
139+
run_one ~budgetf Swap;
52140
]
53-
|> List.concat_map @@ run_one ~budgetf
141+
|> List.concat

‎bench/bench_ref.ml‎

Lines changed: 114 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -26,44 +26,132 @@ module Ref = struct
2626
modify ~backoff:(Backoff.once backoff) x f
2727
end
2828

29-
type t = Op : string * int * 'a * ('a Ref.t -> _) * ('a Ref.t -> _) -> t
29+
type _ op =
30+
| Get : int op
31+
| Incr : int op
32+
| Push_and_pop : int list op
33+
| Cas_int : int op
34+
| Xchg_int : int op
35+
| Swap : (int * int) op
36+
37+
let run_one (type a) ~budgetf ?(n_iter = 500 * Util.iter_factor) (op : a op) =
38+
let name, extra, (value : a) =
39+
match op with
40+
| Get -> ("get", 10, 42)
41+
| Incr -> ("incr", 1, 0)
42+
| Push_and_pop -> ("push & pop", 2, [])
43+
| Cas_int -> ("cas int", 1, 0)
44+
| Xchg_int -> ("xchg int", 1, 0)
45+
| Swap -> ("swap", 1, (4, 2))
46+
in
3047

31-
let run_one ~budgetf ?(n_iter = 500 * Util.iter_factor)
32-
(Op (name, extra, value, op1, op2)) =
3348
let n_iter = n_iter * extra in
3449

3550
let loc = Ref.make value in
3651

3752
let init _ = () in
3853
let work _ () =
39-
let rec loop i =
40-
if i > 0 then begin
41-
op1 loc |> ignore;
42-
op2 loc |> ignore;
43-
loop (i - 2)
44-
end
45-
in
46-
loop n_iter
54+
match op with
55+
| Get ->
56+
let rec loop i =
57+
if i > 0 then begin
58+
let a =
59+
Ref.get (Sys.opaque_identity loc)
60+
land Ref.get (Sys.opaque_identity loc)
61+
and b =
62+
Ref.get (Sys.opaque_identity loc)
63+
land Ref.get (Sys.opaque_identity loc)
64+
and c =
65+
Ref.get (Sys.opaque_identity loc)
66+
land Ref.get (Sys.opaque_identity loc)
67+
and d =
68+
Ref.get (Sys.opaque_identity loc)
69+
land Ref.get (Sys.opaque_identity loc)
70+
in
71+
loop (i - 8 + (a - b) + (c - d))
72+
end
73+
in
74+
loop n_iter
75+
| Incr ->
76+
let rec loop i =
77+
if i > 0 then begin
78+
Ref.incr loc;
79+
Ref.incr loc;
80+
Ref.incr loc;
81+
Ref.incr loc;
82+
Ref.incr loc;
83+
Ref.incr loc;
84+
loop (i - 6)
85+
end
86+
in
87+
loop n_iter
88+
| Push_and_pop ->
89+
let[@inline] push x = Ref.modify x (fun xs -> 101 :: xs)
90+
and[@inline] pop x =
91+
Ref.modify x (function [] -> [] | _ :: xs -> xs)
92+
in
93+
let rec loop i =
94+
if i > 0 then begin
95+
push loc;
96+
pop loc |> ignore;
97+
push loc;
98+
pop loc |> ignore;
99+
loop (i - 4)
100+
end
101+
in
102+
loop n_iter
103+
| Cas_int ->
104+
let rec loop i =
105+
if i > 0 then begin
106+
Ref.compare_and_set loc 0 1 |> ignore;
107+
Ref.compare_and_set loc 1 0 |> ignore;
108+
Ref.compare_and_set loc 0 1 |> ignore;
109+
Ref.compare_and_set loc 1 0 |> ignore;
110+
Ref.compare_and_set loc 0 1 |> ignore;
111+
Ref.compare_and_set loc 1 0 |> ignore;
112+
loop (i - 6)
113+
end
114+
in
115+
loop n_iter
116+
| Xchg_int ->
117+
let rec loop i =
118+
if i > 0 then begin
119+
Ref.exchange loc 1 |> ignore;
120+
Ref.exchange loc 0 |> ignore;
121+
Ref.exchange loc 1 |> ignore;
122+
Ref.exchange loc 0 |> ignore;
123+
Ref.exchange loc 1 |> ignore;
124+
Ref.exchange loc 0 |> ignore;
125+
loop (i - 6)
126+
end
127+
in
128+
loop n_iter
129+
| Swap ->
130+
let[@inline] swap x = Ref.modify x (fun (x, y) -> (y, x)) in
131+
let rec loop i =
132+
if i > 0 then begin
133+
swap loc;
134+
swap loc;
135+
swap loc;
136+
swap loc;
137+
swap loc;
138+
swap loc;
139+
loop (i - 6)
140+
end
141+
in
142+
loop n_iter
47143
in
48144

49145
Times.record ~budgetf ~n_domains:1 ~init ~work ()
50146
|> Times.to_thruput_metrics ~n:n_iter ~singular:"op" ~config:name
51147

52148
let run_suite ~budgetf =
53149
[
54-
(let get x = Ref.get x in
55-
Op ("get", 10, 42, get, get));
56-
(let incr x = Ref.incr x in
57-
Op ("incr", 1, 0, incr, incr));
58-
(let push x = Ref.modify x (fun xs -> 101 :: xs)
59-
and pop x = Ref.modify x (function [] -> [] | _ :: xs -> xs) in
60-
Op ("push & pop", 2, [], push, pop));
61-
(let cas01 x = Ref.compare_and_set x 0 1
62-
and cas10 x = Ref.compare_and_set x 1 0 in
63-
Op ("cas int", 1, 0, cas01, cas10));
64-
(let xchg1 x = Ref.exchange x 1 and xchg0 x = Ref.exchange x 0 in
65-
Op ("xchg int", 1, 0, xchg1, xchg0));
66-
(let swap x = Ref.modify x (fun (x, y) -> (y, x)) in
67-
Op ("swap", 2, (4, 2), swap, swap));
150+
run_one ~budgetf Get;
151+
run_one ~budgetf Incr;
152+
run_one ~budgetf Push_and_pop;
153+
run_one ~budgetf Cas_int;
154+
run_one ~budgetf Xchg_int;
155+
run_one ~budgetf Swap;
68156
]
69-
|> List.concat_map @@ run_one ~budgetf
157+
|> List.concat

0 commit comments

Comments
 (0)