[Git][ghc/ghc][wip/tsan/cmm-codegen] 5 commits: rts: Style fixes

Ben Gamari (@bgamari) gitlab at gitlab.haskell.org
Mon Jul 24 18:33:42 UTC 2023



Ben Gamari pushed to branch wip/tsan/cmm-codegen at Glasgow Haskell Compiler / GHC


Commits:
a38fa0bf by Ben Gamari at 2023-07-24T14:33:01-04:00
rts: Style fixes

- - - - -
a7d012c9 by Ben Gamari at 2023-07-24T14:33:14-04:00
codeGen/tsan: Rework handling of spilling

- - - - -
f7decdf3 by Ben Gamari at 2023-07-24T14:33:14-04:00
hadrian: More debug information

- - - - -
d53eb92e by Ben Gamari at 2023-07-24T14:33:14-04:00
Improve TSAN documentation

- - - - -
75437706 by Ben Gamari at 2023-07-24T14:33:15-04:00
hadrian: More selective TSAN instrumentation

- - - - -


5 changed files:

- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Cmm/ThreadSanitizer.hs
- hadrian/src/Flavour.hs
- rts/Updates.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/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/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/97e297677ef8478d30157f8a1cac5cd84f9623b4...7543770667bc95d953665ecffbdeab9ac1f12940

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97e297677ef8478d30157f8a1cac5cd84f9623b4...7543770667bc95d953665ecffbdeab9ac1f12940
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/96e2a903/attachment-0001.html>


More information about the ghc-commits mailing list