blob: 9620973d1045f036c67d00fd45b3996981b562fd (
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
|
-----------------------------------------------------------------------------
--
-- Code generation for coverage
--
-- (c) Galois Connections, Inc. 2006
--
-----------------------------------------------------------------------------
module CgHpc (cgTickBox, initHpc, hpcTable) where
import Cmm
import CLabel
import Module
import MachOp
import CmmUtils
import CgMonad
import CgForeignCall
import ForeignCall
import FastString
import HscTypes
import Char
cgTickBox :: Module -> Int -> Code
cgTickBox mod n = do
let tick_box = (cmmIndex I64
(CmmLit $ CmmLabel $ mkHpcTicksLabel $ mod)
(fromIntegral n)
)
stmtsC [ CmmStore tick_box
(CmmMachOp (MO_Add I64)
[ CmmLoad tick_box I64
, CmmLit (CmmInt 1 I64)
])
]
hpcTable :: Module -> HpcInfo -> Code
hpcTable this_mod hpc_tickCount = do
emitData ReadOnlyData
[ CmmDataLabel mkHpcModuleNameLabel
, CmmString $ map (fromIntegral . ord)
(module_name_str)
++ [0]
]
emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++
[ CmmStaticLit (CmmInt 0 I64)
| _ <- take hpc_tickCount [0..]
]
where
module_name_str = moduleNameString (Module.moduleName this_mod)
initHpc :: Module -> HpcInfo -> Code
initHpc this_mod tickCount
= do { emitForeignCall'
PlayRisky
[]
(CmmForeignCall
(CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
CCallConv
)
[ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
, (CmmLit $ mkIntCLit tickCount,NoHint)
, (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
]
(Just [])
}
where
mod_alloc = mkFastString "hs_hpc_module"
|
