atomic.c 9.75 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 121 122 123 124
// This is only provided by clang
#if !defined(__has_builtin)
#define __has_builtin(x) 0
#endif

125
extern StgWord hs_atomic_nand8(StgWord x, StgWord val);
126
StgWord
127
hs_atomic_nand8(StgWord x, StgWord val)
128
{
129
#if defined(__clang__) && __has_builtin(__sync_fetch_and_nand)
130
  CAS_NAND((volatile StgWord8 *) x, (StgWord8) val)
131
#else
132
  return __sync_fetch_and_nand((volatile StgWord8 *) x, (StgWord8) val);
133 134 135
#endif
}

136
extern StgWord hs_atomic_nand16(StgWord x, StgWord val);
137
StgWord
138
hs_atomic_nand16(StgWord x, StgWord val)
139
{
140
#if defined(__clang__) && __has_builtin(__sync_fetch_and_nand)
141
  CAS_NAND((volatile StgWord16 *) x, (StgWord16) val);
142
#else
143
  return __sync_fetch_and_nand((volatile StgWord16 *) x, (StgWord16) val);
144 145 146
#endif
}

147
extern StgWord hs_atomic_nand32(StgWord x, StgWord val);
148
StgWord
149
hs_atomic_nand32(StgWord x, StgWord val)
150
{
151
#if defined(__clang__) && __has_builtin(__sync_fetch_and_nand)
152
  CAS_NAND((volatile StgWord32 *) x, (StgWord32) val);
153
#else
154
  return __sync_fetch_and_nand((volatile StgWord32 *) x, (StgWord32) val);
155 156 157
#endif
}

158
#if WORD_SIZE_IN_BITS == 64
159
extern StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val);
160
StgWord64
161
hs_atomic_nand64(StgWord x, StgWord64 val)
162
{
163
#if defined(__clang__) && __has_builtin(__sync_fetch_and_nand)
164
  CAS_NAND((volatile StgWord64 *) x, val);
165
#else
166
  return __sync_fetch_and_nand((volatile StgWord64 *) x, val);
167 168
#endif
}
169
#endif
170 171 172

// FetchOrByteArrayOp_Int

173
extern StgWord hs_atomic_or8(StgWord x, StgWord val);
174
StgWord
175
hs_atomic_or8(StgWord x, StgWord val)
176
{
177
  return __sync_fetch_and_or((volatile StgWord8 *) x, (StgWord8) val);
178 179
}

180
extern StgWord hs_atomic_or16(StgWord x, StgWord val);
181
StgWord
182
hs_atomic_or16(StgWord x, StgWord val)
183
{
184
  return __sync_fetch_and_or((volatile StgWord16 *) x, (StgWord16) val);
185 186
}

187
extern StgWord hs_atomic_or32(StgWord x, StgWord val);
188
StgWord
189
hs_atomic_or32(StgWord x, StgWord val)
190
{
191
  return __sync_fetch_and_or((volatile StgWord32 *) x, (StgWord32) val);
192 193
}

194
#if WORD_SIZE_IN_BITS == 64
195
extern StgWord64 hs_atomic_or64(StgWord x, StgWord64 val);
196
StgWord64
197
hs_atomic_or64(StgWord x, StgWord64 val)
198
{
199
  return __sync_fetch_and_or((volatile StgWord64 *) x, val);
200
}
201
#endif
202 203 204

// FetchXorByteArrayOp_Int

205
extern StgWord hs_atomic_xor8(StgWord x, StgWord val);
206
StgWord
207
hs_atomic_xor8(StgWord x, StgWord val)
208
{
209
  return __sync_fetch_and_xor((volatile StgWord8 *) x, (StgWord8) val);
210 211
}

212
extern StgWord hs_atomic_xor16(StgWord x, StgWord val);
213
StgWord
214
hs_atomic_xor16(StgWord x, StgWord val)
215
{
216
  return __sync_fetch_and_xor((volatile StgWord16 *) x, (StgWord16) val);
217 218
}

219
extern StgWord hs_atomic_xor32(StgWord x, StgWord val);
220
StgWord
221
hs_atomic_xor32(StgWord x, StgWord val)
222
{
223
  return __sync_fetch_and_xor((volatile StgWord32 *) x, (StgWord32) val);
224 225
}

226
#if WORD_SIZE_IN_BITS == 64
227
extern StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val);
228
StgWord64
229
hs_atomic_xor64(StgWord x, StgWord64 val)
230
{
231
  return __sync_fetch_and_xor((volatile StgWord64 *) x, val);
232
}
233
#endif
234 235 236

// CasByteArrayOp_Int

