atomic.c 9.47 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 110 111 112 113 114 115 116 117 118 119

// FetchNandByteArrayOp_Int

// Workaround for http://llvm.org/bugs/show_bug.cgi?id=8842
#define CAS_NAND(x, val)                                            \
  {                                                                 \
    __typeof__ (*(x)) tmp = *(x);                                   \
    while (!__sync_bool_compare_and_swap(x, tmp, ~(tmp & (val)))) { \
      tmp = *(x);                                                   \
    }                                                               \
    return tmp;                                                     \
  }

120
extern StgWord hs_atomic_nand8(StgWord x, StgWord val);
121
StgWord
122
hs_atomic_nand8(StgWord x, StgWord val)
123 124
{
#ifdef __clang__
125
  CAS_NAND((volatile StgWord8 *) x, (StgWord8) val)
126
#else
127
  return __sync_fetch_and_nand((volatile StgWord8 *) x, (StgWord8) val);
128 129 130
#endif
}

131
extern StgWord hs_atomic_nand16(StgWord x, StgWord val);
132
StgWord
133
hs_atomic_nand16(StgWord x, StgWord val)
134 135
{
#ifdef __clang__
136
  CAS_NAND((volatile StgWord16 *) x, (StgWord16) val);
137
#else
138
  return __sync_fetch_and_nand((volatile StgWord16 *) x, (StgWord16) val);
139 140 141
#endif
}

142
extern StgWord hs_atomic_nand32(StgWord x, StgWord val);
143
StgWord
144
hs_atomic_nand32(StgWord x, StgWord val)
145 146
{
#ifdef __clang__
147
  CAS_NAND((volatile StgWord32 *) x, (StgWord32) val);
148
#else
149
  return __sync_fetch_and_nand((volatile StgWord32 *) x, (StgWord32) val);
150 151 152
#endif
}

153
#if WORD_SIZE_IN_BITS == 64
154
extern StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val);
155
StgWord64
156
hs_atomic_nand64(StgWord x, StgWord64 val)
157 158
{
#ifdef __clang__
159
  CAS_NAND((volatile StgWord64 *) x, val);
160
#else
161
  return __sync_fetch_and_nand((volatile StgWord64 *) x, val);
162 163
#endif
}
164
#endif
165 166 167

// FetchOrByteArrayOp_Int

168
extern StgWord hs_atomic_or8(StgWord x, StgWord val);
169
StgWord
170
hs_atomic_or8(StgWord x, StgWord val)
171
{
172
  return __sync_fetch_and_or((volatile StgWord8 *) x, (StgWord8) val);
173 174
}

175
extern StgWord hs_atomic_or16(StgWord x, StgWord val);
176
StgWord
177
hs_atomic_or16(StgWord x, StgWord val)
178
{
179
  return __sync_fetch_and_or((volatile StgWord16 *) x, (StgWord16) val);
180 181
}

182
extern StgWord hs_atomic_or32(StgWord x, StgWord val);
183
StgWord
184
hs_atomic_or32(StgWord x, StgWord val)
185
{
186
  return __sync_fetch_and_or((volatile StgWord32 *) x, (StgWord32) val);
187 188
}

189
#if WORD_SIZE_IN_BITS == 64
190
extern StgWord64 hs_atomic_or64(StgWord x, StgWord64 val);
191
StgWord64
192
hs_atomic_or64(StgWord x, StgWord64 val)
193
{
194
  return __sync_fetch_and_or((volatile StgWord64 *) x, val);
195
}
196
#endif
197 198 199

// FetchXorByteArrayOp_Int

200
extern StgWord hs_atomic_xor8(StgWord x, StgWord val);
201
StgWord
202
hs_atomic_xor8(StgWord x, StgWord val)
203
{
204
  return __sync_fetch_and_xor((volatile StgWord8 *) x, (StgWord8) val);
205 206
}

207
extern StgWord hs_atomic_xor16(StgWord x, StgWord val);
208
StgWord
209
hs_atomic_xor16(StgWord x, StgWord val)
210
{
211
  return __sync_fetch_and_xor((volatile StgWord16 *) x, (StgWord16) val);
212 213
}

214
extern StgWord hs_atomic_xor32(StgWord x, StgWord val);
215
StgWord
216
hs_atomic_xor32(StgWord x, StgWord val)
217
{
218
  return __sync_fetch_and_xor((volatile StgWord32 *) x, (StgWord32) val);
219 220
}

221
#if WORD_SIZE_IN_BITS == 64
222
extern StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val);
223
StgWord64
224
hs_atomic_xor64(StgWord x, StgWord64 val)
225
{
226
  return __sync_fetch_and_xor((volatile StgWord64 *) x, val);
227
}
228
#endif
229 230 231

