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