module StgCmmHpc ( initHpc, mkTickBox ) where
-import StgCmmUtils
import StgCmmMonad
-import StgCmmForeign
-import MkZipCfgCmm
-import Cmm
+import MkGraph
+import CmmDecl
+import CmmExpr
import CLabel
import Module
import CmmUtils
-import FastString
import HscTypes
-import Char
import StaticFlags
mkTickBox :: Module -> Int -> CmmAGraph
where
tick_box = cmmIndex W64
(CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
- (fromIntegral n)
+ n
-initHpc :: Module -> HpcInfo -> FCode CmmAGraph
+initHpc :: Module -> HpcInfo -> FCode ()
-- Emit top-level tables for HPC and return code to initialise
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)
+ = return ()
+initHpc this_mod (HpcInfo tickCount _hashNo)
+ = whenC opt_Hpc $
+ do { emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++
[ CmmStaticLit (CmmInt 0 W64)
| _ <- take tickCount [0::Int ..]
]
-
- ; id <- newTemp bWord -- TODO FIXME NOW
- ; emitCCall
- [(id,NoHint)]
- (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False 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
-
-
-