-----------------------------------------------------------------------------
--
-- Code generation for coverage
--
-- (c) Galois Connections, Inc. 2006
--
-----------------------------------------------------------------------------

module StgCmmHpc ( initHpc, mkTickBox ) where

import GhcPrelude

import StgCmmMonad

import MkGraph
import CmmExpr
import CLabel
import Module
import CmmUtils
import StgCmmUtils
import HscTypes
import DynFlags

import Control.Monad

mkTickBox :: DynFlags -> Module -> Int -> CmmAGraph
mkTickBox :: DynFlags -> Module -> Int -> CmmAGraph
mkTickBox dflags :: DynFlags
dflags mod :: Module
mod n :: Int
n
  = CmmExpr -> CmmExpr -> CmmAGraph
mkStore CmmExpr
tick_box (MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W64)
                                [ CmmExpr -> CmmType -> CmmExpr
CmmLoad CmmExpr
tick_box CmmType
b64
                                , CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt 1 Width
W64)
                                ])
  where
    tick_box :: CmmExpr
tick_box = DynFlags -> Width -> CmmExpr -> Int -> CmmExpr
cmmIndex DynFlags
dflags 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 ()
-- Emit top-level tables for HPC and return code to initialise
initHpc :: Module -> HpcInfo -> FCode ()
initHpc _ (NoHpcInfo {})
  = () -> FCode ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
initHpc this_mod :: Module
this_mod (HpcInfo tickCount :: Int
tickCount _hashNo :: Int
_hashNo)
  = do DynFlags
dflags <- FCode DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
       Bool -> FCode () -> FCode ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Hpc DynFlags
dflags) (FCode () -> FCode ()) -> FCode () -> FCode ()
forall a b. (a -> b) -> a -> b
$
           do CLabel -> [CmmLit] -> FCode ()
emitDataLits (Module -> CLabel
mkHpcTicksLabel Module
this_mod)
                           [ (Integer -> Width -> CmmLit
CmmInt 0 Width
W64)
                           | Int
_ <- Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
tickCount [0 :: Int ..]
                           ]