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 libffi)
 128    | CCALL            Word16    -- stack frame size
 129                       (Ptr ())  -- addr of the glue code
 130                       Word16    -- whether or not the call is interruptible
 131                                 -- (XXX: inefficient, but I don't know
 132                                 -- what the alignment constraints are.)
 133
 134    -- For doing magic ByteArray passing to foreign calls
 135    | SWIZZLE          Word16 -- to the ptr N words down the stack,
 136                       Word16 -- add M (interpreted as a signed 16-bit entity)
 137
 138    -- To Infinity And Beyond
 139    | ENTER
 140    | RETURN             -- return a lifted value
 141    | RETURN_UBX CgRep -- return an unlifted value, here's its rep
 142
 143    -- Breakpoints
 144    | BRK_FUN          (MutableByteArray# RealWorld) Word16 BreakInfo
 145
 146 data BreakInfo
 147    = BreakInfo
 148    { breakInfo_module :: Module
 149    , breakInfo_number :: {-# UNPACK #-} !Int
 150    , breakInfo_vars   :: [(Id,Word16)]
 151    , breakInfo_resty  :: Type
 152    }
 153
 154 instance Outputable BreakInfo where
 155    ppr info = text "BreakInfo" <+>
 156               parens (ppr (breakInfo_module info) <+>
 157                       ppr (breakInfo_number info) <+>
 158                       ppr (breakInfo_vars info) <+>
 159                       ppr (breakInfo_resty info))
 160
 161 -- -----------------------------------------------------------------------------
 162 -- Printing bytecode instructions
 163
 164 instance Outputable a => Outputable (ProtoBCO a) where
 165    ppr (ProtoBCO name instrs bitmap bsize arity origin malloced)
 166       = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity
 167                 <+> text (show malloced) <> colon)
 168         $$ nest 6 (text "bitmap: " <+> text (show bsize) <+> text (show bitmap))
 169         $$ nest 6 (vcat (map ppr instrs))
 170         $$ case origin of
 171               Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
 172               Right rhs -> pprCoreExpr (deAnnotate rhs)
 173
 174 instance Outputable BCInstr where
 175    ppr (STKCHECK n)          = text "STKCHECK" <+> ppr n
 176    ppr (PUSH_L offset)       = text "PUSH_L  " <+> ppr offset
 177    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> ppr o1 <+> ppr o2
 178    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr o3
 179    ppr (PUSH_G nm)           = text "PUSH_G  " <+> ppr nm
 180    ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers."
 181                                                <> ppr op
 182    ppr (PUSH_BCO bco)        = text "PUSH_BCO" <+> nest 3 (ppr bco)
 183    ppr (PUSH_ALTS bco)       = text "PUSH_ALTS " <+> ppr bco
 184    ppr (PUSH_ALTS_UNLIFTED bco pk) = text "PUSH_ALTS_UNLIFTED " <+> ppr pk <+> ppr bco
 185
 186    ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit
 187    ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> text (show aa)
 188    ppr PUSH_APPLY_N             = text "PUSH_APPLY_N"
 189    ppr PUSH_APPLY_V             = text "PUSH_APPLY_V"
 190    ppr PUSH_APPLY_F             = text "PUSH_APPLY_F"
 191    ppr PUSH_APPLY_D             = text "PUSH_APPLY_D"
 192    ppr PUSH_APPLY_L             = text "PUSH_APPLY_L"
 193    ppr PUSH_APPLY_P             = text "PUSH_APPLY_P"
 194    ppr PUSH_APPLY_PP            = text "PUSH_APPLY_PP"
 195    ppr PUSH_APPLY_PPP           = text "PUSH_APPLY_PPP"
 196    ppr PUSH_APPLY_PPPP          = text "PUSH_APPLY_PPPP"
 197    ppr PUSH_APPLY_PPPPP         = text "PUSH_APPLY_PPPPP"
 198    ppr PUSH_APPLY_PPPPPP        = text "PUSH_APPLY_PPPPPP"
 199
 200    ppr (SLIDE n d)           = text "SLIDE   " <+> ppr n <+> ppr d
 201    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> ppr sz
 202    ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> ppr sz
 203    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> ppr arity <+> ppr sz
 204    ppr (MKAP offset sz)      = text "MKAP    " <+> ppr sz <+> text "words,"
 205                                                <+> ppr offset <+> text "stkoff"
 206    ppr (MKPAP offset sz)     = text "MKPAP   " <+> ppr sz <+> text "words,"
 207                                                <+> ppr offset <+> text "stkoff"
 208    ppr (UNPACK sz)           = text "UNPACK  " <+> ppr sz
 209    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
 210    ppr (LABEL     lab)       = text "__"       <> ppr lab <> colon
 211    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab
 212    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
 213    ppr (TESTLT_W  i lab)     = text "TESTLT_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
 214    ppr (TESTEQ_W  i lab)     = text "TESTEQ_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
 215    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
 216    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
 217    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
 218    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> ppr lab
 219    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> ppr i <+> text "__" <> ppr lab
 220    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
 221    ppr CASEFAIL              = text "CASEFAIL"
 222    ppr (JMP lab)             = text "JMP"      <+> ppr lab
 223    ppr (CCALL off marshall_addr int) = text "CCALL   " <+> ppr off
 224                                                 <+> text "marshall code at"
 225                                                <+> text (show marshall_addr)
 226                                                <+> (if int == 1
 227                                                     then text "(interruptible)"
 228                                                     else empty)
 229    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff
 230                                                <+> text "by" <+> ppr n
 231    ppr ENTER                 = text "ENTER"
 232    ppr RETURN                = text "RETURN"
 233    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
 234    ppr (BRK_FUN _breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> ppr index <+> ppr info
 235
 236 -- -----------------------------------------------------------------------------
 237 -- The stack use, in words, of each bytecode insn.  These _must_ be
 238 -- correct, or overestimates of reality, to be safe.
 239
 240 -- NOTE: we aggregate the stack use from case alternatives too, so that
 241 -- we can do a single stack check at the beginning of a function only.
 242
 243 -- This could all be made more accurate by keeping track of a proper
 244 -- stack high water mark, but it doesn't seem worth the hassle.
 245
 246 protoBCOStackUse :: ProtoBCO a -> Word
 247 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
 248
 249 bciStackUse :: BCInstr -> Word
 250 bciStackUse STKCHECK{}            = 0
 251 bciStackUse PUSH_L{}              = 1
 252 bciStackUse PUSH_LL{}             = 2
 253 bciStackUse PUSH_LLL{}            = 3
 254 bciStackUse PUSH_G{}              = 1
 255 bciStackUse PUSH_PRIMOP{}         = 1
 256 bciStackUse PUSH_BCO{}            = 1
 257 bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
 258 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
 259 bciStackUse (PUSH_UBX _ nw)       = fromIntegral nw
 260 bciStackUse PUSH_APPLY_N{}        = 1
 261 bciStackUse PUSH_APPLY_V{}        = 1
 262 bciStackUse PUSH_APPLY_F{}        = 1
 263 bciStackUse PUSH_APPLY_D{}        = 1
 264 bciStackUse PUSH_APPLY_L{}        = 1
 265 bciStackUse PUSH_APPLY_P{}        = 1
 266 bciStackUse PUSH_APPLY_PP{}       = 1
 267 bciStackUse PUSH_APPLY_PPP{}      = 1
 268 bciStackUse PUSH_APPLY_PPPP{}     = 1
 269 bciStackUse PUSH_APPLY_PPPPP{}    = 1
 270 bciStackUse PUSH_APPLY_PPPPPP{}   = 1
 271 bciStackUse ALLOC_AP{}            = 1
 272 bciStackUse ALLOC_AP_NOUPD{}      = 1
 273 bciStackUse ALLOC_PAP{}           = 1
 274 bciStackUse (UNPACK sz)           = fromIntegral sz
 275 bciStackUse LABEL{}               = 0
 276 bciStackUse TESTLT_I{}            = 0
 277 bciStackUse TESTEQ_I{}            = 0
 278 bciStackUse TESTLT_W{}            = 0
 279 bciStackUse TESTEQ_W{}            = 0
 280 bciStackUse TESTLT_F{}            = 0
 281 bciStackUse TESTEQ_F{}            = 0
 282 bciStackUse TESTLT_D{}            = 0
 283 bciStackUse TESTEQ_D{}            = 0
 284 bciStackUse TESTLT_P{}            = 0
 285 bciStackUse TESTEQ_P{}            = 0
 286 bciStackUse CASEFAIL{}            = 0
 287 bciStackUse JMP{}                 = 0
 288 bciStackUse ENTER{}               = 0
 289 bciStackUse RETURN{}              = 0
 290 bciStackUse RETURN_UBX{}          = 1
 291 bciStackUse CCALL{}               = 0
 292 bciStackUse SWIZZLE{}             = 0
 293 bciStackUse BRK_FUN{}             = 0
 294
 295 -- These insns actually reduce stack use, but we need the high-tide level,
 296 -- so can't use this info.  Not that it matters much.
 297 bciStackUse SLIDE{}               = 0
 298 bciStackUse MKAP{}                = 0
 299 bciStackUse MKPAP{}               = 0
 300 bciStackUse PACK{}                = 1 -- worst case is PACK 0 words
 301 \end{code}