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