1 -----------------------------------------------------------------------------
3 -- Code generation for coverage
5 -- (c) Galois Connections, Inc. 2006
7 -----------------------------------------------------------------------------
9 module CgHpc (cgTickBox, initHpc, hpcTable) where
26 cgTickBox :: Module -> Int -> Code
28 let tick_box = (cmmIndex I64
29 (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
32 stmtsC [ CmmStore tick_box
33 (CmmMachOp (MO_Add I64)
34 [ CmmLoad tick_box I64
35 , CmmLit (CmmInt 1 I64)
39 visible_tick = mkFastString "hs_hpc_tick"
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 I64)
52 | _ <- take hpc_tickCount [0..]
55 module_name_str = moduleNameString (Module.moduleName this_mod)
56 hpcTable this_mod (NoHpcInfo) = error "TODO: impossible"
58 initHpc :: Module -> HpcInfo -> Code
59 initHpc this_mod (HpcInfo tickCount hashNo)
60 = do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW
65 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
68 [ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
69 , (CmmLit $ mkIntCLit tickCount,NoHint)
70 , (CmmLit $ mkIntCLit hashNo,NoHint)
71 , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
74 NoC_SRT -- No SRT b/c we PlayRisky
77 mod_alloc = mkFastString "hs_hpc_module"