← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to compiler/ghci/ByteCodeInstr.lhs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
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
import Data.Word
 
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 :: Word16,
 
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 = Word16
 
52
 
 
53
data BCInstr
 
54
   -- Messing with the stack
 
55
   = STKCHECK  Word
 
56
 
 
57
   -- Push locals (existing bits of the stack)
 
58
   | PUSH_L    !Word16{-offset-}
 
59
   | PUSH_LL   !Word16 !Word16{-2 offsets-}
 
60
   | PUSH_LLL  !Word16 !Word16 !Word16{-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 ())) Word16
 
73
        -- push this int/float/double/addr, on the stack. Word16
 
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     Word16{-this many-} Word16{-down by this much-}
 
96
 
 
97
   -- To do with the heap
 
98
   | ALLOC_AP  !Word16 -- make an AP with this many payload words
 
99
   | ALLOC_AP_NOUPD !Word16 -- make an AP_NOUPD with this many payload words
 
100
   | ALLOC_PAP !Word16 !Word16 -- make a PAP with this arity / payload words
 
101
   | MKAP      !Word16{-ptr to AP is this far down stack-} !Word16{-number of words-}
 
102
   | MKPAP     !Word16{-ptr to PAP is this far down stack-} !Word16{-number of words-}
 
103
   | UNPACK    !Word16 -- unpack N words from t.o.s Constr
 
104
   | PACK      DataCon !Word16
 
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_W  Word   LocalLabel
 
112
   | TESTEQ_W  Word   LocalLabel
 
113
   | TESTLT_F  Float  LocalLabel
 
114
   | TESTEQ_F  Float  LocalLabel
 
115
   | TESTLT_D  Double LocalLabel
 
116
   | TESTEQ_D  Double LocalLabel
 
117
 
 
118
   -- The Word16 value is a constructor number and therefore
 
119
   -- stored in the insn stream rather than as an offset into
 
120
   -- the literal pool.
 
121
   | TESTLT_P  Word16 LocalLabel
 
122
   | TESTEQ_P  Word16 LocalLabel
 
123
 
 
124
   | CASEFAIL
 
125
   | JMP              LocalLabel
 
126
 
 
127
   -- For doing calls to C (via glue code generated by ByteCodeFFI, or libffi)
 
128
   | CCALL            Word16    -- stack frame size
 
129
                      (Ptr ())  -- addr of the glue code
 
130
 
 
131
   -- For doing magic ByteArray passing to foreign calls
 
132
   | SWIZZLE          Word16 -- to the ptr N words down the stack,
 
133
                      Word16 -- add M (interpreted as a signed 16-bit entity)
 
134
 
 
135
   -- To Infinity And Beyond
 
136
   | ENTER
 
137
   | RETURN             -- return a lifted value
 
138
   | RETURN_UBX CgRep -- return an unlifted value, here's its rep
 
139
 
 
140
   -- Breakpoints 
 
