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 (MKPAP offset sz)     = text "MKPAP   " <+> int sz <+> text "words,"
 175                                                <+> int offset <+> text "stkoff"
 176    ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
 177    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
 178    ppr (LABEL     lab)       = text "__"       <> int lab <> colon
 179    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
 180    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
 181    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
 182    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
 183    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
 184    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
 185    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
 186    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
 187    ppr CASEFAIL              = text "CASEFAIL"
 188    ppr (JMP lab)             = text "JMP"      <+> int lab
 189    ppr (CCALL off marshall_addr) = text "CCALL   " <+> int off
 190                                                 <+> text "marshall code at"
 191                                                <+> text (show marshall_addr)
 192    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff
 193                                                <+> text "by" <+> int n
 194    ppr ENTER                 = text "ENTER"
 195    ppr RETURN                = text "RETURN"
 196    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
 197
 198 -- -----------------------------------------------------------------------------
 199 -- The stack use, in words, of each bytecode insn.  These _must_ be
 200 -- correct, or overestimates of reality, to be safe.
 201
 202 -- NOTE: we aggregate the stack use from case alternatives too, so that
 203 -- we can do a single stack check at the beginning of a function only.
 204
 205 -- This could all be made more accurate by keeping track of a proper
 206 -- stack high water mark, but it doesn't seem worth the hassle.
 207
 208 protoBCOStackUse :: ProtoBCO a -> Int
 209 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
 210
 211 bciStackUse :: BCInstr -> Int
 212 bciStackUse STKCHECK{}            = 0
 213 bciStackUse PUSH_L{}              = 1
 214 bciStackUse PUSH_LL{}             = 2
 215 bciStackUse PUSH_LLL{}            = 3
 216 bciStackUse PUSH_G{}              = 1
 217 bciStackUse PUSH_PRIMOP{}         = 1
 218 bciStackUse PUSH_BCO{}            = 1
 219 bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
 220 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
 221 bciStackUse (PUSH_UBX _ nw)       = nw
 222 bciStackUse PUSH_APPLY_N{}        = 1
 223 bciStackUse PUSH_APPLY_V{}        = 1
 224 bciStackUse PUSH_APPLY_F{}        = 1
 225 bciStackUse PUSH_APPLY_D{}        = 1
 226 bciStackUse PUSH_APPLY_L{}        = 1
 227 bciStackUse PUSH_APPLY_P{}        = 1
 228 bciStackUse PUSH_APPLY_PP{}       = 1
 229 bciStackUse PUSH_APPLY_PPP{}      = 1
 230 bciStackUse PUSH_APPLY_PPPP{}     = 1
 231 bciStackUse PUSH_APPLY_PPPPP{}    = 1
 232 bciStackUse PUSH_APPLY_PPPPPP{}   = 1
 233 bciStackUse ALLOC_AP{}            = 1
 234 bciStackUse ALLOC_PAP{}           = 1
 235 bciStackUse (UNPACK sz)           = sz
 236 bciStackUse LABEL{}               = 0
 237 bciStackUse TESTLT_I{}            = 0
 238 bciStackUse TESTEQ_I{}            = 0
 239 bciStackUse TESTLT_F{}            = 0
 240 bciStackUse TESTEQ_F{}            = 0
 241 bciStackUse TESTLT_D{}            = 0
 242 bciStackUse TESTEQ_D{}            = 0
 243 bciStackUse TESTLT_P{}            = 0
 244 bciStackUse TESTEQ_P{}            = 0
 245 bciStackUse CASEFAIL{}            = 0
 246 bciStackUse JMP{}                 = 0
 247 bciStackUse ENTER{}               = 0
 248 bciStackUse RETURN{}              = 0
 249 bciStackUse RETURN_UBX{}          = 1
 250 bciStackUse CCALL{}               = 0
 251 bciStackUse SWIZZLE{}             = 0
 252
 253 -- These insns actually reduce stack use, but we need the high-tide level,
 254 -- so can't use this info.  Not that it matters much.
 255 bciStackUse SLIDE{}               = 0
 256 bciStackUse MKAP{}                = 0
 257 bciStackUse MKPAP{}               = 0
 258 bciStackUse PACK{}                = 1 -- worst case is PACK 0 words
 259 \end{code}