1 -----------------------------------------------------------------------------
3 -- Code generation for coverage
5 -- (c) Galois Connections, Inc. 2006
7 -----------------------------------------------------------------------------
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 module StgCmmHpc ( initHpc, mkTickBox ) where
35 mkTickBox :: Module -> Int -> CmmAGraph
37 = mkStore tick_box (CmmMachOp (MO_Add W64)
38 [ CmmLoad tick_box b64
39 , CmmLit (CmmInt 1 W64)
42 tick_box = cmmIndex W64
43 (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
46 initHpc :: Module -> HpcInfo -> FCode CmmAGraph
47 -- Emit top-level tables for HPC and return code to initialise
48 initHpc this_mod (NoHpcInfo {})
50 initHpc this_mod (HpcInfo tickCount hashNo)
51 = getCode $ whenC opt_Hpc $
52 do { emitData ReadOnlyData
53 [ CmmDataLabel mkHpcModuleNameLabel
54 , CmmString $ map (fromIntegral . ord)
58 ; emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
60 [ CmmStaticLit (CmmInt 0 W64)
61 | _ <- take tickCount [0::Int ..]
64 ; id <- newTemp bWord -- TODO FIXME NOW
67 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
68 [ (mkLblExpr mkHpcModuleNameLabel,AddrHint)
69 , (CmmLit $ mkIntCLit tickCount,NoHint)
70 , (CmmLit $ mkIntCLit hashNo,NoHint)
71 , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,AddrHint)
75 mod_alloc = mkFastString "hs_hpc_module"
76 module_name_str = moduleNameString (Module.moduleName this_mod)
77 full_name_str = if modulePackageId this_mod == mainPackageId
79 else packageIdString (modulePackageId this_mod) ++ "/" ++