compiler/codeGen/CgHpc.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Code generation for coverage
   4 --
   5 -- (c) Galois Connections, Inc. 2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module CgHpc (cgTickBox, initHpc, hpcTable) where
  10
  11 import Cmm
  12 import CLabel
  13 import Module
  14 import MachOp
  15 import CmmUtils
  16 import CgMonad
  17 import CgForeignCall
  18 import ForeignCall
  19 import FastString
  20 import HscTypes
  21 import Char
  22
  23 cgTickBox :: Module -> Int -> Code
  24 cgTickBox mod n = do
  25        let tick_box = (cmmIndex I64
  26                        (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
  27                        (fromIntegral n)
  28                       )
  29        stmtsC [ CmmStore tick_box
  30                          (CmmMachOp (MO_Add I64)
  31                                                [ CmmLoad tick_box I64
  32                                                , CmmLit (mkIntCLit 1)
  33                                                ])
  34               ]
  35
  36
  37 hpcTable :: Module -> HpcInfo -> Code
  38 hpcTable this_mod hpc_tickCount = do
  39                         emitData ReadOnlyData
  40                                         [ CmmDataLabel mkHpcModuleNameLabel
  41                                         , CmmString $ map (fromIntegral . ord)
  42                                                          (module_name_str)
  43                                                       ++ [0]
  44                                         ]
  45                         emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
  46                                         ] ++
  47                                         [ CmmStaticLit (CmmInt 0 I64)
  48                                         | _ <- take hpc_tickCount [0..]
  49                                         ]
  50   where
  51     module_name_str = moduleNameString (Module.moduleName this_mod)
  52
  53
  54 initHpc :: Module -> HpcInfo -> Code
  55 initHpc this_mod tickCount
  56   = do { emitForeignCall'
  57                PlayRisky
  58                []
  59                (CmmForeignCall
  60                  (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
  61                   CCallConv
  62                )
  63                [ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
  64                , (CmmLit $ mkIntCLit tickCount,NoHint)
  65                , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
  66                ]
  67                (Just [])
  68        }
  69   where
  70        mod_alloc = mkFastString "hs_hpc_module"
  71