compiler/codeGen/StgCmmHpc.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Code generation for coverage
   4 --
   5 -- (c) Galois Connections, Inc. 2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module StgCmmHpc ( initHpc, mkTickBox ) where
  10
  11 import StgCmmUtils
  12 import StgCmmMonad
  13 import StgCmmForeign
  14
  15 import MkGraph
  16 import CmmDecl
  17 import CmmExpr
  18 import CLabel
  19 import Module
  20 import CmmUtils
  21 import FastString
  22 import HscTypes
  23 import Data.Char
  24 import StaticFlags
  25 import BasicTypes
  26
  27 mkTickBox :: Module -> Int -> CmmAGraph
  28 mkTickBox mod n
  29   = mkStore tick_box (CmmMachOp (MO_Add W64)
  30                                 [ CmmLoad tick_box b64
  31                                 , CmmLit (CmmInt 1 W64)
  32                                 ])
  33   where
  34     tick_box = cmmIndex W64
  35                         (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
  36                         n
  37
  38 initHpc :: Module -> HpcInfo -> FCode CmmAGraph
  39 -- Emit top-level tables for HPC and return code to initialise
  40 initHpc _ (NoHpcInfo {})
  41   = return mkNop
  42 initHpc this_mod (HpcInfo tickCount hashNo)
  43   = getCode $ whenC opt_Hpc $
  44     do  { emitData ReadOnlyData
  45               [ CmmDataLabel mkHpcModuleNameLabel
  46               , CmmString $ map (fromIntegral . ord)
  47                                (full_name_str)
  48                             ++ [0]
  49               ]
  50         ; emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
  51               ] ++
  52               [ CmmStaticLit (CmmInt 0 W64)
  53               | _ <- take tickCount [0::Int ..]
  54               ]
  55
  56         ; id <- newTemp bWord -- TODO FIXME NOW
  57         ; emitCCall
  58                [(id,NoHint)]
  59                (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
  60                [ (mkLblExpr mkHpcModuleNameLabel,AddrHint)
  61                , (CmmLit $ mkIntCLit tickCount,NoHint)
  62                , (CmmLit $ mkIntCLit hashNo,NoHint)
  63                , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,AddrHint)
  64                ]
  65        }
  66   where
  67     mod_alloc = mkFastString "hs_hpc_module"
  68     module_name_str = moduleNameString (Module.moduleName this_mod)
  69     full_name_str   = if modulePackageId this_mod == mainPackageId
  70                       then module_name_str
  71                       else packageIdString (modulePackageId this_mod) ++ "/" ++
  72                            module_name_str
  73
  74
  75