@@ -17,75 +17,303 @@ module Ref = struct
1717 let before = ! x in
1818 x := after;
1919 before
20+
21+ let incr = incr
22+
23+ let [@ inline] swap x =
24+ let l, r = ! x in
25+ x := (r, l)
26+
27+ let [@ inline] push x = x := 101 :: ! x
28+ let [@ inline] pop x = match ! x with [] -> () | _ :: xs -> x := xs
2029end
2130
22- type t =
23- | Op : string * 'a * ('a Ref .t -> _ ) * ('a Ref .t -> _ ) * [ `RW | `RO ] -> t
31+ type _ op =
32+ | Get : int op
33+ | Incr : int op
34+ | Push_and_pop : int list op
35+ | Cas_int : int op
36+ | Xchg_int : int op
37+ | Swap : (int * int ) op
2438
25- let run_one ~budgetf ?(n_iter = 250 * Util. iter_factor) ~lock_type
26- (Op ( name , value , op1 , op2 , op_kind ) ) =
39+ let run_one ( type a ) ~budgetf ?(n_iter = 250 * Util. iter_factor) ~lock_type
40+ (op : a op ) =
2741 let lock = Lock. create () in
2842 let sem = Sem. create 1 in
2943 let rwlock = Rwlock. create () in
3044
45+ let name, (value : a ) =
46+ match op with
47+ | Get -> (" get" , 42 )
48+ | Incr -> (" incr" , 0 )
49+ | Push_and_pop -> (" push & pop" , [] )
50+ | Cas_int -> (" cas int" , 0 )
51+ | Xchg_int -> (" xchg int" , 0 )
52+ | Swap -> (" swap" , (4 , 2 ))
53+ in
54+
3155 let loc = Ref. make value in
3256
3357 let init _ = () in
3458 let wrap _ () = Scheduler. run in
3559 let work _ () =
36- match (lock_type, op_kind) with
37- | `Lock , _ ->
38- let rec loop i =
39- if i > 0 then begin
40- Lock. acquire lock;
41- op1 loc |> ignore;
42- Lock. release lock;
43- Lock. acquire lock;
44- op2 loc |> ignore;
45- Lock. release lock;
46- loop (i - 2 )
47- end
48- in
49- loop n_iter
50- | `Rwlock , `RW ->
51- let rec loop i =
52- if i > 0 then begin
53- Rwlock. acquire rwlock;
54- op1 loc |> ignore;
55- Rwlock. release rwlock;
56- Rwlock. acquire rwlock;
57- op2 loc |> ignore;
58- Rwlock. release rwlock;
59- loop (i - 2 )
60- end
61- in
62- loop n_iter
63- | `Rwlock , `RO ->
64- let rec loop i =
65- if i > 0 then begin
66- Rwlock. acquire_shared rwlock;
67- op1 loc |> ignore;
68- Rwlock. release_shared rwlock;
69- Rwlock. acquire_shared rwlock;
70- op2 loc |> ignore;
71- Rwlock. release_shared rwlock;
72- loop (i - 2 )
73- end
74- in
75- loop n_iter
76- | `Sem , _ ->
77- let rec loop i =
78- if i > 0 then begin
79- Sem. acquire sem;
80- op1 loc |> ignore;
81- Sem. release sem;
82- Sem. acquire sem;
83- op2 loc |> ignore;
84- Sem. release sem;
85- loop (i - 2 )
86- end
87- in
88- loop n_iter
60+ match (lock_type, op) with
61+ | `Lock , _ -> begin
62+ let acquire = Lock. acquire and release = Lock. release and lock = lock in
63+ match op with
64+ | Get ->
65+ let rec loop i =
66+ if i > 0 then begin
67+ acquire lock;
68+ let a = ! (Sys. opaque_identity loc) in
69+ release lock;
70+ acquire lock;
71+ let b = ! (Sys. opaque_identity loc) in
72+ release lock;
73+ loop (i - 2 + (a - b))
74+ end
75+ in
76+ loop n_iter
77+ | Incr ->
78+ let rec loop i =
79+ if i > 0 then begin
80+ acquire lock;
81+ Ref. incr loc;
82+ release lock;
83+ acquire lock;
84+ Ref. incr loc;
85+ release lock;
86+ loop (i - 2 )
87+ end
88+ in
89+ loop n_iter
90+ | Push_and_pop ->
91+ let rec loop i =
92+ if i > 0 then begin
93+ acquire lock;
94+ Ref. push loc;
95+ release lock;
96+ acquire lock;
97+ Ref. pop loc |> ignore;
98+ release lock;
99+ loop (i - 2 )
100+ end
101+ in
102+ loop n_iter
103+ | Cas_int ->
104+ let rec loop i =
105+ if i > 0 then begin
106+ acquire lock;
107+ Ref. compare_and_set loc 0 1 |> ignore;
108+ release lock;
109+ acquire lock;
110+ Ref. compare_and_set loc 1 0 |> ignore;
111+ release lock;
112+ loop (i - 2 )
113+ end
114+ in
115+ loop n_iter
116+ | Xchg_int ->
117+ let rec loop i =
118+ if i > 0 then begin
119+ acquire lock;
120+ Ref. exchange loc 1 |> ignore;
121+ release lock;
122+ acquire lock;
123+ Ref. exchange loc 0 |> ignore;
124+ release lock;
125+ loop (i - 2 )
126+ end
127+ in
128+ loop n_iter
129+ | Swap ->
130+ let rec loop i =
131+ if i > 0 then begin
132+ acquire lock;
133+ Ref. swap loc;
134+ release lock;
135+ acquire lock;
136+ Ref. swap loc;
137+ release lock;
138+ loop (i - 2 )
139+ end
140+ in
141+ loop n_iter
142+ end
143+ | `Rwlock , Get -> begin
144+ let acquire = Rwlock. acquire_shared
145+ and release = Rwlock. release_shared
146+ and lock = rwlock in
147+ match op with
148+ | Get ->
149+ let rec loop i =
150+ if i > 0 then begin
151+ acquire lock;
152+ let a = ! (Sys. opaque_identity loc) in
153+ release lock;
154+ acquire lock;
155+ let b = ! (Sys. opaque_identity loc) in
156+ release lock;
157+ loop (i - 2 + (a - b))
158+ end
159+ in
160+ loop n_iter
161+ | _ -> ()
162+ end
163+ | `Rwlock , _ -> begin
164+ let acquire = Rwlock. acquire
165+ and release = Rwlock. release
166+ and lock = rwlock in
167+ match op with
168+ | Get -> ()
169+ | Incr ->
170+ let rec loop i =
171+ if i > 0 then begin
172+ acquire lock;
173+ Ref. incr loc;
174+ release lock;
175+ acquire lock;
176+ Ref. incr loc;
177+ release lock;
178+ loop (i - 2 )
179+ end
180+ in
181+ loop n_iter
182+ | Push_and_pop ->
183+ let rec loop i =
184+ if i > 0 then begin
185+ acquire lock;
186+ Ref. push loc;
187+ release lock;
188+ acquire lock;
189+ Ref. pop loc |> ignore;
190+ release lock;
191+ loop (i - 2 )
192+ end
193+ in
194+ loop n_iter
195+ | Cas_int ->
196+ let rec loop i =
197+ if i > 0 then begin
198+ acquire lock;
199+ Ref. compare_and_set loc 0 1 |> ignore;
200+ release lock;
201+ acquire lock;
202+ Ref. compare_and_set loc 1 0 |> ignore;
203+ release lock;
204+ loop (i - 2 )
205+ end
206+ in
207+ loop n_iter
208+ | Xchg_int ->
209+ let rec loop i =
210+ if i > 0 then begin
211+ acquire lock;
212+ Ref. exchange loc 1 |> ignore;
213+ release lock;
214+ acquire lock;
215+ Ref. exchange loc 0 |> ignore;
216+ release lock;
217+ loop (i - 2 )
218+ end
219+ in
220+ loop n_iter
221+ | Swap ->
222+ let rec loop i =
223+ if i > 0 then begin
224+ acquire lock;
225+ Ref. swap loc;
226+ release lock;
227+ acquire lock;
228+ Ref. swap loc;
229+ release lock;
230+ loop (i - 2 )
231+ end
232+ in
233+ loop n_iter
234+ end
235+ | `Sem , _ -> begin
236+ let acquire = Sem. acquire and release = Sem. release and lock = sem in
237+ match op with
238+ | Get ->
239+ let rec loop i =
240+ if i > 0 then begin
241+ acquire lock;
242+ let a = ! (Sys. opaque_identity loc) in
243+ release lock;
244+ acquire lock;
245+ let b = ! (Sys. opaque_identity loc) in
246+ release lock;
247+ loop (i - 2 + (a - b))
248+ end
249+ in
250+ loop n_iter
251+ | Incr ->
252+ let rec loop i =
253+ if i > 0 then begin
254+ acquire lock;
255+ Ref. incr loc;
256+ release lock;
257+ acquire lock;
258+ Ref. incr loc;
259+ release lock;
260+ loop (i - 2 )
261+ end
262+ in
263+ loop n_iter
264+ | Push_and_pop ->
265+ let rec loop i =
266+ if i > 0 then begin
267+ acquire lock;
268+ Ref. push loc;
269+ release lock;
270+ acquire lock;
271+ Ref. pop loc |> ignore;
272+ release lock;
273+ loop (i - 2 )
274+ end
275+ in
276+ loop n_iter
277+ | Cas_int ->
278+ let rec loop i =
279+ if i > 0 then begin
280+ acquire lock;
281+ Ref. compare_and_set loc 0 1 |> ignore;
282+ release lock;
283+ acquire lock;
284+ Ref. compare_and_set loc 1 0 |> ignore;
285+ release lock;
286+ loop (i - 2 )
287+ end
288+ in
289+ loop n_iter
290+ | Xchg_int ->
291+ let rec loop i =
292+ if i > 0 then begin
293+ acquire lock;
294+ Ref. exchange loc 1 |> ignore;
295+ release lock;
296+ acquire lock;
297+ Ref. exchange loc 0 |> ignore;
298+ release lock;
299+ loop (i - 2 )
300+ end
301+ in
302+ loop n_iter
303+ | Swap ->
304+ let rec loop i =
305+ if i > 0 then begin
306+ acquire lock;
307+ Ref. swap loc;
308+ release lock;
309+ acquire lock;
310+ Ref. swap loc;
311+ release lock;
312+ loop (i - 2 )
313+ end
314+ in
315+ loop n_iter
316+ end
89317 in
90318
91319 let config =
@@ -99,24 +327,14 @@ let run_one ~budgetf ?(n_iter = 250 * Util.iter_factor) ~lock_type
99327 |> Times. to_thruput_metrics ~n: n_iter ~singular: " op" ~config
100328
101329let run_suite ~budgetf =
102- Util. cross [ `Lock ; `Rwlock ; `Sem ]
103- [
104- (let get x = ! x in
105- Op (" get" , 42 , get, get, `RO ));
106- (let incr x = x := ! x + 1 in
107- Op (" incr" , 0 , incr, incr, `RW ));
108- (let push x = x := 101 :: ! x
109- and pop x = match ! x with [] -> () | _ :: xs -> x := xs in
110- Op (" push & pop" , [] , push, pop, `RW ));
111- (let cas01 x = Ref. compare_and_set x 0 1
112- and cas10 x = Ref. compare_and_set x 1 0 in
113- Op (" cas int" , 0 , cas01, cas10, `RW ));
114- (let xchg1 x = Ref. exchange x 1 and xchg0 x = Ref. exchange x 0 in
115- Op (" xchg int" , 0 , xchg1, xchg0, `RW ));
116- (let swap x =
117- let l, r = ! x in
118- x := (r, l)
119- in
120- Op (" swap" , (4 , 2 ), swap, swap, `RW ));
121- ]
122- |> List. concat_map @@ fun (lock_type , op ) -> run_one ~budgetf ~lock_type op
330+ [ `Lock ; `Rwlock ; `Sem ]
331+ |> List. concat_map @@ fun lock_type ->
332+ [
333+ run_one ~budgetf ~lock_type Get ;
334+ run_one ~budgetf ~lock_type Incr ;
335+ run_one ~budgetf ~lock_type Push_and_pop ;
336+ run_one ~budgetf ~lock_type Cas_int ;
337+ run_one ~budgetf ~lock_type Xchg_int ;
338+ run_one ~budgetf ~lock_type Swap ;
339+ ]
340+ |> List. concat
0 commit comments