compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms

The pure Haskell implementation causes i386 regression in unrelated
work that can be fixed by using C-based atomic increment, see added
comment for details.

compiler/GHC/Types/Unique/Supply.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
 
 module GHC.Types.Unique.Supply (
         -- * Main data type
@@ -48,9 +49,9 @@ import Foreign.Storable
 #define NO_FETCH_ADD
 #endif
 
-#if defined(NO_FETCH_ADD)
+#if defined(javascript_HOST_ARCH)
 import GHC.Exts ( atomicCasWord64Addr#, eqWord64# )
-#else
+#elif !defined(NO_FETCH_ADD)
 import GHC.Exts( fetchAddWordAddr#, word64ToWord#, wordToWord64# )
 #endif
 
@@ -232,9 +233,8 @@ mkSplitUniqSupply c
         (# s4, MkSplitUniqSupply (tag .|. u) x y #)
         }}}}
 
-#if defined(NO_FETCH_ADD)
--- GHC currently does not provide this operation on 32-bit platforms,
--- hence the CAS-based implementation.
+#if defined(javascript_HOST_ARCH)
+-- CAS-based pure Haskell implementation
 fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
                     -> (# State# RealWorld, Word64# #)
 fetchAddWord64Addr# = go
@@ -246,7 +246,35 @@ 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 =

compiler/cbits/genSym.c

@@ -16,3 +16,14 @@ HsWord64 ghc_unique_counter64 = 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)
+{
+#if defined(HAVE_C11_ATOMICS)
+    return __atomic_fetch_add(p, incr, __ATOMIC_SEQ_CST);
+#else
+    return __sync_fetch_and_add(p, incr);
+#endif
+}
+#endif

rts/RtsSymbols.c

@@ -927,7 +927,6 @@ extern char **environ;
       SymI_HasProto(getUserEra)                                         \
       SymI_HasProto(requestHeapCensus)                                  \
       SymI_HasProto(atomic_inc)                                         \
-      SymI_HasProto(atomic_inc64)                                       \
       SymI_HasProto(atomic_dec)                                         \
       SymI_HasProto(hs_spt_lookup)                                      \
       SymI_HasProto(hs_spt_insert)                                      \

rts/include/stg/SMP.h

@@ -81,16 +81,6 @@ EXTERN_INLINE StgWord cas_seq_cst_relaxed(StgVolatilePtr p, StgWord o, StgWord n
  */
 EXTERN_INLINE StgWord atomic_inc(StgVolatilePtr p, StgWord n);
 
-
-/*
- * Atomic 64-bit addition of by the provided quantity
- *
- * atomic_inc64(p, n) {
- *   return ((*p) += n);
- * }
- */
-EXTERN_INLINE StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 n);
-
 /*
  * Atomic decrement
  *
@@ -523,16 +513,6 @@ atomic_inc(StgVolatilePtr p, StgWord incr)
 #endif
 }
 
-EXTERN_INLINE StgWord64
-atomic_inc64(StgWord64 volatile* p, StgWord64 incr)
-{
-#if defined(HAVE_C11_ATOMICS)
-    return __atomic_add_fetch(p, incr, __ATOMIC_SEQ_CST);
-#else
-    return __sync_add_and_fetch(p, incr);
-#endif
-}
-
 EXTERN_INLINE StgWord
 atomic_dec(StgVolatilePtr p)
 {
@@ -686,15 +666,6 @@ atomic_inc(StgVolatilePtr p, StgWord incr)
     return ((*p) += incr);
 }
 
-
-EXTERN_INLINE StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 incr);
-EXTERN_INLINE StgWord64
-atomic_inc64(StgWord64 volatile* p, StgWord64 incr)
-{
-    return ((*p) += incr);
-}
-
-
 INLINE_HEADER StgWord
 atomic_dec(StgVolatilePtr p)
 {