module StgCmmHpc ( initHpc, mkTickBox ) where
import StgCmmUtils
import StgCmmMonad
import StgCmmForeign
import MkZipCfgCmm
import Cmm
import CLabel
import Module
import CmmUtils
import FastString
import HscTypes
import Data.Char
import StaticFlags
import BasicTypes
mkTickBox :: Module -> Int -> CmmAGraph
mkTickBox mod n
= mkStore tick_box (CmmMachOp (MO_Add W64)
[ CmmLoad tick_box b64
, CmmLit (CmmInt 1 W64)
])
where
tick_box = cmmIndex W64
(CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
(fromIntegral n)
initHpc :: Module -> HpcInfo -> FCode CmmAGraph
initHpc _ (NoHpcInfo {})
= return mkNop
initHpc this_mod (HpcInfo tickCount hashNo)
= getCode $ whenC opt_Hpc $
do { emitData ReadOnlyData
[ CmmDataLabel mkHpcModuleNameLabel
, CmmString $ map (fromIntegral . ord)
(full_name_str)
++ [0]
]
; emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++
[ CmmStaticLit (CmmInt 0 W64)
| _ <- take tickCount [0::Int ..]
]
; id <- newTemp bWord
; emitCCall
[(id,NoHint)]
(CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
[ (mkLblExpr mkHpcModuleNameLabel,AddrHint)
, (CmmLit $ mkIntCLit tickCount,NoHint)
, (CmmLit $ mkIntCLit hashNo,NoHint)
, (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,AddrHint)
]
}
where
mod_alloc = mkFastString "hs_hpc_module"
module_name_str = moduleNameString (Module.moduleName this_mod)
full_name_str = if modulePackageId this_mod == mainPackageId
then module_name_str
else packageIdString (modulePackageId this_mod) ++ "/" ++
module_name_str