codeGen: Introduce ThreadSanitizer instrumentation

This introduces a new Cmm pass which instruments the program with
ThreadSanitizer annotations, allowing full tracking of mutator memory
accesses via TSAN.

11 files changed, 363 insertions, 2 deletions

diff --git a/compiler/GHC/Cmm/Config.hs b/compiler/GHC/Cmm/Config.hs
index 415becd109..4c8f8f2280 100644
--- a/compiler/GHC/Cmm/Config.hs
+++ b/compiler/GHC/Cmm/Config.hs
@@ -19,6 +19,7 @@ data CmmConfig = CmmConfig
   , cmmDoLinting           :: !Bool    -- ^ Do Cmm Linting Optimization or not
   , cmmOptElimCommonBlks   :: !Bool    -- ^ Eliminate common blocks or not
   , cmmOptSink             :: !Bool    -- ^ Perform sink after stack layout or not
+  , cmmOptThreadSanitizer  :: !Bool    -- ^ Instrument memory accesses for ThreadSanitizer
   , cmmGenStackUnwindInstr :: !Bool    -- ^ Generate stack unwinding instructions (for debugging)
   , cmmExternalDynamicRefs :: !Bool    -- ^ Generate code to link against dynamic libraries
   , cmmDoCmmSwitchPlans    :: !Bool    -- ^ Should the Cmm pass replace Stg switch statements
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs
index c0a37cd3bc..9a5a5aa338 100644
--- a/compiler/GHC/Cmm/Pipeline.hs
+++ b/compiler/GHC/Cmm/Pipeline.hs
@@ -19,6 +19,7 @@ import GHC.Cmm.LayoutStack
 import GHC.Cmm.ProcPoint
 import GHC.Cmm.Sink
 import GHC.Cmm.Switch.Implement
+import GHC.Cmm.ThreadSanitizer
 
 import GHC.Types.Unique.Supply
 
@@ -98,6 +99,13 @@ cpsTop logger platform cfg proc =
              else pure g
       dump Opt_D_dump_cmm_switch "Post switch plan" g
 
