[Git][ghc/ghc][master] 13 commits: compiler: Style fixes
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Aug 1 18:47:48 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d5a65af6 by Ben Gamari at 2023-08-01T14:47:18-04:00
compiler: Style fixes
- - - - -
7218c80a by Ben Gamari at 2023-08-01T14:47:19-04:00
rts: Fix implicit cast
This ensures that Task.h can be built with a C++ compiler.
- - - - -
d6d5aafc by Ben Gamari at 2023-08-01T14:47:19-04:00
testsuite: Fix warning in hs_try_putmvar001
- - - - -
d9eddf7a by Ben Gamari at 2023-08-01T14:47:19-04:00
testsuite: Add AtomicModifyIORef test
- - - - -
f9eea4ba by Ben Gamari at 2023-08-01T14:47:19-04:00
rts: Introduce NO_WARN macro
This allows fine-grained ignoring of warnings.
- - - - -
497b24ec by Ben Gamari at 2023-08-01T14:47:19-04:00
rts: Simplify atomicModifyMutVar2# implementation
Previously we would perform a redundant load in the non-threaded RTS in
atomicModifyMutVar2# implementation for the benefit of the non-moving
GC's write barrier. Eliminate this.
- - - - -
52ee082b by Ben Gamari at 2023-08-01T14:47:19-04:00
rts: Introduce more principled fence operations
- - - - -
cd3c0377 by Ben Gamari at 2023-08-01T14:47:19-04:00
rts: Introduce SET_INFO_RELAXED
- - - - -
6df2352a by Ben Gamari at 2023-08-01T14:47:19-04:00
rts: Style fixes
- - - - -
4ef6f319 by Ben Gamari at 2023-08-01T14:47:19-04:00
codeGen/tsan: Rework handling of spilling
- - - - -
f9ca7e27 by Ben Gamari at 2023-08-01T14:47:19-04:00
hadrian: More debug information
- - - - -
df4153ac by Ben Gamari at 2023-08-01T14:47:19-04:00
Improve TSAN documentation
- - - - -
fecae988 by Ben Gamari at 2023-08-01T14:47:19-04:00
hadrian: More selective TSAN instrumentation
- - - - -
17 changed files:
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/ThreadSanitizer.hs
- hadrian/src/Flavour.hs
- + libraries/base/tests/AtomicModifyIORef.hs
- + libraries/base/tests/AtomicModifyIORef.stdout
- libraries/base/tests/all.T
- rts/PrimOps.cmm
- rts/StgStdThunks.cmm
- rts/Task.h
- rts/Updates.h
- rts/include/Cmm.h
- rts/include/Rts.h
- rts/include/Stg.h
- rts/include/rts/TSANUtils.h
- rts/include/rts/storage/ClosureMacros.h
- rts/include/stg/SMP.h
- testsuite/tests/concurrent/should_run/hs_try_putmvar001_c.c
Changes:
=====================================
compiler/GHC/Cmm/Parser.y
=====================================
@@ -205,7 +205,7 @@ memory ordering guarantees. These are supported in Cmm syntax as follows:
%relaxed W_[ptr] = ...; // an atomic store with relaxed ordering semantics
%release W_[ptr] = ...; // an atomic store with release ordering semantics
- x = W_(ptr); // a non-atomic load
+ x = W_[ptr]; // a non-atomic load
x = %relaxed W_[ptr]; // an atomic load with relaxed ordering
x = %acquire W_[ptr]; // an atomic load with acquire ordering
// or equivalently...
=====================================
compiler/GHC/Cmm/ThreadSanitizer.hs
=====================================
@@ -6,7 +6,6 @@ module GHC.Cmm.ThreadSanitizer (annotateTSAN) where
import GHC.Prelude
-import GHC.StgToCmm.Utils (get_GlobalReg_addr)
import GHC.Platform
import GHC.Platform.Regs (activeStgRegs, callerSaves)
import GHC.Cmm
@@ -24,12 +23,12 @@ import GHC.Types.Unique.Supply
import Data.Maybe (fromMaybe)
data Env = Env { platform :: Platform
- , uniques :: [Unique]
+ , uniques :: UniqSupply
}
annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph
annotateTSAN platform graph = do
- env <- Env platform <$> getUniquesM
+ env <- Env platform <$> getUniqueSupplyM
return $ modifyGraph (mapGraphBlocks (annotateBlock env)) graph
mapBlockList :: (forall e' x'. n e' x' -> Block n e' x')
@@ -37,11 +36,11 @@ mapBlockList :: (forall e' x'. n e' x' -> Block n e' x')
mapBlockList f (BlockCO n rest ) = f n `blockAppend` mapBlockList f rest
mapBlockList f (BlockCC n rest m) = f n `blockAppend` mapBlockList f rest `blockAppend` f m
mapBlockList f (BlockOC rest m) = mapBlockList f rest `blockAppend` f m
-mapBlockList _ BNil = BNil
-mapBlockList f (BMiddle blk) = f blk
-mapBlockList f (BCat a b) = mapBlockList f a `blockAppend` mapBlockList f b
-mapBlockList f (BSnoc a n) = mapBlockList f a `blockAppend` f n
-mapBlockList f (BCons n a) = f n `blockAppend` mapBlockList f a
+mapBlockList _ BNil = BNil
+mapBlockList f (BMiddle blk) = f blk
+mapBlockList f (BCat a b) = mapBlockList f a `blockAppend` mapBlockList f b
+mapBlockList f (BSnoc a n) = mapBlockList f a `blockAppend` f n
+mapBlockList f (BCons n a) = f n `blockAppend` mapBlockList f a
annotateBlock :: Env -> Block CmmNode e x -> Block CmmNode e x
annotateBlock env = mapBlockList (annotateNode env)
@@ -114,10 +113,10 @@ annotatePrim :: Env
-> [CmmActual] -- ^ arguments
-> Maybe (Block CmmNode O O)
-- ^ 'Just' a block of instrumentation, if applicable
-annotatePrim env (MO_AtomicRMW w aop) [dest] [addr, val] = Just $ tsanAtomicRMW env MemOrderSeqCst aop w addr val dest
-annotatePrim env (MO_AtomicRead w mord) [dest] [addr] = Just $ tsanAtomicLoad env mord w addr dest
-annotatePrim env (MO_AtomicWrite w mord) [] [addr, val] = Just $ tsanAtomicStore env mord w val addr
-annotatePrim env (MO_Xchg w) [dest] [addr, val] = Just $ tsanAtomicExchange env MemOrderSeqCst w val addr dest
+annotatePrim env (MO_AtomicRMW w aop) [dest] [addr, val] = Just $ tsanAtomicRMW env MemOrderSeqCst aop w addr val dest
+annotatePrim env (MO_AtomicRead w mord) [dest] [addr] = Just $ tsanAtomicLoad env mord w addr dest
+annotatePrim env (MO_AtomicWrite w mord) [] [addr, val] = Just $ tsanAtomicStore env mord w val addr
+annotatePrim env (MO_Xchg w) [dest] [addr, val] = Just $ tsanAtomicExchange env MemOrderSeqCst w val addr dest
annotatePrim env (MO_Cmpxchg w) [dest] [addr, expected, new]
= Just $ tsanAtomicCas env MemOrderSeqCst MemOrderSeqCst w addr expected new dest
annotatePrim _ _ _ _ = Nothing
@@ -133,14 +132,15 @@ mkUnsafeCall env ftgt formals args =
call `blockAppend` -- perform call
restore -- restore global registers
where
- -- We are rather conservative here and just save/restore all GlobalRegs.
- (save, restore) = saveRestoreCallerRegs (platform env)
+ (save, restore) = saveRestoreCallerRegs gregs_us (platform env)
+
+ (arg_us, gregs_us) = splitUniqSupply (uniques env)
-- We also must be careful not to mention caller-saved registers in
-- arguments as Cmm-Lint checks this. To accomplish this we instead bind
-- the arguments to local registers.
arg_regs :: [CmmReg]
- arg_regs = zipWith arg_reg (uniques env) args
+ arg_regs = zipWith arg_reg (uniqsFromSupply arg_us) args
where
arg_reg :: Unique -> CmmExpr -> CmmReg
arg_reg u expr = CmmLocal $ LocalReg u (cmmExprType (platform env) expr)
@@ -150,31 +150,34 @@ mkUnsafeCall env ftgt formals args =
call = CmmUnsafeForeignCall ftgt formals (map CmmReg arg_regs)
-saveRestoreCallerRegs :: Platform
+-- | We save the contents of global registers in locals and allow the
+-- register allocator to spill them to the stack around the call.
+-- We cannot use the register table for this since we would interface
+-- with {SAVE,RESTORE}_THREAD_STATE.
+saveRestoreCallerRegs :: UniqSupply -> Platform
-> (Block CmmNode O O, Block CmmNode O O)
-saveRestoreCallerRegs platform =
+saveRestoreCallerRegs us platform =
(save, restore)
where
- regs = filter (callerSaves platform) (activeStgRegs platform)
-
- save = blockFromList (map saveReg regs)
-
- saveReg :: GlobalReg -> CmmNode O O
- saveReg reg =
- CmmStore (get_GlobalReg_addr platform reg)
- (CmmReg (CmmGlobal (GlobalRegUse reg ty)))
- NaturallyAligned
- where ty = globalRegSpillType platform reg
-
- restore = blockFromList (map restoreReg regs)
-
- restoreReg :: GlobalReg -> CmmNode O O
- restoreReg reg =
- CmmAssign (CmmGlobal (GlobalRegUse reg ty))
- (CmmLoad (get_GlobalReg_addr platform reg)
- ty
- NaturallyAligned)
- where ty = globalRegSpillType platform reg
+ regs_to_save :: [GlobalReg]
+ regs_to_save = filter (callerSaves platform) (activeStgRegs platform)
+
+ nodes :: [(CmmNode O O, CmmNode O O)]
+ nodes =
+ zipWith mk_reg regs_to_save (uniqsFromSupply us)
+ where
+ mk_reg :: GlobalReg -> Unique -> (CmmNode O O, CmmNode O O)
+ mk_reg reg u =
+ let ty = globalRegSpillType platform reg
+ greg = CmmGlobal (GlobalRegUse reg ty)
+ lreg = CmmLocal (LocalReg u ty)
+ save = CmmAssign lreg (CmmReg greg)
+ restore = CmmAssign greg (CmmReg lreg)
+ in (save, restore)
+
+ (save_nodes, restore_nodes) = unzip nodes
+ save = blockFromList save_nodes
+ restore = blockFromList restore_nodes
-- | Mirrors __tsan_memory_order
-- <https://github.com/llvm-mirror/compiler-rt/blob/master/include/sanitizer/tsan_interface_atomic.h#L32>
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -46,7 +46,8 @@ flavourTransformers = M.fromList
, "ticky_ghc" =: enableTickyGhc
, "split_sections" =: splitSections
, "no_split_sections" =: noSplitSections
- , "thread_sanitizer" =: enableThreadSanitizer
+ , "thread_sanitizer" =: enableThreadSanitizer False
+ , "thread_sanitizer_cmm" =: enableThreadSanitizer True
, "llvm" =: viaLlvmBackend
, "profiled_ghc" =: enableProfiledGhc
, "no_dynamic_ghc" =: disableDynamicGhcPrograms
@@ -151,7 +152,8 @@ werror =
-- | Build C and Haskell objects with debugging information.
enableDebugInfo :: Flavour -> Flavour
enableDebugInfo = addArgs $ notStage0 ? mconcat
- [ builder (Ghc CompileHs) ? arg "-g3"
+ [ builder (Ghc CompileHs) ? pure ["-g3"]
+ , builder (Ghc CompileCWithGhc) ? pure ["-optc-g3"]
, builder (Cc CompileC) ? arg "-g3"
, builder (Cabal Setup) ? arg "--disable-library-stripping"
, builder (Cabal Setup) ? arg "--disable-executable-stripping"
@@ -217,14 +219,18 @@ noSplitSections f = f { ghcSplitSections = False }
-- | Build GHC and libraries with ThreadSanitizer support. You likely want to
-- configure with @--disable-large-address-space@ when using this.
-enableThreadSanitizer :: Flavour -> Flavour
-enableThreadSanitizer = addArgs $ notStage0 ? mconcat
- [ builder (Ghc CompileHs) ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer")
- , builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread"
+enableThreadSanitizer :: Bool -> Flavour -> Flavour
+enableThreadSanitizer instrumentCmm = addArgs $ notStage0 ? mconcat
+ [ instrumentCmm ? builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=thread"
+
, builder (Ghc LinkHs) ? (arg "-optc-fsanitize=thread" <> arg "-optl-fsanitize=thread")
, builder Cc ? arg "-fsanitize=thread"
, builder (Cabal Flags) ? arg "thread-sanitizer"
, builder Testsuite ? arg "--config=have_thread_sanitizer=True"
+ , builder (Ghc CompileHs) ? mconcat
+ [ package pkg ? (arg "-optc-fsanitize=thread" <> arg "-fcmm-thread-sanitizer")
+ | pkg <- [base, ghcPrim, array, rts]
+ ]
]
-- | Use the LLVM backend in stages 1 and later.
=====================================
libraries/base/tests/AtomicModifyIORef.hs
=====================================
@@ -0,0 +1,21 @@
+import Control.Concurrent
+import Control.Monad
+import Data.IORef
+
+main :: IO ()
+main = do
+ let nThreads = 10
+ nIncrs = 10000000
+
+ ref <- newIORef (42 :: Int)
+ dones <- replicateM nThreads $ do
+ done <- newEmptyMVar
+ forkIO $ do
+ replicateM_ nIncrs $ atomicModifyIORef' ref $ \old -> (old + 1, ())
+ putMVar done ()
+ putStrLn "."
+ return done
+
+ mapM_ takeMVar dones
+ readIORef ref >>= print
+
=====================================
libraries/base/tests/AtomicModifyIORef.stdout
=====================================
@@ -0,0 +1,11 @@
+.
+.
+.
+.
+.
+.
+.
+.
+.
+.
+100000042
=====================================
libraries/base/tests/all.T
=====================================
@@ -308,6 +308,7 @@ test('listThreads', normal, compile_and_run, [''])
test('listThreads1', omit_ghci, compile_and_run, [''])
test('inits1tails1', normal, compile_and_run, [''])
test('CLC149', normal, compile, [''])
+test('AtomicModifyIORef', normal, compile_and_run, [''])
test('AtomicSwapIORef', normal, compile_and_run, [''])
test('T23454', normal, compile_fail, [''])
test('T23687', normal, compile_and_run, [''])
=====================================
rts/PrimOps.cmm
=====================================
@@ -785,12 +785,13 @@ stg_atomicModifyMutVar2zh ( gcptr mv, gcptr f )
(h) = prim %cmpxchgW(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y);
if (h != x) { goto retry; }
#else
- h = StgMutVar_var(mv);
StgMutVar_var(mv) = y;
#endif
- if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) {
- ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", h "ptr");
+ W_ info;
+ info = %relaxed GET_INFO(mv);
+ if (info == stg_MUT_VAR_CLEAN_info) {
+ ccall dirty_MUT_VAR(BaseReg "ptr", mv "ptr", x "ptr");
}
return (x,z);
=====================================
rts/StgStdThunks.cmm
=====================================
@@ -94,7 +94,7 @@ import CLOSURE stg_upd_frame_info;
} \
field = StgClosure_payload(UNTAG(selectee),offset); \
jump stg_ap_0_fast(field); \
- } \
+ } \
}
/* NOTE: no need to ENTER() here, we know the closure cannot
evaluate to a function, because we're going to do a field
=====================================
rts/Task.h
=====================================
@@ -288,7 +288,7 @@ INLINE_HEADER Task *
myTask (void)
{
#if defined(THREADED_RTS) && !defined(MYTASK_USE_TLV)
- return getThreadLocalVar(¤tTaskKey);
+ return (Task*) getThreadLocalVar(¤tTaskKey);
#else
return my_task;
#endif
=====================================
rts/Updates.h
=====================================
@@ -76,9 +76,9 @@ INLINE_HEADER void updateWithIndirection (Capability *cap,
/* See Note [Heap memory barriers] in SMP.h */
bdescr *bd = Bdescr((StgPtr)p1);
if (bd->gen_no != 0) {
- IF_NONMOVING_WRITE_BARRIER_ENABLED {
- updateRemembSetPushThunk(cap, (StgThunk*)p1);
- }
+ IF_NONMOVING_WRITE_BARRIER_ENABLED {
+ updateRemembSetPushThunk(cap, (StgThunk*)p1);
+ }
recordMutableCap(p1, cap, bd->gen_no);
TICK_UPD_OLD_IND();
} else {
=====================================
rts/include/Cmm.h
=====================================
@@ -596,6 +596,7 @@
/* Getting/setting the info pointer of a closure */
#define SET_INFO(p,info) StgHeader_info(p) = info
#define SET_INFO_RELEASE(p,info) %release StgHeader_info(p) = info
+#define SET_INFO_RELAXED(p,info) %relaxed StgHeader_info(p) = info
#define GET_INFO(p) StgHeader_info(p)
#define GET_INFO_ACQUIRE(p) %acquire GET_INFO(p)
@@ -687,10 +688,18 @@
#define RELEASE_FENCE prim %fence_release();
#define ACQUIRE_FENCE prim %fence_acquire();
+// TODO
+#if 1
+#define ACQUIRE_FENCE_ON(x) if (1) { W_ tmp; (tmp) = prim %load_acquire64(x); }
+#else
+#define ACQUIRE_FENCE_ON(x) ACQUIRE_FENCE
+#endif
+
#else
#define RELEASE_FENCE /* nothing */
#define ACQUIRE_FENCE /* nothing */
+#define ACQUIRE_FENCE_ON(x) /* nothing */
#endif /* THREADED_RTS */
/* -----------------------------------------------------------------------------
=====================================
rts/include/Rts.h
=====================================
@@ -236,7 +236,6 @@ void _warnFail(const char *filename, unsigned int linenum);
/* Parallel information */
#include "rts/OSThreads.h"
-#include "rts/TSANUtils.h"
#include "rts/SpinLock.h"
#include "rts/Messages.h"
=====================================
rts/include/Stg.h
=====================================
@@ -284,6 +284,17 @@
# define STG_RETURNS_NONNULL
#endif
+/* -----------------------------------------------------------------------------
+ Suppressing C warnings
+ -------------------------------------------------------------------------- */
+
+#define DO_PRAGMA(x) _Pragma(#x)
+#define NO_WARN(warnoption, ...) \
+ DO_PRAGMA(GCC diagnostic push) \
+ DO_PRAGMA(GCC diagnostic ignored #warnoption) \
+ __VA_ARGS__ \
+ DO_PRAGMA(GCC diagnostic pop)
+
/* -----------------------------------------------------------------------------
Global type definitions
-------------------------------------------------------------------------- */
@@ -382,6 +393,7 @@ external prototype return neither of these types to workaround #11395.
#include "stg/MachRegsForHost.h"
#include "stg/Regs.h"
#include "stg/Ticky.h"
+#include "rts/TSANUtils.h"
#if IN_STG_CODE
/*
=====================================
rts/include/rts/TSANUtils.h
=====================================
@@ -28,6 +28,40 @@
* In general it's best to add suppressions only as a last resort, when the
* more precise annotation functions prove to be insufficient.
*
+ * GHC can be configured with two extents of TSAN instrumentation:
+ *
+ * - instrumenting the C RTS (by passing `-optc-fsanitize=thread`
+ * when compiling the RTS)
+ *
+ * - instrumenting both the C RTS and Cmm memory accesses (by passing
+ * `-optc-fsanitize=thread -fcmm-thread-sanitizer` to all GHC invocations).
+ *
+ * These two modes can be realized in Hadrian using the `+thread_sanitizer`
+ * and `+thread_sanitizer_cmm` flavour transformers.
+ *
+ * Tips and tricks:
+ *
+ * - One should generally run TSAN instrumented programs with the environment
+ * variable
+ *
+ * TSAN_OPTIONS=suppressions=$ghc_root/rts/.tsan-suppressions
+ *
+ * to maximize signal-to-noise.
+ *
+ * - One can set a breakpoint on `__tsan_on_report` in a debugger to pause when
+ * a TSAN report is found.
+ *
+ * - TSAN-instrumented will by default exit with code 66 when a violation has
+ * been found. However, this can be disabled by setting
+ * `TSAN_OPTIONS=exitcode=0`
+ *
+ * - If TSAN is able to report useful stack traces it may help to set
+ * `TSAN_OPTIONS=history_size=3` or greater (up to 7). This increases the
+ * size of TSAN's per-thread memory access history buffer.
+ *
+ * - TSAN report messages can be redirected to a file using
+ * `TSAN_OPTIONS=log_path=...`
+ *
* Users guide: https://github.com/google/sanitizers/wiki/ThreadSanitizerCppManual
*/
=====================================
rts/include/rts/storage/ClosureMacros.h
=====================================
@@ -47,6 +47,11 @@
EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info);
EXTERN_INLINE void SET_INFO(StgClosure *c, const StgInfoTable *info) {
+ c->header.info = info;
+}
+
+EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info);
+EXTERN_INLINE void SET_INFO_RELAXED(StgClosure *c, const StgInfoTable *info) {
RELAXED_STORE(&c->header.info, info);
}
@@ -70,6 +75,7 @@ EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl (const StgInfoTable *i);
EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl (const StgInfoTable *i);
#if defined(TABLES_NEXT_TO_CODE)
+NO_WARN(-Warray-bounds,
EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;}
EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;}
EXTERN_INLINE StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;}
@@ -79,6 +85,7 @@ EXTERN_INLINE StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return (
EXTERN_INLINE StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;}
EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;}
EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;}
+)
#else
EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;}
EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;}
=====================================
rts/include/stg/SMP.h
=====================================
@@ -490,10 +490,25 @@ busy_wait_nop(void)
// These are typically necessary only in very specific cases (e.g. WSDeque)
// where the ordered operations aren't expressive enough to capture the desired
// ordering.
+//
+// Additionally, it is preferable to use the *_FENCE_ON() forms, which turn into
+// memory accesses when compiling for ThreadSanitizer (as ThreadSanitizer is
+// otherwise unable to reason about fences). See Note [ThreadSanitizer] in
+// TSANUtils.h.
+
#define ACQUIRE_FENCE() __atomic_thread_fence(__ATOMIC_ACQUIRE)
#define RELEASE_FENCE() __atomic_thread_fence(__ATOMIC_RELEASE)
#define SEQ_CST_FENCE() __atomic_thread_fence(__ATOMIC_SEQ_CST)
+#if defined(TSAN_ENABLED)
+#define ACQUIRE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_ACQUIRE);)
+#define RELEASE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_RELEASE);)
+#define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);)
+#define ACQUIRE_FENCE_ON(x) (void)ACQUIRE_LOAD(x)
+#else
+#define ACQUIRE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_ACQUIRE)
+#endif
+
/* ---------------------------------------------------------------------- */
#else /* !THREADED_RTS */
@@ -521,6 +536,8 @@ busy_wait_nop(void)
#define ACQUIRE_FENCE()
#define RELEASE_FENCE()
#define SEQ_CST_FENCE()
+#define ACQUIRE_FENCE_ON(x)
+#define RELEASE_FENCE_ON(x)
#if !IN_STG_CODE || IN_STGCRUN
INLINE_HEADER StgWord
=====================================
testsuite/tests/concurrent/should_run/hs_try_putmvar001_c.c
=====================================
@@ -10,12 +10,13 @@ struct callback {
int *presult;
};
-void* callback(struct callback *p)
+void* callback(void *p)
{
+ struct callback *cb = (struct callback *) p;
usleep(200);
- *p->presult = 42;
- hs_try_putmvar(p->cap,p->mvar);
- free(p);
+ *cb->presult = 42;
+ hs_try_putmvar(cb->cap, cb->mvar);
+ free(cb);
hs_thread_done();
return NULL;
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2bedffdc07b766f01dfcd4fc73a3859305814f3...fecae988ceeec8490d6de729567e344b6033e4b0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2bedffdc07b766f01dfcd4fc73a3859305814f3...fecae988ceeec8490d6de729567e344b6033e4b0
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/20230801/c6a4c9c5/attachment-0001.html>
More information about the ghc-commits
mailing list