From 39f3ac3e1b47e9fdac8fcf2d1edcc300a37deb82 Mon Sep 17 00:00:00 2001
From: Cheng Shao <terrorjack@type.dance>
Date: Mon, 11 Mar 2024 18:34:28 +0000
Subject: [PATCH] Revert "compiler: make genSym use C-based atomic increment on
non-JS 32-bit platforms"
This reverts commit 615eb855416ce536e02ed935ecc5a6f25519ae16. It was
originally intended to fix #24449, but it was merely sweeping the bug
under the rug. 3836a110577b5c9343915fd96c1b2c64217e0082 has properly
fixed the fragile test, and we no longer need the C version of genSym.
Furthermore, the C implementation causes trouble when compiling with
clang that targets i386 due to alignment warning and libatomic linking
issue, so it makes sense to revert it.
---
compiler/GHC/Types/Unique/Supply.hs | 38 ++++-------------------------
compiler/cbits/genSym.c | 8 ------
2 files changed, 5 insertions(+), 41 deletions(-)
diff --git a/compiler/GHC/Types/Unique/Supply.hs b/compiler/GHC/Types/Unique/Supply.hs
index a809163c070b..a2bd26c2d211 100644
--- a/compiler/GHC/Types/Unique/Supply.hs
+++ b/compiler/GHC/Types/Unique/Supply.hs
@@ -7,7 +7,6 @@
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
module GHC.Types.Unique.Supply (
-- * Main data type
@@ -49,9 +48,9 @@ import Foreign.Storable
#define NO_FETCH_ADD
#endif
-#if defined(javascript_HOST_ARCH)
+#if defined(NO_FETCH_ADD)
import GHC.Exts ( atomicCasWord64Addr#, eqWord64# )
-#elif !defined(NO_FETCH_ADD)
+#else
import GHC.Exts( fetchAddWordAddr#, word64ToWord#, wordToWord64# )
#endif
@@ -233,8 +232,9 @@ mkSplitUniqSupply c
(# s4, MkSplitUniqSupply (tag .|. u) x y #)
}}}}
-#if defined(javascript_HOST_ARCH)
--- CAS-based pure Haskell implementation
+#if defined(NO_FETCH_ADD)
+-- GHC currently does not provide this operation on 32-bit platforms,
+-- hence the CAS-based implementation.
fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
-> (# State# RealWorld, Word64# #)
fetchAddWord64Addr# = go
@@ -246,35 +246,7 @@ fetchAddWord64Addr# = go
(# s2, res #)
| 1# <- res `eqWord64#` n0 -> (# s2, n0 #)
| otherwise -> go ptr inc s2
-
-#elif defined(NO_FETCH_ADD)
-
--- atomic_inc64 is defined in compiler/cbits/genSym.c. This is of
--- course not ideal, but we need to live with it for now given the
--- current situation:
--- 1. There's no Haskell primop fetchAddWord64Addr# on 32-bit
--- platforms yet
--- 2. The Cmm %fetch_add64 primop syntax is only present in ghc 9.8
--- but we currently bootstrap from older ghc in our CI
--- 3. The Cmm MO_AtomicRMW operation with 64-bit width is well
--- supported on 32-bit platforms already, but the plumbing from
--- either Haskell or Cmm doesn't work yet because of 1 or 2
--- 4. There's hs_atomic_add64 in ghc-prim cbits that we ought to use,
--- but it's only available on 32-bit starting from ghc 9.8
--- 5. The pure Haskell implementation causes mysterious i386
--- regression in unrelated ghc work that can only be fixed by the C
--- version here
-
-foreign import ccall unsafe "atomic_inc64" atomic_inc64 :: Addr# -> Word64# -> IO Word64
-
-fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
- -> (# State# RealWorld, Word64# #)
-fetchAddWord64Addr# addr inc s0 =
- case unIO (atomic_inc64 addr inc) s0 of
- (# s1, W64# res #) -> (# s1, res #)
-
#else
-
fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
-> (# State# RealWorld, Word64# #)
fetchAddWord64Addr# addr inc s0 =
diff --git a/compiler/cbits/genSym.c b/compiler/cbits/genSym.c
index ee5988ee3ba2..cac02582c2af 100644
--- a/compiler/cbits/genSym.c
+++ b/compiler/cbits/genSym.c
@@ -15,11 +15,3 @@ HsWord64 ghc_unique_counter64 = 0;
#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0)
HsInt ghc_unique_inc = 1;
#endif
-
-// Only used on 32-bit non-JS platforms
-#if WORD_SIZE_IN_BITS != 64
-StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 incr)
-{
- return __atomic_fetch_add(p, incr, __ATOMIC_SEQ_CST);
-}
-#endif
--
GitLab