1 -----------------------------------------------------------------------------
3 -- Code generation for coverage
5 -- (c) Galois Connections, Inc. 2006
7 -----------------------------------------------------------------------------
9 module CgHpc (cgTickBox, initHpc, hpcTable) where
28 cgTickBox :: Module -> Int -> Code
30 let tick_box = (cmmIndex W64
31 (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
34 stmtsC [ CmmStore tick_box
35 (CmmMachOp (MO_Add W64)
36 [ CmmLoad tick_box b64
37 , CmmLit (CmmInt 1 W64)
41 hpcTable :: Module -> HpcInfo -> Code
42 hpcTable this_mod (HpcInfo hpc_tickCount _) = do
44 [ CmmDataLabel mkHpcModuleNameLabel
45 , CmmString $ map (fromIntegral . ord)
49 emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
51 [ CmmStaticLit (CmmInt 0 W64)
52 | _ <- take hpc_tickCount [0::Int ..]
55 module_name_str = moduleNameString (Module.moduleName this_mod)
56 full_name_str = if modulePackageId this_mod == mainPackageId
58 else packageIdString (modulePackageId this_mod) ++ "/" ++
61 hpcTable _ (NoHpcInfo {}) = error "TODO: impossible"
63 initHpc :: Module -> HpcInfo -> Code
64 initHpc this_mod (HpcInfo tickCount hashNo)
65 = do { id <- newTemp bWord
70 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
73 [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) AddrHint
74 , CmmHinted (word32 tickCount) NoHint
75 , CmmHinted (word32 hashNo) NoHint
76 , CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) AddrHint
79 NoC_SRT -- No SRT b/c we PlayRisky
83 word32 i = CmmLit (CmmInt (fromIntegral (fromIntegral i :: Word32)) W32)
84 mod_alloc = mkFastString "hs_hpc_module"
85 initHpc _ (NoHpcInfo {}) = panic "initHpc: NoHpcInfo"