1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
(* TASlock, TTASlock implementations from The Art of Multiprocessor Programming -
M.Herlihy, N. Shavit, V. Luchangco, M. Spear *)
module type LOCK = sig
type t
val create : unit -> t
val acquire : t -> unit
val release : t -> unit
end
module TASlock : LOCK = struct
type t = bool Atomic.t
let create () = Atomic.make false
let rec acquire t =
if not @@ Atomic.compare_and_set t false true then (
Domain.cpu_relax ();
acquire t)
let release t = Atomic.set t false
end
module TTASlock : LOCK = struct
type t = bool Atomic.t
let create () = Atomic.make false
let rec acquire t =
if Atomic.get t then (
Domain.cpu_relax ();
acquire t)
else if not (Atomic.compare_and_set t false true) then (
Domain.cpu_relax ();
acquire t)
let release t = Atomic.set t false
end
module TTASlock_boff : LOCK = struct
type t = bool Atomic.t
let create () = Atomic.make false
let rec acquire_ ?(backoff = Backoff.default) t =
if Atomic.get t then (
Domain.cpu_relax ();
acquire_ ~backoff t)
else if not (Atomic.compare_and_set t false true) then
acquire_ ~backoff:(Backoff.once backoff) t
let acquire t = acquire_ t
let release t = Atomic.set t false
end
|
