summaryrefslogtreecommitdiff
path: root/compiler/GHC/ByteCode/Instr.hs
blob: 85600703fa813d38cf4424aef1880139106bcef5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
{-# LANGUAGE CPP              #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
--
--  (c) The University of Glasgow 2002-2006
--

-- | Bytecode instruction definitions
module GHC.ByteCode.Instr (
        BCInstr(..), ProtoBCO(..), bciStackUse, LocalLabel(..)
  ) where

import GHC.Prelude

import GHC.ByteCode.Types
import GHCi.RemoteTypes
import GHCi.FFI (C_ffi_cif)
import GHC.StgToCmm.Layout     ( ArgRep(..) )
import GHC.Utils.Outputable
import GHC.Types.Name
import GHC.Types.Unique
import GHC.Types.Literal
import GHC.Core.DataCon
import GHC.Builtin.PrimOps
import GHC.Runtime.Heap.Layout

import Data.Word
import GHC.Stack.CCS (CostCentre)

import GHC.Stg.Syntax

-- ----------------------------------------------------------------------------
-- Bytecode instructions

data ProtoBCO a
   = ProtoBCO {
        protoBCOName       :: a,          -- name, in some sense
        protoBCOInstrs     :: [BCInstr],  -- instrs
        -- arity and GC info
        protoBCOBitmap     :: [StgWord],
        protoBCOBitmapSize :: Word16,
        protoBCOArity      :: Int,
        -- what the BCO came from, for debugging only
        protoBCOExpr       :: Either [CgStgAlt] CgStgRhs,
        -- malloc'd pointers
        protoBCOFFIs       :: [FFIInfo]
   }

-- | A local block label (e.g. identifying a case alternative).
newtype LocalLabel = LocalLabel { getLocalLabel :: Word32 }
  deriving (Eq, Ord)

instance Outputable LocalLabel where
  ppr (LocalLabel lbl) = text "lbl:" <> ppr lbl

data BCInstr
   -- Messing with the stack
   = STKCHECK  Word

   -- Push locals (existing bits of the stack)
   | PUSH_L    !Word16{-offset-}
   | PUSH_LL   !Word16 !Word16{-2 offsets-}
   | PUSH_LLL  !Word16 !Word16 !Word16{-3 offsets-}

   -- Push the specified local as a 8, 16, 32 bit value onto the stack. (i.e.,
   -- the stack will grow by 8, 16 or 32 bits)
   | PUSH8  !Word16
   | PUSH16 !Word16
   | PUSH32 !Word16

   -- Push the specifiec local as a 8, 16, 32 bit value onto the stack, but the
   -- value will take the whole word on the stack (i.e., the stack will grow by
   -- a word)
   -- This is useful when extracting a packed constructor field for further use.
   -- Currently we expect all values on the stack to take full words, except for
   -- the ones used for PACK (i.e., actually constracting new data types, in
   -- which case we use PUSH{8,16,32})
   | PUSH8_W  !Word16
   | PUSH16_W !Word16
   | PUSH32_W !Word16

   -- Push a ptr  (these all map to PUSH_G really)
   | PUSH_G       Name
   | PUSH_PRIMOP  PrimOp
   | PUSH_BCO     (ProtoBCO Name)

   -- Push an alt continuation
   | PUSH_ALTS          (ProtoBCO Name)
   | PUSH_ALTS_UNLIFTED (ProtoBCO Name) ArgRep
   | PUSH_ALTS_TUPLE    (ProtoBCO Name) -- continuation
                        !TupleInfo
                        (ProtoBCO Name) -- tuple return BCO

   -- Pushing 8, 16 and 32 bits of padding (for constructors).
   | PUSH_PAD8
   | PUSH_PAD16
   | PUSH_PAD32

   -- Pushing literals
   | PUSH_UBX8  Literal
   | PUSH_UBX16 Literal
   | PUSH_UBX32 Literal
   | PUSH_UBX   Literal Word16
        -- push this int/float/double/addr, on the stack. Word16
        -- is # of words to copy from literal pool.  Eitherness reflects
        -- the difficulty of dealing with MachAddr here, mostly due to
        -- the excessive (and unnecessary) restrictions imposed by the
        -- designers of the new Foreign library.  In particular it is
        -- quite impossible to convert an Addr to any other integral
        -- type, and it appears impossible to get hold of the bits of
        -- an addr, even though we need to assemble BCOs.

   -- various kinds of application
   | PUSH_APPLY_N
   | PUSH_APPLY_V
   | PUSH_APPLY_F
   | PUSH_APPLY_D
   | PUSH_APPLY_L
   | PUSH_APPLY_P
   | PUSH_APPLY_PP
   | PUSH_APPLY_PPP
   | PUSH_APPLY_PPPP
   | PUSH_APPLY_PPPPP
   | PUSH_APPLY_PPPPPP

   | SLIDE     Word16{-this many-} Word16{-down by this much-}

   -- To do with the heap
   | ALLOC_AP  !Word16 -- make an AP with this many payload words
   | ALLOC_AP_NOUPD !Word16 -- make an AP_NOUPD with this many payload words
   | ALLOC_PAP !Word16 !Word16 -- make a PAP with this arity / payload words
   | MKAP      !Word16{-ptr to AP is this far down stack-} !Word16{-number of words-}
   | MKPAP     !Word16{-ptr to PAP is this far down stack-} !Word16{-number of words-}
   | UNPACK    !Word16 -- unpack N words from t.o.s Constr
   | PACK      DataCon !Word16
                        -- after assembly, the DataCon is an index into the
                        -- itbl array
   -- For doing case trees
   | LABEL     LocalLabel
   | TESTLT_I  Int    LocalLabel
   | TESTEQ_I  Int    LocalLabel
   | TESTLT_W  Word   LocalLabel
   | TESTEQ_W  Word   LocalLabel
   | TESTLT_F  Float  LocalLabel
   | TESTEQ_F  Float  LocalLabel
   | TESTLT_D  Double LocalLabel
   | TESTEQ_D  Double LocalLabel

   -- The Word16 value is a constructor number and therefore
   -- stored in the insn stream rather than as an offset into
   -- the literal pool.
   | TESTLT_P  Word16 LocalLabel
   | TESTEQ_P  Word16 LocalLabel

   | CASEFAIL
   | JMP              LocalLabel

   -- For doing calls to C (via glue code generated by libffi)
   | CCALL            Word16    -- stack frame size
                      (RemotePtr C_ffi_cif) -- addr of the glue code
                      Word16    -- flags.
                                --
                                -- 0x1: call is interruptible
                                -- 0x2: call is unsafe
                                --
                                -- (XXX: inefficient, but I don't know
                                -- what the alignment constraints are.)

   -- For doing magic ByteArray passing to foreign calls
   | SWIZZLE          Word16 -- to the ptr N words down the stack,
                      Word16 -- add M (interpreted as a signed 16-bit entity)

   -- To Infinity And Beyond
   | ENTER
   | RETURN            -- return a lifted value
   | RETURN_UBX ArgRep -- return an unlifted value, here's its rep
   | RETURN_TUPLE      -- return an unboxed tuple (info already on stack)

   -- Breakpoints
   | BRK_FUN          Word16 Unique (RemotePtr CostCentre)

-- -----------------------------------------------------------------------------
-- Printing bytecode instructions

instance Outputable a => Outputable (ProtoBCO a) where
   ppr (ProtoBCO { protoBCOName       = name
                 , protoBCOInstrs     = instrs
                 , protoBCOBitmap     = bitmap
                 , protoBCOBitmapSize = bsize
                 , protoBCOArity      = arity
                 , protoBCOExpr       = origin
                 , protoBCOFFIs       = ffis })
      = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity
                <+> text (show ffis) <> colon)
        $$ nest 3 (case origin of
                      Left alts ->
                        vcat (zipWith (<+>) (char '{' : repeat (char ';'))
                             (map (pprStgAltShort shortStgPprOpts) alts))
                      Right rhs ->
                        pprStgRhsShort shortStgPprOpts rhs
                  )
        $$ nest 3 (text "bitmap: " <+> text (show bsize) <+> ppr bitmap)
        $$ nest 3 (vcat (map ppr instrs))

