compiler/ghci/ByteCodeInstr.lhs

   1 %
   2 % (c) The University of Glasgow 2000-2006
   3 %
   4 ByteCodeInstrs: Bytecode instruction definitions
   5
   6 \begin{code}
   7 module ByteCodeInstr (
   8         BCInstr(..), ProtoBCO(..), bciStackUse, BreakInfo (..)
   9   ) where
  10
  11 #include "HsVersions.h"
  12 #include "../includes/MachDeps.h"
  13
  14 import ByteCodeItbls    ( ItblPtr )
  15
  16 import Type
  17 import Outputable
  18 import Name
  19 import Id
  20 import CoreSyn
  21 import PprCore
  22 import Literal
  23 import DataCon
  24 import VarSet
  25 import PrimOp
  26 import SMRep
  27
  28 import GHC.Ptr
  29
  30 import Module (Module)
  31 import GHC.Prim
  32
  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 :: Int,
  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 = Int
  52
  53 data BCInstr
  54    -- Messing with the stack
  55    = STKCHECK  Int
  56
  57    -- Push locals (existing bits of the stack)
  58    | PUSH_L    Int{-offset-}
  59    | PUSH_LL   Int Int{-2 offsets-}
  60    | PUSH_LLL  Int Int Int{-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 ())) Int
  73         -- push this int/float/double/addr, on the stack.  Int
  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     Int{-this many-} Int{-down by this much-}
  96
  97    -- To do with the heap
  98    | ALLOC_AP  Int      -- make an AP with this many payload words
  99    | ALLOC_PAP Int Int  -- make a PAP with this arity / payload words
 100    | MKAP      Int{-ptr to AP is this far down stack-} Int{-# words-}
 101    | MKPAP     Int{-ptr to PAP is this far down stack-} Int{-# words-}
 102    | UNPACK    Int      -- unpack N words from t.o.s Constr
 103    | PACK      DataCon Int
 104                         -- after assembly, the DataCon is an index into the
 105                         -- itbl array
 106    -- For doing case trees
 107    | LABEL     LocalLabel
 108    | TESTLT_I  Int    LocalLabel
 109    | TESTEQ_I  Int    LocalLabel
 110    | TESTLT_F  Float  LocalLabel
 111    | TESTEQ_F  Float  LocalLabel
 112    | TESTLT_D  Double LocalLabel
 113    | TESTEQ_D  Double LocalLabel
 114
 115    -- The Int value is a constructor number and therefore
 116    -- stored in the insn stream rather than as an offset into
 117    -- the literal pool.
 118    | TESTLT_P  Int    LocalLabel
 119    | TESTEQ_P  Int    LocalLabel
 120
 121    | CASEFAIL
 122    | JMP              LocalLabel
 123
 124    -- For doing calls to C (via glue code generated by ByteCodeFFI)
 125    | CCALL            Int       -- stack frame size
 126                       (Ptr ())  -- addr of the glue code
 127
 128    -- For doing magic ByteArray passing to foreign calls
 129    | SWIZZLE          Int       -- to the ptr N words down the stack,
 130                       Int       -- add M (interpreted as a signed 16-bit entity)
 131
 132    -- To Infinity And Beyond
 133    | ENTER
 134    | RETURN             -- return a lifted value
 135    | RETURN_UBX CgRep -- return an unlifted value, here's its rep
 136
 137    -- Breakpoints
 138    | BRK_FUN          (MutableByteArray# RealWorld) Int BreakInfo
 139
 140 data BreakInfo
 141    = BreakInfo
 142    { breakInfo_module :: Module
 143    , breakInfo_number :: {-# UNPACK #-} !Int
 144    , breakInfo_vars   :: [(Id,Int)]
 145    , breakInfo_resty  :: Type
 146    }
 147
 148 instance Outputable BreakInfo where
 149    ppr info = text "BreakInfo" <+>
 150               parens (ppr (breakInfo_module info) <+>
 151                       ppr (breakInfo_number info) <+>
 152                       ppr (breakInfo_vars info) <+>
 153                       ppr (breakInfo_resty info))
 154
 155 -- -----------------------------------------------------------------------------
 156 -- Printing bytecode instructions
 157
 158 instance Outputable a => Outputable (ProtoBCO a) where
 159    ppr (ProtoBCO name instrs bitmap bsize arity origin malloced)
 160       = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity
 161                 <+> text (show malloced) <> colon)
 162         $$ nest 6 (text "bitmap: " <+> text (show bsize) <+> text (show bitmap))
 163         $$ nest 6 (vcat (map ppr instrs))
 164         $$ case origin of
 165               Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
 166               Right rhs -> pprCoreExpr (deAnnotate rhs)
 167
 168 instance Outputable BCInstr where
 169    ppr (STKCHECK n)          = text "STKCHECK" <+> int n
 170    ppr (PUSH_L offset)       = text "PUSH_L  " <+> int offset
 171    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> int o1 <+> int o2
 172    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3
 173    ppr (PUSH_G nm)           = text "PUSH_G  " <+> ppr nm
 174    ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers."
 175                                                <> ppr op
 176    ppr (PUSH_BCO bco)        = text "PUSH_BCO" <+> nest 3 (ppr bco)
 177    ppr (PUSH_ALTS bco)       = text "PUSH_ALTS " <+> ppr bco
 178    ppr (PUSH_ALTS_UNLIFTED bco pk) = text "PUSH_ALTS_UNLIFTED " <+> ppr pk <+> ppr bco
 179
 180    ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit
 181    ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int nw) <+> text (show aa)
 182    ppr PUSH_APPLY_N             = text "PUSH_APPLY_N"
 183    ppr PUSH_APPLY_V             = text "PUSH_APPLY_V"
 184    ppr PUSH_APPLY_F             = text "PUSH_APPLY_F"
 185    ppr PUSH_APPLY_D             = text "PUSH_APPLY_D"
 186    ppr PUSH_APPLY_L             = text "PUSH_APPLY_L"
 187    ppr PUSH_APPLY_P             = text "PUSH_APPLY_P"
 188    ppr PUSH_APPLY_PP            = text "PUSH_APPLY_PP"
 189    ppr PUSH_APPLY_PPP           = text "PUSH_APPLY_PPP"
 190    ppr PUSH_APPLY_PPPP          = text "PUSH_APPLY_PPPP"
 191    ppr PUSH_APPLY_PPPPP         = text "PUSH_APPLY_PPPPP"
 192    ppr PUSH_APPLY_PPPPPP        = text "PUSH_APPLY_PPPPPP"
 193
 194    ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
 195    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> int sz
 196    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> int arity <+> int sz
 197    ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words,"
 198                                                <+> int offset <+> text "stkoff"
 199    ppr (MKPAP offset sz)     = text "MKPAP   " <+> int sz <+> text "words,"
 200                                                <+> int offset <+> text "stkoff"
 201    ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
 202    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
 203    ppr (LABEL     lab)       = text "__"       <> int lab <> colon
 204    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
 205    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
 206    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
 207    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
 208    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
 209    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
 210    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
 211    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
 212    ppr CASEFAIL              = text "CASEFAIL"
 213    ppr (JMP lab)             = text "JMP"      <+> int lab
 214    ppr (CCALL off marshall_addr) = text "CCALL   " <+> int off
 215                                                 <+> text "marshall code at"
 216                                                <+> text (show marshall_addr)
 217    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff
 218                                                <+> text "by" <+> int n
 219    ppr ENTER                 = text "ENTER"
 220    ppr RETURN                = text "RETURN"
 221    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
 222    ppr (BRK_FUN breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> int index <+> ppr info
 223
 224 -- -----------------------------------------------------------------------------
 225 -- The stack use, in words, of each bytecode insn.  These _must_ be
 226 -- correct, or overestimates of reality, to be safe.
 227
 228 -- NOTE: we aggregate the stack use from case alternatives too, so that
 229 -- we can do a single stack check at the beginning of a function only.
 230
 231 -- This could all be made more accurate by keeping track of a proper
 232 -- stack high water mark, but it doesn't seem worth the hassle.
 233
 234 protoBCOStackUse :: ProtoBCO a -> Int
 235 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
 236
 237 bciStackUse :: BCInstr -> Int
 238 bciStackUse STKCHECK{}            = 0
 239 bciStackUse PUSH_L{}              = 1
 240 bciStackUse PUSH_LL{}             = 2
 241 bciStackUse PUSH_LLL{}            = 3
 242 bciStackUse PUSH_G{}              = 1
 243 bciStackUse PUSH_PRIMOP{}         = 1
 244 bciStackUse PUSH_BCO{}            = 1
 245 bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
 246 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
 247 bciStackUse (PUSH_UBX _ nw)       = nw
 248 bciStackUse PUSH_APPLY_N{}        = 1
 249 bciStackUse PUSH_APPLY_V{}        = 1
 250 bciStackUse PUSH_APPLY_F{}        = 1
 251 bciStackUse PUSH_APPLY_D{}        = 1
 252 bciStackUse PUSH_APPLY_L{}        = 1
 253 bciStackUse PUSH_APPLY_P{}        = 1
 254 bciStackUse PUSH_APPLY_PP{}       = 1
 255 bciStackUse PUSH_APPLY_PPP{}      = 1
 256 bciStackUse PUSH_APPLY_PPPP{}     = 1
 257 bciStackUse PUSH_APPLY_PPPPP{}    = 1
 258 bciStackUse PUSH_APPLY_PPPPPP{}   = 1
 259 bciStackUse ALLOC_AP{}            = 1
 260 bciStackUse ALLOC_PAP{}           = 1
 261 bciStackUse (UNPACK sz)           = sz
 262 bciStackUse LABEL{}               = 0
 263 bciStackUse TESTLT_I{}            = 0
 264 bciStackUse TESTEQ_I{}            = 0
 265 bciStackUse TESTLT_F{}            = 0
 266 bciStackUse TESTEQ_F{}            = 0
 267 bciStackUse TESTLT_D{}            = 0
 268 bciStackUse TESTEQ_D{}            = 0
 269 bciStackUse TESTLT_P{}            = 0
 270 bciStackUse TESTEQ_P{}            = 0
 271 bciStackUse CASEFAIL{}            = 0
 272 bciStackUse JMP{}                 = 0
 273 bciStackUse ENTER{}               = 0
 274 bciStackUse RETURN{}              = 0
 275 bciStackUse RETURN_UBX{}          = 1
 276 bciStackUse CCALL{}               = 0
 277 bciStackUse SWIZZLE{}             = 0
 278 bciStackUse BRK_FUN{}             = 0
 279
 280 -- These insns actually reduce stack use, but we need the high-tide level,
 281 -- so can't use this info.  Not that it matters much.
 282 bciStackUse SLIDE{}               = 0
 283 bciStackUse MKAP{}                = 0
 284 bciStackUse MKPAP{}               = 0
 285 bciStackUse PACK{}                = 1 -- worst case is PACK 0 words
 286 \end{code}