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
|
module GHC.HsToCore.Breakpoints
( mkModBreaks
) where
import GHC.Prelude
import qualified GHC.Runtime.Interpreter as GHCi
import GHC.Runtime.Interpreter.Types
import GHCi.RemoteTypes
import GHC.ByteCode.Types
import GHC.Stack.CCS
import GHC.Unit
import GHC.HsToCore.Ticks (Tick (..))
import GHC.Data.SizedSeq
import GHC.Utils.Outputable as Outputable
import Data.List (intersperse)
import Data.Array
-- | Initialize memory for breakpoint data that is shared between the bytecode
-- generator and the interpreter.
--
-- Since GHCi and the RTS need to interact with breakpoint data and the bytecode
-- generator needs to encode this information for each expression, the data is
-- allocated remotely in GHCi's address space and passed to the codegen as
-- foreign pointers.
mkModBreaks :: Interp -> Module -> SizedSeq Tick -> IO ModBreaks
mkModBreaks interp mod extendedMixEntries
= do
let count = fromIntegral $ sizeSS extendedMixEntries
entries = ssElts extendedMixEntries
breakArray <- GHCi.newBreakArray interp count
ccs <- mkCCSArray interp mod count entries
mod_ptr <- GHCi.newModuleName interp (moduleName mod)
let
locsTicks = listArray (0,count-1) [ tick_loc t | t <- entries ]
varsTicks = listArray (0,count-1) [ tick_ids t | t <- entries ]
declsTicks = listArray (0,count-1) [ tick_path t | t <- entries ]
return $ emptyModBreaks
{ modBreaks_flags = breakArray
, modBreaks_locs = locsTicks
, modBreaks_vars = varsTicks
, modBreaks_decls = declsTicks
, modBreaks_ccs = ccs
, modBreaks_module = mod_ptr
}
mkCCSArray
:: Interp -> Module -> Int -> [Tick]
-> IO (Array BreakIndex (RemotePtr GHC.Stack.CCS.CostCentre))
mkCCSArray interp modul count entries
| GHCi.interpreterProfiled interp = do
let module_str = moduleNameString (moduleName modul)
costcentres <- GHCi.mkCostCentres interp module_str (map mk_one entries)
return (listArray (0,count-1) costcentres)
| otherwise = return (listArray (0,-1) [])
where
mk_one t = (name, src)
where name = concat $ intersperse "." $ tick_path t
src = renderWithContext defaultSDocContext $ ppr $ tick_loc t
|