-- Print enough of the STG expression to enable the reader to find
-- the expression in the -ddump-stg output.  That is, we need to
-- include at least a binder.

pprStgExprShort :: OutputablePass pass => StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExprShort _ (StgCase _expr var _ty _alts) =
  text "case of" <+> ppr var
pprStgExprShort _ (StgLet _ bnd _) =
  text "let" <+> pprStgBindShort bnd <+> text "in ..."
pprStgExprShort _ (StgLetNoEscape _ bnd _) =
  text "let-no-escape" <+> pprStgBindShort bnd <+> text "in ..."
pprStgExprShort opts (StgTick t e) = ppr t <+> pprStgExprShort opts e
pprStgExprShort opts e = pprStgExpr opts e

pprStgBindShort :: OutputablePass pass => GenStgBinding pass -> SDoc
pprStgBindShort (StgNonRec x _) =
  ppr x <+> text "= ..."
pprStgBindShort (StgRec bs) =
  char '{' <+> ppr (fst (head bs)) <+> text "= ...; ... }"

pprStgAltShort :: OutputablePass pass => StgPprOpts -> GenStgAlt pass -> SDoc
pprStgAltShort opts (con, args, expr) =
  ppr con <+> sep (map ppr args) <+> text "->" <+> pprStgExprShort opts expr