// CasByteArrayOp_Int

232
extern StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new);
233
StgWord
234
hs_cmpxchg8(StgWord x, StgWord old, StgWord new)
235
{
236
  return __sync_val_compare_and_swap((volatile StgWord8 *) x, (StgWord8) old, (StgWord8) new);
237 238
}

239
extern StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new);
240
StgWord
241
hs_cmpxchg16(StgWord x, StgWord old, StgWord new)
242
{
243
  return __sync_val_compare_and_swap((volatile StgWord16 *) x, (StgWord16) old, (StgWord16) new);
244 245
}

246
extern StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new);
247
StgWord
248
hs_cmpxchg32(StgWord x, StgWord old, StgWord new)
249
{
250
  return __sync_val_compare_and_swap((volatile StgWord32 *) x, (StgWord32) old, (StgWord32) new);
251 252
}

253
#if WORD_SIZE_IN_BITS == 64
254
extern StgWord hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new);
255
StgWord
256
hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new)
257
{
258
  return __sync_val_compare_and_swap((volatile StgWord64 *) x, old, new);
259
}
260
#endif
261 262

// AtomicReadByteArrayOp_Int
263 264 265 266
// 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.
267 268 269 270
//
// 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.
271

272
extern StgWord hs_atomicread8(StgWord x);
273
StgWord
274
hs_atomicread8(StgWord x)
275
{
276
#if HAVE_C11_ATOMICS
277
  return __atomic_load_n((StgWord8 *) x, __ATOMIC_SEQ_CST);
278 279 280
#else
  return __sync_add_and_fetch((StgWord8 *) x, 0);
#endif
281 282
}

283
extern StgWord hs_atomicread16(StgWord x);
284
StgWord
285
hs_atomicread16(StgWord x)
286
{
287
#if HAVE_C11_ATOMICS
288
  return __atomic_load_n((StgWord16 *) x, __ATOMIC_SEQ_CST);
289 290 291
#else
  return __sync_add_and_fetch((StgWord16 *) x, 0);
#endif
292 293
}

294
extern StgWord hs_atomicread32(StgWord x);
295
StgWord
296
hs_atomicread32(StgWord x)
297
{
298
#if HAVE_C11_ATOMICS
299
  return __atomic_load_n((StgWord32 *) x, __ATOMIC_SEQ_CST);
300 301 302
#else
  return __sync_add_and_fetch((StgWord32 *) x, 0);
#endif
303 304
}

305
extern StgWord64 hs_atomicread64(StgWord x);
306
StgWord64
307
hs_atomicread64(StgWord x)
308
{
309
#if HAVE_C11_ATOMICS
310
  return __atomic_load_n((StgWord64 *) x, __ATOMIC_SEQ_CST);
311 312 313
#else
  return __sync_add_and_fetch((StgWord64 *) x, 0);
#endif
314 315 316
}

// AtomicWriteByteArrayOp_Int
317 318
// Implies a full memory barrier (see compiler/prelude/primops.txt.pp)
// __ATOMIC_SEQ_CST: Full barrier (see hs_atomicread8 above).
319

320
extern void hs_atomicwrite8(StgWord x, StgWord val);
321
void
322
hs_atomicwrite8(StgWord x, StgWord val)
323
{
324
#if HAVE_C11_ATOMICS
325
  __atomic_store_n((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
326 327 328
#else
  while (!__sync_bool_compare_and_swap((StgWord8 *) x, *(StgWord8 *) x, (StgWord8) val));
#endif
329 330
}

331
extern void hs_atomicwrite16(StgWord x, StgWord val);
332
void
333
hs_atomicwrite16(StgWord x, StgWord val)
334
{
335
#if HAVE_C11_ATOMICS
336
  __atomic_store_n((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
337 338 339
#else
  while (!__sync_bool_compare_and_swap((StgWord16 *) x, *(StgWord16 *) x, (StgWord16) val));
#endif
340 341
}

342
extern void hs_atomicwrite32(StgWord x, StgWord val);
343
void
344
hs_atomicwrite32(StgWord x, StgWord val)
345
{
346
#if HAVE_C11_ATOMICS
347
  __atomic_store_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
348 349 350
#else
  while (!__sync_bool_compare_and_swap((StgWord32 *) x, *(StgWord32 *) x, (StgWord32) val));
#endif
351 352
}

353
extern void hs_atomicwrite64(StgWord x, StgWord64 val);
354
void
355
hs_atomicwrite64(StgWord x, StgWord64 val)
356
{
357
#if HAVE_C11_ATOMICS
358
  __atomic_store_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
359 360 361
#else
  while (!__sync_bool_compare_and_swap((StgWord64 *) x, *(StgWord64 *) x, (StgWord64) val));
#endif
362
}