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