blob: a93af34961b5c3db9cefb548c82348f456898ab9 (
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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
-----------------------------------------------------------------------------
--
-- Code generation for coverage
--
-- (c) Galois Connections, Inc. 2006
--
-----------------------------------------------------------------------------
module StgCmmHpc ( initHpc, mkTickBox ) where
import StgCmmUtils
import StgCmmMonad
import StgCmmForeign
import MkGraph
import CmmDecl
import CmmExpr
import CLabel
import Module
import CmmUtils
import FastString
import HscTypes
import Data.Char
import StaticFlags
import BasicTypes
mkTickBox :: Module -> Int -> CmmAGraph
mkTickBox mod n
= mkStore tick_box (CmmMachOp (MO_Add W64)
[ CmmLoad tick_box b64
, CmmLit (CmmInt 1 W64)
])
where
tick_box = cmmIndex W64
(CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
n
initHpc :: Module -> HpcInfo -> FCode CmmAGraph
-- Emit top-level tables for HPC and return code to initialise
initHpc _ (NoHpcInfo {})
= return mkNop
initHpc this_mod (HpcInfo tickCount hashNo)
= getCode $ whenC opt_Hpc $
do { emitData ReadOnlyData
[ CmmDataLabel mkHpcModuleNameLabel
, CmmString $ map (fromIntegral . ord)
(full_name_str)
++ [0]
]
; emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++
[ CmmStaticLit (CmmInt 0 W64)
| _ <- take tickCount [0::Int ..]
]
; id <- newTemp bWord -- TODO FIXME NOW
; emitCCall
[(id,NoHint)]
(CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
[ (mkLblExpr mkHpcModuleNameLabel,AddrHint)
, (CmmLit $ mkIntCLit tickCount,NoHint)
, (CmmLit $ mkIntCLit hashNo,NoHint)
, (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,AddrHint)
]
}
where
mod_alloc = mkFastString "hs_hpc_module"
module_name_str = moduleNameString (Module.moduleName this_mod)
full_name_str = if modulePackageId this_mod == mainPackageId
then module_name_str
else packageIdString (modulePackageId this_mod) ++ "/" ++
module_name_str
|
