1 -----------------------------------------------------------------------------
3 -- Code generation for coverage
5 -- (c) Galois Connections, Inc. 2006
7 -----------------------------------------------------------------------------
9 module CgHpc (cgTickBox, initHpc, hpcTable) where
23 cgTickBox :: Module -> Int -> Code
25 let tick_box = (cmmIndex I64
26 (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
29 stmtsC [ CmmStore tick_box
30 (CmmMachOp (MO_Add I64)
31 [ CmmLoad tick_box I64
32 , CmmLit (CmmInt 1 I64)
37 hpcTable :: Module -> HpcInfo -> Code
38 hpcTable this_mod hpc_tickCount = do
40 [ CmmDataLabel mkHpcModuleNameLabel
41 , CmmString $ map (fromIntegral . ord)
45 emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
47 [ CmmStaticLit (CmmInt 0 I64)
48 | _ <- take hpc_tickCount [0..]
51 module_name_str = moduleNameString (Module.moduleName this_mod)
54 initHpc :: Module -> HpcInfo -> Code
55 initHpc this_mod tickCount
56 = do { emitForeignCall'
60 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
63 [ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
64 , (CmmLit $ mkIntCLit tickCount,NoHint)
65 , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
70 mod_alloc = mkFastString "hs_hpc_module"