141
   | BRK_FUN          (MutableByteArray# RealWorld) Word16 BreakInfo
 
142
 
 
143
data BreakInfo 
 
144
   = BreakInfo
 
145
   { breakInfo_module :: Module
 
146
   , breakInfo_number :: {-# UNPACK #-} !Int
 
147
   , breakInfo_vars   :: [(Id,Word16)]
 
148
   , breakInfo_resty  :: Type
 
149
   }
 
150
 
 
151
instance Outputable BreakInfo where
 
152
   ppr info = text "BreakInfo" <+>
 
153
              parens (ppr (breakInfo_module info) <+>
 
154
                      ppr (breakInfo_number info) <+>
 
155
                      ppr (breakInfo_vars info) <+>
 
156
                      ppr (breakInfo_resty info))
 
157
 
 
158
-- -----------------------------------------------------------------------------
 
159
-- Printing bytecode instructions
 
160
 
 
161
instance Outputable a => Outputable (ProtoBCO a) where
 
162
   ppr (ProtoBCO name instrs bitmap bsize arity origin malloced)
 
163
      = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity 
 
164
                <+> text (show malloced) <> colon)
 
165
        $$ nest 6 (text "bitmap: " <+> text (show bsize) <+> text (show bitmap))
 
166
        $$ nest 6 (vcat (map ppr instrs))
 
167
        $$ case origin of
 
168
              Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
 
169
              Right rhs -> pprCoreExpr (deAnnotate rhs)
 
170
 
 
171
instance Outputable BCInstr where
 
172
   ppr (STKCHECK n)          = text "STKCHECK" <+> ppr n
 
173
   ppr (PUSH_L offset)       = text "PUSH_L  " <+> ppr offset
 
174
   ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> ppr o1 <+> ppr o2
 
175
   ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr o3
 
176
   ppr (PUSH_G nm)           = text "PUSH_G  " <+> ppr nm
 
177
   ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers." 
 
178
                                               <> ppr op
 
179
   ppr (PUSH_BCO bco)        = text "PUSH_BCO" <+> nest 3 (ppr bco)
 
180
   ppr (PUSH_ALTS bco)       = text "PUSH_ALTS " <+> ppr bco
 
181
   ppr (PUSH_ALTS_UNLIFTED bco pk) = text "PUSH_ALTS_UNLIFTED " <+> ppr pk <+> ppr bco
 
182
 
 
183
   ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit
 
184
   ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> text (show aa)
 
185
   ppr PUSH_APPLY_N             = text "PUSH_APPLY_N"
 
186
   ppr PUSH_APPLY_V             = text "PUSH_APPLY_V"
 
187
   ppr PUSH_APPLY_F             = text "PUSH_APPLY_F"
 
188
   ppr PUSH_APPLY_D             = text "PUSH_APPLY_D"
 
189
   ppr PUSH_APPLY_L             = text "PUSH_APPLY_L"
 
190
   ppr PUSH_APPLY_P             = text "PUSH_APPLY_P"
 
191
   ppr PUSH_APPLY_PP            = text "PUSH_APPLY_PP"
 
192
   ppr PUSH_APPLY_PPP           = text "PUSH_APPLY_PPP"
 
193
   ppr PUSH_APPLY_PPPP          = text "PUSH_APPLY_PPPP"
 
194
   ppr PUSH_APPLY_PPPPP         = text "PUSH_APPLY_PPPPP"
 
195
   ppr PUSH_APPLY_PPPPPP        = text "PUSH_APPLY_PPPPPP"
 
196
 
 
197
   ppr (SLIDE n d)           = text "SLIDE   " <+> ppr n <+> ppr d
 
198
   ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> ppr sz
 
199
   ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> ppr sz
 
200
   ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> ppr arity <+> ppr sz
 
201
   ppr (MKAP offset sz)      = text "MKAP    " <+> ppr sz <+> text "words," 
 
202
                                               <+> ppr offset <+> text "stkoff"
 
203
   ppr (MKPAP offset sz)     = text "MKPAP   " <+> ppr sz <+> text "words,"
 
204
                                               <+> ppr offset <+> text "stkoff"
 
205
   ppr (UNPACK sz)           = text "UNPACK  " <+> ppr sz
 
206
   ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
 
207
   ppr (LABEL     lab)       = text "__"       <> ppr lab <> colon
 
208
   ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab
 
209
   ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
 
210
   ppr (TESTLT_W  i lab)     = text "TESTLT_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
 
211
   ppr (TESTEQ_W  i lab)     = text "TESTEQ_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
 
212
   ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
 
213
   ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
 
214
   ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
 
215
   ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> ppr lab
 
216
   ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> ppr i <+> text "__" <> ppr lab
 
217
   ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
 
218
   ppr CASEFAIL              = text "CASEFAIL"
 
219
   ppr (JMP lab)             = text "JMP"      <+> ppr lab
 
220
   ppr (CCALL off marshall_addr) = text "CCALL   " <+> ppr off 
 
221
                                                <+> text "marshall code at" 
 
222
                                               <+> text (show marshall_addr)
 
223
   ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff
 
224
                                               <+> text "by" <+> ppr n
 
225
   ppr ENTER                 = text "ENTER"
 
226
   ppr RETURN                = text "RETURN"
 
227
   ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
 
228
   ppr (BRK_FUN _breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> ppr index <+> ppr info
 
229
 
 
230
-- -----------------------------------------------------------------------------
 
231
-- The stack use, in words, of each bytecode insn.  These _must_ be
 
232
-- correct, or overestimates of reality, to be safe.
 
233
 
 
234
-- NOTE: we aggregate the stack use from case alternatives too, so that
 
235
-- we can do a single stack check at the beginning of a function only.
 
236
 
 
237
-- This could all be made more accurate by keeping track of a proper
 
238
-- stack high water mark, but it doesn't seem worth the hassle.
 
239
 
 
240
protoBCOStackUse :: ProtoBCO a -> Word
 
241
protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
 
242
 
 
243
bciStackUse :: BCInstr -> Word
 
244
bciStackUse STKCHECK{}            = 0
 
245
bciStackUse PUSH_L{}              = 1
 
246
bciStackUse PUSH_LL{}             = 2
 
247
bciStackUse PUSH_LLL{}            = 3
 
248
bciStackUse PUSH_G{}              = 1
 
249
bciStackUse PUSH_PRIMOP{}         = 1
 
250
bciStackUse PUSH_BCO{}            = 1
 
251
bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
 
252
bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
 
253
bciStackUse (PUSH_UBX _ nw)       = fromIntegral nw
 
254
bciStackUse PUSH_APPLY_N{}        = 1
 
255
bciStackUse PUSH_APPLY_V{}        = 1
 
256
bciStackUse PUSH_APPLY_F{}        = 1
 
257
bciStackUse PUSH_APPLY_D{}        = 1
 
258
bciStackUse PUSH_APPLY_L{}        = 1
 
259
bciStackUse PUSH_APPLY_P{}        = 1
 
260
bciStackUse PUSH_APPLY_PP{}       = 1
 
261
bciStackUse PUSH_APPLY_PPP{}      = 1
 
262
bciStackUse PUSH_APPLY_PPPP{}     = 1
 
263
bciStackUse PUSH_APPLY_PPPPP{}    = 1
 
264
bciStackUse PUSH_APPLY_PPPPPP{}   = 1
 
265
bciStackUse ALLOC_AP{}            = 1
 
266
bciStackUse ALLOC_AP_NOUPD{}      = 1
 
267
bciStackUse ALLOC_PAP{}           = 1
 
268
bciStackUse (UNPACK sz)           = fromIntegral sz
 
269
bciStackUse LABEL{}               = 0
 
270
bciStackUse TESTLT_I{}            = 0
 
271
bciStackUse TESTEQ_I{}            = 0
 
272
bciStackUse TESTLT_W{}            = 0
 
273
bciStackUse TESTEQ_W{}            = 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}