+      ----------- ThreadSanitizer instrumentation -----------------------------
+      g <- {-# SCC "annotateTSAN" #-}
+          if cmmOptThreadSanitizer cfg
+          then runUniqSM $ annotateTSAN platform g
+          else return g
+      dump Opt_D_dump_cmm_thread_sanitizer "ThreadSanitizer instrumentation" g
+
       ----------- Proc points -------------------------------------------------
       let
         call_pps :: ProcPointSet -- LabelMap
diff --git a/compiler/GHC/Cmm/ThreadSanitizer.hs b/compiler/GHC/Cmm/ThreadSanitizer.hs
new file mode 100644
index 0000000000..0200654ae2
--- /dev/null
+++ b/compiler/GHC/Cmm/ThreadSanitizer.hs
@@ -0,0 +1,285 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+
+-- | Annotate a CmmGraph with ThreadSanitizer instrumentation calls.
+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
+import GHC.Cmm.Utils
+import GHC.Cmm.CLabel
+import GHC.Cmm.Dataflow
+import GHC.Cmm.Dataflow.Block
+import GHC.Cmm.Dataflow.Graph
+import GHC.Data.FastString
+import GHC.Types.Basic
+import GHC.Types.ForeignCall
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
+
+import Data.Maybe (fromMaybe)
+
+data Env = Env { platform :: Platform
+               , uniques :: [Unique]
+               }
+
+annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph
+annotateTSAN platform graph = do
+    env <- Env platform <$> getUniquesM
+    return $ modifyGraph (mapGraphBlocks (annotateBlock env)) graph
+
+mapBlockList :: (forall e' x'. n e' x' -> Block n e' x')
+             -> Block 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
+
+annotateBlock :: Env -> Block CmmNode e x -> Block CmmNode e x
+annotateBlock env = mapBlockList (annotateNode env)
+
+annotateNode :: Env -> CmmNode e x -> Block CmmNode e x
+annotateNode env node =
+    case node of
+      CmmEntry{}              -> BlockCO node BNil
+      CmmComment{}            -> BMiddle node
+      CmmTick{}               -> BMiddle node
+      CmmUnwind{}             -> BMiddle node
+      CmmAssign{}             -> annotateNodeOO env node
+      CmmStore lhs rhs align  ->
+          let ty = cmmExprType (platform env) rhs
+              rhs_nodes = annotateLoads env (collectExprLoads rhs)
+              lhs_nodes = annotateLoads env (collectExprLoads lhs)
+              st        = tsanStore env align ty lhs
+          in rhs_nodes `blockAppend` lhs_nodes `blockAppend` st `blockSnoc` node
+      CmmUnsafeForeignCall (PrimTarget op) formals args ->
+          let node' = fromMaybe (BMiddle node) (annotatePrim env op formals args)
+              arg_nodes = blockConcat $ map (annotateExpr env) args
+          in arg_nodes `blockAppend` node'
+      CmmUnsafeForeignCall{}  -> annotateNodeOO env node
+      CmmBranch{}             -> annotateNodeOC env node
+      CmmCondBranch{}         -> annotateNodeOC env node
+      CmmSwitch{}             -> annotateNodeOC env node
+      CmmCall{}               -> annotateNodeOC env node
+      CmmForeignCall{}        -> annotateNodeOC env node
+
+annotateNodeOO :: Env -> CmmNode O O -> Block CmmNode O O
+annotateNodeOO env node =
+    annotateLoads env (collectLoadsNode node) `blockSnoc` node
+
+annotateNodeOC :: Env -> CmmNode O C -> Block CmmNode O C
+annotateNodeOC env node =
+    annotateLoads env (collectLoadsNode node) `blockJoinTail` node
+
+annotateExpr :: Env -> CmmExpr -> Block CmmNode O O
+annotateExpr env expr =
+    annotateLoads env (collectExprLoads expr)
+
+data Load = Load CmmType AlignmentSpec CmmExpr
+
+annotateLoads :: Env -> [Load] -> Block CmmNode O O
+annotateLoads env loads =
+    blockConcat
+    [ tsanLoad env align ty addr
+    | Load ty align addr <- loads
+    ]
+
+collectLoadsNode :: CmmNode e x -> [Load]
+collectLoadsNode node =
+    foldExp (\exp rest -> collectExprLoads exp ++ rest) node []
+
+-- | Collect all of the memory locations loaded from by a 'CmmExpr'.
+collectExprLoads :: CmmExpr -> [Load]
+collectExprLoads (CmmLit _)           = []
+collectExprLoads (CmmLoad e ty align) = [Load ty align e]
+collectExprLoads (CmmReg _)           = []
+collectExprLoads (CmmMachOp _op args) = foldMap collectExprLoads args
+collectExprLoads (CmmStackSlot _ _)   = []
+collectExprLoads (CmmRegOff _ _)      = []
+
+-- | Generate TSAN instrumentation for a 'CallishMachOp' occurrence.
+annotatePrim :: Env
+             -> CallishMachOp   -- ^ the applied operation
+             -> [CmmFormal]     -- ^ results
+             -> [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_Cmpxchg w)          [dest]   [addr, expected, new]
+                                                               = Just $ tsanAtomicCas env MemOrderSeqCst MemOrderSeqCst w addr expected new dest
+annotatePrim _    _                       _        _           = Nothing
+
+mkUnsafeCall :: Env
+             -> ForeignTarget  -- ^ function
+             -> [CmmFormal]    -- ^ results
+             -> [CmmActual]    -- ^ arguments
+             -> Block CmmNode O O
+mkUnsafeCall env ftgt formals args =
+    save `blockAppend`     -- save global registers
+    bind_args `blockSnoc`  -- bind arguments to local registers
+    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)
+
+    -- 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
+      where
+        arg_reg :: Unique -> CmmExpr -> CmmReg
+        arg_reg u expr = CmmLocal $ LocalReg u (cmmExprType (platform env) expr)
+
+    bind_args :: Block CmmNode O O
+    bind_args = blockConcat $ zipWith (\r e -> BMiddle $ CmmAssign r e) arg_regs args
+
+    call = CmmUnsafeForeignCall ftgt formals (map CmmReg arg_regs)
+
+saveRestoreCallerRegs :: Platform
+                      -> (Block CmmNode O O, Block CmmNode O O)
+saveRestoreCallerRegs platform =
+    (save, restore)
+  where
+    regs = filter (callerSaves platform) (activeStgRegs platform)
+
+    save = blockFromList (map saveReg regs)
+    saveReg reg =
+      CmmStore (get_GlobalReg_addr platform reg)
+               (CmmReg (CmmGlobal reg))
+               NaturallyAligned
+
+    restore = blockFromList (map restoreReg regs)
+    restoreReg reg =
+      CmmAssign (CmmGlobal reg)
+                (CmmLoad (get_GlobalReg_addr platform reg)
+                         (globalRegType platform reg)
+                         NaturallyAligned)
+
+-- | Mirrors __tsan_memory_order
+-- <https://github.com/llvm-mirror/compiler-rt/blob/master/include/sanitizer/tsan_interface_atomic.h#L32>
+memoryOrderToTsanMemoryOrder :: Env -> MemoryOrdering -> CmmExpr
+memoryOrderToTsanMemoryOrder env mord =
+    mkIntExpr (platform env) n
+  where
+    n = case mord of
+      MemOrderRelaxed -> 0
+      MemOrderAcquire -> 2
+      MemOrderRelease -> 3
+      MemOrderSeqCst  -> 5
+
+tsanTarget :: FastString     -- ^ function name
+           -> [ForeignHint]  -- ^ formals
+           -> [ForeignHint]  -- ^ arguments
+           -> ForeignTarget
+tsanTarget fn formals args =
+    ForeignTarget (CmmLit (CmmLabel lbl)) conv
+  where
+    conv = ForeignConvention CCallConv args formals CmmMayReturn
+    lbl = mkForeignLabel fn Nothing ForeignLabelInExternalPackage IsFunction
+
+tsanStore :: Env
+          -> AlignmentSpec -> CmmType -> CmmExpr
+          -> Block CmmNode O O
+tsanStore env align ty addr =
+    mkUnsafeCall env ftarget [] [addr]
+  where
+    ftarget = tsanTarget fn [] [AddrHint]
+    w = widthInBytes (typeWidth ty)
+    fn = case align of
+           Unaligned
+             | w > 1    -> fsLit $ "__tsan_unaligned_write" ++ show w
+           _            -> fsLit $ "__tsan_write" ++ show w
+
+tsanLoad :: Env
+         -> AlignmentSpec -> CmmType -> CmmExpr
+         -> Block CmmNode O O
+tsanLoad env align ty addr =
+    mkUnsafeCall env ftarget [] [addr]
+  where
+    ftarget = tsanTarget fn [] [AddrHint]
+    w = widthInBytes (typeWidth ty)
+    fn = case align of
+           Unaligned
+             | w > 1    -> fsLit $ "__tsan_unaligned_read" ++ show w
+           _            -> fsLit $ "__tsan_read" ++ show w
+
+tsanAtomicStore :: Env
+                -> MemoryOrdering -> Width -> CmmExpr -> CmmExpr
+                -> Block CmmNode O O
+tsanAtomicStore env mord w val addr =
+    mkUnsafeCall env ftarget [] [addr, val, mord']
+  where
+    mord' = memoryOrderToTsanMemoryOrder env mord
+    ftarget = tsanTarget fn [] [AddrHint, NoHint, NoHint]
+    fn = fsLit $ "__tsan_atomic" ++ show (widthInBits w) ++ "_store"
+
+tsanAtomicLoad :: Env
+               -> MemoryOrdering -> Width -> CmmExpr -> LocalReg
+               -> Block CmmNode O O
+tsanAtomicLoad env mord w addr dest =
+    mkUnsafeCall env ftarget [dest] [addr, mord']
+  where
+    mord' = memoryOrderToTsanMemoryOrder env mord
+    ftarget = tsanTarget fn [NoHint] [AddrHint, NoHint]
+    fn = fsLit $ "__tsan_atomic" ++ show (widthInBits w) ++ "_load"
+
+tsanAtomicExchange :: Env
+                   -> MemoryOrdering -> Width -> CmmExpr -> CmmExpr -> LocalReg
+                   -> Block CmmNode O O
+tsanAtomicExchange env mord w val addr dest =
+    mkUnsafeCall env ftarget [dest] [addr, val, mord']
+  where
+    mord' = memoryOrderToTsanMemoryOrder env mord
+    ftarget = tsanTarget fn [NoHint] [AddrHint, NoHint, NoHint]
+    fn = fsLit $ "__tsan_atomic" ++ show (widthInBits w) ++ "_exchange"
+
+-- N.B. C11 CAS returns a boolean (to avoid the ABA problem) whereas Cmm's CAS
+-- returns the expected value. We use define a shim in the RTS to provide
+-- Cmm's semantics using the TSAN C11 primitive.
+tsanAtomicCas :: Env
+              -> MemoryOrdering  -- ^ success ordering
+              -> MemoryOrdering  -- ^ failure ordering
+              -> Width
+              -> CmmExpr         -- ^ address
+              -> CmmExpr         -- ^ expected value
+              -> CmmExpr         -- ^ new value
+              -> LocalReg        -- ^ result destination
+              -> Block CmmNode O O
+tsanAtomicCas env mord_success mord_failure w addr expected new dest =
+    mkUnsafeCall env ftarget [dest] [addr, expected, new, mord_success', mord_failure']
+  where
+    mord_success' = memoryOrderToTsanMemoryOrder env mord_success
+    mord_failure' = memoryOrderToTsanMemoryOrder env mord_failure
+    ftarget = tsanTarget fn [NoHint] [AddrHint, NoHint, NoHint, NoHint, NoHint]
+    fn = fsLit $ "ghc_tsan_atomic" ++ show (widthInBits w) ++ "_compare_exchange"
+
+tsanAtomicRMW :: Env
+              -> MemoryOrdering -> AtomicMachOp -> Width -> CmmExpr -> CmmExpr -> LocalReg
+              -> Block CmmNode O O
+tsanAtomicRMW env mord op w addr val dest =
+    mkUnsafeCall env ftarget [dest] [addr, val, mord']
+  where
+    mord' = memoryOrderToTsanMemoryOrder env mord
+    ftarget = tsanTarget fn [NoHint] [AddrHint, NoHint, NoHint]
+    op' = case op of
+           AMO_Add  -> "fetch_add"
+           AMO_Sub  -> "fetch_sub"
+           AMO_And  -> "fetch_and"
+           AMO_Nand -> "fetch_nand"
+           AMO_Or   -> "fetch_or"
+           AMO_Xor  -> "fetch_xor"
+    fn = fsLit $ "__tsan_atomic" ++ show (widthInBits w) ++ "_" ++ op'
+
diff --git a/compiler/GHC/Driver/Config/Cmm.hs b/compiler/GHC/Driver/Config/Cmm.hs
index 26ee35cba1..e130385cb0 100644
--- a/compiler/GHC/Driver/Config/Cmm.hs
+++ b/compiler/GHC/Driver/Config/Cmm.hs
@@ -18,6 +18,7 @@ initCmmConfig dflags = CmmConfig
   , cmmDoLinting           = gopt Opt_DoCmmLinting        dflags
   , cmmOptElimCommonBlks   = gopt Opt_CmmElimCommonBlocks dflags
   , cmmOptSink             = gopt Opt_CmmSink             dflags
+  , cmmOptThreadSanitizer  = gopt Opt_CmmThreadSanitizer dflags
   , cmmGenStackUnwindInstr = debugLevel dflags > 0
   , cmmExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags
   , cmmDoCmmSwitchPlans    = not (backendHasNativeSwitch (backend dflags))
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 1d8bd226b3..f45397d887 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -66,6 +66,7 @@ data DumpFlag
    | Opt_D_dump_cmm_split
    | Opt_D_dump_cmm_info
    | Opt_D_dump_cmm_cps
+   | Opt_D_dump_cmm_thread_sanitizer
    -- end cmm subflags
    | Opt_D_dump_cfg_weights -- ^ Dump the cfg used for block layout.
    | Opt_D_dump_asm
@@ -354,6 +355,7 @@ data GeneralFlag
    | Opt_Ticky_Dyn_Thunk
    | Opt_Ticky_Tag
    | Opt_Ticky_AP                    -- ^ Use regular thunks even when we could use std ap thunks in order to get entry counts
+   | Opt_CmmThreadSanitizer
    | Opt_RPath
    | Opt_RelativeDynlibPaths
    | Opt_CompactUnwind               -- ^ @-fcompact-unwind@
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index a0c371f76c..831267e2bf 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -2434,6 +2434,8 @@ dynamic_flags_deps = [
         (setDumpFlag Opt_D_dump_cmm_cps)
   , make_ord_flag defGhcFlag "ddump-cmm-opt"
         (setDumpFlag Opt_D_dump_opt_cmm)
+  , make_ord_flag defGhcFlag "ddump-cmm-thread-sanitizer"
+        (setDumpFlag Opt_D_dump_cmm_thread_sanitizer)
   , make_ord_flag defGhcFlag "ddump-cfg-weights"
         (setDumpFlag Opt_D_dump_cfg_weights)
   , make_ord_flag defGhcFlag "ddump-core-stats"
@@ -3511,8 +3513,8 @@ fFlagsDeps = [
         unless (platformOS (targetPlatform dflags) == OSDarwin && turn_on)
                (addWarn "-compact-unwind is only implemented by the darwin platform. Ignoring.")
         return dflags)),
-  flagSpec "show-error-context"               Opt_ShowErrorContext
-
+  flagSpec "show-error-context"               Opt_ShowErrorContext,
+  flagSpec "cmm-thread-sanitizer"             Opt_CmmThreadSanitizer
   ]
   ++ fHoleFlags
 
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 3ad8271127..4b66f8dc33 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -214,6 +214,7 @@ Library
         GHC.Cmm.Sink
         GHC.Cmm.Switch
         GHC.Cmm.Switch.Implement
+        GHC.Cmm.ThreadSanitizer
         GHC.CmmToAsm
         GHC.Cmm.LRegSet
         GHC.CmmToAsm.AArch64
diff --git a/docs/users_guide/debugging.rst b/docs/users_guide/debugging.rst
index 1448662698..e9d61e3834 100644
--- a/docs/users_guide/debugging.rst
+++ b/docs/users_guide/debugging.rst
@@ -551,6 +551,13 @@ These flags dump various phases of GHC's C-\\- pipeline.
 
     Dump the results of the C-\\- control flow optimisation pass.
 
+.. ghc-flag:: -ddump-cmm-thread-sanitizer
+    :shortdesc: Dump the results of the C-\\- ThreadSanitizer elaboration pass.
+    :type: dynamic
+
+    Dump the results of the C-\\- pass responsible for adding instrumentation
+    added by :ghc-flag:`-fcmm-thread-sanitizer`.
+
 .. ghc-flag:: -ddump-cmm-cbe
     :shortdesc: Dump the results of common block elimination
     :type: dynamic
@@ -1075,6 +1082,15 @@ Checking for consistency
     Note that this is only intended to be used as a debugging measure, not as
     the primary means of catching out-of-bounds accesses.
 
+.. ghc-flag:: -fcmm-thread-sanitizer
+    :shortdesc: Enable ThreadSanitizer instrumentation of memory accesses.
+    :type: dynamic
+
+    This enables generation of `ThreadSanitizer
+    <https://github.com/google/sanitizers/wiki/ThreadSanitizerCppManual>`
+    instrumentation of memory accesses. Requires use of ``-fsanitize=thread``
+    or similar when compiling and linking.
+
 .. _checking-determinism:
 
 Checking for determinism
diff --git a/rts/TSANUtils.c b/rts/TSANUtils.c
new file mode 100644
index 0000000000..790381acdb
--- /dev/null
+++ b/rts/TSANUtils.c
@@ -0,0 +1,37 @@
+#include <Rts.h>
+
+#if defined(TSAN_ENABLED)
+
+uint64_t ghc_tsan_atomic64_compare_exchange(uint64_t *ptr, uint64_t expected, uint64_t new_value, int success_memorder, int failure_memorder)
+{
+    __tsan_atomic64_compare_exchange_strong(
+            ptr, &expected, new_value,
+            success_memorder, failure_memorder);
+    return expected;
+}
+
+uint32_t ghc_tsan_atomic32_compare_exchange(uint32_t *ptr, uint32_t expected, uint32_t new_value, int success_memorder, int failure_memorder)
+{
+    __tsan_atomic32_compare_exchange_strong(
+            ptr, &expected, new_value,
+            success_memorder, failure_memorder);
+    return expected;
+}
+
+uint16_t ghc_tsan_atomic16_compare_exchange(uint16_t *ptr, uint16_t expected, uint16_t new_value, int success_memorder, int failure_memorder)
+{
+    __tsan_atomic16_compare_exchange_strong(
+            ptr, &expected, new_value,
+            success_memorder, failure_memorder);
+    return expected;
+}
+
+uint8_t ghc_tsan_atomic8_compare_exchange(uint8_t *ptr, uint8_t expected, uint8_t new_value, int success_memorder, int failure_memorder)
+{
+    __tsan_atomic8_compare_exchange_strong(
+            ptr, &expected, new_value,
+            success_memorder, failure_memorder);
+    return expected;
+}
+
+#endif
diff --git a/rts/include/rts/TSANUtils.h b/rts/include/rts/TSANUtils.h
index ddcf108041..da2240085e 100644
--- a/rts/include/rts/TSANUtils.h
+++ b/rts/include/rts/TSANUtils.h
@@ -65,3 +65,10 @@ void AnnotateBenignRaceSized(const char *file,
 
 #define TSAN_ANNOTATE_BENIGN_RACE(addr,desc)                            \
     TSAN_ANNOTATE_BENIGN_RACE_SIZED((void*)(addr), sizeof(*addr), desc)
+
+
+uint64_t ghc_tsan_atomic64_compare_exchange(uint64_t *ptr, uint64_t expected, uint64_t new_value, int success_memorder, int failure_memorder);
+uint32_t ghc_tsan_atomic32_compare_exchange(uint32_t *ptr, uint32_t expected, uint32_t new_value, int success_memorder, int failure_memorder);
+uint16_t ghc_tsan_atomic16_compare_exchange(uint16_t *ptr, uint16_t expected, uint16_t new_value, int success_memorder, int failure_memorder);
+uint8_t ghc_tsan_atomic8_compare_exchange(uint8_t *ptr, uint8_t expected, uint8_t new_value, int success_memorder, int failure_memorder);
+
diff --git a/rts/rts.cabal.in b/rts/rts.cabal.in
index e4a78a64cf..d10ee390e4 100644
--- a/rts/rts.cabal.in
+++ b/rts/rts.cabal.in
@@ -588,6 +588,7 @@ library
                  Trace.c
                  TraverseHeap.c
                  TraverseHeapTest.c
+                 TSANUtils.c
                  WSDeque.c
                  Weak.c
                  eventlog/EventLog.c