summaryrefslogtreecommitdiff
path: root/compiler/GHC/StgToCmm/Hpc.hs
blob: fd2a84c6e225d030ed87ac0d0a50108be84084ac (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
-----------------------------------------------------------------------------
--
-- Code generation for coverage
--
-- (c) Galois Connections, Inc. 2006
--
-----------------------------------------------------------------------------

module GHC.StgToCmm.Hpc ( initHpc, mkTickBox ) where

import GHC.Prelude
import GHC.Platform

import GHC.StgToCmm.Monad
import GHC.StgToCmm.Utils

import GHC.Cmm.Graph
import GHC.Cmm.Expr
import GHC.Cmm.CLabel
import GHC.Cmm.Utils

import GHC.Unit.Module
import GHC.Types.HpcInfo

import Control.Monad

mkTickBox :: Platform -> Module -> Int -> CmmAGraph
mkTickBox platform mod n
  = mkStore tick_box (CmmMachOp (MO_Add W64)
                                [ CmmLoad tick_box b64 NaturallyAligned
                                , CmmLit (CmmInt 1 W64)
                                ])
  where
    tick_box = cmmIndex platform W64
                        (CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
                        n

-- | Emit top-level tables for HPC and return code to initialise
initHpc :: Module -> HpcInfo -> FCode ()
initHpc _ NoHpcInfo{}
  = return ()
initHpc this_mod (HpcInfo tickCount _hashNo)
  = do do_hpc <- stgToCmmOptHpc <$> getStgToCmmConfig
       when do_hpc $
           emitDataLits (mkHpcTicksLabel this_mod)
                        [ CmmInt 0 W64
                        | _ <- take tickCount [0 :: Int ..]
                        ]