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
   9   ) where
  10
  11 #include "HsVersions.h"
  12 #include "../includes/MachDeps.h"
  13
  14 import Outputable
  15 import Name
  16 import Id
  17 import CoreSyn
  18 import PprCore
  19 import Literal
  20 import DataCon
  21 import VarSet
  22 import PrimOp
  23 import SMRep
  24
  25 import GHC.Ptr
  26
  27 -- ----------------------------------------------------------------------------
  28 -- Bytecode instructions
  29
  30 data ProtoBCO a
  31    = ProtoBCO {
  32         protoBCOName       :: a,          -- name, in some sense
  33         protoBCOInstrs     :: [BCInstr],  -- instrs
  34         -- arity and GC info
  35         protoBCOBitmap     :: [StgWord],
  36         protoBCOBitmapSize :: Int,
  37         protoBCOArity      :: Int,
  38         -- what the BCO came from
  39         protoBCOExpr       :: Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet),
  40         -- malloc'd pointers
  41         protoBCOPtrs       :: [Ptr ()]
  42    }
  43
  44 type LocalLabel = Int
  45
  46 data BCInstr
  47    -- Messing with the stack
  48    = STKCHECK  Int
  49
  50    -- Push locals (existing bits of the stack)
  51    | PUSH_L    Int{-offset-}
  52    | PUSH_LL   Int Int{-2 offsets-}
  53    | PUSH_LLL  Int Int Int{-3 offsets-}
  54
  55    -- Push a ptr  (these all map to PUSH_G really)
  56    | PUSH_G       Name
  57    | PUSH_PRIMOP  PrimOp
  58    | PUSH_BCO     (ProtoBCO Name)
  59
  60    -- Push an alt continuation
  61    | PUSH_ALTS          (ProtoBCO Name)
  62    | PUSH_ALTS_UNLIFTED (ProtoBCO Name) CgRep
  63
  64    -- Pushing literals
  65    | PUSH_UBX  (Either Literal (Ptr ())) Int
  66         -- push this int/float/double/addr, on the stack.  Int
  67         -- is # of words to copy from literal pool.  Eitherness reflects
  68         -- the difficulty of dealing with MachAddr here, mostly due to
  69         -- the excessive (and unnecessary) restrictions imposed by the
  70         -- designers of the new Foreign library.  In particular it is
  71         -- quite impossible to convert an Addr to any other integral
  72         -- type, and it appears impossible to get hold of the bits of
  73         -- an addr, even though we need to to assemble BCOs.
  74
  75    -- various kinds of application
  76    | PUSH_APPLY_N
  77    | PUSH_APPLY_V
  78    | PUSH_APPLY_F
  79    | PUSH_APPLY_D
  80    | PUSH_APPLY_L
  81    | PUSH_APPLY_P
  82    | PUSH_APPLY_PP
  83    | PUSH_APPLY_PPP
  84    | PUSH_APPLY_PPPP
  85    | PUSH_APPLY_PPPPP
  86    | PUSH_APPLY_PPPPPP
  87
  88    | SLIDE     Int{-this many-} Int{-down by this much-}
  89
  90    -- To do with the heap
  91    | ALLOC_AP  Int      -- make an AP with this many payload words
  92    | ALLOC_PAP Int Int  -- make a PAP with this arity / payload words
  93    | MKAP      Int{-ptr to AP is this far down stack-} Int{-# words-}
  94    | MKPAP     Int{-ptr to PAP is this far down stack-} Int{-# words-}
  95    | UNPACK    Int      -- unpack N words from t.o.s Constr
  96    | PACK      DataCon Int
  97                         -- after assembly, the DataCon is an index into the
  98                         -- itbl array
  99    -- For doing case trees
 100    | LABEL     LocalLabel
 101    | TESTLT_I  Int    LocalLabel
 102    | TESTEQ_I  Int    LocalLabel
 103    | TESTLT_F  Float  LocalLabel
 104    | TESTEQ_F  Float  LocalLabel
 105    | TESTLT_D  Double LocalLabel
 106    | TESTEQ_D  Double LocalLabel
 107
 108    -- The Int value is a constructor number and therefore
 109    -- stored in the insn stream rather than as an offset into
 110    -- the literal pool.
 111    | TESTLT_P  Int    LocalLabel
 112    | TESTEQ_P  Int    LocalLabel
 113
 114    | CASEFAIL
 115    | JMP              LocalLabel
 116
 117    -- For doing calls to C (via glue code generated by ByteCodeFFI)
 118    | CCALL            Int       -- stack frame size
 119                       (Ptr ())  -- addr of the glue code
 120
 121    -- For doing magic ByteArray passing to foreign calls
 122    | SWIZZLE          Int       -- to the ptr N words down the stack,
 123                       Int       -- add M (interpreted as a signed 16-bit entity)
 124
 125    -- To Infinity And Beyond
 126    | ENTER
 127    | RETURN             -- return a lifted value
 128    | RETURN_UBX CgRep -- return an unlifted value, here's its rep
 129
 130 -- -----------------------------------------------------------------------------
 131 -- Printing bytecode instructions
 132
 133 instance Outputable a => Outputable (ProtoBCO a) where
 134    ppr (ProtoBCO name instrs bitmap bsize arity origin malloced)
 135       = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity
 136                 <+> text (show malloced) <> colon)
 137         $$ nest 6 (text "bitmap: " <+> text (show bsize) <+> text (show bitmap))
 138         $$ nest 6 (vcat (map ppr instrs))
 139         $$ case origin of
 140               Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
 141               Right rhs -> pprCoreExpr (deAnnotate rhs)
 142
 143 instance Outputable BCInstr where
 144    ppr (STKCHECK n)          = text "STKCHECK" <+> int n
 145    ppr (PUSH_L offset)       = text "PUSH_L  " <+> int offset
 146    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> int o1 <+> int o2
 147    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3
 148    ppr (PUSH_G nm)           = text "PUSH_G  " <+> ppr nm
 149    ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers."
 150                                                <> ppr op
 151    ppr (PUSH_BCO bco)        = text "PUSH_BCO" <+> nest 3 (ppr bco)
 152    ppr (PUSH_ALTS bco)       = text "PUSH_ALTS " <+> ppr bco
 153    ppr (PUSH_ALTS_UNLIFTED bco pk) = text "PUSH_ALTS_UNLIFTED " <+> ppr pk <+> ppr bco
 154
 155    ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit
 156    ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int nw) <+> text (show aa)
 157    ppr PUSH_APPLY_N             = text "PUSH_APPLY_N"
 158    ppr PUSH_APPLY_V             = text "PUSH_APPLY_V"
 159    ppr PUSH_APPLY_F             = text "PUSH_APPLY_F"
 160    ppr PUSH_APPLY_D             = text "PUSH_APPLY_D"
 161    ppr PUSH_APPLY_L             = text "PUSH_APPLY_L"
 162    ppr PUSH_APPLY_P             = text "PUSH_APPLY_P"
 163    ppr PUSH_APPLY_PP            = text "PUSH_APPLY_PP"
 164    ppr PUSH_APPLY_PPP           = text "PUSH_APPLY_PPP"
 165    ppr PUSH_APPLY_PPPP          = text "PUSH_APPLY_PPPP"
 166    ppr PUSH_APPLY_PPPPP         = text "PUSH_APPLY_PPPPP"
 167    ppr PUSH_APPLY_PPPPPP        = text "PUSH_APPLY_PPPPPP"
 168
 169    ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
 170    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> int sz
 171    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> int arity <+> int sz
 172    ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words,"
 173                                                <+> int offset <+> text "stkoff"
 174    ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
 175    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
 176    ppr (LABEL     lab)       = text "__"       <> int lab <> colon
 177    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
 178    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
 179    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
 180    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
 181    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
 182    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
 183    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
 184    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
 185    ppr (JMP lab)             = text "JMP"      <+> int lab
 186    ppr CASEFAIL              = text "CASEFAIL"
 187    ppr ENTER                 = text "ENTER"
 188    ppr RETURN                = text "RETURN"
 189    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
 190    ppr (CCALL off marshall_addr) = text "CCALL   " <+> int off
 191                                                 <+> text "marshall code at"
 192                                                <+> text (show marshall_addr)
 193    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff
 194                                                <+> text "by" <+> int n
 195
 196 -- -----------------------------------------------------------------------------
 197 -- The stack use, in words, of each bytecode insn.  These _must_ be
 198 -- correct, or overestimates of reality, to be safe.
 199
 200 -- NOTE: we aggregate the stack use from case alternatives too, so that
 201 -- we can do a single stack check at the beginning of a function only.
 202
 203 -- This could all be made more accurate by keeping track of a proper
 204 -- stack high water mark, but it doesn't seem worth the hassle.
 205
 206 protoBCOStackUse :: ProtoBCO a -> Int
 207 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
 208
 209 bciStackUse :: BCInstr -> Int
 210 bciStackUse STKCHECK{}            = 0
 211 bciStackUse PUSH_L{}              = 1
 212 bciStackUse PUSH_LL{}             = 2
 213 bciStackUse PUSH_LLL{}            = 3
 214 bciStackUse PUSH_G{}              = 1
 215 bciStackUse PUSH_PRIMOP{}         = 1
 216 bciStackUse PUSH_BCO{}            = 1
 217 bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
 218 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
 219 bciStackUse (PUSH_UBX _ nw)       = nw
 220 bciStackUse PUSH_APPLY_N{}        = 1
 221 bciStackUse PUSH_APPLY_V{}        = 1
 222 bciStackUse PUSH_APPLY_F{}        = 1
 223 bciStackUse PUSH_APPLY_D{}        = 1
 224 bciStackUse PUSH_APPLY_L{}        = 1
 225 bciStackUse PUSH_APPLY_P{}        = 1
 226 bciStackUse PUSH_APPLY_PP{}       = 1
 227 bciStackUse PUSH_APPLY_PPP{}      = 1
 228 bciStackUse PUSH_APPLY_PPPP{}     = 1
 229 bciStackUse PUSH_APPLY_PPPPP{}    = 1
 230 bciStackUse PUSH_APPLY_PPPPPP{}   = 1
 231 bciStackUse ALLOC_AP{}            = 1
 232 bciStackUse ALLOC_PAP{}           = 1
 233 bciStackUse (UNPACK sz)           = sz
 234 bciStackUse LABEL{}               = 0
 235 bciStackUse TESTLT_I{}            = 0
 236 bciStackUse TESTEQ_I{}            = 0
 237 bciStackUse TESTLT_F{}            = 0
 238 bciStackUse TESTEQ_F{}            = 0
 239 bciStackUse TESTLT_D{}            = 0
 240 bciStackUse TESTEQ_D{}            = 0
 241 bciStackUse TESTLT_P{}            = 0
 242 bciStackUse TESTEQ_P{}            = 0
 243 bciStackUse CASEFAIL{}            = 0
 244 bciStackUse JMP{}                 = 0
 245 bciStackUse ENTER{}               = 0
 246 bciStackUse RETURN{}              = 0
 247 bciStackUse RETURN_UBX{}          = 1
 248 bciStackUse CCALL{}               = 0
 249 bciStackUse SWIZZLE{}             = 0
 250
 251 -- These insns actually reduce stack use, but we need the high-tide level,
 252 -- so can't use this info.  Not that it matters much.
 253 bciStackUse SLIDE{}               = 0
 254 bciStackUse MKAP{}                = 0
 255 bciStackUse MKPAP{}               = 0
 256 bciStackUse PACK{}                = 1 -- worst case is PACK 0 words
 257 \end{code}