Source file subatomic.ml
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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
type ('a : value_or_null) t = { mutable contents : 'a }
external make
: ('a : value_or_null).
'a -> ('a t[@local_opt])
@@ portable
= "%makemutable"
external make_contended
: ('a : value_or_null).
'a -> ('a t[@local_opt])
@@ portable
= "caml_atomic_make_contended"
external get : ('a : value_or_null). 'a t @ local -> 'a @@ portable = "%field0"
external set : ('a : value_or_null). 'a t @ local -> 'a -> unit @@ portable = "%setfield0"
module Shared = struct
external get
: ('a : value_or_null).
'a t @ local shared -> 'a @ shared
@@ portable
= "%atomic_load"
external set
: ('a : value_or_null mod contended).
'a t @ local shared -> 'a -> unit
@@ portable
= "%atomic_set"
external exchange
: ('a : value_or_null mod contended).
'a t @ local shared -> 'a -> 'a
@@ portable
= "%atomic_exchange"
external compare_and_set
: ('a : value_or_null mod contended).
'a t @ local shared -> 'a -> 'a -> bool
@@ portable
= "%atomic_cas"
external compare_exchange
: ('a : value_or_null mod contended).
'a t @ local shared -> 'a -> 'a -> 'a
@@ portable
= "%atomic_compare_exchange"
external fetch_and_add
: int t @ local shared
-> int
-> int
@@ portable
= "%atomic_fetch_add"
external add : int t @ local shared -> int -> unit @@ portable = "%atomic_add"
external sub : int t @ local shared -> int -> unit @@ portable = "%atomic_sub"
external logand : int t @ local shared -> int -> unit @@ portable = "%atomic_land"
external logor : int t @ local shared -> int -> unit @@ portable = "%atomic_lor"
external logxor : int t @ local shared -> int -> unit @@ portable = "%atomic_lxor"
let incr r = add r 1
let decr r = sub r 1
end
module Loc = struct
type record : mutable_data
type repr = record * int
type (!'a : value_or_null) t : mutable_data with 'a
external unsafe_of_atomic_loc
: ('a : value_or_null).
('a Stdlib.Atomic.Loc.t[@local_opt]) -> ('a t[@local_opt])
@@ portable
= "%identity"
external to_repr
: ('a : value_or_null).
('a t[@local_opt]) -> (repr[@local_opt])
@@ portable
= "%identity"
external field
: ('a : value_or_null).
record @ local -> int -> 'a
@@ portable
= "%obj_field"
let get t =
let r, n = to_repr t in
field (Sys.opaque_identity r) n
;;
external set_field
: ('a : value_or_null).
record @ local -> int -> 'a -> unit
@@ portable
= "%obj_set_field"
let set t v =
let r, n = to_repr t in
set_field (Sys.opaque_identity r) n v
;;
module Shared = struct
external unsafe_of_atomic_loc
: ('a : value_or_null).
('a Stdlib.Atomic.Loc.t[@local_opt]) @ shared -> ('a t[@local_opt]) @ shared
@@ portable
= "%identity"
external get
: ('a : value_or_null).
'a t @ local shared -> 'a @ shared
@@ portable
= "%atomic_load_loc"
external set
: ('a : value_or_null mod contended).
'a t @ local shared -> 'a -> unit
@@ portable
= "%atomic_set_loc"
external exchange
: ('a : value_or_null mod contended).
'a t @ local shared -> 'a -> 'a
@@ portable
= "%atomic_exchange_loc"
external compare_and_set
: ('a : value_or_null mod contended).
'a t @ local shared -> 'a -> 'a -> bool
@@ portable
= "%atomic_cas_loc"
external compare_exchange
: ('a : value_or_null mod contended).
'a t @ local shared -> 'a -> 'a -> 'a
@@ portable
= "%atomic_compare_exchange_loc"
external fetch_and_add
: int t @ local shared
-> int
-> int
@@ portable
= "%atomic_fetch_add_loc"
external add : int t @ local shared -> int -> unit @@ portable = "%atomic_add_loc"
external sub : int t @ local shared -> int -> unit @@ portable = "%atomic_sub_loc"
external logand : int t @ local shared -> int -> unit @@ portable = "%atomic_land_loc"
external logor : int t @ local shared -> int -> unit @@ portable = "%atomic_lor_loc"
external logxor : int t @ local shared -> int -> unit @@ portable = "%atomic_lxor_loc"
let incr r = add r 1
let decr r = sub r 1
end
end