[Git][ghc/ghc][master] 2 commits: Revert "compiler: make genSym use C-based atomic increment on non-JS 32-bit platforms"
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Mar 12 23:27:47 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
39f3ac3e by Cheng Shao at 2024-03-12T19:27:11-04:00
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.
- - - - -
e6bfb85c by Cheng Shao at 2024-03-12T19:27:11-04:00
compiler: fix out-of-bound memory access of genSym on 32-bit
This commit fixes an unnoticed out-of-bound memory access of genSym on
32-bit. ghc_unique_inc is 32-bit sized/aligned on 32-bit platforms,
but we mistakenly treat it as a Word64 pointer in genSym, and
therefore will accidentally load 2 garbage higher bytes, or with a
small but non-zero chance, overwrite something else in the data
section depends on how the linker places the data segments. This
regression was introduced in !11802 and fixed here.
- - - - -
2 changed files:
- compiler/GHC/Types/Unique/Supply.hs
- compiler/cbits/genSym.c
Changes:
=====================================
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,16 +48,16 @@ import Foreign.Storable
#define NO_FETCH_ADD
#endif
-#if defined(javascript_HOST_ARCH)
-import GHC.Exts ( atomicCasWord64Addr#, eqWord64# )
-#elif !defined(NO_FETCH_ADD)
-import GHC.Exts( fetchAddWordAddr#, word64ToWord#, wordToWord64# )
+#if defined(NO_FETCH_ADD)
+import GHC.Exts ( atomicCasWord64Addr#, eqWord64#, readWord64OffAddr# )
+#else
+import GHC.Exts( fetchAddWordAddr#, word64ToWord# )
#endif
import GHC.Exts ( Addr#, State#, Word64#, RealWorld )
-
+import GHC.Int ( Int(..) )
import GHC.Word( Word64(..) )
-import GHC.Exts( plusWord64#, readWord64OffAddr# )
+import GHC.Exts( plusWord64#, int2Word#, wordToWord64# )
{-
************************************************************************
@@ -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 =
@@ -286,9 +258,9 @@ genSym :: IO Word64
genSym = do
let !mask = (1 `unsafeShiftL` uNIQUE_BITS) - 1
let !(Ptr counter) = ghc_unique_counter64
- let !(Ptr inc_ptr) = ghc_unique_inc
- u <- IO $ \s0 -> case readWord64OffAddr# inc_ptr 0# s0 of
- (# s1, inc #) -> case fetchAddWord64Addr# counter inc s1 of
+ I# inc# <- peek ghc_unique_inc
+ let !inc = wordToWord64# (int2Word# inc#)
+ u <- IO $ \s1 -> case fetchAddWord64Addr# counter inc s1 of
(# s2, val #) ->
let !u = W64# (val `plusWord64#` inc) .&. mask
in (# s2, u #)
=====================================
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea971d314c4eba59e12e94bf3eb8edb95fbfac5...e6bfb85c842edca36754bb8914e725fbaa1a83a6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea971d314c4eba59e12e94bf3eb8edb95fbfac5...e6bfb85c842edca36754bb8914e725fbaa1a83a6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240312/ca650885/attachment-0001.html>
More information about the ghc-commits
mailing list