Fix warnings in ByteCodeInstr
[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 module ByteCodeInstr ( 
10         BCInstr(..), ProtoBCO(..), bciStackUse, BreakInfo (..) 
11   ) where
12
13 #include "HsVersions.h"
14 #include "../includes/MachDeps.h"
15
16 import ByteCodeItbls    ( ItblPtr )
17
18 import Type
19 import Outputable
20 import Name
21 import Id
22 import CoreSyn
23 import PprCore
24 import Literal
25 import DataCon
26 import VarSet
27 import PrimOp
28 import SMRep
29
30 import Module (Module)
31 import GHC.Exts
32
33
34 -- ----------------------------------------------------------------------------
35 -- Bytecode instructions
36
37 data ProtoBCO a 
38    = ProtoBCO { 
39         protoBCOName       :: a,          -- name, in some sense
40         protoBCOInstrs     :: [BCInstr],  -- instrs
41         -- arity and GC info
42         protoBCOBitmap     :: [StgWord],
43         protoBCOBitmapSize :: Int,
44         protoBCOArity      :: Int,
45         -- what the BCO came from
46         protoBCOExpr       :: Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet),
47         -- malloc'd pointers
48         protoBCOPtrs       :: [Either ItblPtr (Ptr ())]
49    }
50
51 type LocalLabel = Int
52
53 data BCInstr
54    -- Messing with the stack
55    = STKCHECK  Int
56
57    -- Push locals (existing bits of the stack)
58    | PUSH_L    !Int{-offset-}
59    | PUSH_LL   !Int !Int{-2 offsets-}
60    | PUSH_LLL  !Int !Int !Int{-3 offsets-}
61
62    -- Push a ptr  (these all map to PUSH_G really)
63    | PUSH_G       Name
64    | PUSH_PRIMOP  PrimOp
65    | PUSH_BCO     (ProtoBCO Name)
66
67    -- Push an alt continuation
68    | PUSH_ALTS          (ProtoBCO Name)
69    | PUSH_ALTS_UNLIFTED (ProtoBCO Name) CgRep
70
71    -- Pushing literals
72    | PUSH_UBX  (Either Literal (Ptr ())) Int
73         -- push this int/float/double/addr, on the stack.  Int
74         -- is # of words to copy from literal pool.  Eitherness reflects
75         -- the difficulty of dealing with MachAddr here, mostly due to
76         -- the excessive (and unnecessary) restrictions imposed by the
77         -- designers of the new Foreign library.  In particular it is
78         -- quite impossible to convert an Addr to any other integral
79         -- type, and it appears impossible to get hold of the bits of
80         -- an addr, even though we need to to assemble BCOs.
81
82    -- various kinds of application
83    | PUSH_APPLY_N
84    | PUSH_APPLY_V
85    | PUSH_APPLY_F
86    | PUSH_APPLY_D
87    | PUSH_APPLY_L
88    | PUSH_APPLY_P
89    | PUSH_APPLY_PP
90    | PUSH_APPLY_PPP
91    | PUSH_APPLY_PPPP
92    | PUSH_APPLY_PPPPP
93    | PUSH_APPLY_PPPPPP
94
95    | SLIDE     Int{-this many-} Int{-down by this much-}
96
97    -- To do with the heap
98    | ALLOC_AP  !Int      -- make an AP with this many payload words
99    | ALLOC_AP_NOUPD !Int -- make an AP_NOUPD with this many payload words
100    | ALLOC_PAP !Int !Int -- make a PAP with this arity / payload words
101    | MKAP      !Int{-ptr to AP is this far down stack-} !Int{-number of words-}
102    | MKPAP     !Int{-ptr to PAP is this far down stack-} !Int{-number of words-}
103    | UNPACK    !Int     -- unpack N words from t.o.s Constr
104    | PACK      DataCon !Int
105                         -- after assembly, the DataCon is an index into the
106                         -- itbl array
107    -- For doing case trees
108    | LABEL     LocalLabel
109    | TESTLT_I  Int    LocalLabel
110    | TESTEQ_I  Int    LocalLabel
111    | TESTLT_F  Float  LocalLabel
112    | TESTEQ_F  Float  LocalLabel
113    | TESTLT_D  Double LocalLabel
114    | TESTEQ_D  Double LocalLabel
115
116    -- The Int value is a constructor number and therefore
117    -- stored in the insn stream rather than as an offset into
118    -- the literal pool.
119    | TESTLT_P  Int    LocalLabel
120    | TESTEQ_P  Int    LocalLabel
121
122    | CASEFAIL
123    | JMP              LocalLabel
124
125    -- For doing calls to C (via glue code generated by ByteCodeFFI, or libffi)
126    | CCALL            Int       -- stack frame size
127                       (Ptr ())  -- addr of the glue code
128
129    -- For doing magic ByteArray passing to foreign calls
130    | SWIZZLE          Int       -- to the ptr N words down the stack,
131                       Int       -- add M (interpreted as a signed 16-bit entity)
132
133    -- To Infinity And Beyond
134    | ENTER
135    | RETURN             -- return a lifted value
136    | RETURN_UBX CgRep -- return an unlifted value, here's its rep
137
138    -- Breakpoints 
139    | BRK_FUN          (MutableByteArray# RealWorld) Int BreakInfo
140
141 data BreakInfo 
142    = BreakInfo
143    { breakInfo_module :: Module
144    , breakInfo_number :: {-# UNPACK #-} !Int
145    , breakInfo_vars   :: [(Id,Int)]
146    , breakInfo_resty  :: Type
147    }
148
149 instance Outputable BreakInfo where
150    ppr info = text "BreakInfo" <+>
151               parens (ppr (breakInfo_module info) <+>
152                       ppr (breakInfo_number info) <+>
153                       ppr (breakInfo_vars info) <+>
154                       ppr (breakInfo_resty info))
155
156 -- -----------------------------------------------------------------------------
157 -- Printing bytecode instructions
158
159 instance Outputable a => Outputable (ProtoBCO a) where
160    ppr (ProtoBCO name instrs bitmap bsize arity origin malloced)
161       = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity 
162                 <+> text (show malloced) <> colon)
163         $$ nest 6 (text "bitmap: " <+> text (show bsize) <+> text (show bitmap))
164         $$ nest 6 (vcat (map ppr instrs))
165         $$ case origin of
166               Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
167               Right rhs -> pprCoreExpr (deAnnotate rhs)
168
169 instance Outputable BCInstr where
170    ppr (STKCHECK n)          = text "STKCHECK" <+> int n
171    ppr (PUSH_L offset)       = text "PUSH_L  " <+> int offset
172    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> int o1 <+> int o2
173    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3
174    ppr (PUSH_G nm)           = text "PUSH_G  " <+> ppr nm
175    ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers." 
176                                                <> ppr op
177    ppr (PUSH_BCO bco)        = text "PUSH_BCO" <+> nest 3 (ppr bco)
178    ppr (PUSH_ALTS bco)       = text "PUSH_ALTS " <+> ppr bco
179    ppr (PUSH_ALTS_UNLIFTED bco pk) = text "PUSH_ALTS_UNLIFTED " <+> ppr pk <+> ppr bco
180
181    ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit
182    ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int nw) <+> text (show aa)
183    ppr PUSH_APPLY_N             = text "PUSH_APPLY_N"
184    ppr PUSH_APPLY_V             = text "PUSH_APPLY_V"
185    ppr PUSH_APPLY_F             = text "PUSH_APPLY_F"
186    ppr PUSH_APPLY_D             = text "PUSH_APPLY_D"
187    ppr PUSH_APPLY_L             = text "PUSH_APPLY_L"
188    ppr PUSH_APPLY_P             = text "PUSH_APPLY_P"
189    ppr PUSH_APPLY_PP            = text "PUSH_APPLY_PP"
190    ppr PUSH_APPLY_PPP           = text "PUSH_APPLY_PPP"
191    ppr PUSH_APPLY_PPPP          = text "PUSH_APPLY_PPPP"
192    ppr PUSH_APPLY_PPPPP         = text "PUSH_APPLY_PPPPP"
193    ppr PUSH_APPLY_PPPPPP        = text "PUSH_APPLY_PPPPPP"
194
195    ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
196    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> int sz
197    ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> int sz
198    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> int arity <+> int sz
199    ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words," 
200                                                <+> int offset <+> text "stkoff"
201    ppr (MKPAP offset sz)     = text "MKPAP   " <+> int sz <+> text "words,"
202                                                <+> int offset <+> text "stkoff"
203    ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
204    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
205    ppr (LABEL     lab)       = text "__"       <> int lab <> colon
206    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
207    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
208    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
209    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
210    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
211    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
212    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
213    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
214    ppr CASEFAIL              = text "CASEFAIL"
215    ppr (JMP lab)             = text "JMP"      <+> int lab
216    ppr (CCALL off marshall_addr) = text "CCALL   " <+> int off 
217                                                 <+> text "marshall code at" 
218                                                <+> text (show marshall_addr)
219    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff 
220                                                <+> text "by" <+> int n 
221    ppr ENTER                 = text "ENTER"
222    ppr RETURN                = text "RETURN"
223    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
224    ppr (BRK_FUN _breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> int index <+> ppr info 
225
226 -- -----------------------------------------------------------------------------
227 -- The stack use, in words, of each bytecode insn.  These _must_ be
228 -- correct, or overestimates of reality, to be safe.
229
230 -- NOTE: we aggregate the stack use from case alternatives too, so that
231 -- we can do a single stack check at the beginning of a function only.
232
233 -- This could all be made more accurate by keeping track of a proper
234 -- stack high water mark, but it doesn't seem worth the hassle.
235
236 protoBCOStackUse :: ProtoBCO a -> Int
237 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
238
239 bciStackUse :: BCInstr -> Int
240 bciStackUse STKCHECK{}            = 0
241 bciStackUse PUSH_L{}              = 1
242 bciStackUse PUSH_LL{}             = 2
243 bciStackUse PUSH_LLL{}            = 3
244 bciStackUse PUSH_G{}              = 1
245 bciStackUse PUSH_PRIMOP{}         = 1
246 bciStackUse PUSH_BCO{}            = 1
247 bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
248 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
249 bciStackUse (PUSH_UBX _ nw)       = nw
250 bciStackUse PUSH_APPLY_N{}        = 1
251 bciStackUse PUSH_APPLY_V{}        = 1
252 bciStackUse PUSH_APPLY_F{}        = 1
253 bciStackUse PUSH_APPLY_D{}        = 1
254 bciStackUse PUSH_APPLY_L{}        = 1
255 bciStackUse PUSH_APPLY_P{}        = 1
256 bciStackUse PUSH_APPLY_PP{}       = 1
257 bciStackUse PUSH_APPLY_PPP{}      = 1
258 bciStackUse PUSH_APPLY_PPPP{}     = 1
259 bciStackUse PUSH_APPLY_PPPPP{}    = 1
260 bciStackUse PUSH_APPLY_PPPPPP{}   = 1
261 bciStackUse ALLOC_AP{}            = 1
262 bciStackUse ALLOC_AP_NOUPD{}      = 1
263 bciStackUse ALLOC_PAP{}           = 1
264 bciStackUse (UNPACK sz)           = sz
265 bciStackUse LABEL{}               = 0
266 bciStackUse TESTLT_I{}            = 0
267 bciStackUse TESTEQ_I{}            = 0
268 bciStackUse TESTLT_F{}            = 0
269 bciStackUse TESTEQ_F{}            = 0
270 bciStackUse TESTLT_D{}            = 0
271 bciStackUse TESTEQ_D{}            = 0
272 bciStackUse TESTLT_P{}            = 0
273 bciStackUse TESTEQ_P{}            = 0
274 bciStackUse CASEFAIL{}            = 0
275 bciStackUse JMP{}                 = 0
276 bciStackUse ENTER{}               = 0
277 bciStackUse RETURN{}              = 0
278 bciStackUse RETURN_UBX{}          = 1
279 bciStackUse CCALL{}               = 0
280 bciStackUse SWIZZLE{}             = 0
281 bciStackUse BRK_FUN{}             = 0
282
283 -- These insns actually reduce stack use, but we need the high-tide level,
284 -- so can't use this info.  Not that it matters much.
285 bciStackUse SLIDE{}               = 0
286 bciStackUse MKAP{}                = 0
287 bciStackUse MKPAP{}               = 0
288 bciStackUse PACK{}                = 1 -- worst case is PACK 0 words
289 \end{code}