atomic.c 11.4 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
#include "Rts.h"

// Fallbacks for atomic primops on byte arrays. The builtins used
// below are supported on both GCC and LLVM.
//
// Ideally these function would take StgWord8, StgWord16, etc but
// older GCC versions incorrectly assume that the register that the
// argument is passed in has been zero extended, which is incorrect
// according to the ABI and is not what GHC does when it generates
// calls to these functions.

// FetchAddByteArrayOp_Int

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 45

// FetchSubByteArrayOp_Int

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 77

// FetchAndByteArrayOp_Int

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 109

// FetchNandByteArrayOp_Int

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
// Note [__sync_fetch_and_nand usage]
// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//
// The __sync_fetch_and_nand builtin is a bit of a disaster. It was introduced
// in GCC long ago with silly semantics. Specifically:
//
//    *ptr = ~(tmp & value)
//
// Clang introduced the builtin with the same semantics.
//
// In GCC 4.4 the operation's semantics were rightly changed to,
//
//    *ptr = ~tmp & value
//
// and the -Wsync-nand warning was added warning users of the operation about
// the change.
//
// Clang took this change as a reason to remove support for the
// builtin in 2010. Then, in 2014 Clang re-added support with the new
// semantics. However, the warning flag was given a different name
// (-Wsync-fetch-and-nand-semantics-changed) for added fun.
//
// Consequently, we are left with a bit of a mess: GHC requires GCC >4.4
// (enforced by the FP_GCC_VERSION autoconf check), so we thankfully don't need
// to support the operation's older broken semantics. However, we need to take
// care to explicitly disable -Wsync-nand wherever possible, lest the build
// fails with -Werror.  Furthermore, we need to emulate the operation when
// building with some Clang versions (shipped by some Mac OS X releases) which
// lack support for the builtin.
//
// In the words of Bob Dylan: everything is broken.
//
// See also:
//
//  * https://bugs.llvm.org/show_bug.cgi?id=8842
//  * https://ghc.haskell.org/trac/ghc/ticket/9678
//

148 149 150 151 152 153 154 155 156
#define CAS_NAND(x, val)                                            \
  {                                                                 \
    __typeof__ (*(x)) tmp = *(x);                                   \
    while (!__sync_bool_compare_and_swap(x, tmp, ~(tmp & (val)))) { \
      tmp = *(x);                                                   \
    }                                                               \
    return tmp;                                                     \
  }

157
// N.B. __has_builtin is only provided by clang
158 159 160 161
#if !defined(__has_builtin)
#define __has_builtin(x) 0
#endif

162 163 164 165 166 167
#if defined(__clang__) && !__has_builtin(__sync_fetch_and_nand)
#define USE_SYNC_FETCH_AND_NAND 0
#else
#define USE_SYNC_FETCH_AND_NAND 1
#endif

168 169
// Otherwise this fails with -Werror
#pragma GCC diagnostic push
170 171 172
#if defined(__clang__)
#pragma GCC diagnostic ignored "-Wsync-fetch-and-nand-semantics-changed"
#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 183
#else
  CAS_NAND((volatile StgWord8 *) x, (StgWord8) val)
184 185 186
#endif
}

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 194
#else
  CAS_NAND((volatile StgWord16 *) x, (StgWord16) val);
195 196 197
#endif
}

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 205
#else
  CAS_NAND((volatile StgWord32 *) x, (StgWord32) val);
206 207 208
#endif
}

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 217
#else
  CAS_NAND((volatile StgWord64 *) x, val);
218 219
#endif
}
220
#endif
221

222 223
#pragma GCC diagnostic pop

224 225
// FetchOrByteArrayOp_Int

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 257

// FetchXorByteArrayOp_Int

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 289

// CasByteArrayOp_Int

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 322 323 324
// Implies a full memory barrier (see compiler/prelude/primops.txt.pp)
// __ATOMIC_SEQ_CST: Full barrier in both directions (hoisting and sinking
// of code) and synchronizes with acquire loads and release stores in
// all threads.
325 326 327 328
//
// When we lack C11 atomics support we emulate these using the old GCC __sync
// primitives which the GCC documentation claims "usually" implies a full
// 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 337 338
#else
  return __sync_add_and_fetch((StgWord8 *) x, 0);
#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 348 349
#else
  return __sync_add_and_fetch((StgWord16 *) x, 0);
#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 359 360
#else
  return __sync_add_and_fetch((StgWord32 *) x, 0);
#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 370 371
#else
  return __sync_add_and_fetch((StgWord64 *) x, 0);
#endif
372 373 374
}

// AtomicWriteByteArrayOp_Int
375 376
// Implies a full memory barrier (see compiler/prelude/primops.txt.pp)
// __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 385 386
#else
  while (!__sync_bool_compare_and_swap((StgWord8 *) x, *(StgWord8 *) x, (StgWord8) val));
#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 396 397
#else
  while (!__sync_bool_compare_and_swap((StgWord16 *) x, *(StgWord16 *) x, (StgWord16) val));
#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 407 408
#else
  while (!__sync_bool_compare_and_swap((StgWord32 *) x, *(StgWord32 *) x, (StgWord32) val));
#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 418 419
#else
  while (!__sync_bool_compare_and_swap((StgWord64 *) x, *(StgWord64 *) x, (StgWord64) val));
#endif
420
}