2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
8 -----------------------------------------------------------------------------
10 -- Code generation for coverage
12 -- (c) Galois Connections, Inc. 2006
14 -----------------------------------------------------------------------------
16 module CgHpc (cgTickBox, initHpc, hpcTable) where
36 cgTickBox :: Module -> Int -> Code
38 let tick_box = (cmmIndex I64
39 (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
42 stmtsC [ CmmStore tick_box
43 (CmmMachOp (MO_Add I64)
44 [ CmmLoad tick_box I64
45 , CmmLit (CmmInt 1 I64)
49 hpcTable :: Module -> HpcInfo -> Code
50 hpcTable this_mod (HpcInfo hpc_tickCount _) = do
52 [ CmmDataLabel mkHpcModuleNameLabel
53 , CmmString $ map (fromIntegral . ord)
57 emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
59 [ CmmStaticLit (CmmInt 0 I64)
60 | _ <- take hpc_tickCount [0::Int ..]
63 module_name_str = moduleNameString (Module.moduleName this_mod)
64 full_name_str = if modulePackageId this_mod == mainPackageId
66 else packageIdString (modulePackageId this_mod) ++ "/" ++
69 hpcTable this_mod (NoHpcInfo {}) = error "TODO: impossible"
71 initHpc :: Module -> HpcInfo -> Code
72 initHpc this_mod (HpcInfo tickCount hashNo)
73 = do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW
78 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
81 [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) PtrHint
82 , CmmHinted (word32 tickCount) NoHint
83 , CmmHinted (word32 hashNo) NoHint
84 , CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) PtrHint
87 NoC_SRT -- No SRT b/c we PlayRisky
91 word32 i = CmmLit (CmmInt (fromIntegral (fromIntegral i :: Word32)) I32)
92 mod_alloc = mkFastString "hs_hpc_module"