    {-# 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 { Env -> Platform
    platform :: Platform
                   , Env -> [Unique]
    uniques :: [Unique]
                   }

    annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph
    annotateTSAN :: Platform -> CmmGraph -> UniqSM CmmGraph
    annotateTSAN Platform
    platform CmmGraph
    graph = do
        Env
    env <- Platform -> [Unique] -> Env
    Env Platform
    platform ([Unique] -> Env) -> UniqSM [Unique] -> UniqSM Env
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> UniqSM [Unique]
    forall (m :: * -> *). MonadUnique m => m [Unique]
    getUniquesM
        CmmGraph -> UniqSM CmmGraph
    forall a. a -> UniqSM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmGraph -> UniqSM CmmGraph) -> CmmGraph -> UniqSM CmmGraph
    forall a b. (a -> b) -> a -> b
    $ (Graph CmmNode C C -> Graph CmmNode C C) -> CmmGraph -> CmmGraph
    forall (n :: Extensibility -> Extensibility -> *)
           (n' :: Extensibility -> Extensibility -> *).
    (Graph n C C -> Graph n' C C) -> GenCmmGraph n -> GenCmmGraph n'
    modifyGraph ((forall (e1 :: Extensibility) (x1 :: Extensibility).
     Block CmmNode e1 x1 -> Block CmmNode e1 x1)
    -> Graph CmmNode C C -> Graph CmmNode C C
    forall (block :: (Extensibility -> Extensibility -> *)
                     -> Extensibility -> Extensibility -> *)
           (n :: Extensibility -> Extensibility -> *)
           (block' :: (Extensibility -> Extensibility -> *)
                      -> Extensibility -> Extensibility -> *)
           (n' :: Extensibility -> Extensibility -> *) (e :: Extensibility)
           (x :: Extensibility).
    (forall (e1 :: Extensibility) (x1 :: Extensibility).
     block n e1 x1 -> block' n' e1 x1)
    -> Graph' block n e x -> Graph' block' n' e x
    mapGraphBlocks (Env -> Block CmmNode e1 x1 -> Block CmmNode e1 x1
    forall (e :: Extensibility) (x :: Extensibility).
    Env -> Block CmmNode e x -> Block CmmNode e x
    annotateBlock Env
    env)) CmmGraph
    graph

    mapBlockList :: (forall e' x'. n e' x' -> Block n e' x')
                 -> Block n e x -> Block n e x
    mapBlockList :: forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e x -> Block n e x
    mapBlockList forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f (BlockCO n C 'Open
    n Block n 'Open 'Open
    rest  ) = n e 'Open -> Block n e 'Open
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f n e 'Open
    n C 'Open
    n Block n e 'Open -> Block n 'Open x -> Block n e x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n 'Open x -> Block n 'Open x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e x -> Block n e x
    mapBlockList n e' x' -> Block n e' x'
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f Block n 'Open x
    Block n 'Open 'Open
    rest
    mapBlockList forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f (BlockCC n C 'Open
    n Block n 'Open 'Open
    rest n 'Open C
    m) = n e 'Open -> Block n e 'Open
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f n e 'Open
    n C 'Open
    n Block n e 'Open -> Block n 'Open 'Open -> Block n e 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n 'Open 'Open -> Block n 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e x -> Block n e x
    mapBlockList n e' x' -> Block n e' x'
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f Block n 'Open 'Open
    rest Block n e 'Open -> Block n 'Open x -> Block n e x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` n 'Open x -> Block n 'Open x
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f n 'Open x
    n 'Open C
    m
    mapBlockList forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f (BlockOC   Block n 'Open 'Open
    rest n 'Open C
    m) = (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e 'Open -> Block n e 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e x -> Block n e x
    mapBlockList n e' x' -> Block n e' x'
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f Block n e 'Open
    Block n 'Open 'Open
    rest Block n e 'Open -> Block n 'Open x -> Block n e x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` n 'Open x -> Block n 'Open x
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f n 'Open x
    n 'Open C
    m
    mapBlockList forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    _ Block n e x
    BNil = Block n e x
    Block n 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    Block n 'Open 'Open
    BNil
    mapBlockList forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f (BMiddle n 'Open 'Open
    blk) = n e x -> Block n e x
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f n e x
    n 'Open 'Open
    blk
    mapBlockList forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f (BCat Block n 'Open 'Open
    a Block n 'Open 'Open
    b) = (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e 'Open -> Block n e 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e x -> Block n e x
    mapBlockList n e' x' -> Block n e' x'
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f Block n e 'Open
    Block n 'Open 'Open
    a Block n e 'Open -> Block n 'Open x -> Block n e x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n 'Open x -> Block n 'Open x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e x -> Block n e x
    mapBlockList n e' x' -> Block n e' x'
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f Block n 'Open x
    Block n 'Open 'Open
    b
    mapBlockList forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f (BSnoc Block n 'Open 'Open
    a n 'Open 'Open
    n) = (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e 'Open -> Block n e 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e x -> Block n e x
    mapBlockList n e' x' -> Block n e' x'
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f Block n e 'Open
    Block n 'Open 'Open
    a Block n e 'Open -> Block n 'Open x -> Block n e x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` n 'Open x -> Block n 'Open x
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f n 'Open x
    n 'Open 'Open
    n
    mapBlockList forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f (BCons n 'Open 'Open
    n Block n 'Open 'Open
    a) = n e 'Open -> Block n e 'Open
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f n e 'Open
    n 'Open 'Open
    n Block n e 'Open -> Block n 'Open x -> Block n e x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n 'Open x -> Block n 'Open x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e x -> Block n e x
    mapBlockList n e' x' -> Block n e' x'
    forall (e' :: Extensibility) (x' :: Extensibility).
    n e' x' -> Block n e' x'
    f Block n 'Open x
    Block n 'Open 'Open
    a

    annotateBlock :: Env -> Block CmmNode e x -> Block CmmNode e x
    annotateBlock :: forall (e :: Extensibility) (x :: Extensibility).
    Env -> Block CmmNode e x -> Block CmmNode e x
    annotateBlock Env
    env = (forall (e' :: Extensibility) (x' :: Extensibility).
     CmmNode e' x' -> Block CmmNode e' x')
    -> Block CmmNode e x -> Block CmmNode e x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    (forall (e' :: Extensibility) (x' :: Extensibility).
     n e' x' -> Block n e' x')
    -> Block n e x -> Block n e x
    mapBlockList (Env -> CmmNode e' x' -> Block CmmNode e' x'
    forall (e :: Extensibility) (x :: Extensibility).
    Env -> CmmNode e x -> Block CmmNode e x
    annotateNode Env
    env)

    annotateNode :: Env -> CmmNode e x -> Block CmmNode e x
    annotateNode :: forall (e :: Extensibility) (x :: Extensibility).
    Env -> CmmNode e x -> Block CmmNode e x
    annotateNode Env
    env CmmNode e x
    node =
        case CmmNode e x
    node of
          CmmEntry{}              -> CmmNode C 'Open
    -> Block CmmNode 'Open 'Open -> Block CmmNode C 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    n C 'Open -> Block n 'Open 'Open -> Block n C 'Open
    BlockCO CmmNode e x
    CmmNode C 'Open
    node Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    Block n 'Open 'Open
    BNil
          CmmComment{}            -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    n 'Open 'Open -> Block n 'Open 'Open
    BMiddle CmmNode e x
    CmmNode 'Open 'Open
    node
          CmmTick{}               -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    n 'Open 'Open -> Block n 'Open 'Open
    BMiddle CmmNode e x
    CmmNode 'Open 'Open
    node
          CmmUnwind{}             -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    n 'Open 'Open -> Block n 'Open 'Open
    BMiddle CmmNode e x
    CmmNode 'Open 'Open
    node
          CmmAssign{}             -> Env -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    annotateNodeOO Env
    env CmmNode e x
    CmmNode 'Open 'Open
    node
          CmmStore CmmExpr
    lhs CmmExpr
    rhs AlignmentSpec
    align  ->
              let ty :: CmmType
    ty = Platform -> CmmExpr -> CmmType
    cmmExprType (Env -> Platform
    platform Env
    env) CmmExpr
    rhs
                  rhs_nodes :: Block CmmNode 'Open 'Open
    rhs_nodes = Env -> [Load] -> Block CmmNode 'Open 'Open
    annotateLoads Env
    env (CmmExpr -> [Load]
    collectExprLoads CmmExpr
    rhs)
                  lhs_nodes :: Block CmmNode 'Open 'Open
    lhs_nodes = Env -> [Load] -> Block CmmNode 'Open 'Open
    annotateLoads Env
    env (CmmExpr -> [Load]
    collectExprLoads CmmExpr
    lhs)
                  st :: Block CmmNode 'Open 'Open
    st        = Env
    -> AlignmentSpec -> CmmType -> CmmExpr -> Block CmmNode 'Open 'Open
    tsanStore Env
    env AlignmentSpec
    align CmmType
    ty CmmExpr
    lhs
              in Block CmmNode e 'Open
    Block CmmNode 'Open 'Open
    rhs_nodes Block CmmNode e 'Open
    -> Block CmmNode 'Open 'Open -> Block CmmNode e 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` Block CmmNode 'Open 'Open
    lhs_nodes Block CmmNode e 'Open
    -> Block CmmNode 'Open 'Open -> Block CmmNode e 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` Block CmmNode 'Open 'Open
    st Block CmmNode e 'Open
    -> CmmNode 'Open 'Open -> Block CmmNode e 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e 'Open -> n 'Open 'Open -> Block n e 'Open
    `blockSnoc` CmmNode e x
    CmmNode 'Open 'Open
    node
          CmmUnsafeForeignCall (PrimTarget CallishMachOp
    op) [CmmFormal]
    formals [CmmExpr]
    args ->
              let node' :: Block CmmNode 'Open 'Open
    node' = Block CmmNode 'Open 'Open
    -> Maybe (Block CmmNode 'Open 'Open) -> Block CmmNode 'Open 'Open
    forall a. a -> Maybe a -> a
    fromMaybe (CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    n 'Open 'Open -> Block n 'Open 'Open
    BMiddle CmmNode e x
    CmmNode 'Open 'Open
    node) (Env
    -> CallishMachOp
    -> [CmmFormal]
    -> [CmmExpr]
    -> Maybe (Block CmmNode 'Open 'Open)
    annotatePrim Env
    env CallishMachOp
    op [CmmFormal]
    formals [CmmExpr]
    args)
                  arg_nodes :: Block CmmNode 'Open 'Open
    arg_nodes = [Block CmmNode 'Open 'Open] -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    [Block n 'Open 'Open] -> Block n 'Open 'Open
    blockConcat ([Block CmmNode 'Open 'Open] -> Block CmmNode 'Open 'Open)
    -> [Block CmmNode 'Open 'Open] -> Block CmmNode 'Open 'Open
    forall a b. (a -> b) -> a -> b
    $ (CmmExpr -> Block CmmNode 'Open 'Open)
    -> [CmmExpr] -> [Block CmmNode 'Open 'Open]
    forall a b. (a -> b) -> [a] -> [b]
    map (Env -> CmmExpr -> Block CmmNode 'Open 'Open
    annotateExpr Env
    env) [CmmExpr]
    args
              in Block CmmNode e 'Open
    Block CmmNode 'Open 'Open
    arg_nodes Block CmmNode e 'Open -> Block CmmNode 'Open x -> Block CmmNode e x
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend` Block CmmNode 'Open x
    Block CmmNode 'Open 'Open
    node'
          CmmUnsafeForeignCall{}  -> Env -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    annotateNodeOO Env
    env CmmNode e x
    CmmNode 'Open 'Open
    node
          CmmBranch{}             -> Env -> CmmNode 'Open C -> Block CmmNode 'Open C
    annotateNodeOC Env
    env CmmNode e x
    CmmNode 'Open C
    node
          CmmCondBranch{}         -> Env -> CmmNode 'Open C -> Block CmmNode 'Open C
    annotateNodeOC Env
    env CmmNode e x
    CmmNode 'Open C
    node
          CmmSwitch{}             -> Env -> CmmNode 'Open C -> Block CmmNode 'Open C
    annotateNodeOC Env
    env CmmNode e x
    CmmNode 'Open C
    node
          CmmCall{}               -> Env -> CmmNode 'Open C -> Block CmmNode 'Open C
    annotateNodeOC Env
    env CmmNode e x
    CmmNode 'Open C
    node
          CmmForeignCall{}        -> Env -> CmmNode 'Open C -> Block CmmNode 'Open C
    annotateNodeOC Env
    env CmmNode e x
    CmmNode 'Open C
    node

    annotateNodeOO :: Env -> CmmNode O O -> Block CmmNode O O
    annotateNodeOO :: Env -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    annotateNodeOO Env
    env CmmNode 'Open 'Open
    node =
        Env -> [Load] -> Block CmmNode 'Open 'Open
    annotateLoads Env
    env (CmmNode 'Open 'Open -> [Load]
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> [Load]
    collectLoadsNode CmmNode 'Open 'Open
    node) Block CmmNode 'Open 'Open
    -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e 'Open -> n 'Open 'Open -> Block n e 'Open
    `blockSnoc` CmmNode 'Open 'Open
    node

    annotateNodeOC :: Env -> CmmNode O C -> Block CmmNode O C
    annotateNodeOC :: Env -> CmmNode 'Open C -> Block CmmNode 'Open C
    annotateNodeOC Env
    env CmmNode 'Open C
    node =
        Env -> [Load] -> Block CmmNode 'Open 'Open
    annotateLoads Env
    env (CmmNode 'Open C -> [Load]
    forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> [Load]
    collectLoadsNode CmmNode 'Open C
    node) Block CmmNode 'Open 'Open
    -> CmmNode 'Open C -> Block CmmNode 'Open C
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e 'Open -> n 'Open C -> Block n e C
    `blockJoinTail` CmmNode 'Open C
    node

    annotateExpr :: Env -> CmmExpr -> Block CmmNode O O
    annotateExpr :: Env -> CmmExpr -> Block CmmNode 'Open 'Open
    annotateExpr Env
    env CmmExpr
    expr =
        Env -> [Load] -> Block CmmNode 'Open 'Open
    annotateLoads Env
    env (CmmExpr -> [Load]
    collectExprLoads CmmExpr
    expr)

    data Load = Load CmmType AlignmentSpec CmmExpr

    annotateLoads :: Env -> [Load] -> Block CmmNode O O
    annotateLoads :: Env -> [Load] -> Block CmmNode 'Open 'Open
    annotateLoads Env
    env [Load]
    loads =
        [Block CmmNode 'Open 'Open] -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    [Block n 'Open 'Open] -> Block n 'Open 'Open
    blockConcat
        [ Env
    -> AlignmentSpec -> CmmType -> CmmExpr -> Block CmmNode 'Open 'Open
    tsanLoad Env
    env AlignmentSpec
    align CmmType
    ty CmmExpr
    addr
        | Load CmmType
    ty AlignmentSpec
    align CmmExpr
    addr <- [Load]
    loads
        ]

    collectLoadsNode :: CmmNode e x -> [Load]
    collectLoadsNode :: forall (e :: Extensibility) (x :: Extensibility).
    CmmNode e x -> [Load]
    collectLoadsNode CmmNode e x
    node =
        (CmmExpr -> [Load] -> [Load]) -> CmmNode e x -> [Load] -> [Load]
    forall z (e :: Extensibility) (x :: Extensibility).
    (CmmExpr -> z -> z) -> CmmNode e x -> z -> z
    foldExp (\CmmExpr
    exp [Load]
    rest -> CmmExpr -> [Load]
    collectExprLoads CmmExpr
    exp [Load] -> [Load] -> [Load]
    forall a. [a] -> [a] -> [a]
    ++ [Load]
    rest) CmmNode e x
    node []

    -- | Collect all of the memory locations loaded from by a 'CmmExpr'.
    collectExprLoads :: CmmExpr -> [Load]
    collectExprLoads :: CmmExpr -> [Load]
    collectExprLoads (CmmLit CmmLit
    _)           = []
    collectExprLoads (CmmLoad CmmExpr
    e CmmType
    ty AlignmentSpec
    align) = [CmmType -> AlignmentSpec -> CmmExpr -> Load
    Load CmmType
    ty AlignmentSpec
    align CmmExpr
    e]
    collectExprLoads (CmmReg CmmReg
    _)           = []
    collectExprLoads (CmmMachOp MachOp
    _op [CmmExpr]
    args) = (CmmExpr -> [Load]) -> [CmmExpr] -> [Load]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap CmmExpr -> [Load]
    collectExprLoads [CmmExpr]
    args
    collectExprLoads (CmmStackSlot Area
    _ Int
    _)   = []
    collectExprLoads (CmmRegOff CmmReg
    _ Int
    _)      = []

    -- | 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
    -> CallishMachOp
    -> [CmmFormal]
    -> [CmmExpr]
    -> Maybe (Block CmmNode 'Open 'Open)
    annotatePrim Env
    env (MO_AtomicRMW Width
    w AtomicMachOp
    aop)    [CmmFormal
    dest]   [CmmExpr
    addr, CmmExpr
    val] = Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a. a -> Maybe a
    Just (Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open))
    -> Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a b. (a -> b) -> a -> b
    $ Env
    -> MemoryOrdering
    -> AtomicMachOp
    -> Width
    -> CmmExpr
    -> CmmExpr
    -> CmmFormal
    -> Block CmmNode 'Open 'Open
    tsanAtomicRMW Env
    env MemoryOrdering
    MemOrderSeqCst AtomicMachOp
    aop Width
    w CmmExpr
    addr CmmExpr
    val CmmFormal
    dest
    annotatePrim Env
    env (MO_AtomicRead Width
    w MemoryOrdering
    mord)  [CmmFormal
    dest]   [CmmExpr
    addr]      = Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a. a -> Maybe a
    Just (Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open))
    -> Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a b. (a -> b) -> a -> b
    $ Env
    -> MemoryOrdering
    -> Width
    -> CmmExpr
    -> CmmFormal
    -> Block CmmNode 'Open 'Open
    tsanAtomicLoad Env
    env MemoryOrdering
    mord Width
    w CmmExpr
    addr CmmFormal
    dest
    annotatePrim Env
    env (MO_AtomicWrite Width
    w MemoryOrdering
    mord) []       [CmmExpr
    addr, CmmExpr
    val] = Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a. a -> Maybe a
    Just (Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open))
    -> Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a b. (a -> b) -> a -> b
    $ Env
    -> MemoryOrdering
    -> Width
    -> CmmExpr
    -> CmmExpr
    -> Block CmmNode 'Open 'Open
    tsanAtomicStore Env
    env MemoryOrdering
    mord Width
    w CmmExpr
    val CmmExpr
    addr
    annotatePrim Env
    env (MO_Xchg Width
    w)             [CmmFormal
    dest]   [CmmExpr
    addr, CmmExpr
    val] = Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a. a -> Maybe a
    Just (Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open))
    -> Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a b. (a -> b) -> a -> b
    $ Env
    -> MemoryOrdering
    -> Width
    -> CmmExpr
    -> CmmExpr
    -> CmmFormal
    -> Block CmmNode 'Open 'Open
    tsanAtomicExchange Env
    env MemoryOrdering
    MemOrderSeqCst Width
    w CmmExpr
    val CmmExpr
    addr CmmFormal
    dest
    annotatePrim Env
    env (MO_Cmpxchg Width
    w)          [CmmFormal
    dest]   [CmmExpr
    addr, CmmExpr
    expected, CmmExpr
    new]
                                                                   = Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a. a -> Maybe a
    Just (Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open))
    -> Block CmmNode 'Open 'Open -> Maybe (Block CmmNode 'Open 'Open)
    forall a b. (a -> b) -> a -> b
    $ Env
    -> MemoryOrdering
    -> MemoryOrdering
    -> Width
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> CmmFormal
    -> Block CmmNode 'Open 'Open
    tsanAtomicCas Env
    env MemoryOrdering
    MemOrderSeqCst MemoryOrdering
    MemOrderSeqCst Width
    w CmmExpr
    addr CmmExpr
    expected CmmExpr
    new CmmFormal
    dest
    annotatePrim Env
    _    CallishMachOp
    _                       [CmmFormal]
    _        [CmmExpr]
    _           = Maybe (Block CmmNode 'Open 'Open)
    forall a. Maybe a
    Nothing

    mkUnsafeCall :: Env
                 -> ForeignTarget  -- ^ function
                 -> [CmmFormal]    -- ^ results
                 -> [CmmActual]    -- ^ arguments
                 -> Block CmmNode O O
    mkUnsafeCall :: Env
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Block CmmNode 'Open 'Open
    mkUnsafeCall Env
    env ForeignTarget
    ftgt [CmmFormal]
    formals [CmmExpr]
    args =
        Block CmmNode 'Open 'Open
    save Block CmmNode 'Open 'Open
    -> Block CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend`     -- save global registers
        Block CmmNode 'Open 'Open
    bind_args Block CmmNode 'Open 'Open
    -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility).
    Block n e 'Open -> n 'Open 'Open -> Block n e 'Open
    `blockSnoc`  -- bind arguments to local registers
        CmmNode 'Open 'Open
    call Block CmmNode 'Open 'Open
    -> Block CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *)
           (e :: Extensibility) (x :: Extensibility).
    Block n e 'Open -> Block n 'Open x -> Block n e x
    `blockAppend`     -- perform call
        Block CmmNode 'Open 'Open
    restore                -- restore global registers
      where
        -- We are rather conservative here and just save/restore all GlobalRegs.
        (Block CmmNode 'Open 'Open
    save, Block CmmNode 'Open 'Open
    restore) = Platform -> (Block CmmNode 'Open 'Open, Block CmmNode 'Open 'Open)
    saveRestoreCallerRegs (Env -> Platform
    platform Env
    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 :: [CmmReg]
    arg_regs = (Unique -> CmmExpr -> CmmReg) -> [Unique] -> [CmmExpr] -> [CmmReg]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Unique -> CmmExpr -> CmmReg
    arg_reg (Env -> [Unique]
    uniques Env
    env) [CmmExpr]
    args
          where
            arg_reg :: Unique -> CmmExpr -> CmmReg
            arg_reg :: Unique -> CmmExpr -> CmmReg
    arg_reg Unique
    u CmmExpr
    expr = CmmFormal -> CmmReg
    CmmLocal (CmmFormal -> CmmReg) -> CmmFormal -> CmmReg
    forall a b. (a -> b) -> a -> b
    $ Unique -> CmmType -> CmmFormal
    LocalReg Unique
    u (Platform -> CmmExpr -> CmmType
    cmmExprType (Env -> Platform
    platform Env
    env) CmmExpr
    expr)

        bind_args :: Block CmmNode O O
        bind_args :: Block CmmNode 'Open 'Open
    bind_args = [Block CmmNode 'Open 'Open] -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    [Block n 'Open 'Open] -> Block n 'Open 'Open
    blockConcat ([Block CmmNode 'Open 'Open] -> Block CmmNode 'Open 'Open)
    -> [Block CmmNode 'Open 'Open] -> Block CmmNode 'Open 'Open
    forall a b. (a -> b) -> a -> b
    $ (CmmReg -> CmmExpr -> Block CmmNode 'Open 'Open)
    -> [CmmReg] -> [CmmExpr] -> [Block CmmNode 'Open 'Open]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\CmmReg
    r CmmExpr
    e -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    n 'Open 'Open -> Block n 'Open 'Open
    BMiddle (CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open)
    -> CmmNode 'Open 'Open -> Block CmmNode 'Open 'Open
    forall a b. (a -> b) -> a -> b
    $ CmmReg -> CmmExpr -> CmmNode 'Open 'Open
    CmmAssign CmmReg
    r CmmExpr
    e) [CmmReg]
    arg_regs [CmmExpr]
    args

        call :: CmmNode 'Open 'Open
    call = ForeignTarget -> [CmmFormal] -> [CmmExpr] -> CmmNode 'Open 'Open
    CmmUnsafeForeignCall ForeignTarget
    ftgt [CmmFormal]
    formals ((CmmReg -> CmmExpr) -> [CmmReg] -> [CmmExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map CmmReg -> CmmExpr
    CmmReg [CmmReg]
    arg_regs)

    saveRestoreCallerRegs :: Platform
                          -> (Block CmmNode O O, Block CmmNode O O)
    saveRestoreCallerRegs :: Platform -> (Block CmmNode 'Open 'Open, Block CmmNode 'Open 'Open)
    saveRestoreCallerRegs Platform
    platform =
        (Block CmmNode 'Open 'Open
    save, Block CmmNode 'Open 'Open
    restore)
      where
        regs :: [GlobalReg]
    regs = (GlobalReg -> Bool) -> [GlobalReg] -> [GlobalReg]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Platform -> GlobalReg -> Bool
    callerSaves Platform
    platform) (Platform -> [GlobalReg]
    activeStgRegs Platform
    platform)

        save :: Block CmmNode 'Open 'Open
    save = [CmmNode 'Open 'Open] -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    [n 'Open 'Open] -> Block n 'Open 'Open
    blockFromList ((GlobalReg -> CmmNode 'Open 'Open)
    -> [GlobalReg] -> [CmmNode 'Open 'Open]
    forall a b. (a -> b) -> [a] -> [b]
    map GlobalReg -> CmmNode 'Open 'Open
    saveReg [GlobalReg]
    regs)
        saveReg :: GlobalReg -> CmmNode 'Open 'Open
    saveReg GlobalReg
    reg =
          CmmExpr -> CmmExpr -> AlignmentSpec -> CmmNode 'Open 'Open
    CmmStore (Platform -> GlobalReg -> CmmExpr
    get_GlobalReg_addr Platform
    platform GlobalReg
    reg)
                   (CmmReg -> CmmExpr
    CmmReg (GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    reg))
                   AlignmentSpec
    NaturallyAligned

        restore :: Block CmmNode 'Open 'Open
    restore = [CmmNode 'Open 'Open] -> Block CmmNode 'Open 'Open
    forall (n :: Extensibility -> Extensibility -> *).
    [n 'Open 'Open] -> Block n 'Open 'Open
    blockFromList ((GlobalReg -> CmmNode 'Open 'Open)
    -> [GlobalReg] -> [CmmNode 'Open 'Open]
    forall a b. (a -> b) -> [a] -> [b]
    map GlobalReg -> CmmNode 'Open 'Open
    restoreReg [GlobalReg]
    regs)
        restoreReg :: GlobalReg -> CmmNode 'Open 'Open
    restoreReg GlobalReg
    reg =
          CmmReg -> CmmExpr -> CmmNode 'Open 'Open
    CmmAssign (GlobalReg -> CmmReg
    CmmGlobal GlobalReg
    reg)
                    (CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
    CmmLoad (Platform -> GlobalReg -> CmmExpr
    get_GlobalReg_addr Platform
    platform GlobalReg
    reg)
                             (Platform -> GlobalReg -> CmmType
    globalRegType Platform
    platform GlobalReg
    reg)
                             AlignmentSpec
    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 -> MemoryOrdering -> CmmExpr
    memoryOrderToTsanMemoryOrder Env
    env MemoryOrdering
    mord =
        Platform -> Int -> CmmExpr
    mkIntExpr (Env -> Platform
    platform Env
    env) Int
    n
      where
        n :: Int
    n = case MemoryOrdering
    mord of
          MemoryOrdering
    MemOrderRelaxed -> Int
    0
          MemoryOrdering
    MemOrderAcquire -> Int
    2
          MemoryOrdering
    MemOrderRelease -> Int
    3
          MemoryOrdering
    MemOrderSeqCst  -> Int
    5

    tsanTarget :: FastString     -- ^ function name
               -> [ForeignHint]  -- ^ formals
               -> [ForeignHint]  -- ^ arguments
               -> ForeignTarget
    tsanTarget :: FastString -> [ForeignHint] -> [ForeignHint] -> ForeignTarget
    tsanTarget FastString
    fn [ForeignHint]
    formals [ForeignHint]
    args =
        CmmExpr -> ForeignConvention -> ForeignTarget
    ForeignTarget (CmmLit -> CmmExpr
    CmmLit (CLabel -> CmmLit
    CmmLabel CLabel
    lbl)) ForeignConvention
    conv
      where
        conv :: ForeignConvention
    conv = CCallConv
    -> [ForeignHint]
    -> [ForeignHint]
    -> CmmReturnInfo
    -> ForeignConvention
    ForeignConvention CCallConv
    CCallConv [ForeignHint]
    args [ForeignHint]
    formals CmmReturnInfo
    CmmMayReturn
        lbl :: CLabel
    lbl = FastString
    -> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
    mkForeignLabel FastString
    fn Maybe Int
    forall a. Maybe a
    Nothing ForeignLabelSource
    ForeignLabelInExternalPackage FunctionOrData
    IsFunction

    tsanStore :: Env
              -> AlignmentSpec -> CmmType -> CmmExpr
              -> Block CmmNode O O
    tsanStore :: Env
    -> AlignmentSpec -> CmmType -> CmmExpr -> Block CmmNode 'Open 'Open
    tsanStore Env
    env AlignmentSpec
    align CmmType
    ty CmmExpr
    addr =
        Env
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Block CmmNode 'Open 'Open
    mkUnsafeCall Env
    env ForeignTarget
    ftarget [] [CmmExpr
    addr]
      where
        ftarget :: ForeignTarget
    ftarget = FastString -> [ForeignHint] -> [ForeignHint] -> ForeignTarget
    tsanTarget FastString
    fn [] [ForeignHint
    AddrHint]
        w :: Int
    w = Width -> Int
    widthInBytes (CmmType -> Width
    typeWidth CmmType
    ty)
        fn :: FastString
    fn = case AlignmentSpec
    align of
               AlignmentSpec
    Unaligned
                 | Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1    -> String -> FastString
    fsLit (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ String
    "__tsan_unaligned_write" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    w
               AlignmentSpec
    _            -> String -> FastString
    fsLit (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ String
    "__tsan_write" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    w

    tsanLoad :: Env
             -> AlignmentSpec -> CmmType -> CmmExpr
             -> Block CmmNode O O
    tsanLoad :: Env
    -> AlignmentSpec -> CmmType -> CmmExpr -> Block CmmNode 'Open 'Open
    tsanLoad Env
    env AlignmentSpec
    align CmmType
    ty CmmExpr
    addr =
        Env
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Block CmmNode 'Open 'Open
    mkUnsafeCall Env
    env ForeignTarget
    ftarget [] [CmmExpr
    addr]
      where
        ftarget :: ForeignTarget
    ftarget = FastString -> [ForeignHint] -> [ForeignHint] -> ForeignTarget
    tsanTarget FastString
    fn [] [ForeignHint
    AddrHint]
        w :: Int
    w = Width -> Int
    widthInBytes (CmmType -> Width
    typeWidth CmmType
    ty)
        fn :: FastString
    fn = case AlignmentSpec
    align of
               AlignmentSpec
    Unaligned
                 | Int
    w Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1    -> String -> FastString
    fsLit (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ String
    "__tsan_unaligned_read" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    w
               AlignmentSpec
    _            -> String -> FastString
    fsLit (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ String
    "__tsan_read" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    w

    tsanAtomicStore :: Env
                    -> MemoryOrdering -> Width -> CmmExpr -> CmmExpr
                    -> Block CmmNode O O
    tsanAtomicStore :: Env
    -> MemoryOrdering
    -> Width
    -> CmmExpr
    -> CmmExpr
    -> Block CmmNode 'Open 'Open
    tsanAtomicStore Env
    env MemoryOrdering
    mord Width
    w CmmExpr
    val CmmExpr
    addr =
        Env
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Block CmmNode 'Open 'Open
    mkUnsafeCall Env
    env ForeignTarget
    ftarget [] [CmmExpr
    addr, CmmExpr
    val, CmmExpr
    mord']
      where
        mord' :: CmmExpr
    mord' = Env -> MemoryOrdering -> CmmExpr
    memoryOrderToTsanMemoryOrder Env
    env MemoryOrdering
    mord
        ftarget :: ForeignTarget
    ftarget = FastString -> [ForeignHint] -> [ForeignHint] -> ForeignTarget
    tsanTarget FastString
    fn [] [ForeignHint
    AddrHint, ForeignHint
    NoHint, ForeignHint
    NoHint]
        fn :: FastString
    fn = String -> FastString
    fsLit (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ String
    "__tsan_atomic" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Width -> Int
    widthInBits Width
    w) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_store"

    tsanAtomicLoad :: Env
                   -> MemoryOrdering -> Width -> CmmExpr -> LocalReg
                   -> Block CmmNode O O
    tsanAtomicLoad :: Env
    -> MemoryOrdering
    -> Width
    -> CmmExpr
    -> CmmFormal
    -> Block CmmNode 'Open 'Open
    tsanAtomicLoad Env
    env MemoryOrdering
    mord Width
    w CmmExpr
    addr CmmFormal
    dest =
        Env
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Block CmmNode 'Open 'Open
    mkUnsafeCall Env
    env ForeignTarget
    ftarget [CmmFormal
    dest] [CmmExpr
    addr, CmmExpr
    mord']
      where
        mord' :: CmmExpr
    mord' = Env -> MemoryOrdering -> CmmExpr
    memoryOrderToTsanMemoryOrder Env
    env MemoryOrdering
    mord
        ftarget :: ForeignTarget
    ftarget = FastString -> [ForeignHint] -> [ForeignHint] -> ForeignTarget
    tsanTarget FastString
    fn [ForeignHint
    NoHint] [ForeignHint
    AddrHint, ForeignHint
    NoHint]
        fn :: FastString
    fn = String -> FastString
    fsLit (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ String
    "__tsan_atomic" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Width -> Int
    widthInBits Width
    w) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_load"

    tsanAtomicExchange :: Env
                       -> MemoryOrdering -> Width -> CmmExpr -> CmmExpr -> LocalReg
                       -> Block CmmNode O O
    tsanAtomicExchange :: Env
    -> MemoryOrdering
    -> Width
    -> CmmExpr
    -> CmmExpr
    -> CmmFormal
    -> Block CmmNode 'Open 'Open
    tsanAtomicExchange Env
    env MemoryOrdering
    mord Width
    w CmmExpr
    val CmmExpr
    addr CmmFormal
    dest =
        Env
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Block CmmNode 'Open 'Open
    mkUnsafeCall Env
    env ForeignTarget
    ftarget [CmmFormal
    dest] [CmmExpr
    addr, CmmExpr
    val, CmmExpr
    mord']
      where
        mord' :: CmmExpr
    mord' = Env -> MemoryOrdering -> CmmExpr
    memoryOrderToTsanMemoryOrder Env
    env MemoryOrdering
    mord
        ftarget :: ForeignTarget
    ftarget = FastString -> [ForeignHint] -> [ForeignHint] -> ForeignTarget
    tsanTarget FastString
    fn [ForeignHint
    NoHint] [ForeignHint
    AddrHint, ForeignHint
    NoHint, ForeignHint
    NoHint]
        fn :: FastString
    fn = String -> FastString
    fsLit (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ String
    "__tsan_atomic" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Width -> Int
    widthInBits Width
    w) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_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
    -> MemoryOrdering
    -> MemoryOrdering
    -> Width
    -> CmmExpr
    -> CmmExpr
    -> CmmExpr
    -> CmmFormal
    -> Block CmmNode 'Open 'Open
    tsanAtomicCas Env
    env MemoryOrdering
    mord_success MemoryOrdering
    mord_failure Width
    w CmmExpr
    addr CmmExpr
    expected CmmExpr
    new CmmFormal
    dest =
        Env
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Block CmmNode 'Open 'Open
    mkUnsafeCall Env
    env ForeignTarget
    ftarget [CmmFormal
    dest] [CmmExpr
    addr, CmmExpr
    expected, CmmExpr
    new, CmmExpr
    mord_success', CmmExpr
    mord_failure']
      where
        mord_success' :: CmmExpr
    mord_success' = Env -> MemoryOrdering -> CmmExpr
    memoryOrderToTsanMemoryOrder Env
    env MemoryOrdering
    mord_success
        mord_failure' :: CmmExpr
    mord_failure' = Env -> MemoryOrdering -> CmmExpr
    memoryOrderToTsanMemoryOrder Env
    env MemoryOrdering
    mord_failure
        ftarget :: ForeignTarget
    ftarget = FastString -> [ForeignHint] -> [ForeignHint] -> ForeignTarget
    tsanTarget FastString
    fn [ForeignHint
    NoHint] [ForeignHint
    AddrHint, ForeignHint
    NoHint, ForeignHint
    NoHint, ForeignHint
    NoHint, ForeignHint
    NoHint]
        fn :: FastString
    fn = String -> FastString
    fsLit (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ String
    "ghc_tsan_atomic" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Width -> Int
    widthInBits Width
    w) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_compare_exchange"

    tsanAtomicRMW :: Env
                  -> MemoryOrdering -> AtomicMachOp -> Width -> CmmExpr -> CmmExpr -> LocalReg
                  -> Block CmmNode O O
    tsanAtomicRMW :: Env
    -> MemoryOrdering
    -> AtomicMachOp
    -> Width
    -> CmmExpr
    -> CmmExpr
    -> CmmFormal
    -> Block CmmNode 'Open 'Open
    tsanAtomicRMW Env
    env MemoryOrdering
    mord AtomicMachOp
    op Width
    w CmmExpr
    addr CmmExpr
    val CmmFormal
    dest =
        Env
    -> ForeignTarget
    -> [CmmFormal]
    -> [CmmExpr]
    -> Block CmmNode 'Open 'Open
    mkUnsafeCall Env
    env ForeignTarget
    ftarget [CmmFormal
    dest] [CmmExpr
    addr, CmmExpr
    val, CmmExpr
    mord']
      where
        mord' :: CmmExpr
    mord' = Env -> MemoryOrdering -> CmmExpr
    memoryOrderToTsanMemoryOrder Env
    env MemoryOrdering
    mord
        ftarget :: ForeignTarget
    ftarget = FastString -> [ForeignHint] -> [ForeignHint] -> ForeignTarget
    tsanTarget FastString
    fn [ForeignHint
    NoHint] [ForeignHint
    AddrHint, ForeignHint
    NoHint, ForeignHint
    NoHint]
        op' :: String
    op' = case AtomicMachOp
    op of
               AtomicMachOp
    AMO_Add  -> String
    "fetch_add"
               AtomicMachOp
    AMO_Sub  -> String
    "fetch_sub"
               AtomicMachOp
    AMO_And  -> String
    "fetch_and"
               AtomicMachOp
    AMO_Nand -> String
    "fetch_nand"
               AtomicMachOp
    AMO_Or   -> String
    "fetch_or"
               AtomicMachOp
    AMO_Xor  -> String
    "fetch_xor"
        fn :: FastString
    fn = String -> FastString
    fsLit (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ String
    "__tsan_atomic" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Width -> Int
    widthInBits Width
    w) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    op'