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 module ByteCodeInstr (
   9         BCInstr(..), ProtoBCO(..), bciStackUse, BreakInfo (..)
  10   ) where
  11
  12 #include "HsVersions.h"
  13 #include "../includes/MachDeps.h"
  14
  15 import ByteCodeItbls    ( ItblPtr )
  16
  17 import Type
  18 import Outputable
  19 import Name
  20 import Id
  21 import CoreSyn
  22 import PprCore
  23 import Literal
  24 import DataCon
  25 import VarSet
  26 import PrimOp
  27 import SMRep
  28
  29 import GHC.Ptr
  30
  31 import Module (Module)
  32 import GHC.Prim
  33
  34
  35 -- ----------------------------------------------------------------------------
  36 -- Bytecode instructions
  37
  38 data ProtoBCO a
  39    = ProtoBCO {
  40         protoBCOName       :: a,          -- name, in some sense
  41         protoBCOInstrs     :: [BCInstr],  -- instrs
  42         -- arity and GC info
  43         protoBCOBitmap     :: [StgWord],
  44         protoBCOBitmapSize :: Int,
  45         protoBCOArity      :: Int,
  46         -- what the BCO came from
  47         protoBCOExpr       :: Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet),
  48         -- malloc'd pointers
  49         protoBCOPtrs       :: [Either ItblPtr (Ptr ())]
  50    }
  51
  52 type LocalLabel = Int
  53
  54 data BCInstr
  55    -- Messing with the stack
  56    = STKCHECK  Int
  57
  58    -- Push locals (existing bits of the stack)
  59    | PUSH_L    !Int{-offset-}
  60    | PUSH_LL   !Int !Int{-2 offsets-}
  61    | PUSH_LLL  !Int !Int !Int{-3 offsets-}
  62
  63    -- Push a ptr  (these all map to PUSH_G really)
  64    | PUSH_G       Name
  65    | PUSH_PRIMOP  PrimOp
  66    | PUSH_BCO     (ProtoBCO Name)
  67
  68    -- Push an alt continuation
  69    | PUSH_ALTS          (ProtoBCO Name)
  70    | PUSH_ALTS_UNLIFTED (ProtoBCO Name) CgRep
  71
  72    -- Pushing literals
  73    | PUSH_UBX  (Either Literal (Ptr ())) Int
  74         -- push this int/float/double/addr, on the stack.  Int
  75         -- is # of words to copy from literal pool.  Eitherness reflects
  76         -- the difficulty of dealing with MachAddr here, mostly due to
  77         -- the excessive (and unnecessary) restrictions imposed by the
  78         -- designers of the new Foreign library.  In particular it is
  79         -- quite impossible to convert an Addr to any other integral
  80         -- type, and it appears impossible to get hold of the bits of
  81         -- an addr, even though we need to to assemble BCOs.
  82
  83    -- various kinds of application
  84    | PUSH_APPLY_N
  85    | PUSH_APPLY_V
  86    | PUSH_APPLY_F
  87    | PUSH_APPLY_D
  88    | PUSH_APPLY_L
  89    | PUSH_APPLY_P
  90    | PUSH_APPLY_PP
  91    | PUSH_APPLY_PPP
  92    | PUSH_APPLY_PPPP
  93    | PUSH_APPLY_PPPPP
  94    | PUSH_APPLY_PPPPPP
  95
  96    | SLIDE     Int{-this many-} Int{-down by this much-}
  97
  98    -- To do with the heap
  99    | ALLOC_AP  !Int     -- make an AP with this many payload words
 100    | ALLOC_PAP !Int !Int        -- make a PAP with this arity / payload words
 101    | MKAP      !Int{-ptr to AP is this far down stack-} !Int{-# words-}
 102    | MKPAP     !Int{-ptr to PAP is this far down stack-} !Int{-# words-}
 103    | UNPACK    !Int     -- unpack N words from t.o.s Constr
 104    | PACK      DataCon !Int
 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 Int 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  Int    LocalLabel
 120    | TESTEQ_P  Int    LocalLabel
 121
 122    | CASEFAIL
 123    | JMP              LocalLabel
 124
 125    -- For doing calls to C (via glue code generated by ByteCodeFFI)
 126    | CCALL            Int       -- stack frame size
 127                       (Ptr ())  -- addr of the glue code
 128
 129    -- For doing magic ByteArray passing to foreign calls
 130    | SWIZZLE          Int       -- to the ptr N words down the stack,
 131                       Int       -- 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) Int BreakInfo
 140
 141 data BreakInfo
 142    = BreakInfo
 143    { breakInfo_module :: Module
 144    , breakInfo_number :: {-# UNPACK #-} !Int
 145    , breakInfo_vars   :: [(Id,Int)]
 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" <+> int n
 171    ppr (PUSH_L offset)       = text "PUSH_L  " <+> int offset
 172    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> int o1 <+> int o2
 173    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int 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 (int nw) <+> ppr lit
 182    ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int 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   " <+> int n <+> int d
 196    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> int sz
 197    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> int arity <+> int sz
 198    ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words,"
 199                                                <+> int offset <+> text "stkoff"
 200    ppr (MKPAP offset sz)     = text "MKPAP   " <+> int sz <+> text "words,"
 201                                                <+> int offset <+> text "stkoff"
 202    ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
 203    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
 204    ppr (LABEL     lab)       = text "__"       <> int lab <> colon
 205    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
 206    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
 207    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
 208    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
 209    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
 210    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
 211    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
 212    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
 213    ppr CASEFAIL              = text "CASEFAIL"
 214    ppr (JMP lab)             = text "JMP"      <+> int lab
 215    ppr (CCALL off marshall_addr) = text "CCALL   " <+> int off
 216                                                 <+> text "marshall code at"
 217                                                <+> text (show marshall_addr)
 218    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff
 219                                                <+> text "by" <+> int n
 220    ppr ENTER                 = text "ENTER"
 221    ppr RETURN                = text "RETURN"
 222    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
 223    ppr (BRK_FUN breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> int index <+> ppr info
 224
 225 -- -----------------------------------------------------------------------------
 226 -- The stack use, in words, of each bytecode insn.  These _must_ be
 227 -- correct, or overestimates of reality, to be safe.
 228
 229 -- NOTE: we aggregate the stack use from case alternatives too, so that
 230 -- we can do a single stack check at the beginning of a function only.
 231
 232 -- This could all be made more accurate by keeping track of a proper
 233 -- stack high water mark, but it doesn't seem worth the hassle.
 234
 235 protoBCOStackUse :: ProtoBCO a -> Int
 236 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
 237
 238 bciStackUse :: BCInstr -> Int
 239 bciStackUse STKCHECK{}            = 0
 240 bciStackUse PUSH_L{}              = 1
 241 bciStackUse PUSH_LL{}             = 2
 242 bciStackUse PUSH_LLL{}            = 3
 243 bciStackUse PUSH_G{}              = 1
 244 bciStackUse PUSH_PRIMOP{}         = 1
 245 bciStackUse PUSH_BCO{}            = 1
 246 bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
 247 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
 248 bciStackUse (PUSH_UBX _ nw)       = nw
 249 bciStackUse PUSH_APPLY_N{}        = 1
 250 bciStackUse PUSH_APPLY_V{}        = 1
 251 bciStackUse PUSH_APPLY_F{}        = 1
 252 bciStackUse PUSH_APPLY_D{}        = 1
 253 bciStackUse PUSH_APPLY_L{}        = 1
 254 bciStackUse PUSH_APPLY_P{}        = 1
 255 bciStackUse PUSH_APPLY_PP{}       = 1
 256 bciStackUse PUSH_APPLY_PPP{}      = 1
 257 bciStackUse PUSH_APPLY_PPPP{}     = 1
 258 bciStackUse PUSH_APPLY_PPPPP{}    = 1
 259 bciStackUse PUSH_APPLY_PPPPPP{}   = 1
 260 bciStackUse ALLOC_AP{}            = 1
 261 bciStackUse ALLOC_PAP{}           = 1
 262 bciStackUse (UNPACK sz)           = sz
 263 bciStackUse LABEL{}               = 0
 264 bciStackUse TESTLT_I{}            = 0
 265 bciStackUse TESTEQ_I{}            = 0
 266 bciStackUse TESTLT_F{}            = 0
 267 bciStackUse TESTEQ_F{}            = 0
 268 bciStackUse TESTLT_D{}            = 0
 269 bciStackUse TESTEQ_D{}            = 0
 270 bciStackUse TESTLT_P{}            = 0
 271 bciStackUse TESTEQ_P{}            = 0
 272 bciStackUse CASEFAIL{}            = 0
 273 bciStackUse JMP{}                 = 0
 274 bciStackUse ENTER{}               = 0
 275 bciStackUse RETURN{}              = 0
 276 bciStackUse RETURN_UBX{}          = 1
 277 bciStackUse CCALL{}               = 0
 278 bciStackUse SWIZZLE{}             = 0
 279 bciStackUse BRK_FUN{}             = 0
 280
 281 -- These insns actually reduce stack use, but we need the high-tide level,
 282 -- so can't use this info.  Not that it matters much.
 283 bciStackUse SLIDE{}               = 0
 284 bciStackUse MKAP{}                = 0
 285 bciStackUse MKPAP{}               = 0
 286 bciStackUse PACK{}                = 1 -- worst case is PACK 0 words
 287 \end{code}