blob: 0205bd0911ca1a297845a7c7510235075637ef2b (
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
76
77
78
79
80
81
82
83
|
-----------------------------------------------------------------------------
--
-- Code generation for coverage
--
-- (c) Galois Connections, Inc. 2006
--
-----------------------------------------------------------------------------
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module StgCmmHpc ( initHpc, mkTickBox ) where
import StgCmmUtils
import StgCmmMonad
import StgCmmForeign
import StgCmmClosure
import MkZipCfgCmm
import Cmm
import CLabel
import Module
import CmmUtils
import ForeignCall
import FastString
import HscTypes
import Char
import StaticFlags
import PackageConfig
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)
(fromIntegral n)
initHpc :: Module -> HpcInfo -> FCode CmmAGraph
-- Emit top-level tables for HPC and return code to initialise
initHpc this_mod (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 False)
[ (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
|
