1 -----------------------------------------------------------------------------
3 -- Code generation for coverage
5 -- (c) Galois Connections, Inc. 2006
7 -----------------------------------------------------------------------------
9 module CgHpc (cgTickBox, initHpc, hpcTable) where
25 cgTickBox :: Module -> Int -> Code
27 let tick_box = (cmmIndex I64
28 (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
31 stmtsC [ CmmStore tick_box
32 (CmmMachOp (MO_Add I64)
33 [ CmmLoad tick_box I64
34 , CmmLit (CmmInt 1 I64)
37 let ext_tick_box = CmmLit $ CmmLabel $ mkHpcModuleOffsetLabel $ mod
39 whenC (opt_Hpc_Tracer) $ do
44 (CmmLit $ CmmLabel $ mkForeignLabel visible_tick Nothing False)
47 [ (CmmMachOp (MO_Add I32)
48 [ CmmLoad ext_tick_box I32
49 , CmmLit (CmmInt (fromIntegral n) I32)
54 visible_tick = mkFastString "hs_hpc_tick"
56 hpcTable :: Module -> HpcInfo -> Code
57 hpcTable this_mod hpc_tickCount = do
59 [ CmmDataLabel mkHpcModuleNameLabel
60 , CmmString $ map (fromIntegral . ord)
65 [ CmmDataLabel (mkHpcModuleOffsetLabel this_mod)
66 , CmmStaticLit (CmmInt 0 I32)
68 emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
70 [ CmmStaticLit (CmmInt 0 I64)
71 | _ <- take hpc_tickCount [0..]
74 module_name_str = moduleNameString (Module.moduleName this_mod)
77 initHpc :: Module -> HpcInfo -> Code
78 initHpc this_mod tickCount
79 = do { id <- newTemp wordRep
84 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
87 [ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
88 , (CmmLit $ mkIntCLit tickCount,NoHint)
89 , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
92 ; let ext_tick_box = CmmLit $ CmmLabel $ mkHpcModuleOffsetLabel $ this_mod
93 ; stmtsC [ CmmStore ext_tick_box (CmmReg id) ]
96 mod_alloc = mkFastString "hs_hpc_module"