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_F  Float  LocalLabel
 112    | TESTEQ_F  Float  LocalLabel
 113    | TESTLT_D  Double LocalLabel
 114    | TESTEQ_D  Double LocalLabel
 115
 116    -- The Word16 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  Word16 LocalLabel
 120    | TESTEQ_P  Word16 LocalLabel
 121
 122    | CASEFAIL
 123    | JMP              LocalLabel
 124
 125    -- For doing calls to C (via glue code generated by ByteCodeFFI, or libffi)
 126    | CCALL            Word16    -- stack frame size
 127                       (Ptr ())  -- addr of the glue code
 128
 129    -- For doing magic ByteArray passing to foreign calls
 130    | SWIZZLE          Word16 -- to the ptr N words down the stack,
 131                       Word16 -- 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) Word16 BreakInfo
 140
 141 data BreakInfo
 142    = BreakInfo
 143    { breakInfo_module :: Module
 144    , breakInfo_number :: {-# UNPACK #-} !Int
 145    , breakInfo_vars   :: [(Id,Word16)]
 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" <+> ppr n
 171    ppr (PUSH_L offset)       = text "PUSH_L  " <+> ppr offset
 172    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> ppr o1 <+> ppr o2
 173    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr 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 (ppr nw) <+> ppr lit
 182    ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (ppr 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   " <+> ppr n <+> ppr d
 196    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> ppr sz
 197    ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> ppr sz
 198    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> ppr arity <+> ppr sz
 199    ppr (MKAP offset sz)      = text "MKAP    " <+> ppr sz <+> text "words,"
 200                                                <+> ppr offset <+> text "stkoff"
 201    ppr (MKPAP offset sz)     = text "MKPAP   " <+> ppr sz <+> text "words,"
 202                                                <+> ppr offset <+> text "stkoff"
 203    ppr (UNPACK sz)           = text "UNPACK  " <+> ppr sz
 204    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
 205    ppr (LABEL     lab)       = text "__"       <> ppr lab <> colon
 206    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab
 207    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
 208    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
 209    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
 210    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
 211    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> ppr lab
 212    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> ppr i <+> text "__" <> ppr lab
 213    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
 214    ppr CASEFAIL              = text "CASEFAIL"
 215    ppr (JMP lab)             = text "JMP"      <+> ppr lab
 216    ppr (CCALL off marshall_addr) = text "CCALL   " <+> ppr off
 217                                                 <+> text "marshall code at"
 218                                                <+> text (show marshall_addr)
 219    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff
 220                                                <+> text "by" <+> ppr 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>" <+> ppr 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 -> Word
 237 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
 238
 239 bciStackUse :: BCInstr -> Word
 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)       = fromIntegral 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)           = fromIntegral 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}