Update Trac ticket URLs to point to GitLab
[ghc.git] / libraries / ghc-prim / cbits / atomic.c
1 #include "Rts.h"
2
3 // Fallbacks for atomic primops on byte arrays. The builtins used
4 // below are supported on both GCC and LLVM.
5 //
6 // Ideally these function would take StgWord8, StgWord16, etc but
7 // older GCC versions incorrectly assume that the register that the
8 // argument is passed in has been zero extended, which is incorrect
9 // according to the ABI and is not what GHC does when it generates
10 // calls to these functions.
11
12 // FetchAddByteArrayOp_Int
13
14 extern StgWord hs_atomic_add8(StgWord x, StgWord val);
15 StgWord
16 hs_atomic_add8(StgWord x, StgWord val)
17 {
18 return __sync_fetch_and_add((volatile StgWord8 *) x, (StgWord8) val);
19 }
20
21 extern StgWord hs_atomic_add16(StgWord x, StgWord val);
22 StgWord
23 hs_atomic_add16(StgWord x, StgWord val)
24 {
25 return __sync_fetch_and_add((volatile StgWord16 *) x, (StgWord16) val);
26 }
27
28 extern StgWord hs_atomic_add32(StgWord x, StgWord val);
29 StgWord
30 hs_atomic_add32(StgWord x, StgWord val)
31 {
32 return __sync_fetch_and_add((volatile StgWord32 *) x, (StgWord32) val);
33 }
34
35 #if WORD_SIZE_IN_BITS == 64
36 extern StgWord64 hs_atomic_add64(StgWord x, StgWord64 val);
37 StgWord64
38 hs_atomic_add64(StgWord x, StgWord64 val)
39 {
40 return __sync_fetch_and_add((volatile StgWord64 *) x, val);
41 }
42 #endif
43
44 // FetchSubByteArrayOp_Int
45
46 extern StgWord hs_atomic_sub8(StgWord x, StgWord val);
47 StgWord
48 hs_atomic_sub8(StgWord x, StgWord val)
49 {
50 return __sync_fetch_and_sub((volatile StgWord8 *) x, (StgWord8) val);
51 }
52
53 extern StgWord hs_atomic_sub16(StgWord x, StgWord val);
54 StgWord
55 hs_atomic_sub16(StgWord x, StgWord val)
56 {
57 return __sync_fetch_and_sub((volatile StgWord16 *) x, (StgWord16) val);
58 }
59
60 extern StgWord hs_atomic_sub32(StgWord x, StgWord val);
61 StgWord
62 hs_atomic_sub32(StgWord x, StgWord val)
63 {
64 return __sync_fetch_and_sub((volatile StgWord32 *) x, (StgWord32) val);
65 }
66
67 #if WORD_SIZE_IN_BITS == 64
68 extern StgWord64 hs_atomic_sub64(StgWord x, StgWord64 val);
69 StgWord64
70 hs_atomic_sub64(StgWord x, StgWord64 val)
71 {
72 return __sync_fetch_and_sub((volatile StgWord64 *) x, val);
73 }
74 #endif
75
76 // FetchAndByteArrayOp_Int
77
78 extern StgWord hs_atomic_and8(StgWord x, StgWord val);
79 StgWord
80 hs_atomic_and8(StgWord x, StgWord val)
81 {
82 return __sync_fetch_and_and((volatile StgWord8 *) x, (StgWord8) val);
83 }
84
85 extern StgWord hs_atomic_and16(StgWord x, StgWord val);
86 StgWord
87 hs_atomic_and16(StgWord x, StgWord val)
88 {
89 return __sync_fetch_and_and((volatile StgWord16 *) x, (StgWord16) val);
90 }
91
92 extern StgWord hs_atomic_and32(StgWord x, StgWord val);
93 StgWord
94 hs_atomic_and32(StgWord x, StgWord val)
95 {
96 return __sync_fetch_and_and((volatile StgWord32 *) x, (StgWord32) val);
97 }
98
99 #if WORD_SIZE_IN_BITS == 64
100 extern StgWord64 hs_atomic_and64(StgWord x, StgWord64 val);
101 StgWord64
102 hs_atomic_and64(StgWord x, StgWord64 val)
103 {
104 return __sync_fetch_and_and((volatile StgWord64 *) x, val);
105 }
106 #endif
107
108 // FetchNandByteArrayOp_Int
109
110 // Note [__sync_fetch_and_nand usage]
111 // ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
112 //
113 // The __sync_fetch_and_nand builtin is a bit of a disaster. It was introduced
114 // in GCC long ago with silly semantics. Specifically:
115 //
116 // *ptr = ~(tmp & value)
117 //
118 // Clang introduced the builtin with the same semantics.
119 //
120 // In GCC 4.4 the operation's semantics were rightly changed to,
121 //
122 // *ptr = ~tmp & value
123 //
124 // and the -Wsync-nand warning was added warning users of the operation about
125 // the change.
126 //
127 // Clang took this change as a reason to remove support for the
128 // builtin in 2010. Then, in 2014 Clang re-added support with the new
129 // semantics. However, the warning flag was given a different name
130 // (-Wsync-fetch-and-nand-semantics-changed) for added fun.
131 //
132 // Consequently, we are left with a bit of a mess: GHC requires GCC >4.4
133 // (enforced by the FP_GCC_VERSION autoconf check), so we thankfully don't need
134 // to support the operation's older broken semantics. However, we need to take
135 // care to explicitly disable -Wsync-nand wherever possible, lest the build
136 // fails with -Werror. Furthermore, we need to emulate the operation when
137 // building with some Clang versions (shipped by some Mac OS X releases) which
138 // lack support for the builtin.
139 //
140 // In the words of Bob Dylan: everything is broken.
141 //
142 // See also:
143 //
144 // * https://bugs.llvm.org/show_bug.cgi?id=8842
145 // * https://gitlab.haskell.org/ghc/ghc/issues/9678
146 //
147
148 #define CAS_NAND(x, val) \
149 { \
150 __typeof__ (*(x)) tmp = *(x); \
151 while (!__sync_bool_compare_and_swap(x, tmp, ~(tmp & (val)))) { \
152 tmp = *(x); \
153 } \
154 return tmp; \
155 }
156
157 // N.B. __has_builtin is only provided by clang
158 #if !defined(__has_builtin)
159 #define __has_builtin(x) 0
160 #endif
161
162 #if defined(__clang__) && !__has_builtin(__sync_fetch_and_nand)
163 #define USE_SYNC_FETCH_AND_NAND 0
164 #else
165 #define USE_SYNC_FETCH_AND_NAND 1
166 #endif
167
168 // Otherwise this fails with -Werror
169 #pragma GCC diagnostic push
170 #if defined(__clang__)
171 #pragma GCC diagnostic ignored "-Wsync-fetch-and-nand-semantics-changed"
172 #elif defined(__GNUC__)
173 #pragma GCC diagnostic ignored "-Wsync-nand"
174 #endif
175
176 extern StgWord hs_atomic_nand8(StgWord x, StgWord val);
177 StgWord
178 hs_atomic_nand8(StgWord x, StgWord val)
179 {
180 #if USE_SYNC_FETCH_AND_NAND
181 return __sync_fetch_and_nand((volatile StgWord8 *) x, (StgWord8) val);
182 #else
183 CAS_NAND((volatile StgWord8 *) x, (StgWord8) val)
184 #endif
185 }
186
187 extern StgWord hs_atomic_nand16(StgWord x, StgWord val);
188 StgWord
189 hs_atomic_nand16(StgWord x, StgWord val)
190 {
191 #if USE_SYNC_FETCH_AND_NAND
192 return __sync_fetch_and_nand((volatile StgWord16 *) x, (StgWord16) val);
193 #else
194 CAS_NAND((volatile StgWord16 *) x, (StgWord16) val);
195 #endif
196 }
197
198 extern StgWord hs_atomic_nand32(StgWord x, StgWord val);
199 StgWord
200 hs_atomic_nand32(StgWord x, StgWord val)
201 {
202 #if USE_SYNC_FETCH_AND_NAND
203 return __sync_fetch_and_nand((volatile StgWord32 *) x, (StgWord32) val);
204 #else
205 CAS_NAND((volatile StgWord32 *) x, (StgWord32) val);
206 #endif
207 }
208
209 #if WORD_SIZE_IN_BITS == 64
210 extern StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val);
211 StgWord64
212 hs_atomic_nand64(StgWord x, StgWord64 val)
213 {
214 #if USE_SYNC_FETCH_AND_NAND
215 return __sync_fetch_and_nand((volatile StgWord64 *) x, val);
216 #else
217 CAS_NAND((volatile StgWord64 *) x, val);
218 #endif
219 }
220 #endif
221
222 #pragma GCC diagnostic pop
223
224 // FetchOrByteArrayOp_Int
225
226 extern StgWord hs_atomic_or8(StgWord x, StgWord val);
227 StgWord
228 hs_atomic_or8(StgWord x, StgWord val)
229 {
230 return __sync_fetch_and_or((volatile StgWord8 *) x, (StgWord8) val);
231 }
232
233 extern StgWord hs_atomic_or16(StgWord x, StgWord val);
234 StgWord
235 hs_atomic_or16(StgWord x, StgWord val)
236 {
237 return __sync_fetch_and_or((volatile StgWord16 *) x, (StgWord16) val);
238 }
239
240 extern StgWord hs_atomic_or32(StgWord x, StgWord val);
241 StgWord
242 hs_atomic_or32(StgWord x, StgWord val)
243 {
244 return __sync_fetch_and_or((volatile StgWord32 *) x, (StgWord32) val);
245 }
246
247 #if WORD_SIZE_IN_BITS == 64
248 extern StgWord64 hs_atomic_or64(StgWord x, StgWord64 val);
249 StgWord64
250 hs_atomic_or64(StgWord x, StgWord64 val)
251 {
252 return __sync_fetch_and_or((volatile StgWord64 *) x, val);
253 }
254 #endif
255
256 // FetchXorByteArrayOp_Int
257
258 extern StgWord hs_atomic_xor8(StgWord x, StgWord val);
259 StgWord
260 hs_atomic_xor8(StgWord x, StgWord val)
261 {
262 return __sync_fetch_and_xor((volatile StgWord8 *) x, (StgWord8) val);
263 }
264
265 extern StgWord hs_atomic_xor16(StgWord x, StgWord val);
266 StgWord
267 hs_atomic_xor16(StgWord x, StgWord val)
268 {
269 return __sync_fetch_and_xor((volatile StgWord16 *) x, (StgWord16) val);
270 }
271
272 extern StgWord hs_atomic_xor32(StgWord x, StgWord val);
273 StgWord
274 hs_atomic_xor32(StgWord x, StgWord val)
275 {
276 return __sync_fetch_and_xor((volatile StgWord32 *) x, (StgWord32) val);
277 }
278
279 #if WORD_SIZE_IN_BITS == 64
280 extern StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val);
281 StgWord64
282 hs_atomic_xor64(StgWord x, StgWord64 val)
283 {
284 return __sync_fetch_and_xor((volatile StgWord64 *) x, val);
285 }
286 #endif
287
288 // CasByteArrayOp_Int
289
290 extern StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new);
291 StgWord
292 hs_cmpxchg8(StgWord x, StgWord old, StgWord new)
293 {
294 return __sync_val_compare_and_swap((volatile StgWord8 *) x, (StgWord8) old, (StgWord8) new);
295 }
296
297 extern StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new);
298 StgWord
299 hs_cmpxchg16(StgWord x, StgWord old, StgWord new)
300 {
301 return __sync_val_compare_and_swap((volatile StgWord16 *) x, (StgWord16) old, (StgWord16) new);
302 }
303
304 extern StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new);
305 StgWord
306 hs_cmpxchg32(StgWord x, StgWord old, StgWord new)
307 {
308 return __sync_val_compare_and_swap((volatile StgWord32 *) x, (StgWord32) old, (StgWord32) new);
309 }
310
311 #if WORD_SIZE_IN_BITS == 64
312 extern StgWord hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new);
313 StgWord
314 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new)
315 {
316 return __sync_val_compare_and_swap((volatile StgWord64 *) x, old, new);
317 }
318 #endif
319
320 // AtomicReadByteArrayOp_Int
321 // Implies a full memory barrier (see compiler/prelude/primops.txt.pp)
322 // __ATOMIC_SEQ_CST: Full barrier in both directions (hoisting and sinking
323 // of code) and synchronizes with acquire loads and release stores in
324 // all threads.
325 //
326 // When we lack C11 atomics support we emulate these using the old GCC __sync
327 // primitives which the GCC documentation claims "usually" implies a full
328 // barrier.
329
330 extern StgWord hs_atomicread8(StgWord x);
331 StgWord
332 hs_atomicread8(StgWord x)
333 {
334 #if HAVE_C11_ATOMICS
335 return __atomic_load_n((StgWord8 *) x, __ATOMIC_SEQ_CST);
336 #else
337 return __sync_add_and_fetch((StgWord8 *) x, 0);
338 #endif
339 }
340
341 extern StgWord hs_atomicread16(StgWord x);
342 StgWord
343 hs_atomicread16(StgWord x)
344 {
345 #if HAVE_C11_ATOMICS
346 return __atomic_load_n((StgWord16 *) x, __ATOMIC_SEQ_CST);
347 #else
348 return __sync_add_and_fetch((StgWord16 *) x, 0);
349 #endif
350 }
351
352 extern StgWord hs_atomicread32(StgWord x);
353 StgWord
354 hs_atomicread32(StgWord x)
355 {
356 #if HAVE_C11_ATOMICS
357 return __atomic_load_n((StgWord32 *) x, __ATOMIC_SEQ_CST);
358 #else
359 return __sync_add_and_fetch((StgWord32 *) x, 0);
360 #endif
361 }
362
363 extern StgWord64 hs_atomicread64(StgWord x);
364 StgWord64
365 hs_atomicread64(StgWord x)
366 {
367 #if HAVE_C11_ATOMICS
368 return __atomic_load_n((StgWord64 *) x, __ATOMIC_SEQ_CST);
369 #else
370 return __sync_add_and_fetch((StgWord64 *) x, 0);
371 #endif
372 }
373
374 // AtomicWriteByteArrayOp_Int
375 // Implies a full memory barrier (see compiler/prelude/primops.txt.pp)
376 // __ATOMIC_SEQ_CST: Full barrier (see hs_atomicread8 above).
377
378 extern void hs_atomicwrite8(StgWord x, StgWord val);
379 void
380 hs_atomicwrite8(StgWord x, StgWord val)
381 {
382 #if HAVE_C11_ATOMICS
383 __atomic_store_n((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
384 #else
385 while (!__sync_bool_compare_and_swap((StgWord8 *) x, *(StgWord8 *) x, (StgWord8) val));
386 #endif
387 }
388
389 extern void hs_atomicwrite16(StgWord x, StgWord val);
390 void
391 hs_atomicwrite16(StgWord x, StgWord val)
392 {
393 #if HAVE_C11_ATOMICS
394 __atomic_store_n((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
395 #else
396 while (!__sync_bool_compare_and_swap((StgWord16 *) x, *(StgWord16 *) x, (StgWord16) val));
397 #endif
398 }
399
400 extern void hs_atomicwrite32(StgWord x, StgWord val);
401 void
402 hs_atomicwrite32(StgWord x, StgWord val)
403 {
404 #if HAVE_C11_ATOMICS
405 __atomic_store_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
406 #else
407 while (!__sync_bool_compare_and_swap((StgWord32 *) x, *(StgWord32 *) x, (StgWord32) val));
408 #endif
409 }
410
411 extern void hs_atomicwrite64(StgWord x, StgWord64 val);
412 void
413 hs_atomicwrite64(StgWord x, StgWord64 val)
414 {
415 #if HAVE_C11_ATOMICS
416 __atomic_store_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
417 #else
418 while (!__sync_bool_compare_and_swap((StgWord64 *) x, *(StgWord64 *) x, (StgWord64) val));
419 #endif
420 }