blob: cb9c7babde70a787bb582f917034428d480696cb (
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
84
85
86
87
88
89
90
91
92
93
|
{-# 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
-----------------------------------------------------------------------------
--
-- 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 CgUtils
import CgMonad
import CgForeignCall
import ForeignCall
import ClosureInfo
import FastString
import HscTypes
import Char
import StaticFlags
import PackageConfig
import Data.Word
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 (HpcInfo hpc_tickCount _) = do
emitData ReadOnlyData
[ CmmDataLabel mkHpcModuleNameLabel
, CmmString $ map (fromIntegral . ord)
(full_name_str)
++ [0]
]
emitData Data $ [ CmmDataLabel (mkHpcTicksLabel this_mod)
] ++
[ CmmStaticLit (CmmInt 0 I64)
| _ <- take hpc_tickCount [0::Int ..]
]
where
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
hpcTable this_mod (NoHpcInfo {}) = error "TODO: impossible"
initHpc :: Module -> HpcInfo -> Code
initHpc this_mod (HpcInfo tickCount hashNo)
= do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW
; emitForeignCall'
PlayRisky
[CmmHinted id NoHint]
(CmmCallee
(CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
CCallConv
)
[ CmmHinted (mkLblExpr mkHpcModuleNameLabel) PtrHint
, CmmHinted (word32 tickCount) NoHint
, CmmHinted (word32 hashNo) NoHint
, CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) PtrHint
]
(Just [])
NoC_SRT -- No SRT b/c we PlayRisky
CmmMayReturn
}
where
word32 i = CmmLit (CmmInt (fromIntegral (fromIntegral i :: Word32)) I32)
mod_alloc = mkFastString "hs_hpc_module"
|
