Support the GHCi debugger with -fexternal-interpreter
[ghc.git] / compiler / ghci / ByteCodeInstr.hs
1 {-# LANGUAGE CPP, MagicHash #-}
2 {-# OPTIONS_GHC -funbox-strict-fields #-}
3 --
4 -- (c) The University of Glasgow 2002-2006
5 --
6
7 -- | ByteCodeInstrs: Bytecode instruction definitions
8 module ByteCodeInstr (
9 BCInstr(..), ProtoBCO(..), bciStackUse,
10 ) where
11
12 #include "HsVersions.h"
13 #include "../includes/MachDeps.h"
14
15 import GhcPrelude
16
17 import ByteCodeTypes
18 import GHCi.RemoteTypes
19 import GHCi.FFI (C_ffi_cif)
20 import StgCmmLayout ( ArgRep(..) )
21 import PprCore
22 import Outputable
23 import FastString
24 import Name
25 import Unique
26 import Id
27 import CoreSyn
28 import Literal
29 import DataCon
30 import VarSet
31 import PrimOp
32 import SMRep
33
34 import Data.Word
35 import GHC.Stack.CCS (CostCentre)
36
37 -- ----------------------------------------------------------------------------
38 -- Bytecode instructions
39
40 data ProtoBCO a
41 = ProtoBCO {
42 protoBCOName :: a, -- name, in some sense
43 protoBCOInstrs :: [BCInstr], -- instrs
44 -- arity and GC info
45 protoBCOBitmap :: [StgWord],
46 protoBCOBitmapSize :: Word16,
47 protoBCOArity :: Int,
48 -- what the BCO came from
49 protoBCOExpr :: Either [AnnAlt Id DVarSet] (AnnExpr Id DVarSet),
50 -- malloc'd pointers
51 protoBCOFFIs :: [FFIInfo]
52 }
53
54 type LocalLabel = Word16
55
56 data BCInstr
57 -- Messing with the stack
58 = STKCHECK Word
59
60 -- Push locals (existing bits of the stack)
61 | PUSH_L !Word16{-offset-}
62 | PUSH_LL !Word16 !Word16{-2 offsets-}
63 | PUSH_LLL !Word16 !Word16 !Word16{-3 offsets-}
64
65 -- Push the specified local as a 8, 16, 32 bit value onto the stack. (i.e.,
66 -- the stack will grow by 8, 16 or 32 bits)
67 | PUSH8 !Word16
68 | PUSH16 !Word16
69 | PUSH32 !Word16
70
71 -- Push the specifiec local as a 8, 16, 32 bit value onto the stack, but the
72 -- value will take the whole word on the stack (i.e., the stack will gorw by
73 -- a word)
74 -- This is useful when extracting a packed constructor field for further use.
75 -- Currently we expect all values on the stack to take full words, except for
76 -- the ones used for PACK (i.e., actually constracting new data types, in
77 -- which case we use PUSH{8,16,32})
78 | PUSH8_W !Word16
79 | PUSH16_W !Word16
80 | PUSH32_W !Word16
81
82 -- Push a ptr (these all map to PUSH_G really)
83 | PUSH_G Name
84 | PUSH_PRIMOP PrimOp
85 | PUSH_BCO (ProtoBCO Name)
86
87 -- Push an alt continuation
88 | PUSH_ALTS (ProtoBCO Name)
89 | PUSH_ALTS_UNLIFTED (ProtoBCO Name) ArgRep
90
91 -- Pushing 8, 16 and 32 bits of padding (for constructors).
92 | PUSH_PAD8
93 | PUSH_PAD16
94 | PUSH_PAD32
95
96 -- Pushing literals
97 | PUSH_UBX8 Literal
98 | PUSH_UBX16 Literal
99 | PUSH_UBX32 Literal
100 | PUSH_UBX Literal Word16
101 -- push this int/float/double/addr, on the stack. Word16
102 -- is # of words to copy from literal pool. Eitherness reflects
103 -- the difficulty of dealing with MachAddr here, mostly due to
104 -- the excessive (and unnecessary) restrictions imposed by the
105 -- designers of the new Foreign library. In particular it is
106 -- quite impossible to convert an Addr to any other integral
107 -- type, and it appears impossible to get hold of the bits of
108 -- an addr, even though we need to assemble BCOs.
109
110 -- various kinds of application
111 | PUSH_APPLY_N
112 | PUSH_APPLY_V
113 | PUSH_APPLY_F
114 | PUSH_APPLY_D
115 | PUSH_APPLY_L
116 | PUSH_APPLY_P
117 | PUSH_APPLY_PP
118 | PUSH_APPLY_PPP
119 | PUSH_APPLY_PPPP
120 | PUSH_APPLY_PPPPP
121 | PUSH_APPLY_PPPPPP
122
123 | SLIDE Word16{-this many-} Word16{-down by this much-}
124
125 -- To do with the heap
126 | ALLOC_AP !Word16 -- make an AP with this many payload words
127 | ALLOC_AP_NOUPD !Word16 -- make an AP_NOUPD with this many payload words
128 | ALLOC_PAP !Word16 !Word16 -- make a PAP with this arity / payload words
129 | MKAP !Word16{-ptr to AP is this far down stack-} !Word16{-number of words-}
130 | MKPAP !Word16{-ptr to PAP is this far down stack-} !Word16{-number of words-}
131 | UNPACK !Word16 -- unpack N words from t.o.s Constr
132 | PACK DataCon !Word16
133 -- after assembly, the DataCon is an index into the
134 -- itbl array
135 -- For doing case trees
136 | LABEL LocalLabel
137 | TESTLT_I Int LocalLabel
138 | TESTEQ_I Int LocalLabel
139 | TESTLT_W Word LocalLabel
140 | TESTEQ_W Word LocalLabel
141 | TESTLT_F Float LocalLabel
142 | TESTEQ_F Float LocalLabel
143 | TESTLT_D Double LocalLabel
144 | TESTEQ_D Double LocalLabel
145
146 -- The Word16 value is a constructor number and therefore
147 -- stored in the insn stream rather than as an offset into
148 -- the literal pool.
149 | TESTLT_P Word16 LocalLabel
150 | TESTEQ_P Word16 LocalLabel
151
152 | CASEFAIL
153 | JMP LocalLabel
154
155 -- For doing calls to C (via glue code generated by libffi)
156 | CCALL Word16 -- stack frame size
157 (RemotePtr C_ffi_cif) -- addr of the glue code
158 Word16 -- flags.
159 --
160 -- 0x1: call is interruptible
161 -- 0x2: call is unsafe
162 --
163 -- (XXX: inefficient, but I don't know
164 -- what the alignment constraints are.)
165
166 -- For doing magic ByteArray passing to foreign calls
167 | SWIZZLE Word16 -- to the ptr N words down the stack,
168 Word16 -- add M (interpreted as a signed 16-bit entity)
169
170 -- To Infinity And Beyond
171 | ENTER
172 | RETURN -- return a lifted value
173 | RETURN_UBX ArgRep -- return an unlifted value, here's its rep
174
175 -- Breakpoints
176 | BRK_FUN Word16 Unique (RemotePtr CostCentre)
177
178 -- -----------------------------------------------------------------------------
179 -- Printing bytecode instructions
180
181 instance Outputable a => Outputable (ProtoBCO a) where
182 ppr (ProtoBCO name instrs bitmap bsize arity origin ffis)
183 = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity
184 <+> text (show ffis) <> colon)
185 $$ nest 3 (case origin of
186 Left alts -> vcat (zipWith (<+>) (char '{' : repeat (char ';'))
187 (map (pprCoreAltShort.deAnnAlt) alts)) <+> char '}'
188 Right rhs -> pprCoreExprShort (deAnnotate rhs))
189 $$ nest 3 (text "bitmap: " <+> text (show bsize) <+> ppr bitmap)
190 $$ nest 3 (vcat (map ppr instrs))
191
192 -- Print enough of the Core expression to enable the reader to find
193 -- the expression in the -ddump-prep output. That is, we need to
194 -- include at least a binder.
195
196 pprCoreExprShort :: CoreExpr -> SDoc
197 pprCoreExprShort expr@(Lam _ _)
198 = let
199 (bndrs, _) = collectBinders expr
200 in
201 char '\\' <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow <+> text "..."
202
203 pprCoreExprShort (Case _expr var _ty _alts)
204 = text "case of" <+> ppr var
205
206 pprCoreExprShort (Let (NonRec x _) _) = text "let" <+> ppr x <+> ptext (sLit ("= ... in ..."))
207 pprCoreExprShort (Let (Rec bs) _) = text "let {" <+> ppr (fst (head bs)) <+> ptext (sLit ("= ...; ... } in ..."))
208
209 pprCoreExprShort (Tick t e) = ppr t <+> pprCoreExprShort e
210 pprCoreExprShort (Cast e _) = pprCoreExprShort e <+> text "`cast` T"
211
212 pprCoreExprShort e = pprCoreExpr e
213
214 pprCoreAltShort :: CoreAlt -> SDoc
215 pprCoreAltShort (con, args, expr) = ppr con <+> sep (map ppr args) <+> text "->" <+> pprCoreExprShort expr
216
217 instance Outputable BCInstr where
218 ppr (STKCHECK n) = text "STKCHECK" <+> ppr n
219 ppr (PUSH_L offset) = text "PUSH_L " <+> ppr offset
220 ppr (PUSH_LL o1 o2) = text "PUSH_LL " <+> ppr o1 <+> ppr o2
221 ppr (PUSH_LLL o1 o2 o3) = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr o3
222 ppr (PUSH8 offset) = text "PUSH8 " <+> ppr offset
223 ppr (PUSH16 offset) = text "PUSH16 " <+> ppr offset
224 ppr (PUSH32 offset) = text "PUSH32 " <+> ppr offset
225 ppr (PUSH8_W offset) = text "PUSH8_W " <+> ppr offset
226 ppr (PUSH16_W offset) = text "PUSH16_W " <+> ppr offset
227 ppr (PUSH32_W offset) = text "PUSH32_W " <+> ppr offset
228 ppr (PUSH_G nm) = text "PUSH_G " <+> ppr nm
229 ppr (PUSH_PRIMOP op) = text "PUSH_G " <+> text "GHC.PrimopWrappers."
230 <> ppr op
231 ppr (PUSH_BCO bco) = hang (text "PUSH_BCO") 2 (ppr bco)
232 ppr (PUSH_ALTS bco) = hang (text "PUSH_ALTS") 2 (ppr bco)
233 ppr (PUSH_ALTS_UNLIFTED bco pk) = hang (text "PUSH_ALTS_UNLIFTED" <+> ppr pk) 2 (ppr bco)
234
235 ppr PUSH_PAD8 = text "PUSH_PAD8"
236 ppr PUSH_PAD16 = text "PUSH_PAD16"
237 ppr PUSH_PAD32 = text "PUSH_PAD32"
238
239 ppr (PUSH_UBX8 lit) = text "PUSH_UBX8" <+> ppr lit
240 ppr (PUSH_UBX16 lit) = text "PUSH_UBX16" <+> ppr lit
241 ppr (PUSH_UBX32 lit) = text "PUSH_UBX32" <+> ppr lit
242 ppr (PUSH_UBX lit nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit
243 ppr PUSH_APPLY_N = text "PUSH_APPLY_N"
244 ppr PUSH_APPLY_V = text "PUSH_APPLY_V"
245 ppr PUSH_APPLY_F = text "PUSH_APPLY_F"
246 ppr PUSH_APPLY_D = text "PUSH_APPLY_D"
247 ppr PUSH_APPLY_L = text "PUSH_APPLY_L"
248 ppr PUSH_APPLY_P = text "PUSH_APPLY_P"
249 ppr PUSH_APPLY_PP = text "PUSH_APPLY_PP"
250 ppr PUSH_APPLY_PPP = text "PUSH_APPLY_PPP"
251 ppr PUSH_APPLY_PPPP = text "PUSH_APPLY_PPPP"
252 ppr PUSH_APPLY_PPPPP = text "PUSH_APPLY_PPPPP"
253 ppr PUSH_APPLY_PPPPPP = text "PUSH_APPLY_PPPPPP"
254
255 ppr (SLIDE n d) = text "SLIDE " <+> ppr n <+> ppr d
256 ppr (ALLOC_AP sz) = text "ALLOC_AP " <+> ppr sz
257 ppr (ALLOC_AP_NOUPD sz) = text "ALLOC_AP_NOUPD " <+> ppr sz
258 ppr (ALLOC_PAP arity sz) = text "ALLOC_PAP " <+> ppr arity <+> ppr sz
259 ppr (MKAP offset sz) = text "MKAP " <+> ppr sz <+> text "words,"
260 <+> ppr offset <+> text "stkoff"
261 ppr (MKPAP offset sz) = text "MKPAP " <+> ppr sz <+> text "words,"
262 <+> ppr offset <+> text "stkoff"
263 ppr (UNPACK sz) = text "UNPACK " <+> ppr sz
264 ppr (PACK dcon sz) = text "PACK " <+> ppr dcon <+> ppr sz
265 ppr (LABEL lab) = text "__" <> ppr lab <> colon
266 ppr (TESTLT_I i lab) = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab
267 ppr (TESTEQ_I i lab) = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
268 ppr (TESTLT_W i lab) = text "TESTLT_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
269 ppr (TESTEQ_W i lab) = text "TESTEQ_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
270 ppr (TESTLT_F f lab) = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
271 ppr (TESTEQ_F f lab) = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
272 ppr (TESTLT_D d lab) = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
273 ppr (TESTEQ_D d lab) = text "TESTEQ_D" <+> double d <+> text "__" <> ppr lab
274 ppr (TESTLT_P i lab) = text "TESTLT_P" <+> ppr i <+> text "__" <> ppr lab
275 ppr (TESTEQ_P i lab) = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
276 ppr CASEFAIL = text "CASEFAIL"
277 ppr (JMP lab) = text "JMP" <+> ppr lab
278 ppr (CCALL off marshall_addr flags) = text "CCALL " <+> ppr off
279 <+> text "marshall code at"
280 <+> text (show marshall_addr)
281 <+> (case flags of
282 0x1 -> text "(interruptible)"
283 0x2 -> text "(unsafe)"
284 _ -> empty)
285 ppr (SWIZZLE stkoff n) = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff
286 <+> text "by" <+> ppr n
287 ppr ENTER = text "ENTER"
288 ppr RETURN = text "RETURN"
289 ppr (RETURN_UBX pk) = text "RETURN_UBX " <+> ppr pk
290 ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> ppr uniq <+> text "<cc>"
291
292 -- -----------------------------------------------------------------------------
293 -- The stack use, in words, of each bytecode insn. These _must_ be
294 -- correct, or overestimates of reality, to be safe.
295
296 -- NOTE: we aggregate the stack use from case alternatives too, so that
297 -- we can do a single stack check at the beginning of a function only.
298
299 -- This could all be made more accurate by keeping track of a proper
300 -- stack high water mark, but it doesn't seem worth the hassle.
301
302 protoBCOStackUse :: ProtoBCO a -> Word
303 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
304
305 bciStackUse :: BCInstr -> Word
306 bciStackUse STKCHECK{} = 0
307 bciStackUse PUSH_L{} = 1
308 bciStackUse PUSH_LL{} = 2
309 bciStackUse PUSH_LLL{} = 3
310 bciStackUse PUSH8{} = 1 -- overapproximation
311 bciStackUse PUSH16{} = 1 -- overapproximation
312 bciStackUse PUSH32{} = 1 -- overapproximation on 64bit arch
313 bciStackUse PUSH8_W{} = 1 -- takes exactly 1 word
314 bciStackUse PUSH16_W{} = 1 -- takes exactly 1 word
315 bciStackUse PUSH32_W{} = 1 -- takes exactly 1 word
316 bciStackUse PUSH_G{} = 1
317 bciStackUse PUSH_PRIMOP{} = 1
318 bciStackUse PUSH_BCO{} = 1
319 bciStackUse (PUSH_ALTS bco) = 2 + protoBCOStackUse bco
320 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
321 bciStackUse (PUSH_PAD8) = 1 -- overapproximation
322 bciStackUse (PUSH_PAD16) = 1 -- overapproximation
323 bciStackUse (PUSH_PAD32) = 1 -- overapproximation on 64bit arch
324 bciStackUse (PUSH_UBX8 _) = 1 -- overapproximation
325 bciStackUse (PUSH_UBX16 _) = 1 -- overapproximation
326 bciStackUse (PUSH_UBX32 _) = 1 -- overapproximation on 64bit arch
327 bciStackUse (PUSH_UBX _ nw) = fromIntegral nw
328 bciStackUse PUSH_APPLY_N{} = 1
329 bciStackUse PUSH_APPLY_V{} = 1
330 bciStackUse PUSH_APPLY_F{} = 1
331 bciStackUse PUSH_APPLY_D{} = 1
332 bciStackUse PUSH_APPLY_L{} = 1
333 bciStackUse PUSH_APPLY_P{} = 1
334 bciStackUse PUSH_APPLY_PP{} = 1
335 bciStackUse PUSH_APPLY_PPP{} = 1
336 bciStackUse PUSH_APPLY_PPPP{} = 1
337 bciStackUse PUSH_APPLY_PPPPP{} = 1
338 bciStackUse PUSH_APPLY_PPPPPP{} = 1
339 bciStackUse ALLOC_AP{} = 1
340 bciStackUse ALLOC_AP_NOUPD{} = 1
341 bciStackUse ALLOC_PAP{} = 1
342 bciStackUse (UNPACK sz) = fromIntegral sz
343 bciStackUse LABEL{} = 0
344 bciStackUse TESTLT_I{} = 0
345 bciStackUse TESTEQ_I{} = 0
346 bciStackUse TESTLT_W{} = 0
347 bciStackUse TESTEQ_W{} = 0
348 bciStackUse TESTLT_F{} = 0
349 bciStackUse TESTEQ_F{} = 0
350 bciStackUse TESTLT_D{} = 0
351 bciStackUse TESTEQ_D{} = 0
352 bciStackUse TESTLT_P{} = 0
353 bciStackUse TESTEQ_P{} = 0
354 bciStackUse CASEFAIL{} = 0
355 bciStackUse JMP{} = 0
356 bciStackUse ENTER{} = 0
357 bciStackUse RETURN{} = 0
358 bciStackUse RETURN_UBX{} = 1
359 bciStackUse CCALL{} = 0
360 bciStackUse SWIZZLE{} = 0
361 bciStackUse BRK_FUN{} = 0
362
363 -- These insns actually reduce stack use, but we need the high-tide level,
364 -- so can't use this info. Not that it matters much.
365 bciStackUse SLIDE{} = 0
366 bciStackUse MKAP{} = 0
367 bciStackUse MKPAP{} = 0
368 bciStackUse PACK{} = 1 -- worst case is PACK 0 words