[Git][ghc/ghc][wip/tsan/cmm-codegen] 7 commits: rts: Introduce more principled fence operations
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Mon Jul 24 18:17:59 UTC 2023
Ben Gamari pushed to branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC
Commits:
afdc15ea by Ben Gamari at 2023-07-24T14:13:28-04:00
rts: Introduce more principled fence operations
- - - - -
6bdb0bce by Ben Gamari at 2023-07-24T14:14:02-04:00
rts: Introduce SET_INFO_RELAXED
- - - - -
af672b66 by Ben Gamari at 2023-07-24T14:14:11-04:00
rts: Fix unsupported fence warnings with TSAN
- - - - -
9451cd1e by Ben Gamari at 2023-07-24T14:17:51-04:00
codeGen/tsan: Rework handling of spilling
- - - - -
65feb180 by Ben Gamari at 2023-07-24T14:17:51-04:00
hadrian: More debug information
- - - - -
4993f3b4 by Ben Gamari at 2023-07-24T14:17:51-04:00
Improve TSAN documentation
- - - - -
e4820538 by Ben Gamari at 2023-07-24T14:17:51-04:00
hadrian: More selective TSAN instrumentation
- - - - -
7 changed files:
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/ThreadSanitizer.hs
- hadrian/src/Flavour.hs
- rts/include/Cmm.h
- rts/include/rts/TSANUtils.h
- rts/include/rts/storage/ClosureMacros.h
- rts/include/stg/SMP.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/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/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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4045a960c7e224e3a084edc67755c3fdc2ffa70...e4820538810f0b348ee0155f90811ada0956058b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4045a960c7e224e3a084edc67755c3fdc2ffa70...e4820538810f0b348ee0155f90811ada0956058b
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/41f3711a/attachment-0001.html>
More information about the ghc-commits
mailing list