ghc/compiler/ghci/ByteCodeInstr.lhs

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