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