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}