module GHC.StgToCmm.Hpc ( initHpc, mkTickBox ) where
import GHC.Prelude
import GHC.Platform
import GHC.StgToCmm.Monad
import GHC.StgToCmm.Utils
import GHC.Cmm.Graph
import GHC.Cmm.Expr
import GHC.Cmm.CLabel
import GHC.Cmm.Utils
import GHC.Unit.Module
import GHC.Types.HpcInfo
import Control.Monad
mkTickBox :: Platform -> Module -> Int -> CmmAGraph
mkTickBox :: Platform -> Module -> Int -> CmmAGraph
mkTickBox Platform
platform Module
mod Int
n
= CmmExpr -> CmmExpr -> CmmAGraph
mkStore CmmExpr
tick_box (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W64)
[ CmmExpr -> CmmType -> AlignmentSpec -> CmmExpr
CmmLoad CmmExpr
tick_box CmmType
b64 AlignmentSpec
NaturallyAligned
, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt Integer
1 Width
W64)
])
where
tick_box :: CmmExpr
tick_box = Platform -> Width -> CmmExpr -> Int -> CmmExpr
cmmIndex Platform
platform Width
W64
(CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
forall a b. (a -> b) -> a -> b
$ Module -> CLabel
mkHpcTicksLabel (Module -> CLabel) -> Module -> CLabel
forall a b. (a -> b) -> a -> b
$ Module
mod)
Int
n
initHpc :: Module -> HpcInfo -> FCode ()
initHpc :: Module -> HpcInfo -> FCode ()
initHpc Module
_ NoHpcInfo{}
= () -> FCode ()
forall a. a -> FCode a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
initHpc Module
this_mod (HpcInfo Int
tickCount Int
_hashNo)
= do do_hpc <- StgToCmmConfig -> Bool
stgToCmmOptHpc (StgToCmmConfig -> Bool) -> FCode StgToCmmConfig -> FCode Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FCode StgToCmmConfig
getStgToCmmConfig
when do_hpc $
emitDataLits (mkHpcTicksLabel this_mod)
[ CmmInt 0 W64
| _ <- take tickCount [0 :: Int ..]
]