Fix #8487: Debugger confuses variables
[ghc.git] / compiler / ghci / ByteCodeTypes.hs
1 {-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
2 --
3 -- (c) The University of Glasgow 2002-2006
4 --
5
6 -- | Bytecode assembler types
7 module ByteCodeTypes
8 ( CompiledByteCode(..), seqCompiledByteCode, FFIInfo(..)
9 , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
10 , ItblEnv, ItblPtr(..)
11 , CgBreakInfo(..)
12 , ModBreaks (..), BreakIndex, emptyModBreaks
13 , CCostCentre
14 ) where
15
16 import GhcPrelude
17
18 import FastString
19 import Id
20 import Name
21 import NameEnv
22 import Outputable
23 import PrimOp
24 import SizedSeq
25 import Type
26 import SrcLoc
27 import GHCi.BreakArray
28 import GHCi.RemoteTypes
29 import GHCi.FFI
30 import Control.DeepSeq
31
32 import Foreign
33 import Data.Array
34 import Data.Array.Base ( UArray(..) )
35 import Data.ByteString (ByteString)
36 import Data.IntMap (IntMap)
37 import qualified Data.IntMap as IntMap
38 import Data.Maybe (catMaybes)
39 import GHC.Exts.Heap
40 import GHC.Stack.CCS
41
42 -- -----------------------------------------------------------------------------
43 -- Compiled Byte Code
44
45 data CompiledByteCode = CompiledByteCode
46 { bc_bcos :: [UnlinkedBCO] -- Bunch of interpretable bindings
47 , bc_itbls :: ItblEnv -- A mapping from DataCons to their itbls
48 , bc_ffis :: [FFIInfo] -- ffi blocks we allocated
49 , bc_strs :: [RemotePtr ()] -- malloc'd strings
50 , bc_breaks :: Maybe ModBreaks -- breakpoint info (Nothing if we're not
51 -- creating breakpoints, for some reason)
52 }
53 -- ToDo: we're not tracking strings that we malloc'd
54 newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)
55 deriving (Show, NFData)
56
57 instance Outputable CompiledByteCode where
58 ppr CompiledByteCode{..} = ppr bc_bcos
59
60 -- Not a real NFData instance, because ModBreaks contains some things
61 -- we can't rnf
62 seqCompiledByteCode :: CompiledByteCode -> ()
63 seqCompiledByteCode CompiledByteCode{..} =
64 rnf bc_bcos `seq`
65 rnf (nameEnvElts bc_itbls) `seq`
66 rnf bc_ffis `seq`
67 rnf bc_strs `seq`
68 rnf (fmap seqModBreaks bc_breaks)
69
70 type ItblEnv = NameEnv (Name, ItblPtr)
71 -- We need the Name in the range so we know which
72 -- elements to filter out when unloading a module
73
74 newtype ItblPtr = ItblPtr (RemotePtr StgInfoTable)
75 deriving (Show, NFData)
76
77 data UnlinkedBCO
78 = UnlinkedBCO {
79 unlinkedBCOName :: !Name,
80 unlinkedBCOArity :: {-# UNPACK #-} !Int,
81 unlinkedBCOInstrs :: !(UArray Int Word16), -- insns
82 unlinkedBCOBitmap :: !(UArray Int Word64), -- bitmap
83 unlinkedBCOLits :: !(SizedSeq BCONPtr), -- non-ptrs
84 unlinkedBCOPtrs :: !(SizedSeq BCOPtr) -- ptrs
85 }
86
87 instance NFData UnlinkedBCO where
88 rnf UnlinkedBCO{..} =
89 rnf unlinkedBCOLits `seq`
90 rnf unlinkedBCOPtrs
91
92 data BCOPtr
93 = BCOPtrName !Name
94 | BCOPtrPrimOp !PrimOp
95 | BCOPtrBCO !UnlinkedBCO
96 | BCOPtrBreakArray -- a pointer to this module's BreakArray
97
98 instance NFData BCOPtr where
99 rnf (BCOPtrBCO bco) = rnf bco
100 rnf x = x `seq` ()
101
102 data BCONPtr
103 = BCONPtrWord {-# UNPACK #-} !Word
104 | BCONPtrLbl !FastString
105 | BCONPtrItbl !Name
106 | BCONPtrStr !ByteString
107
108 instance NFData BCONPtr where
109 rnf x = x `seq` ()
110
111 -- | Information about a breakpoint that we know at code-generation time
112 data CgBreakInfo
113 = CgBreakInfo
114 { cgb_vars :: [Maybe (Id,Word16)]
115 , cgb_resty :: Type
116 }
117 -- See Note [Syncing breakpoint info] in compiler/main/InteractiveEval.hs
118
119 -- Not a real NFData instance because we can't rnf Id or Type
120 seqCgBreakInfo :: CgBreakInfo -> ()
121 seqCgBreakInfo CgBreakInfo{..} =
122 rnf (map snd (catMaybes (cgb_vars))) `seq`
123 seqType cgb_resty
124
125 instance Outputable UnlinkedBCO where
126 ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
127 = sep [text "BCO", ppr nm, text "with",
128 ppr (sizeSS lits), text "lits",
129 ppr (sizeSS ptrs), text "ptrs" ]
130
131 instance Outputable CgBreakInfo where
132 ppr info = text "CgBreakInfo" <+>
133 parens (ppr (cgb_vars info) <+>
134 ppr (cgb_resty info))
135
136 -- -----------------------------------------------------------------------------
137 -- Breakpoints
138
139 -- | Breakpoint index
140 type BreakIndex = Int
141
142 -- | C CostCentre type
143 data CCostCentre
144
145 -- | All the information about the breakpoints for a module
146 data ModBreaks
147 = ModBreaks
148 { modBreaks_flags :: ForeignRef BreakArray
149 -- ^ The array of flags, one per breakpoint,
150 -- indicating which breakpoints are enabled.
151 , modBreaks_locs :: !(Array BreakIndex SrcSpan)
152 -- ^ An array giving the source span of each breakpoint.
153 , modBreaks_vars :: !(Array BreakIndex [OccName])
154 -- ^ An array giving the names of the free variables at each breakpoint.
155 , modBreaks_decls :: !(Array BreakIndex [String])
156 -- ^ An array giving the names of the declarations enclosing each breakpoint.
157 , modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre))
158 -- ^ Array pointing to cost centre for each breakpoint
159 , modBreaks_breakInfo :: IntMap CgBreakInfo
160 -- ^ info about each breakpoint from the bytecode generator
161 }
162
163 seqModBreaks :: ModBreaks -> ()
164 seqModBreaks ModBreaks{..} =
165 rnf modBreaks_flags `seq`
166 rnf modBreaks_locs `seq`
167 rnf modBreaks_vars `seq`
168 rnf modBreaks_decls `seq`
169 rnf modBreaks_ccs `seq`
170 rnf (fmap seqCgBreakInfo modBreaks_breakInfo)
171
172 -- | Construct an empty ModBreaks
173 emptyModBreaks :: ModBreaks
174 emptyModBreaks = ModBreaks
175 { modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
176 -- ToDo: can we avoid this?
177 , modBreaks_locs = array (0,-1) []
178 , modBreaks_vars = array (0,-1) []
179 , modBreaks_decls = array (0,-1) []
180 , modBreaks_ccs = array (0,-1) []
181 , modBreaks_breakInfo = IntMap.empty
182 }