distclean: <lib>/.depend[.bak]
[ghc-hetmet.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_GHC -funbox-strict-fields #-}
8
9 {-# OPTIONS -w #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
14 -- for details
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 Type
26 import Outputable
27 import Name
28 import Id
29 import CoreSyn
30 import PprCore
31 import Literal
32 import DataCon
33 import VarSet
34 import PrimOp
35 import SMRep
36
37 import GHC.Ptr
38
39 import Module (Module)
40 import GHC.Prim
41
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 :: Int,
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 = Int
61
62 data BCInstr
63    -- Messing with the stack
64    = STKCHECK  Int
65
66    -- Push locals (existing bits of the stack)
67    | PUSH_L    !Int{-offset-}
68    | PUSH_LL   !Int !Int{-2 offsets-}
69    | PUSH_LLL  !Int !Int !Int{-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) CgRep
79
80    -- Pushing literals
81    | PUSH_UBX  (Either Literal (Ptr ())) Int
82         -- push this int/float/double/addr, on the stack.  Int
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 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     Int{-this many-} Int{-down by this much-}
105
106    -- To do with the heap
107    | ALLOC_AP  !Int     -- make an AP with this many payload words
108    | ALLOC_PAP !Int !Int        -- make a PAP with this arity / payload words
109    | MKAP      !Int{-ptr to AP is this far down stack-} !Int{-# words-}
110    | MKPAP     !Int{-ptr to PAP is this far down stack-} !Int{-# words-}
111    | UNPACK    !Int     -- unpack N words from t.o.s Constr
112    | PACK      DataCon !Int
113                         -- after assembly, the DataCon is an index into the
114                         -- itbl array
115    -- For doing case trees
116    | LABEL     LocalLabel
117    | TESTLT_I  Int    LocalLabel
118    | TESTEQ_I  Int    LocalLabel
119    | TESTLT_F  Float  LocalLabel
120    | TESTEQ_F  Float  LocalLabel
121    | TESTLT_D  Double LocalLabel
122    | TESTEQ_D  Double LocalLabel
123
124    -- The Int value is a constructor number and therefore
125    -- stored in the insn stream rather than as an offset into
126    -- the literal pool.
127    | TESTLT_P  Int    LocalLabel
128    | TESTEQ_P  Int    LocalLabel
129
130    | CASEFAIL
131    | JMP              LocalLabel
132
133    -- For doing calls to C (via glue code generated by ByteCodeFFI)
134    | CCALL            Int       -- stack frame size
135                       (Ptr ())  -- addr of the glue code
136
137    -- For doing magic ByteArray passing to foreign calls
138    | SWIZZLE          Int       -- to the ptr N words down the stack,
139                       Int       -- add M (interpreted as a signed 16-bit entity)
140
141    -- To Infinity And Beyond
142    | ENTER
143    | RETURN             -- return a lifted value
144    | RETURN_UBX CgRep -- return an unlifted value, here's its rep
145
146    -- Breakpoints 
147    | BRK_FUN          (MutableByteArray# RealWorld) Int BreakInfo
148
149 data BreakInfo 
150    = BreakInfo
151    { breakInfo_module :: Module
152    , breakInfo_number :: {-# UNPACK #-} !Int
153    , breakInfo_vars   :: [(Id,Int)]
154    , breakInfo_resty  :: Type
155    }
156
157 instance Outputable BreakInfo where
158    ppr info = text "BreakInfo" <+>
159               parens (ppr (breakInfo_module info) <+>
160                       ppr (breakInfo_number info) <+>
161                       ppr (breakInfo_vars info) <+>
162                       ppr (breakInfo_resty info))
163
164 -- -----------------------------------------------------------------------------
165 -- Printing bytecode instructions
166
167 instance Outputable a => Outputable (ProtoBCO a) where
168    ppr (ProtoBCO name instrs bitmap bsize arity origin malloced)
169       = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity 
170                 <+> text (show malloced) <> colon)
171         $$ nest 6 (text "bitmap: " <+> text (show bsize) <+> text (show bitmap))
172         $$ nest 6 (vcat (map ppr instrs))
173         $$ case origin of
174               Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
175               Right rhs -> pprCoreExpr (deAnnotate rhs)
176
177 instance Outputable BCInstr where
178    ppr (STKCHECK n)          = text "STKCHECK" <+> int n
179    ppr (PUSH_L offset)       = text "PUSH_L  " <+> int offset
180    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> int o1 <+> int o2
181    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3
182    ppr (PUSH_G nm)           = text "PUSH_G  " <+> ppr nm
183    ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers." 
184                                                <> ppr op
185    ppr (PUSH_BCO bco)        = text "PUSH_BCO" <+> nest 3 (ppr bco)
186    ppr (PUSH_ALTS bco)       = text "PUSH_ALTS " <+> ppr bco
187    ppr (PUSH_ALTS_UNLIFTED bco pk) = text "PUSH_ALTS_UNLIFTED " <+> ppr pk <+> ppr bco
188
189    ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit
190    ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int nw) <+> text (show aa)
191    ppr PUSH_APPLY_N             = text "PUSH_APPLY_N"
192    ppr PUSH_APPLY_V             = text "PUSH_APPLY_V"
193    ppr PUSH_APPLY_F             = text "PUSH_APPLY_F"
194    ppr PUSH_APPLY_D             = text "PUSH_APPLY_D"
195    ppr PUSH_APPLY_L             = text "PUSH_APPLY_L"
196    ppr PUSH_APPLY_P             = text "PUSH_APPLY_P"
197    ppr PUSH_APPLY_PP            = text "PUSH_APPLY_PP"
198    ppr PUSH_APPLY_PPP           = text "PUSH_APPLY_PPP"
199    ppr PUSH_APPLY_PPPP          = text "PUSH_APPLY_PPPP"
200    ppr PUSH_APPLY_PPPPP         = text "PUSH_APPLY_PPPPP"
201    ppr PUSH_APPLY_PPPPPP        = text "PUSH_APPLY_PPPPPP"
202
203    ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
204    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> int sz
205    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> int arity <+> int sz
206    ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words," 
207                                                <+> int offset <+> text "stkoff"
208    ppr (MKPAP offset sz)     = text "MKPAP   " <+> int sz <+> text "words,"
209                                                <+> int offset <+> text "stkoff"
210    ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
211    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
212    ppr (LABEL     lab)       = text "__"       <> int lab <> colon
213    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
214    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
215    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
216    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
217    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
218    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
219    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
220    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
221    ppr CASEFAIL              = text "CASEFAIL"
222    ppr (JMP lab)             = text "JMP"      <+> int lab
223    ppr (CCALL off marshall_addr) = text "CCALL   " <+> int off 
224                                                 <+> text "marshall code at" 
225                                                <+> text (show marshall_addr)
226    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff 
227                                                <+> text "by" <+> int n 
228    ppr ENTER                 = text "ENTER"
229    ppr RETURN                = text "RETURN"
230    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
231    ppr (BRK_FUN breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> int index <+> ppr info 
232
233 -- -----------------------------------------------------------------------------
234 -- The stack use, in words, of each bytecode insn.  These _must_ be
235 -- correct, or overestimates of reality, to be safe.
236
237 -- NOTE: we aggregate the stack use from case alternatives too, so that
238 -- we can do a single stack check at the beginning of a function only.
239
240 -- This could all be made more accurate by keeping track of a proper
241 -- stack high water mark, but it doesn't seem worth the hassle.
242
243 protoBCOStackUse :: ProtoBCO a -> Int
244 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
245
246 bciStackUse :: BCInstr -> Int
247 bciStackUse STKCHECK{}            = 0
248 bciStackUse PUSH_L{}              = 1
249 bciStackUse PUSH_LL{}             = 2
250 bciStackUse PUSH_LLL{}            = 3
251 bciStackUse PUSH_G{}              = 1
252 bciStackUse PUSH_PRIMOP{}         = 1
253 bciStackUse PUSH_BCO{}            = 1
254 bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
255 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
256 bciStackUse (PUSH_UBX _ nw)       = nw
257 bciStackUse PUSH_APPLY_N{}        = 1
258 bciStackUse PUSH_APPLY_V{}        = 1
259 bciStackUse PUSH_APPLY_F{}        = 1
260 bciStackUse PUSH_APPLY_D{}        = 1
261 bciStackUse PUSH_APPLY_L{}        = 1
262 bciStackUse PUSH_APPLY_P{}        = 1
263 bciStackUse PUSH_APPLY_PP{}       = 1
264 bciStackUse PUSH_APPLY_PPP{}      = 1
265 bciStackUse PUSH_APPLY_PPPP{}     = 1
266 bciStackUse PUSH_APPLY_PPPPP{}    = 1
267 bciStackUse PUSH_APPLY_PPPPPP{}   = 1
268 bciStackUse ALLOC_AP{}            = 1
269 bciStackUse ALLOC_PAP{}           = 1
270 bciStackUse (UNPACK sz)           = sz
271 bciStackUse LABEL{}               = 0
272 bciStackUse TESTLT_I{}            = 0
273 bciStackUse TESTEQ_I{}            = 0
274 bciStackUse TESTLT_F{}            = 0
275 bciStackUse TESTEQ_F{}            = 0
276 bciStackUse TESTLT_D{}            = 0
277 bciStackUse TESTEQ_D{}            = 0
278 bciStackUse TESTLT_P{}            = 0
279 bciStackUse TESTEQ_P{}            = 0
280 bciStackUse CASEFAIL{}            = 0
281 bciStackUse JMP{}                 = 0
282 bciStackUse ENTER{}               = 0
283 bciStackUse RETURN{}              = 0
284 bciStackUse RETURN_UBX{}          = 1
285 bciStackUse CCALL{}               = 0
286 bciStackUse SWIZZLE{}             = 0
287 bciStackUse BRK_FUN{}             = 0
288
289 -- These insns actually reduce stack use, but we need the high-tide level,
290 -- so can't use this info.  Not that it matters much.
291 bciStackUse SLIDE{}               = 0
292 bciStackUse MKAP{}                = 0
293 bciStackUse MKPAP{}               = 0
294 bciStackUse PACK{}                = 1 -- worst case is PACK 0 words
295 \end{code}