pprStgRhsShort :: OutputablePass pass => StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhsShort opts (StgRhsClosure _ext _cc upd_flag args body) =
  hang (hsep [ char '\\' <> ppr upd_flag, brackets (interppSP args) ])
       4 (pprStgExprShort opts body)
pprStgRhsShort opts rhs = pprStgRhs opts rhs


instance Outputable BCInstr where
   ppr (STKCHECK n)          = text "STKCHECK" <+> ppr n
   ppr (PUSH_L offset)       = text "PUSH_L  " <+> ppr offset
   ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> ppr o1 <+> ppr o2
   ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr o3
   ppr (PUSH8  offset)       = text "PUSH8  " <+> ppr offset
   ppr (PUSH16 offset)       = text "PUSH16  " <+> ppr offset
   ppr (PUSH32 offset)       = text "PUSH32  " <+> ppr offset
   ppr (PUSH8_W  offset)     = text "PUSH8_W  " <+> ppr offset
   ppr (PUSH16_W offset)     = text "PUSH16_W  " <+> ppr offset
   ppr (PUSH32_W offset)     = text "PUSH32_W  " <+> ppr offset
   ppr (PUSH_G nm)           = text "PUSH_G  " <+> ppr nm
   ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers."
                                               <> ppr op
   ppr (PUSH_BCO bco)        = hang (text "PUSH_BCO") 2 (ppr bco)

   ppr (PUSH_ALTS bco)       = hang (text "PUSH_ALTS") 2 (ppr bco)
   ppr (PUSH_ALTS_UNLIFTED bco pk) = hang (text "PUSH_ALTS_UNLIFTED" <+> ppr pk) 2 (ppr bco)
   ppr (PUSH_ALTS_TUPLE bco tuple_info tuple_bco) =
                               hang (text "PUSH_ALTS_TUPLE" <+> ppr tuple_info)
                                    2
                                    (ppr tuple_bco $+$ ppr bco)

   ppr PUSH_PAD8             = text "PUSH_PAD8"
   ppr PUSH_PAD16            = text "PUSH_PAD16"
   ppr PUSH_PAD32            = text "PUSH_PAD32"

   ppr (PUSH_UBX8  lit)      = text "PUSH_UBX8" <+> ppr lit
   ppr (PUSH_UBX16 lit)      = text "PUSH_UBX16" <+> ppr lit
   ppr (PUSH_UBX32 lit)      = text "PUSH_UBX32" <+> ppr lit
   ppr (PUSH_UBX lit nw)     = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit
   ppr PUSH_APPLY_N          = text "PUSH_APPLY_N"
   ppr PUSH_APPLY_V          = text "PUSH_APPLY_V"
   ppr PUSH_APPLY_F          = text "PUSH_APPLY_F"
   ppr PUSH_APPLY_D          = text "PUSH_APPLY_D"
   ppr PUSH_APPLY_L          = text "PUSH_APPLY_L"
   ppr PUSH_APPLY_P          = text "PUSH_APPLY_P"
   ppr PUSH_APPLY_PP         = text "PUSH_APPLY_PP"
   ppr PUSH_APPLY_PPP        = text "PUSH_APPLY_PPP"
   ppr PUSH_APPLY_PPPP       = text "PUSH_APPLY_PPPP"
   ppr PUSH_APPLY_PPPPP      = text "PUSH_APPLY_PPPPP"
   ppr PUSH_APPLY_PPPPPP     = text "PUSH_APPLY_PPPPPP"

   ppr (SLIDE n d)           = text "SLIDE   " <+> ppr n <+> ppr d
   ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> ppr sz
   ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> ppr sz
   ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> ppr arity <+> ppr sz
   ppr (MKAP offset sz)      = text "MKAP    " <+> ppr sz <+> text "words,"
                                               <+> ppr offset <+> text "stkoff"
   ppr (MKPAP offset sz)     = text "MKPAP   " <+> ppr sz <+> text "words,"
                                               <+> ppr offset <+> text "stkoff"
   ppr (UNPACK sz)           = text "UNPACK  " <+> ppr sz
   ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
   ppr (LABEL     lab)       = text "__"       <> ppr lab <> colon
   ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab
   ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
   ppr (TESTLT_W  i lab)     = text "TESTLT_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
   ppr (TESTEQ_W  i lab)     = text "TESTEQ_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
   ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
   ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
   ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
   ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> ppr lab
   ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> ppr i <+> text "__" <> ppr lab
   ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
   ppr CASEFAIL              = text "CASEFAIL"
   ppr (JMP lab)             = text "JMP"      <+> ppr lab
   ppr (CCALL off marshall_addr flags) = text "CCALL   " <+> ppr off
                                                <+> text "marshall code at"
                                               <+> text (show marshall_addr)
                                               <+> (case flags of
                                                      0x1 -> text "(interruptible)"
                                                      0x2 -> text "(unsafe)"
                                                      _   -> empty)
   ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff
                                               <+> text "by" <+> ppr n
   ppr ENTER                 = text "ENTER"
   ppr RETURN                = text "RETURN"
   ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
   ppr (RETURN_TUPLE)        = text "RETURN_TUPLE"
   ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> ppr uniq <+> text "<cc>"



