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 CgUtils
  17 import CgMonad
  18 import CgForeignCall
  19 import ForeignCall
  20 import ClosureInfo
  21 import FastString
  22 import HscTypes
  23 import Char
  24 import StaticFlags
  25
  26 cgTickBox :: Module -> Int -> Code
  27 cgTickBox mod n = do
  28        let tick_box = (cmmIndex I64
  29                        (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
  30                        (fromIntegral n)
  31                       )
  32        stmtsC [ CmmStore tick_box
  33                          (CmmMachOp (MO_Add I64)
  34                                                [ CmmLoad tick_box I64
  35                                                , CmmLit (CmmInt 1 I64)
  36                                                ])
  37               ]
  38    where
  39       visible_tick = mkFastString "hs_hpc_tick"
  40
  41 hpcTable :: Module -> HpcInfo -> Code
  42 hpcTable this_mod (HpcInfo hpc_tickCount _) = do
  43                         emitData ReadOnlyData
  44                                         [ CmmDataLabel mkHpcModuleNameLabel
  45                                         , CmmString $ map (fromIntegral . ord)
  46                                                          (module_name_str)
  47                                                       ++ [0]
  48                                         ]
  49                         emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
  50                                         ] ++
  51                                         [ CmmStaticLit (CmmInt 0 I64)
  52                                         | _ <- take hpc_tickCount [0..]
  53                                         ]
  54   where
  55     module_name_str = moduleNameString (Module.moduleName this_mod)
  56 hpcTable this_mod (NoHpcInfo) = error "TODO: impossible"
  57
  58 initHpc :: Module -> HpcInfo -> Code
  59 initHpc this_mod (HpcInfo tickCount hashNo)
  60   = do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW
  61        ; emitForeignCall'
  62                PlayRisky
  63                [(id,NoHint)]
  64                (CmmForeignCall
  65                  (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
  66                   CCallConv
  67                )
  68                [ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
  69                , (CmmLit $ mkIntCLit tickCount,NoHint)
  70                , (CmmLit $ mkIntCLit hashNo,NoHint)
  71                , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
  72                ]
  73                (Just [])
  74                NoC_SRT -- No SRT b/c we PlayRisky
  75        }
  76   where
  77        mod_alloc = mkFastString "hs_hpc_module"
  78