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