1 -----------------------------------------------------------------------------
3 -- Code generation for coverage
5 -- (c) Galois Connections, Inc. 2006
7 -----------------------------------------------------------------------------
9 module StgCmmHpc ( initHpc, mkTickBox ) where
26 mkTickBox :: Module -> Int -> CmmAGraph
28 = mkStore tick_box (CmmMachOp (MO_Add W64)
29 [ CmmLoad tick_box b64
30 , CmmLit (CmmInt 1 W64)
33 tick_box = cmmIndex W64
34 (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
37 initHpc :: Module -> HpcInfo -> FCode CmmAGraph
38 -- Emit top-level tables for HPC and return code to initialise
39 initHpc _ (NoHpcInfo {})
41 initHpc this_mod (HpcInfo tickCount hashNo)
42 = getCode $ whenC opt_Hpc $
43 do { emitData ReadOnlyData
44 [ CmmDataLabel mkHpcModuleNameLabel
45 , CmmString $ map (fromIntegral . ord)
49 ; emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
51 [ CmmStaticLit (CmmInt 0 W64)
52 | _ <- take tickCount [0::Int ..]
55 ; id <- newTemp bWord -- TODO FIXME NOW
58 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
59 [ (mkLblExpr mkHpcModuleNameLabel,AddrHint)
60 , (CmmLit $ mkIntCLit tickCount,NoHint)
61 , (CmmLit $ mkIntCLit hashNo,NoHint)
62 , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,AddrHint)
66 mod_alloc = mkFastString "hs_hpc_module"
67 module_name_str = moduleNameString (Module.moduleName this_mod)
68 full_name_str = if modulePackageId this_mod == mainPackageId
70 else packageIdString (modulePackageId this_mod) ++ "/" ++