never executed always true always false
    1 
    2 {-# LANGUAGE FlexibleContexts #-}
    3 {-# OPTIONS_GHC -funbox-strict-fields #-}
    4 --
    5 --  (c) The University of Glasgow 2002-2006
    6 --
    7 
    8 -- | Bytecode instruction definitions
    9 module GHC.ByteCode.Instr (
   10         BCInstr(..), ProtoBCO(..), bciStackUse, LocalLabel(..)
   11   ) where
   12 
   13 import GHC.Prelude
   14 
   15 import GHC.ByteCode.Types
   16 import GHCi.RemoteTypes
   17 import GHCi.FFI (C_ffi_cif)
   18 import GHC.StgToCmm.Layout     ( ArgRep(..) )
   19 import GHC.Utils.Outputable
   20 import GHC.Types.Name
   21 import GHC.Types.Unique
   22 import GHC.Types.Literal
   23 import GHC.Core.DataCon
   24 import GHC.Builtin.PrimOps
   25 import GHC.Runtime.Heap.Layout
   26 
   27 import Data.Word
   28 import GHC.Stack.CCS (CostCentre)
   29 
   30 import GHC.Stg.Syntax
   31 
   32 -- ----------------------------------------------------------------------------
   33 -- Bytecode instructions
   34 
   35 data ProtoBCO a
   36    = ProtoBCO {
   37         protoBCOName       :: a,          -- name, in some sense
   38         protoBCOInstrs     :: [BCInstr],  -- instrs
   39         -- arity and GC info
   40         protoBCOBitmap     :: [StgWord],
   41         protoBCOBitmapSize :: Word16,
   42         protoBCOArity      :: Int,
   43         -- what the BCO came from, for debugging only
   44         protoBCOExpr       :: Either [CgStgAlt] CgStgRhs,
   45         -- malloc'd pointers
   46         protoBCOFFIs       :: [FFIInfo]
   47    }
   48 
   49 -- | A local block label (e.g. identifying a case alternative).
   50 newtype LocalLabel = LocalLabel { getLocalLabel :: Word32 }
   51   deriving (Eq, Ord)
   52 
   53 instance Outputable LocalLabel where
   54   ppr (LocalLabel lbl) = text "lbl:" <> ppr lbl
   55 
   56 data BCInstr
   57    -- Messing with the stack
   58    = STKCHECK  Word
   59 
   60    -- Push locals (existing bits of the stack)
   61    | PUSH_L    !Word16{-offset-}
   62    | PUSH_LL   !Word16 !Word16{-2 offsets-}
   63    | PUSH_LLL  !Word16 !Word16 !Word16{-3 offsets-}
   64 
   65    -- Push the specified local as a 8, 16, 32 bit value onto the stack. (i.e.,
   66    -- the stack will grow by 8, 16 or 32 bits)
   67    | PUSH8  !Word16
   68    | PUSH16 !Word16
   69    | PUSH32 !Word16
   70 
   71    -- Push the specifiec local as a 8, 16, 32 bit value onto the stack, but the
   72    -- value will take the whole word on the stack (i.e., the stack will grow by
   73    -- a word)
   74    -- This is useful when extracting a packed constructor field for further use.
   75    -- Currently we expect all values on the stack to take full words, except for
   76    -- the ones used for PACK (i.e., actually constracting new data types, in
   77    -- which case we use PUSH{8,16,32})
   78    | PUSH8_W  !Word16
   79    | PUSH16_W !Word16
   80    | PUSH32_W !Word16
   81 
   82    -- Push a ptr  (these all map to PUSH_G really)
   83    | PUSH_G       Name
   84    | PUSH_PRIMOP  PrimOp
   85    | PUSH_BCO     (ProtoBCO Name)
   86 
   87    -- Push an alt continuation
   88    | PUSH_ALTS          (ProtoBCO Name)
   89    | PUSH_ALTS_UNLIFTED (ProtoBCO Name) ArgRep
   90    | PUSH_ALTS_TUPLE    (ProtoBCO Name) -- continuation
   91                         !TupleInfo
   92                         (ProtoBCO Name) -- tuple return BCO
   93 
   94    -- Pushing 8, 16 and 32 bits of padding (for constructors).
   95    | PUSH_PAD8
   96    | PUSH_PAD16
   97    | PUSH_PAD32
   98 
   99    -- Pushing literals
  100    | PUSH_UBX8  Literal
  101    | PUSH_UBX16 Literal
  102    | PUSH_UBX32 Literal
  103    | PUSH_UBX   Literal Word16
  104         -- push this int/float/double/addr, on the stack. Word16
  105         -- is # of words to copy from literal pool.  Eitherness reflects
  106         -- the difficulty of dealing with MachAddr here, mostly due to
  107         -- the excessive (and unnecessary) restrictions imposed by the
  108         -- designers of the new Foreign library.  In particular it is
  109         -- quite impossible to convert an Addr to any other integral
  110         -- type, and it appears impossible to get hold of the bits of
  111         -- an addr, even though we need to assemble BCOs.
  112 
  113    -- various kinds of application
  114    | PUSH_APPLY_N
  115    | PUSH_APPLY_V
  116    | PUSH_APPLY_F
  117    | PUSH_APPLY_D
  118    | PUSH_APPLY_L
  119    | PUSH_APPLY_P
  120    | PUSH_APPLY_PP
  121    | PUSH_APPLY_PPP
  122    | PUSH_APPLY_PPPP
  123    | PUSH_APPLY_PPPPP
  124    | PUSH_APPLY_PPPPPP
  125 
  126    | SLIDE     Word16{-this many-} Word16{-down by this much-}
  127 
  128    -- To do with the heap
  129    | ALLOC_AP  !Word16 -- make an AP with this many payload words
  130    | ALLOC_AP_NOUPD !Word16 -- make an AP_NOUPD with this many payload words
  131    | ALLOC_PAP !Word16 !Word16 -- make a PAP with this arity / payload words
  132    | MKAP      !Word16{-ptr to AP is this far down stack-} !Word16{-number of words-}
  133    | MKPAP     !Word16{-ptr to PAP is this far down stack-} !Word16{-number of words-}
  134    | UNPACK    !Word16 -- unpack N words from t.o.s Constr
  135    | PACK      DataCon !Word16
  136                         -- after assembly, the DataCon is an index into the
  137                         -- itbl array
  138    -- For doing case trees
  139    | LABEL     LocalLabel
  140    | TESTLT_I  Int    LocalLabel
  141    | TESTEQ_I  Int    LocalLabel
  142    | TESTLT_W  Word   LocalLabel
  143    | TESTEQ_W  Word   LocalLabel
  144    | TESTLT_F  Float  LocalLabel
  145    | TESTEQ_F  Float  LocalLabel
  146    | TESTLT_D  Double LocalLabel
  147    | TESTEQ_D  Double LocalLabel
  148 
  149    -- The Word16 value is a constructor number and therefore
  150    -- stored in the insn stream rather than as an offset into
  151    -- the literal pool.
  152    | TESTLT_P  Word16 LocalLabel
  153    | TESTEQ_P  Word16 LocalLabel
  154 
  155    | CASEFAIL
  156    | JMP              LocalLabel
  157 
  158    -- For doing calls to C (via glue code generated by libffi)
  159    | CCALL            Word16    -- stack frame size
  160                       (RemotePtr C_ffi_cif) -- addr of the glue code
  161                       Word16    -- flags.
  162                                 --
  163                                 -- 0x1: call is interruptible
  164                                 -- 0x2: call is unsafe
  165                                 --
  166                                 -- (XXX: inefficient, but I don't know
  167                                 -- what the alignment constraints are.)
  168 
  169    -- For doing magic ByteArray passing to foreign calls
  170    | SWIZZLE          Word16 -- to the ptr N words down the stack,
  171                       Word16 -- add M (interpreted as a signed 16-bit entity)
  172 
  173    -- To Infinity And Beyond
  174    | ENTER
  175    | RETURN                 -- return a lifted value
  176    | RETURN_UNLIFTED ArgRep -- return an unlifted value, here's its rep
  177    | RETURN_TUPLE           -- return an unboxed tuple (info already on stack)
  178 
  179    -- Breakpoints
  180    | BRK_FUN          Word16 Unique (RemotePtr CostCentre)
  181 
  182 -- -----------------------------------------------------------------------------
  183 -- Printing bytecode instructions
  184 
  185 instance Outputable a => Outputable (ProtoBCO a) where
  186    ppr (ProtoBCO { protoBCOName       = name
  187                  , protoBCOInstrs     = instrs
  188                  , protoBCOBitmap     = bitmap
  189                  , protoBCOBitmapSize = bsize
  190                  , protoBCOArity      = arity
  191                  , protoBCOExpr       = origin
  192                  , protoBCOFFIs       = ffis })
  193       = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity
  194                 <+> text (show ffis) <> colon)
  195         $$ nest 3 (case origin of
  196                       Left alts ->
  197                         vcat (zipWith (<+>) (char '{' : repeat (char ';'))
  198                              (map (pprStgAltShort shortStgPprOpts) alts))
  199                       Right rhs ->
  200                         pprStgRhsShort shortStgPprOpts rhs
  201                   )
  202         $$ nest 3 (text "bitmap: " <+> text (show bsize) <+> ppr bitmap)
  203         $$ nest 3 (vcat (map ppr instrs))
  204 
  205 -- Print enough of the STG expression to enable the reader to find
  206 -- the expression in the -ddump-stg output.  That is, we need to
  207 -- include at least a binder.
  208 
  209 pprStgExprShort :: OutputablePass pass => StgPprOpts -> GenStgExpr pass -> SDoc
  210 pprStgExprShort _ (StgCase _expr var _ty _alts) =
  211   text "case of" <+> ppr var
  212 pprStgExprShort _ (StgLet _ bnd _) =
  213   text "let" <+> pprStgBindShort bnd <+> text "in ..."
  214 pprStgExprShort _ (StgLetNoEscape _ bnd _) =
  215   text "let-no-escape" <+> pprStgBindShort bnd <+> text "in ..."
  216 pprStgExprShort opts (StgTick t e) = ppr t <+> pprStgExprShort opts e
  217 pprStgExprShort opts e = pprStgExpr opts e
  218 
  219 pprStgBindShort :: OutputablePass pass => GenStgBinding pass -> SDoc
  220 pprStgBindShort (StgNonRec x _) =
  221   ppr x <+> text "= ..."
  222 pprStgBindShort (StgRec bs) =
  223   char '{' <+> ppr (fst (head bs)) <+> text "= ...; ... }"
  224 
  225 pprStgAltShort :: OutputablePass pass => StgPprOpts -> GenStgAlt pass -> SDoc
  226 pprStgAltShort opts (con, args, expr) =
  227   ppr con <+> sep (map ppr args) <+> text "->" <+> pprStgExprShort opts expr
  228 
  229 pprStgRhsShort :: OutputablePass pass => StgPprOpts -> GenStgRhs pass -> SDoc
  230 pprStgRhsShort opts (StgRhsClosure _ext _cc upd_flag args body) =
  231   hang (hsep [ char '\\' <> ppr upd_flag, brackets (interppSP args) ])
  232        4 (pprStgExprShort opts body)
  233 pprStgRhsShort opts rhs = pprStgRhs opts rhs
  234 
  235 
  236 instance Outputable BCInstr where
  237    ppr (STKCHECK n)          = text "STKCHECK" <+> ppr n
  238    ppr (PUSH_L offset)       = text "PUSH_L  " <+> ppr offset
  239    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> ppr o1 <+> ppr o2
  240    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr o3
  241    ppr (PUSH8  offset)       = text "PUSH8  " <+> ppr offset
  242    ppr (PUSH16 offset)       = text "PUSH16  " <+> ppr offset
  243    ppr (PUSH32 offset)       = text "PUSH32  " <+> ppr offset
  244    ppr (PUSH8_W  offset)     = text "PUSH8_W  " <+> ppr offset
  245    ppr (PUSH16_W offset)     = text "PUSH16_W  " <+> ppr offset
  246    ppr (PUSH32_W offset)     = text "PUSH32_W  " <+> ppr offset
  247    ppr (PUSH_G nm)           = text "PUSH_G  " <+> ppr nm
  248    ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers."
  249                                                <> ppr op
  250    ppr (PUSH_BCO bco)        = hang (text "PUSH_BCO") 2 (ppr bco)
  251 
  252    ppr (PUSH_ALTS bco)       = hang (text "PUSH_ALTS") 2 (ppr bco)
  253    ppr (PUSH_ALTS_UNLIFTED bco pk) = hang (text "PUSH_ALTS_UNLIFTED" <+> ppr pk) 2 (ppr bco)
  254    ppr (PUSH_ALTS_TUPLE bco tuple_info tuple_bco) =
  255                                hang (text "PUSH_ALTS_TUPLE" <+> ppr tuple_info)
  256                                     2
  257                                     (ppr tuple_bco $+$ ppr bco)
  258 
  259    ppr PUSH_PAD8             = text "PUSH_PAD8"
  260    ppr PUSH_PAD16            = text "PUSH_PAD16"
  261    ppr PUSH_PAD32            = text "PUSH_PAD32"
  262 
  263    ppr (PUSH_UBX8  lit)      = text "PUSH_UBX8" <+> ppr lit
  264    ppr (PUSH_UBX16 lit)      = text "PUSH_UBX16" <+> ppr lit
  265    ppr (PUSH_UBX32 lit)      = text "PUSH_UBX32" <+> ppr lit
  266    ppr (PUSH_UBX lit nw)     = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit
  267    ppr PUSH_APPLY_N          = text "PUSH_APPLY_N"
  268    ppr PUSH_APPLY_V          = text "PUSH_APPLY_V"
  269    ppr PUSH_APPLY_F          = text "PUSH_APPLY_F"
  270    ppr PUSH_APPLY_D          = text "PUSH_APPLY_D"
  271    ppr PUSH_APPLY_L          = text "PUSH_APPLY_L"
  272    ppr PUSH_APPLY_P          = text "PUSH_APPLY_P"
  273    ppr PUSH_APPLY_PP         = text "PUSH_APPLY_PP"
  274    ppr PUSH_APPLY_PPP        = text "PUSH_APPLY_PPP"
  275    ppr PUSH_APPLY_PPPP       = text "PUSH_APPLY_PPPP"
  276    ppr PUSH_APPLY_PPPPP      = text "PUSH_APPLY_PPPPP"
  277    ppr PUSH_APPLY_PPPPPP     = text "PUSH_APPLY_PPPPPP"
  278 
  279    ppr (SLIDE n d)           = text "SLIDE   " <+> ppr n <+> ppr d
  280    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> ppr sz
  281    ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> ppr sz
  282    ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> ppr arity <+> ppr sz
  283    ppr (MKAP offset sz)      = text "MKAP    " <+> ppr sz <+> text "words,"
  284                                                <+> ppr offset <+> text "stkoff"
  285    ppr (MKPAP offset sz)     = text "MKPAP   " <+> ppr sz <+> text "words,"
  286                                                <+> ppr offset <+> text "stkoff"
  287    ppr (UNPACK sz)           = text "UNPACK  " <+> ppr sz
  288    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
  289    ppr (LABEL     lab)       = text "__"       <> ppr lab <> colon
  290    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab
  291    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
  292    ppr (TESTLT_W  i lab)     = text "TESTLT_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
  293    ppr (TESTEQ_W  i lab)     = text "TESTEQ_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
  294    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
  295    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
  296    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
  297    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> ppr lab
  298    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> ppr i <+> text "__" <> ppr lab
  299    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
  300    ppr CASEFAIL              = text "CASEFAIL"
  301    ppr (JMP lab)             = text "JMP"      <+> ppr lab
  302    ppr (CCALL off marshall_addr flags) = text "CCALL   " <+> ppr off
  303                                                 <+> text "marshall code at"
  304                                                <+> text (show marshall_addr)
  305                                                <+> (case flags of
  306                                                       0x1 -> text "(interruptible)"
  307                                                       0x2 -> text "(unsafe)"
  308                                                       _   -> empty)
  309    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff
  310                                                <+> text "by" <+> ppr n
  311    ppr ENTER                 = text "ENTER"
  312    ppr RETURN                = text "RETURN"
  313    ppr (RETURN_UNLIFTED pk)  = text "RETURN_UNLIFTED  " <+> ppr pk
  314    ppr (RETURN_TUPLE)        = text "RETURN_TUPLE"
  315    ppr (BRK_FUN index uniq _cc) = text "BRK_FUN" <+> ppr index <+> ppr uniq <+> text "<cc>"
  316 
  317 
  318 
  319 -- -----------------------------------------------------------------------------
  320 -- The stack use, in words, of each bytecode insn.  These _must_ be
  321 -- correct, or overestimates of reality, to be safe.
  322 
  323 -- NOTE: we aggregate the stack use from case alternatives too, so that
  324 -- we can do a single stack check at the beginning of a function only.
  325 
  326 -- This could all be made more accurate by keeping track of a proper
  327 -- stack high water mark, but it doesn't seem worth the hassle.
  328 
  329 protoBCOStackUse :: ProtoBCO a -> Word
  330 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
  331 
  332 bciStackUse :: BCInstr -> Word
  333 bciStackUse STKCHECK{}            = 0
  334 bciStackUse PUSH_L{}              = 1
  335 bciStackUse PUSH_LL{}             = 2
  336 bciStackUse PUSH_LLL{}            = 3
  337 bciStackUse PUSH8{}               = 1  -- overapproximation
  338 bciStackUse PUSH16{}              = 1  -- overapproximation
  339 bciStackUse PUSH32{}              = 1  -- overapproximation on 64bit arch
  340 bciStackUse PUSH8_W{}             = 1  -- takes exactly 1 word
  341 bciStackUse PUSH16_W{}            = 1  -- takes exactly 1 word
  342 bciStackUse PUSH32_W{}            = 1  -- takes exactly 1 word
  343 bciStackUse PUSH_G{}              = 1
  344 bciStackUse PUSH_PRIMOP{}         = 1
  345 bciStackUse PUSH_BCO{}            = 1
  346 bciStackUse (PUSH_ALTS bco)       = 2 {- profiling only, restore CCCS -} +
  347                                     3 + protoBCOStackUse bco
  348 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 {- profiling only, restore CCCS -} +
  349                                          4 + protoBCOStackUse bco
  350 bciStackUse (PUSH_ALTS_TUPLE bco info _) =
  351    -- (tuple_bco, tuple_info word, cont_bco, stg_ctoi_t)
  352    -- tuple
  353    -- (tuple_info, tuple_bco, stg_ret_t)
  354    1 {- profiling only -} +
  355    7 + fromIntegral (tupleSize info) + protoBCOStackUse bco
  356 bciStackUse (PUSH_PAD8)           = 1  -- overapproximation
  357 bciStackUse (PUSH_PAD16)          = 1  -- overapproximation
  358 bciStackUse (PUSH_PAD32)          = 1  -- overapproximation on 64bit arch
  359 bciStackUse (PUSH_UBX8 _)         = 1  -- overapproximation
  360 bciStackUse (PUSH_UBX16 _)        = 1  -- overapproximation
  361 bciStackUse (PUSH_UBX32 _)        = 1  -- overapproximation on 64bit arch
  362 bciStackUse (PUSH_UBX _ nw)       = fromIntegral nw
  363 bciStackUse PUSH_APPLY_N{}        = 1
  364 bciStackUse PUSH_APPLY_V{}        = 1
  365 bciStackUse PUSH_APPLY_F{}        = 1
  366 bciStackUse PUSH_APPLY_D{}        = 1
  367 bciStackUse PUSH_APPLY_L{}        = 1
  368 bciStackUse PUSH_APPLY_P{}        = 1
  369 bciStackUse PUSH_APPLY_PP{}       = 1
  370 bciStackUse PUSH_APPLY_PPP{}      = 1
  371 bciStackUse PUSH_APPLY_PPPP{}     = 1
  372 bciStackUse PUSH_APPLY_PPPPP{}    = 1
  373 bciStackUse PUSH_APPLY_PPPPPP{}   = 1
  374 bciStackUse ALLOC_AP{}            = 1
  375 bciStackUse ALLOC_AP_NOUPD{}      = 1
  376 bciStackUse ALLOC_PAP{}           = 1
  377 bciStackUse (UNPACK sz)           = fromIntegral sz
  378 bciStackUse LABEL{}               = 0
  379 bciStackUse TESTLT_I{}            = 0
  380 bciStackUse TESTEQ_I{}            = 0
  381 bciStackUse TESTLT_W{}            = 0
  382 bciStackUse TESTEQ_W{}            = 0
  383 bciStackUse TESTLT_F{}            = 0
  384 bciStackUse TESTEQ_F{}            = 0
  385 bciStackUse TESTLT_D{}            = 0
  386 bciStackUse TESTEQ_D{}            = 0
  387 bciStackUse TESTLT_P{}            = 0
  388 bciStackUse TESTEQ_P{}            = 0
  389 bciStackUse CASEFAIL{}            = 0
  390 bciStackUse JMP{}                 = 0
  391 bciStackUse ENTER{}               = 0
  392 bciStackUse RETURN{}              = 0
  393 bciStackUse RETURN_UNLIFTED{}     = 1 -- pushes stg_ret_X for some X
  394 bciStackUse RETURN_TUPLE{}        = 1 -- pushes stg_ret_t header
  395 bciStackUse CCALL{}               = 0
  396 bciStackUse SWIZZLE{}             = 0
  397 bciStackUse BRK_FUN{}             = 0
  398 
  399 -- These insns actually reduce stack use, but we need the high-tide level,
  400 -- so can't use this info.  Not that it matters much.
  401 bciStackUse SLIDE{}               = 0
  402 bciStackUse MKAP{}                = 0
  403 bciStackUse MKPAP{}               = 0
  404 bciStackUse PACK{}                = 1 -- worst case is PACK 0 words