[Git][ghc/ghc][wip/tsan/cmm-codegen] 6 commits: rts: Introduce NO_WARN macro
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Mon Jul 24 18:00:22 UTC 2023
Ben Gamari pushed to branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC
Commits:
df059575 by Ben Gamari at 2023-07-24T13:58:58-04:00
rts: Introduce NO_WARN macro
This allows fine-grained ignoring of warnings.
- - - - -
04b2fc72 by Ben Gamari at 2023-07-24T13:59:28-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.
- - - - -
47cefc2c by Ben Gamari at 2023-07-24T13:59:45-04:00
codeGen/tsan: Rework handling of spilling
- - - - -
0908d5aa by Ben Gamari at 2023-07-24T13:59:46-04:00
hadrian: More debug information
- - - - -
a5447054 by Ben Gamari at 2023-07-24T13:59:46-04:00
Improve TSAN documentation
- - - - -
e4045a96 by Ben Gamari at 2023-07-24T13:59:46-04:00
hadrian: More selective TSAN instrumentation
- - - - -
6 changed files:
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/ThreadSanitizer.hs
- hadrian/src/Flavour.hs
- rts/PrimOps.cmm
- rts/include/Stg.h
- rts/include/rts/TSANUtils.h
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')
@@ -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
=====================================
@@ -47,7 +47,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
@@ -152,7 +153,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"
@@ -218,14 +220,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.
=====================================
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/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
-------------------------------------------------------------------------- */
=====================================
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
*/
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4af5ca8d0c20fd13289ea28135b9525e3ba642d0...e4045a960c7e224e3a084edc67755c3fdc2ffa70
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4af5ca8d0c20fd13289ea28135b9525e3ba642d0...e4045a960c7e224e3a084edc67755c3fdc2ffa70
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/20230724/58367c6d/attachment-0001.html>
More information about the ghc-commits
mailing list