237
extern StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new);
238
StgWord
239
hs_cmpxchg8(StgWord x, StgWord old, StgWord new)
240
{
241
  return __sync_val_compare_and_swap((volatile StgWord8 *) x, (StgWord8) old, (StgWord8) new);
242 243
}

244
extern StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new);
245
StgWord
246
hs_cmpxchg16(StgWord x, StgWord old, StgWord new)
247
{
248
  return __sync_val_compare_and_swap((volatile StgWord16 *) x, (StgWord16) old, (StgWord16) new);
249 250
}

251
extern StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new);
252
StgWord
253
hs_cmpxchg32(StgWord x, StgWord old, StgWord new)
254
{
255
  return __sync_val_compare_and_swap((volatile StgWord32 *) x, (StgWord32) old, (StgWord32) new);
256 257
}

258
#if WORD_SIZE_IN_BITS == 64
259
extern StgWord hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new);
260
StgWord
261
hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new)
262
{
263
  return __sync_val_compare_and_swap((volatile StgWord64 *) x, old, new);
264
}
265
#endif
266 267

// AtomicReadByteArrayOp_Int
268 269 270 271
// 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.
272 273 274 275
//
// 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.
276

277
extern StgWord hs_atomicread8(StgWord x);
278
StgWord
279
hs_atomicread8(StgWord x)
280
{
281
#if HAVE_C11_ATOMICS
282
  return __atomic_load_n((StgWord8 *) x, __ATOMIC_SEQ_CST);
283 284 285
#else
  return __sync_add_and_fetch((StgWord8 *) x, 0);
#endif
286 287
}

288
extern StgWord hs_atomicread16(StgWord x);
289
StgWord
290
hs_atomicread16(StgWord x)
291
{
292
#if HAVE_C11_ATOMICS
293
  return __atomic_load_n((StgWord16 *) x, __ATOMIC_SEQ_CST);
294 295 296
#else
  return __sync_add_and_fetch((StgWord16 *) x, 0);
#endif
297 298
}

299
extern StgWord hs_atomicread32(StgWord x);
300
StgWord
301
hs_atomicread32(StgWord x)
302
{
303
#if HAVE_C11_ATOMICS
304
  return __atomic_load_n((StgWord32 *) x, __ATOMIC_SEQ_CST);
305 306 307
#else
  return __sync_add_and_fetch((StgWord32 *) x, 0);
#endif
308 309
}

310
extern StgWord64 hs_atomicread64(StgWord x);
311
StgWord64
312
hs_atomicread64(StgWord x)
313
{
314
#if HAVE_C11_ATOMICS
315
  return __atomic_load_n((StgWord64 *) x, __ATOMIC_SEQ_CST);
316 317 318
#else
  return __sync_add_and_fetch((StgWord64 *) x, 0);
#endif
319 320 321
}

// AtomicWriteByteArrayOp_Int
322 323
// Implies a full memory barrier (see compiler/prelude/primops.txt.pp)
// __ATOMIC_SEQ_CST: Full barrier (see hs_atomicread8 above).
324

325
extern void hs_atomicwrite8(StgWord x, StgWord val);
326
void
327
hs_atomicwrite8(StgWord x, StgWord val)
328
{
329
#if HAVE_C11_ATOMICS
330
  __atomic_store_n((StgWord8 *) x, (StgWord8) val, __ATOMIC_SEQ_CST);
331 332 333
#else
  while (!__sync_bool_compare_and_swap((StgWord8 *) x, *(StgWord8 *) x, (StgWord8) val));
#endif
334 335
}

336
extern void hs_atomicwrite16(StgWord x, StgWord val);
337
void
338
hs_atomicwrite16(StgWord x, StgWord val)
339
{
340
#if HAVE_C11_ATOMICS
341
  __atomic_store_n((StgWord16 *) x, (StgWord16) val, __ATOMIC_SEQ_CST);
342 343 344
#else
  while (!__sync_bool_compare_and_swap((StgWord16 *) x, *(StgWord16 *) x, (StgWord16) val));
#endif
345 346
}

347
extern void hs_atomicwrite32(StgWord x, StgWord val);
348
void
349
hs_atomicwrite32(StgWord x, StgWord val)
350
{
351
#if HAVE_C11_ATOMICS
352
  __atomic_store_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
353 354 355
#else
  while (!__sync_bool_compare_and_swap((StgWord32 *) x, *(StgWord32 *) x, (StgWord32) val));
#endif
356 357
}

358
extern void hs_atomicwrite64(StgWord x, StgWord64 val);
359
void
360
hs_atomicwrite64(StgWord x, StgWord64 val)
361
{
362
#if HAVE_C11_ATOMICS
363
  __atomic_store_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
364 365 366
#else
  while (!__sync_bool_compare_and_swap((StgWord64 *) x, *(StgWord64 *) x, (StgWord64) val));
#endif
367
}