[Git][ghc/ghc][master] rts: always build 64-bit atomic ops
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Apr 24 16:20:00 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00
rts: always build 64-bit atomic ops
This patch does a few things:
- Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit
platforms
- Remove legacy "64bit" cabal flag of rts package
- Fix hs_xchg64 function prototype for 32-bit platforms
- Fix AtomicFetch test for wasm32
- - - - -
6 changed files:
- configure.ac
- hadrian/src/Rules/Generate.hs
- libraries/ghc-prim/cbits/atomic.c
- rts/include/stg/Prim.h
- rts/rts.cabal.in
- testsuite/tests/cmm/should_run/AtomicFetch_cmm.cmm
Changes:
=====================================
configure.ac
=====================================
@@ -904,11 +904,6 @@ FP_CHECK_SIZEOF_AND_ALIGNMENT(uint64_t)
dnl for use in settings file
TargetWordSize=$ac_cv_sizeof_void_p
-if test "x$TargetWordSize" = x8; then
- AC_SUBST([Cabal64bit],[True])
-else
- AC_SUBST([Cabal64bit],[False])
-fi
AC_SUBST(TargetWordSize)
AC_C_BIGENDIAN([TargetWordBigEndian=YES],[TargetWordBigEndian=NO])
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -295,11 +295,6 @@ rtsCabalFlags = mconcat
, flag "CabalUseSystemLibFFI" UseSystemFfi
, flag "CabalLibffiAdjustors" UseLibffiForAdjustors
, flag "CabalLeadingUnderscore" LeadingUnderscore
- , interpolateVar "Cabal64bit" $ do
- let settingWord :: Setting -> Action Word
- settingWord s = read <$> setting s
- ws <- settingWord TargetWordSize
- return $ toCabalBool (ws == 8)
]
where
flag = interpolateCabalFlag
=====================================
libraries/ghc-prim/cbits/atomic.c
=====================================
@@ -33,14 +33,12 @@ hs_atomic_add32(StgWord x, StgWord val)
return __sync_fetch_and_add((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_add64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_add64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_add((volatile StgWord64 *) x, val);
}
-#endif
// FetchSubByteArrayOp_Int
@@ -65,14 +63,12 @@ hs_atomic_sub32(StgWord x, StgWord val)
return __sync_fetch_and_sub((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_sub64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_sub64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_sub((volatile StgWord64 *) x, val);
}
-#endif
// FetchAndByteArrayOp_Int
@@ -97,14 +93,12 @@ hs_atomic_and32(StgWord x, StgWord val)
return __sync_fetch_and_and((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_and64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_and64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_and((volatile StgWord64 *) x, val);
}
-#endif
// FetchNandByteArrayOp_Int
@@ -206,7 +200,6 @@ hs_atomic_nand32(StgWord x, StgWord val)
#endif
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_nand64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_nand64(StgWord x, StgWord64 val)
@@ -217,7 +210,6 @@ hs_atomic_nand64(StgWord x, StgWord64 val)
CAS_NAND((volatile StgWord64 *) x, val);
#endif
}
-#endif
#pragma GCC diagnostic pop
@@ -244,14 +236,12 @@ hs_atomic_or32(StgWord x, StgWord val)
return __sync_fetch_and_or((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_or64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_or64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_or((volatile StgWord64 *) x, val);
}
-#endif
// FetchXorByteArrayOp_Int
@@ -276,14 +266,12 @@ hs_atomic_xor32(StgWord x, StgWord val)
return __sync_fetch_and_xor((volatile StgWord32 *) x, (StgWord32) val);
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomic_xor64(StgWord x, StgWord64 val);
StgWord64
hs_atomic_xor64(StgWord x, StgWord64 val)
{
return __sync_fetch_and_xor((volatile StgWord64 *) x, val);
}
-#endif
// CasByteArrayOp_Int
@@ -338,15 +326,13 @@ hs_xchg32(StgWord x, StgWord val)
return (StgWord) __atomic_exchange_n((StgWord32 *) x, (StgWord32) val, __ATOMIC_SEQ_CST);
}
-#if WORD_SIZE_IN_BITS == 64
//GCC provides this even on 32bit, but StgWord is still 32 bits.
-extern StgWord hs_xchg64(StgWord x, StgWord val);
-StgWord
-hs_xchg64(StgWord x, StgWord val)
+extern StgWord64 hs_xchg64(StgWord x, StgWord64 val);
+StgWord64
+hs_xchg64(StgWord x, StgWord64 val)
{
- return (StgWord) __atomic_exchange_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
+ return (StgWord64) __atomic_exchange_n((StgWord64 *) x, (StgWord64) val, __ATOMIC_SEQ_CST);
}
-#endif
// AtomicReadByteArrayOp_Int
// Implies a full memory barrier (see compiler/GHC/Builtin/primops.txt.pp)
@@ -391,7 +377,6 @@ hs_atomicread32(StgWord x)
#endif
}
-#if WORD_SIZE_IN_BITS == 64
extern StgWord64 hs_atomicread64(StgWord x);
StgWord64
hs_atomicread64(StgWord x)
@@ -402,7 +387,6 @@ hs_atomicread64(StgWord x)
return __sync_add_and_fetch((StgWord64 *) x, 0);
#endif
}
-#endif
// AtomicWriteByteArrayOp_Int
// Implies a full memory barrier (see compiler/GHC/Builtin/primops.txt.pp)
@@ -441,7 +425,6 @@ hs_atomicwrite32(StgWord x, StgWord val)
#endif
}
-#if WORD_SIZE_IN_BITS == 64
extern void hs_atomicwrite64(StgWord x, StgWord64 val);
void
hs_atomicwrite64(StgWord x, StgWord64 val)
@@ -452,6 +435,5 @@ hs_atomicwrite64(StgWord x, StgWord64 val)
while (!__sync_bool_compare_and_swap((StgWord64 *) x, *(StgWord64 *) x, (StgWord64) val));
#endif
}
-#endif
#endif
=====================================
rts/include/stg/Prim.h
=====================================
@@ -53,7 +53,7 @@ void hs_atomicwrite64(StgWord x, StgWord64 val);
StgWord hs_xchg8(StgWord x, StgWord val);
StgWord hs_xchg16(StgWord x, StgWord val);
StgWord hs_xchg32(StgWord x, StgWord val);
-StgWord hs_xchg64(StgWord x, StgWord val);
+StgWord64 hs_xchg64(StgWord x, StgWord64 val);
/* libraries/ghc-prim/cbits/bswap.c */
StgWord16 hs_bswap16(StgWord16 x);
=====================================
rts/rts.cabal.in
=====================================
@@ -45,8 +45,6 @@ flag libdw
default: @CabalHaveLibdw@
flag libnuma
default: @CabalHaveLibNuma@
-flag 64bit
- default: @Cabal64bit@
flag leading-underscore
default: @CabalLeadingUnderscore@
flag smp
@@ -289,27 +287,6 @@ library
stg/Types.h
-- See Note [Undefined symbols in the RTS]
- if flag(64bit)
- if flag(leading-underscore)
- ld-options:
- "-Wl,-u,_hs_atomic_add64"
- "-Wl,-u,_hs_atomic_sub64"
- "-Wl,-u,_hs_atomic_and64"
- "-Wl,-u,_hs_atomic_nand64"
- "-Wl,-u,_hs_atomic_or64"
- "-Wl,-u,_hs_atomic_xor64"
- "-Wl,-u,_hs_atomicread64"
- "-Wl,-u,_hs_atomicwrite64"
- else
- ld-options:
- "-Wl,-u,hs_atomic_add64"
- "-Wl,-u,hs_atomic_sub64"
- "-Wl,-u,hs_atomic_and64"
- "-Wl,-u,hs_atomic_nand64"
- "-Wl,-u,hs_atomic_or64"
- "-Wl,-u,hs_atomic_xor64"
- "-Wl,-u,hs_atomicread64"
- "-Wl,-u,hs_atomicwrite64"
if flag(leading-underscore)
ld-options:
"-Wl,-u,_base_GHCziTopHandler_runIO_closure"
@@ -357,21 +334,27 @@ library
"-Wl,-u,_hs_atomic_add8"
"-Wl,-u,_hs_atomic_add16"
"-Wl,-u,_hs_atomic_add32"
+ "-Wl,-u,_hs_atomic_add64"
"-Wl,-u,_hs_atomic_sub8"
"-Wl,-u,_hs_atomic_sub16"
"-Wl,-u,_hs_atomic_sub32"
+ "-Wl,-u,_hs_atomic_sub64"
"-Wl,-u,_hs_atomic_and8"
"-Wl,-u,_hs_atomic_and16"
"-Wl,-u,_hs_atomic_and32"
+ "-Wl,-u,_hs_atomic_and64"
"-Wl,-u,_hs_atomic_nand8"
"-Wl,-u,_hs_atomic_nand16"
"-Wl,-u,_hs_atomic_nand32"
+ "-Wl,-u,_hs_atomic_nand64"
"-Wl,-u,_hs_atomic_or8"
"-Wl,-u,_hs_atomic_or16"
"-Wl,-u,_hs_atomic_or32"
+ "-Wl,-u,_hs_atomic_or64"
"-Wl,-u,_hs_atomic_xor8"
"-Wl,-u,_hs_atomic_xor16"
"-Wl,-u,_hs_atomic_xor32"
+ "-Wl,-u,_hs_atomic_xor64"
"-Wl,-u,_hs_cmpxchg8"
"-Wl,-u,_hs_cmpxchg16"
"-Wl,-u,_hs_cmpxchg32"
@@ -383,9 +366,11 @@ library
"-Wl,-u,_hs_atomicread8"
"-Wl,-u,_hs_atomicread16"
"-Wl,-u,_hs_atomicread32"
+ "-Wl,-u,_hs_atomicread64"
"-Wl,-u,_hs_atomicwrite8"
"-Wl,-u,_hs_atomicwrite16"
"-Wl,-u,_hs_atomicwrite32"
+ "-Wl,-u,_hs_atomicwrite64"
"-Wl,-u,_base_GHCziStackziCloneStack_StackSnapshot_closure"
if flag(find-ptr)
@@ -440,21 +425,27 @@ library
"-Wl,-u,hs_atomic_add8"
"-Wl,-u,hs_atomic_add16"
"-Wl,-u,hs_atomic_add32"
+ "-Wl,-u,hs_atomic_add64"
"-Wl,-u,hs_atomic_sub8"
"-Wl,-u,hs_atomic_sub16"
"-Wl,-u,hs_atomic_sub32"
+ "-Wl,-u,hs_atomic_sub64"
"-Wl,-u,hs_atomic_and8"
"-Wl,-u,hs_atomic_and16"
"-Wl,-u,hs_atomic_and32"
+ "-Wl,-u,hs_atomic_and64"
"-Wl,-u,hs_atomic_nand8"
"-Wl,-u,hs_atomic_nand16"
"-Wl,-u,hs_atomic_nand32"
+ "-Wl,-u,hs_atomic_nand64"
"-Wl,-u,hs_atomic_or8"
"-Wl,-u,hs_atomic_or16"
"-Wl,-u,hs_atomic_or32"
+ "-Wl,-u,hs_atomic_or64"
"-Wl,-u,hs_atomic_xor8"
"-Wl,-u,hs_atomic_xor16"
"-Wl,-u,hs_atomic_xor32"
+ "-Wl,-u,hs_atomic_xor64"
"-Wl,-u,hs_cmpxchg8"
"-Wl,-u,hs_cmpxchg16"
"-Wl,-u,hs_cmpxchg32"
@@ -466,9 +457,11 @@ library
"-Wl,-u,hs_atomicread8"
"-Wl,-u,hs_atomicread16"
"-Wl,-u,hs_atomicread32"
+ "-Wl,-u,hs_atomicread64"
"-Wl,-u,hs_atomicwrite8"
"-Wl,-u,hs_atomicwrite16"
"-Wl,-u,hs_atomicwrite32"
+ "-Wl,-u,hs_atomicwrite64"
"-Wl,-u,base_GHCziStackziCloneStack_StackSnapshot_closure"
if flag(find-ptr)
=====================================
testsuite/tests/cmm/should_run/AtomicFetch_cmm.cmm
=====================================
@@ -7,17 +7,17 @@ cmm_foo64 (P_ p)
{
// p points to a ByteArray header, q points to its first element
P_ q;
- q = p + SIZEOF_StgHeader + WDS(1);
+ q = p + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload;
- bits64 x;
+ I64 x;
- prim %store_seqcst64(q, 42);
- (x) = prim %fetch_add64(q, 5);
- (x) = prim %fetch_sub64(q, 10);
- (x) = prim %fetch_and64(q, 120);
- (x) = prim %fetch_or64(q, 2);
- (x) = prim %fetch_xor64(q, 33);
- (x) = prim %fetch_nand64(q, 127);
+ prim %store_seqcst64(q, 42 :: I64);
+ (x) = prim %fetch_add64(q, 5 :: I64);
+ (x) = prim %fetch_sub64(q, 10 :: I64);
+ (x) = prim %fetch_and64(q, 120 :: I64);
+ (x) = prim %fetch_or64(q, 2 :: I64);
+ (x) = prim %fetch_xor64(q, 33 :: I64);
+ (x) = prim %fetch_nand64(q, 127 :: I64);
(x) = prim %load_seqcst64(q);
return (x);
}
@@ -26,9 +26,9 @@ cmm_foo32 (P_ p)
{
// p points to a ByteArray header, q points to its first element
P_ q;
- q = p + SIZEOF_StgHeader + WDS(1);
+ q = p + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload;
- bits32 x;
+ I32 x;
prim %store_seqcst32(q, 42);
(x) = prim %fetch_add32(q, 5);
@@ -45,9 +45,9 @@ cmm_foo16 (P_ p)
{
// p points to a ByteArray header, q points to its first element
P_ q;
- q = p + SIZEOF_StgHeader + WDS(1);
+ q = p + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload;
- bits16 x;
+ I16 x;
prim %store_seqcst16(q, 42);
(x) = prim %fetch_add16(q, 5);
@@ -64,9 +64,9 @@ cmm_foo8 (P_ p)
{
// p points to a ByteArray header, q points to its first element
P_ q;
- q = p + SIZEOF_StgHeader + WDS(1);
+ q = p + SIZEOF_StgHeader + OFFSET_StgArrBytes_payload;
- bits8 x;
+ I8 x;
prim %store_seqcst8(q, 42);
(x) = prim %fetch_add8(q, 5);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87095f6a283d95016f66f4a14a3da923c394877c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/87095f6a283d95016f66f4a14a3da923c394877c
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/20230424/75a54c5c/attachment-0001.html>
More information about the ghc-commits
mailing list