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 CgHpc (cgTickBox, initHpc, hpcTable) where
34 cgTickBox :: Module -> Int -> Code
36 let tick_box = (cmmIndex I64
37 (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
40 stmtsC [ CmmStore tick_box
41 (CmmMachOp (MO_Add I64)
42 [ CmmLoad tick_box I64
43 , CmmLit (CmmInt 1 I64)
47 hpcTable :: Module -> HpcInfo -> Code
48 hpcTable this_mod (HpcInfo hpc_tickCount _) = do
50 [ CmmDataLabel mkHpcModuleNameLabel
51 , CmmString $ map (fromIntegral . ord)
55 emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
57 [ CmmStaticLit (CmmInt 0 I64)
58 | _ <- take hpc_tickCount [0::Int ..]
61 module_name_str = moduleNameString (Module.moduleName this_mod)
62 full_name_str = if modulePackageId this_mod == mainPackageId
64 else packageIdString (modulePackageId this_mod) ++ "/" ++
67 hpcTable this_mod (NoHpcInfo {}) = error "TODO: impossible"
69 initHpc :: Module -> HpcInfo -> Code
70 initHpc this_mod (HpcInfo tickCount hashNo)
71 = do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW
76 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
79 [ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
80 , (CmmLit $ mkIntCLit tickCount,NoHint)
81 , (CmmLit $ mkIntCLit hashNo,NoHint)
82 , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
85 NoC_SRT -- No SRT b/c we PlayRisky
89 mod_alloc = mkFastString "hs_hpc_module"