-- -----------------------------------------------------------------------------
-- The stack use, in words, of each bytecode insn.  These _must_ be
-- correct, or overestimates of reality, to be safe.

-- NOTE: we aggregate the stack use from case alternatives too, so that
-- we can do a single stack check at the beginning of a function only.

-- This could all be made more accurate by keeping track of a proper
-- stack high water mark, but it doesn't seem worth the hassle.

protoBCOStackUse :: ProtoBCO a -> Word
protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))

bciStackUse :: BCInstr -> Word
bciStackUse STKCHECK{}            = 0
bciStackUse PUSH_L{}              = 1
bciStackUse PUSH_LL{}             = 2
bciStackUse PUSH_LLL{}            = 3
bciStackUse PUSH8{}               = 1  -- overapproximation
bciStackUse PUSH16{}              = 1  -- overapproximation
bciStackUse PUSH32{}              = 1  -- overapproximation on 64bit arch
bciStackUse PUSH8_W{}             = 1  -- takes exactly 1 word
bciStackUse PUSH16_W{}            = 1  -- takes exactly 1 word
bciStackUse PUSH32_W{}            = 1  -- takes exactly 1 word
bciStackUse PUSH_G{}              = 1
bciStackUse PUSH_PRIMOP{}         = 1
bciStackUse PUSH_BCO{}            = 1
bciStackUse (PUSH_ALTS bco)       = 2 {- profiling only, restore CCCS -} +
                                    3 + protoBCOStackUse bco
bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 {- profiling only, restore CCCS -} +
                                         4 + protoBCOStackUse bco
bciStackUse (PUSH_ALTS_TUPLE bco info _) =
   -- (tuple_bco, tuple_info word, cont_bco, stg_ctoi_t)
   -- tuple
   -- (tuple_info, tuple_bco, stg_ret_t)
   1 {- profiling only -} +
   7 + fromIntegral (tupleSize info) + protoBCOStackUse bco
bciStackUse (PUSH_PAD8)           = 1  -- overapproximation
bciStackUse (PUSH_PAD16)          = 1  -- overapproximation
bciStackUse (PUSH_PAD32)          = 1  -- overapproximation on 64bit arch
bciStackUse (PUSH_UBX8 _)         = 1  -- overapproximation
bciStackUse (PUSH_UBX16 _)        = 1  -- overapproximation
bciStackUse (PUSH_UBX32 _)        = 1  -- overapproximation on 64bit arch
bciStackUse (PUSH_UBX _ nw)       = fromIntegral nw
bciStackUse PUSH_APPLY_N{}        = 1
bciStackUse PUSH_APPLY_V{}        = 1
bciStackUse PUSH_APPLY_F{}        = 1
bciStackUse PUSH_APPLY_D{}        = 1
bciStackUse PUSH_APPLY_L{}        = 1
bciStackUse PUSH_APPLY_P{}        = 1
bciStackUse PUSH_APPLY_PP{}       = 1
bciStackUse PUSH_APPLY_PPP{}      = 1
bciStackUse PUSH_APPLY_PPPP{}     = 1
bciStackUse PUSH_APPLY_PPPPP{}    = 1
bciStackUse PUSH_APPLY_PPPPPP{}   = 1
bciStackUse ALLOC_AP{}            = 1
bciStackUse ALLOC_AP_NOUPD{}      = 1
bciStackUse ALLOC_PAP{}           = 1
bciStackUse (UNPACK sz)           = fromIntegral sz
bciStackUse LABEL{}               = 0
bciStackUse TESTLT_I{}            = 0
bciStackUse TESTEQ_I{}            = 0
bciStackUse TESTLT_W{}            = 0
bciStackUse TESTEQ_W{}            = 0
bciStackUse TESTLT_F{}            = 0
bciStackUse TESTEQ_F{}            = 0
bciStackUse TESTLT_D{}            = 0
bciStackUse TESTEQ_D{}            = 0
bciStackUse TESTLT_P{}            = 0
bciStackUse TESTEQ_P{}            = 0
bciStackUse CASEFAIL{}            = 0
bciStackUse JMP{}                 = 0
bciStackUse ENTER{}               = 0
bciStackUse RETURN{}              = 0
bciStackUse RETURN_UBX{}          = 1 -- pushes stg_ret_X for some X
bciStackUse RETURN_TUPLE{}        = 1 -- pushes stg_ret_t header
bciStackUse CCALL{}               = 0
bciStackUse SWIZZLE{}             = 0
bciStackUse BRK_FUN{}             = 0

-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info.  Not that it matters much.
bciStackUse SLIDE{}               = 0
bciStackUse MKAP{}                = 0
bciStackUse MKPAP{}               = 0
bciStackUse PACK{}                = 1 -- worst case is PACK 0 words