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