From: Debian Haskell Group <pkg-haskell-maintainers@lists.alioth.debian.org>
Date: Wed, 13 Dec 2023 10:28:47 +0000 (+0200)
Subject: use-modern-atomics
X-Git-Tag: archive/raspbian/9.4.7-2+rpi1~2^2~2
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=d629557ce59ca5ed863d76497f54116bb7e4225f;p=ghc.git

use-modern-atomics

commit f8fa1d08d7cbfef508bab355bda80f495e928f98
Author: Ben Gamari <bgamari.foss@gmail.com>
Date:   Mon Apr 17 21:04:47 2023 +0000

    ghc-prim: Use C11 atomics

    Previously `ghc-prim`'s atomic wrappers used the legacy `__sync_*`
    family of C builtins. Here we refactor these to rather use the
    appropriate C11 atomic equivalents, allowing us to be more explicit
    about the expected ordering semantics.


Gbp-Pq: Name use-modern-atomics
---

diff --git a/libraries/ghc-prim/cbits/atomic.c b/libraries/ghc-prim/cbits/atomic.c
index c15c596d..a39e4594 100644
--- a/libraries/ghc-prim/cbits/atomic.c
+++ b/libraries/ghc-prim/cbits/atomic.c
@@ -291,28 +291,36 @@ extern StgWord hs_cmpxchg8(StgWord x, StgWord old, StgWord new);
 StgWord
 hs_cmpxchg8(StgWord x, StgWord old, StgWord new)
 {
-  return __sync_val_compare_and_swap((volatile StgWord8 *) x, (StgWord8) old, (StgWord8) new);
+  StgWord8 expected = (StgWord8) old;
+  __atomic_compare_exchange_n((StgWord8 *) x, &expected, (StgWord8) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST);
+  return expected;
 }
 
 extern StgWord hs_cmpxchg16(StgWord x, StgWord old, StgWord new);
 StgWord
 hs_cmpxchg16(StgWord x, StgWord old, StgWord new)
 {
-  return __sync_val_compare_and_swap((volatile StgWord16 *) x, (StgWord16) old, (StgWord16) new);
+  StgWord16 expected = (StgWord16) old;
+  __atomic_compare_exchange_n((StgWord16 *) x, &expected, (StgWord16) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST);
+  return expected;
 }
 
 extern StgWord hs_cmpxchg32(StgWord x, StgWord old, StgWord new);
 StgWord
 hs_cmpxchg32(StgWord x, StgWord old, StgWord new)
 {
-  return __sync_val_compare_and_swap((volatile StgWord32 *) x, (StgWord32) old, (StgWord32) new);
+  StgWord32 expected = (StgWord32) old;
+  __atomic_compare_exchange_n((StgWord32 *) x, &expected, (StgWord32) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST);
+  return expected;
 }
 
 extern StgWord64 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new);
 StgWord64
 hs_cmpxchg64(StgWord x, StgWord64 old, StgWord64 new)
 {
-  return __sync_val_compare_and_swap((volatile StgWord64 *) x, old, new);
+  StgWord64 expected = (StgWord64) old;
+  __atomic_compare_exchange_n((StgWord64 *) x, &expected, (StgWord64) new, false, __ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST);
+  return expected;
 }
 
 // Atomic exchange operations