{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
--
--  (c) The University of Glasgow 2002-2006
--

-- | Bytecode instruction definitions
module GHC.ByteCode.Instr (
        BCInstr(..), ProtoBCO(..), bciStackUse, LocalLabel(..)
  ) where

import GHC.Prelude

import GHC.ByteCode.Types
import GHCi.RemoteTypes
import GHCi.FFI (C_ffi_cif)
import GHC.StgToCmm.Layout     ( ArgRep(..) )
import GHC.Utils.Outputable
import GHC.Types.Name
import GHC.Types.Literal
import GHC.Core.DataCon
import GHC.Builtin.PrimOps
import GHC.Runtime.Heap.Layout ( StgWord )

import Data.Int
import Data.Word

import GHC.Stack.CCS (CostCentre)

import GHC.Stg.Syntax
import GHCi.BreakArray (BreakArray)
import Language.Haskell.Syntax.Module.Name (ModuleName)

-- ----------------------------------------------------------------------------
-- Bytecode instructions

data ProtoBCO a
   = ProtoBCO {
        forall a. ProtoBCO a -> a
protoBCOName       :: a,          -- name, in some sense
        forall a. ProtoBCO a -> [BCInstr]
protoBCOInstrs     :: [BCInstr],  -- instrs
        -- arity and GC info
        forall a. ProtoBCO a -> [StgWord]
protoBCOBitmap     :: [StgWord],
        forall a. ProtoBCO a -> Word
protoBCOBitmapSize :: Word,
        forall a. ProtoBCO a -> Int
protoBCOArity      :: Int,
        -- what the BCO came from, for debugging only
        forall a. ProtoBCO a -> Either [CgStgAlt] CgStgRhs
protoBCOExpr       :: Either [CgStgAlt] CgStgRhs,
        -- malloc'd pointers
        forall a. ProtoBCO a -> [FFIInfo]
protoBCOFFIs       :: [FFIInfo]
   }

-- | A local block label (e.g. identifying a case alternative).
newtype LocalLabel = LocalLabel { LocalLabel -> Word32
getLocalLabel :: Word32 }
  deriving (LocalLabel -> LocalLabel -> Bool
(LocalLabel -> LocalLabel -> Bool)
-> (LocalLabel -> LocalLabel -> Bool) -> Eq LocalLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocalLabel -> LocalLabel -> Bool
== :: LocalLabel -> LocalLabel -> Bool
$c/= :: LocalLabel -> LocalLabel -> Bool
/= :: LocalLabel -> LocalLabel -> Bool
Eq, Eq LocalLabel
Eq LocalLabel =>
(LocalLabel -> LocalLabel -> Ordering)
-> (LocalLabel -> LocalLabel -> Bool)
-> (LocalLabel -> LocalLabel -> Bool)
-> (LocalLabel -> LocalLabel -> Bool)
-> (LocalLabel -> LocalLabel -> Bool)
-> (LocalLabel -> LocalLabel -> LocalLabel)
-> (LocalLabel -> LocalLabel -> LocalLabel)
-> Ord LocalLabel
LocalLabel -> LocalLabel -> Bool
LocalLabel -> LocalLabel -> Ordering
LocalLabel -> LocalLabel -> LocalLabel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LocalLabel -> LocalLabel -> Ordering
compare :: LocalLabel -> LocalLabel -> Ordering
$c< :: LocalLabel -> LocalLabel -> Bool
< :: LocalLabel -> LocalLabel -> Bool
$c<= :: LocalLabel -> LocalLabel -> Bool
<= :: LocalLabel -> LocalLabel -> Bool
$c> :: LocalLabel -> LocalLabel -> Bool
> :: LocalLabel -> LocalLabel -> Bool
$c>= :: LocalLabel -> LocalLabel -> Bool
>= :: LocalLabel -> LocalLabel -> Bool
$cmax :: LocalLabel -> LocalLabel -> LocalLabel
max :: LocalLabel -> LocalLabel -> LocalLabel
$cmin :: LocalLabel -> LocalLabel -> LocalLabel
min :: LocalLabel -> LocalLabel -> LocalLabel
Ord)

instance Outputable LocalLabel where
  ppr :: LocalLabel -> SDoc
ppr (LocalLabel Word32
lbl) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"lbl:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Word32 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word32
lbl

data BCInstr
   -- Messing with the stack
   = STKCHECK  !Word

   -- Push locals (existing bits of the stack)
   | PUSH_L    !WordOff{-offset-}
   | PUSH_LL   !WordOff !WordOff{-2 offsets-}
   | PUSH_LLL  !WordOff !WordOff !WordOff{-3 offsets-}

   -- Push the specified local as a 8, 16, 32 bit value onto the stack. (i.e.,
   -- the stack will grow by 8, 16 or 32 bits)
   | PUSH8  !ByteOff
   | PUSH16 !ByteOff
   | PUSH32 !ByteOff

   -- Push the specified local as a 8, 16, 32 bit value onto the stack, but the
   -- value will take the whole word on the stack (i.e., the stack will grow by
   -- a word)
   -- This is useful when extracting a packed constructor field for further use.
   -- Currently we expect all values on the stack to take full words, except for
   -- the ones used for PACK (i.e., actually constructing new data types, in
   -- which case we use PUSH{8,16,32})
   | PUSH8_W  !ByteOff
   | PUSH16_W !ByteOff
   | PUSH32_W !ByteOff

   -- Push a (heap) ptr  (these all map to PUSH_G really)
   | PUSH_G       Name
   | PUSH_PRIMOP  PrimOp
   | PUSH_BCO     (ProtoBCO Name)

   -- Push an alt continuation
   | PUSH_ALTS          (ProtoBCO Name) ArgRep
   | PUSH_ALTS_TUPLE    (ProtoBCO Name) -- continuation
                        !NativeCallInfo
                        (ProtoBCO Name) -- tuple return BCO

   -- Pushing 8, 16 and 32 bits of padding (for constructors).
   | PUSH_PAD8
   | PUSH_PAD16
   | PUSH_PAD32

   -- Pushing literals
   | PUSH_UBX8  Literal
   | PUSH_UBX16 Literal
   | PUSH_UBX32 Literal
   | PUSH_UBX   Literal !WordOff
        -- push this int/float/double/addr, on the stack. Word
        -- is # of words to copy from literal pool.  Eitherness reflects
        -- the difficulty of dealing with MachAddr here, mostly due to
        -- the excessive (and unnecessary) restrictions imposed by the
        -- designers of the new Foreign library.  In particular it is
        -- quite impossible to convert an Addr to any other integral
        -- type, and it appears impossible to get hold of the bits of
        -- an addr, even though we need to assemble BCOs.

   -- Push a top-level Addr#. This is a pseudo-instruction assembled to PUSH_UBX,
   -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode.
   | PUSH_ADDR Name

   -- various kinds of application
   | PUSH_APPLY_N
   | PUSH_APPLY_V
   | PUSH_APPLY_F
   | PUSH_APPLY_D
   | PUSH_APPLY_L
   | PUSH_APPLY_P
   | PUSH_APPLY_PP
   | PUSH_APPLY_PPP
   | PUSH_APPLY_PPPP
   | PUSH_APPLY_PPPPP
   | PUSH_APPLY_PPPPPP

   | SLIDE     !WordOff{-this many-} !WordOff{-down by this much-}

   -- To do with the heap
   | ALLOC_AP  !HalfWord {- make an AP with this many payload words.
                            HalfWord matches the size of the n_args field in StgAP,
                            make sure that we handle truncation when generating
                            bytecode using this HalfWord type here -}
   | ALLOC_AP_NOUPD !HalfWord -- make an AP_NOUPD with this many payload words
   | ALLOC_PAP !HalfWord !HalfWord -- make a PAP with this arity / payload words
   | MKAP      !WordOff{-ptr to AP is this far down stack-} !HalfWord{-number of words-}
   | MKPAP     !WordOff{-ptr to PAP is this far down stack-} !HalfWord{-number of words-}
   | UNPACK    !WordOff -- unpack N words from t.o.s Constr
   | PACK      DataCon !WordOff
                        -- after assembly, the DataCon is an index into the
                        -- itbl array
   -- For doing case trees
   | LABEL     LocalLabel
   | TESTLT_I   !Int    LocalLabel
   | TESTEQ_I   !Int    LocalLabel
   | TESTLT_W   !Word   LocalLabel
   | TESTEQ_W   !Word   LocalLabel
   | TESTLT_I64 !Int64  LocalLabel
   | TESTEQ_I64 !Int64  LocalLabel
   | TESTLT_I32 !Int32  LocalLabel
   | TESTEQ_I32 !Int32  LocalLabel
   | TESTLT_I16 !Int16  LocalLabel
   | TESTEQ_I16 !Int16  LocalLabel
   | TESTLT_I8  !Int8   LocalLabel
   | TESTEQ_I8  !Int16  LocalLabel
   | TESTLT_W64 !Word64 LocalLabel
   | TESTEQ_W64 !Word64 LocalLabel
   | TESTLT_W32 !Word32 LocalLabel
   | TESTEQ_W32 !Word32 LocalLabel
   | TESTLT_W16 !Word16 LocalLabel
   | TESTEQ_W16 !Word16 LocalLabel
   | TESTLT_W8  !Word8  LocalLabel
   | TESTEQ_W8  !Word8  LocalLabel
   | TESTLT_F   !Float  LocalLabel
   | TESTEQ_F   !Float  LocalLabel
   | TESTLT_D   !Double LocalLabel
   | TESTEQ_D   !Double LocalLabel

   -- The Word16 value is a constructor number and therefore
   -- stored in the insn stream rather than as an offset into
   -- the literal pool.
   | TESTLT_P  !Word16 LocalLabel
   | TESTEQ_P  !Word16 LocalLabel

   | CASEFAIL
   | JMP              LocalLabel

   -- For doing calls to C (via glue code generated by libffi)
   | CCALL            !WordOff  -- stack frame size
                      (RemotePtr C_ffi_cif) -- addr of the glue code
                      !Word16   -- flags.
                                --
                                -- 0x1: call is interruptible
                                -- 0x2: call is unsafe
                                --
                                -- (XXX: inefficient, but I don't know
                                -- what the alignment constraints are.)

   | PRIMCALL

   -- For doing magic ByteArray passing to foreign calls
   | SWIZZLE          !WordOff -- to the ptr N words down the stack,
                      !Int     -- add M

   -- To Infinity And Beyond
   | ENTER
   | RETURN ArgRep -- return a non-tuple value, here's its rep; see
                   -- Note [Return convention for non-tuple values] in GHC.StgToByteCode
   | RETURN_TUPLE  -- return an unboxed tuple (info already on stack); see
                   -- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode

   -- Breakpoints
   | BRK_FUN          (ForeignRef BreakArray)
                      (RemotePtr ModuleName) -- breakpoint tick module
                      !Word16                -- breakpoint tick index
                      (RemotePtr ModuleName) -- breakpoint info module
                      !Word16                -- breakpoint info index
                      (RemotePtr CostCentre)

-- -----------------------------------------------------------------------------
-- Printing bytecode instructions

instance Outputable a => Outputable (ProtoBCO a) where
   ppr :: ProtoBCO a -> SDoc
ppr (ProtoBCO { protoBCOName :: forall a. ProtoBCO a -> a
protoBCOName       = a
name
                 , protoBCOInstrs :: forall a. ProtoBCO a -> [BCInstr]
protoBCOInstrs     = [BCInstr]
instrs
                 , protoBCOBitmap :: forall a. ProtoBCO a -> [StgWord]
protoBCOBitmap     = [StgWord]
bitmap
                 , protoBCOBitmapSize :: forall a. ProtoBCO a -> Word
protoBCOBitmapSize = Word
bsize
                 , protoBCOArity :: forall a. ProtoBCO a -> Int
protoBCOArity      = Int
arity
                 , protoBCOExpr :: forall a. ProtoBCO a -> Either [CgStgAlt] CgStgRhs
protoBCOExpr       = Either [CgStgAlt] CgStgRhs
origin
                 , protoBCOFFIs :: forall a. ProtoBCO a -> [FFIInfo]
protoBCOFFIs       = [FFIInfo]
ffis })
      = (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ProtoBCO" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'#' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
arity
                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text ([FFIInfo] -> String
forall a. Show a => a -> String
show [FFIInfo]
ffis) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon)
        SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
3 (case Either [CgStgAlt] CgStgRhs
origin of
                      Left [CgStgAlt]
alts ->
                        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((SDoc -> SDoc -> SDoc) -> [SDoc] -> [SDoc] -> [SDoc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
(<+>) (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'{' SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: SDoc -> [SDoc]
forall a. a -> [a]
repeat (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
';'))
                             ((CgStgAlt -> SDoc) -> [CgStgAlt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (StgPprOpts -> CgStgAlt -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgAlt pass -> SDoc
pprStgAltShort StgPprOpts
shortStgPprOpts) [CgStgAlt]
alts))
                      Right CgStgRhs
rhs ->
                        StgPprOpts -> CgStgRhs -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhsShort StgPprOpts
shortStgPprOpts CgStgRhs
rhs
                  )
        SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
3 (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"bitmap: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (Word -> String
forall a. Show a => a -> String
show Word
bsize) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [StgWord] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [StgWord]
bitmap)
        SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Int -> SDoc -> SDoc
nest Int
3 ([SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ((BCInstr -> SDoc) -> [BCInstr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map BCInstr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [BCInstr]
instrs))

-- Print enough of the STG expression to enable the reader to find
-- the expression in the -ddump-stg output.  That is, we need to
-- include at least a binder.

pprStgExprShort :: OutputablePass pass => StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExprShort :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExprShort StgPprOpts
_ (StgCase GenStgExpr pass
_expr BinderP pass
var AltType
_ty [GenStgAlt pass]
_alts) =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"case of" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> BinderP pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr BinderP pass
var
pprStgExprShort StgPprOpts
_ (StgLet XLet pass
_ GenStgBinding pass
bnd GenStgExpr pass
_) =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"let" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenStgBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
GenStgBinding pass -> SDoc
pprStgBindShort GenStgBinding pass
bnd SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in ..."
pprStgExprShort StgPprOpts
_ (StgLetNoEscape XLetNoEscape pass
_ GenStgBinding pass
bnd GenStgExpr pass
_) =
  String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"let-no-escape" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenStgBinding pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
GenStgBinding pass -> SDoc
pprStgBindShort GenStgBinding pass
bnd SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"in ..."
pprStgExprShort StgPprOpts
opts (StgTick StgTickish
t GenStgExpr pass
e) = StgTickish -> SDoc
forall a. Outputable a => a -> SDoc
ppr StgTickish
t SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExprShort StgPprOpts
opts GenStgExpr pass
e
pprStgExprShort StgPprOpts
opts GenStgExpr pass
e = StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExpr StgPprOpts
opts GenStgExpr pass
e

pprStgBindShort :: OutputablePass pass => GenStgBinding pass -> SDoc
pprStgBindShort :: forall (pass :: StgPass).
OutputablePass pass =>
GenStgBinding pass -> SDoc
pprStgBindShort (StgNonRec BinderP pass
x GenStgRhs pass
_) =
  BinderP pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr BinderP pass
x SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"= ..."
pprStgBindShort (StgRec [(BinderP pass, GenStgRhs pass)]
bs) =
  Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'{' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> BinderP pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((BinderP pass, GenStgRhs pass) -> BinderP pass
forall a b. (a, b) -> a
fst ([(BinderP pass, GenStgRhs pass)] -> (BinderP pass, GenStgRhs pass)
forall a. HasCallStack => [a] -> a
head [(BinderP pass, GenStgRhs pass)]
bs)) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"= ...; ... }"

pprStgAltShort :: OutputablePass pass => StgPprOpts -> GenStgAlt pass -> SDoc
pprStgAltShort :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgAlt pass -> SDoc
pprStgAltShort StgPprOpts
opts GenStgAlt{alt_con :: forall (pass :: StgPass). GenStgAlt pass -> AltCon
alt_con=AltCon
con, alt_bndrs :: forall (pass :: StgPass). GenStgAlt pass -> [BinderP pass]
alt_bndrs=[BinderP pass]
args, alt_rhs :: forall (pass :: StgPass). GenStgAlt pass -> GenStgExpr pass
alt_rhs=GenStgExpr pass
expr} =
  AltCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr AltCon
con SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((BinderP pass -> SDoc) -> [BinderP pass] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map BinderP pass -> SDoc
forall a. Outputable a => a -> SDoc
ppr [BinderP pass]
args) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"->" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExprShort StgPprOpts
opts GenStgExpr pass
expr

pprStgRhsShort :: OutputablePass pass => StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhsShort :: forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhsShort StgPprOpts
opts (StgRhsClosure XRhsClosure pass
_ext CostCentreStack
_cc UpdateFlag
upd_flag [BinderP pass]
args GenStgExpr pass
body Type
_typ) =
  SDoc -> Int -> SDoc -> SDoc
hang ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep [ Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\\' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UpdateFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr UpdateFlag
upd_flag, SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ([BinderP pass] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [BinderP pass]
args) ])
       Int
4 (StgPprOpts -> GenStgExpr pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgExpr pass -> SDoc
pprStgExprShort StgPprOpts
opts GenStgExpr pass
body)
pprStgRhsShort StgPprOpts
opts GenStgRhs pass
rhs = StgPprOpts -> GenStgRhs pass -> SDoc
forall (pass :: StgPass).
OutputablePass pass =>
StgPprOpts -> GenStgRhs pass -> SDoc
pprStgRhs StgPprOpts
opts GenStgRhs pass
rhs


instance Outputable BCInstr where
   ppr :: BCInstr -> SDoc
ppr (STKCHECK Word
n)          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"STKCHECK" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word
n
   ppr (PUSH_L WordOff
offset)       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_L  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
offset
   ppr (PUSH_LL WordOff
o1 WordOff
o2)       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_LL " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
o1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
o2
   ppr (PUSH_LLL WordOff
o1 WordOff
o2 WordOff
o3)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_LLL" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
o1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
o2 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
o3
   ppr (PUSH8  ByteOff
offset)       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH8  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
offset
   ppr (PUSH16 ByteOff
offset)       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH16  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
offset
   ppr (PUSH32 ByteOff
offset)       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH32  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
offset
   ppr (PUSH8_W  ByteOff
offset)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH8_W  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
offset
   ppr (PUSH16_W ByteOff
offset)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH16_W  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
offset
   ppr (PUSH32_W ByteOff
offset)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH32_W  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
offset
   ppr (PUSH_G Name
nm)           = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_G  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm
   ppr (PUSH_PRIMOP PrimOp
op)      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_G  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GHC.PrimopWrappers."
                                               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PrimOp -> SDoc
forall a. Outputable a => a -> SDoc
ppr PrimOp
op
   ppr (PUSH_BCO ProtoBCO Name
bco)        = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_BCO") Int
2 (ProtoBCO Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr ProtoBCO Name
bco)

   ppr (PUSH_ALTS ProtoBCO Name
bco ArgRep
pk)    = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_ALTS" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ArgRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr ArgRep
pk) Int
2 (ProtoBCO Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr ProtoBCO Name
bco)
   ppr (PUSH_ALTS_TUPLE ProtoBCO Name
bco NativeCallInfo
call_info ProtoBCO Name
tuple_bco) =
                               SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_ALTS_TUPLE" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NativeCallInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr NativeCallInfo
call_info)
                                    Int
2
                                    (ProtoBCO Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr ProtoBCO Name
tuple_bco SDoc -> SDoc -> SDoc
$+$ ProtoBCO Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr ProtoBCO Name
bco)

   ppr BCInstr
PUSH_PAD8             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_PAD8"
   ppr BCInstr
PUSH_PAD16            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_PAD16"
   ppr BCInstr
PUSH_PAD32            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_PAD32"

   ppr (PUSH_UBX8  Literal
lit)      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_UBX8" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
lit
   ppr (PUSH_UBX16 Literal
lit)      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_UBX16" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
lit
   ppr (PUSH_UBX32 Literal
lit)      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_UBX32" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
lit
   ppr (PUSH_UBX Literal
lit WordOff
nw)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_UBX" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
nw) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
lit
   ppr (PUSH_ADDR Name
nm)        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_ADDR" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm
   ppr BCInstr
PUSH_APPLY_N          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_N"
   ppr BCInstr
PUSH_APPLY_V          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_V"
   ppr BCInstr
PUSH_APPLY_F          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_F"
   ppr BCInstr
PUSH_APPLY_D          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_D"
   ppr BCInstr
PUSH_APPLY_L          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_L"
   ppr BCInstr
PUSH_APPLY_P          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_P"
   ppr BCInstr
PUSH_APPLY_PP         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_PP"
   ppr BCInstr
PUSH_APPLY_PPP        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_PPP"
   ppr BCInstr
PUSH_APPLY_PPPP       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_PPPP"
   ppr BCInstr
PUSH_APPLY_PPPPP      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_PPPPP"
   ppr BCInstr
PUSH_APPLY_PPPPPP     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PUSH_APPLY_PPPPPP"

   ppr (SLIDE WordOff
n WordOff
d)           = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SLIDE   " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
d
   ppr (ALLOC_AP HalfWord
sz)         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ALLOC_AP   " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HalfWord -> SDoc
forall a. Outputable a => a -> SDoc
ppr HalfWord
sz
   ppr (ALLOC_AP_NOUPD HalfWord
sz)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ALLOC_AP_NOUPD   " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HalfWord -> SDoc
forall a. Outputable a => a -> SDoc
ppr HalfWord
sz
   ppr (ALLOC_PAP HalfWord
arity HalfWord
sz)  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ALLOC_PAP   " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HalfWord -> SDoc
forall a. Outputable a => a -> SDoc
ppr HalfWord
arity SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HalfWord -> SDoc
forall a. Outputable a => a -> SDoc
ppr HalfWord
sz
   ppr (MKAP WordOff
offset HalfWord
sz)      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"MKAP    " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HalfWord -> SDoc
forall a. Outputable a => a -> SDoc
ppr HalfWord
sz SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"words,"
                                               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
offset SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"stkoff"
   ppr (MKPAP WordOff
offset HalfWord
sz)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"MKPAP   " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> HalfWord -> SDoc
forall a. Outputable a => a -> SDoc
ppr HalfWord
sz SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"words,"
                                               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
offset SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"stkoff"
   ppr (UNPACK WordOff
sz)           = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UNPACK  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
sz
   ppr (PACK DataCon
dcon WordOff
sz)        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PACK    " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dcon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
sz
   ppr (LABEL     LocalLabel
lab)       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__"       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon
   ppr (TESTLT_I  Int
i LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_I" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_I  Int
i LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_I" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_W  Word
i LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_W" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_W  Word
i LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_W" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_I64  Int64
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_I64" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int64 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int64
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_I64  Int64
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_I64" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int64 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int64
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_I32  Int32
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_I32" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int32 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int32
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_I32  Int32
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_I32" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int32 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int32
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_I16  Int16
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_I16" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int16 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int16
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_I16  Int16
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_I16" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int16 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int16
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_I8  Int8
i LocalLabel
lab)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_I8" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int8 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int8
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_I8  Int16
i LocalLabel
lab)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_I8" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int16 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int16
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_W64  Word64
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_W64" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word64 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word64
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_W64  Word64
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_W64" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word64 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word64
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_W32  Word32
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_W32" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word32 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word32
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_W32  Word32
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_W32" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word32 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word32
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_W16  Word16
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_W16" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word16 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word16
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_W16  Word16
i LocalLabel
lab)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_W16" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word16 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word16
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_W8  Word8
i LocalLabel
lab)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_W8" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word8 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word8
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_W8  Word8
i LocalLabel
lab)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_W8" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word8 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word8
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_F  Float
f LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_F" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Float -> SDoc
forall doc. IsLine doc => Float -> doc
float Float
f SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_F  Float
f LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_F" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Float -> SDoc
forall doc. IsLine doc => Float -> doc
float Float
f SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_D  Double
d LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_D" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Double -> SDoc
forall doc. IsLine doc => Double -> doc
double Double
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_D  Double
d LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_D" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Double -> SDoc
forall doc. IsLine doc => Double -> doc
double Double
d SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTLT_P  Word16
i LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTLT_P" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word16 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word16
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (TESTEQ_P  Word16
i LocalLabel
lab)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TESTEQ_P" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word16 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word16
i SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"__" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr BCInstr
CASEFAIL              = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CASEFAIL"
   ppr (JMP LocalLabel
lab)             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"JMP"      SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> LocalLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr LocalLabel
lab
   ppr (CCALL WordOff
off RemotePtr C_ffi_cif
marshal_addr Word16
flags) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CCALL   " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
off
                                                SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"marshal code at"
                                               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text (RemotePtr C_ffi_cif -> String
forall a. Show a => a -> String
show RemotePtr C_ffi_cif
marshal_addr)
                                               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> (case Word16
flags of
                                                      Word16
0x1 -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(interruptible)"
                                                      Word16
0x2 -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(unsafe)"
                                                      Word16
_   -> SDoc
forall doc. IsOutput doc => doc
empty)
   ppr BCInstr
PRIMCALL              = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"PRIMCALL"
   ppr (SWIZZLE WordOff
stkoff Int
n)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SWIZZLE " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"stkoff" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
stkoff
                                               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"by" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
   ppr BCInstr
ENTER                 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"ENTER"
   ppr (RETURN ArgRep
pk)           = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RETURN  " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> ArgRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr ArgRep
pk
   ppr (BCInstr
RETURN_TUPLE)        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RETURN_TUPLE"
   ppr (BRK_FUN ForeignRef BreakArray
_ RemotePtr ModuleName
_tick_mod Word16
tickx RemotePtr ModuleName
_info_mod Word16
infox RemotePtr CostCentre
_)
                             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"BRK_FUN" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<breakarray>"
                               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<tick_module>" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word16 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word16
tickx
                               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<info_module>" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Word16 -> SDoc
forall a. Outputable a => a -> SDoc
ppr Word16
infox
                               SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<cc>"



-- -----------------------------------------------------------------------------
-- The stack use, in words, of each bytecode insn.  These _must_ be
-- correct, or overestimates of reality, to be safe.

-- NOTE: we aggregate the stack use from case alternatives too, so that
-- we can do a single stack check at the beginning of a function only.

-- This could all be made more accurate by keeping track of a proper
-- stack high water mark, but it doesn't seem worth the hassle.

protoBCOStackUse :: ProtoBCO a -> Word
protoBCOStackUse :: forall a. ProtoBCO a -> Word
protoBCOStackUse ProtoBCO a
bco = [Word] -> Word
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((BCInstr -> Word) -> [BCInstr] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map BCInstr -> Word
bciStackUse (ProtoBCO a -> [BCInstr]
forall a. ProtoBCO a -> [BCInstr]
protoBCOInstrs ProtoBCO a
bco))

bciStackUse :: BCInstr -> Word
bciStackUse :: BCInstr -> Word
bciStackUse STKCHECK{}            = Word
0
bciStackUse PUSH_L{}              = Word
1
bciStackUse PUSH_LL{}             = Word
2
bciStackUse PUSH_LLL{}            = Word
3
bciStackUse PUSH8{}               = Word
1  -- overapproximation
bciStackUse PUSH16{}              = Word
1  -- overapproximation
bciStackUse PUSH32{}              = Word
1  -- overapproximation on 64bit arch
bciStackUse PUSH8_W{}             = Word
1  -- takes exactly 1 word
bciStackUse PUSH16_W{}            = Word
1  -- takes exactly 1 word
bciStackUse PUSH32_W{}            = Word
1  -- takes exactly 1 word
bciStackUse PUSH_G{}              = Word
1
bciStackUse PUSH_PRIMOP{}         = Word
1
bciStackUse PUSH_BCO{}            = Word
1
bciStackUse (PUSH_ALTS ProtoBCO Name
bco ArgRep
_)     = Word
2 {- profiling only, restore CCCS -} Word -> Word -> Word
forall a. Num a => a -> a -> a
+
                                    Word
3 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ ProtoBCO Name -> Word
forall a. ProtoBCO a -> Word
protoBCOStackUse ProtoBCO Name
bco
bciStackUse (PUSH_ALTS_TUPLE ProtoBCO Name
bco NativeCallInfo
info ProtoBCO Name
_) =
   -- (tuple_bco, call_info word, cont_bco, stg_ctoi_t)
   -- tuple
   -- (call_info, tuple_bco, stg_ret_t)
   Word
1 {- profiling only -} Word -> Word -> Word
forall a. Num a => a -> a -> a
+
   Word
7 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ WordOff -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (NativeCallInfo -> WordOff
nativeCallSize NativeCallInfo
info) Word -> Word -> Word
forall a. Num a => a -> a -> a
+ ProtoBCO Name -> Word
forall a. ProtoBCO a -> Word
protoBCOStackUse ProtoBCO Name
bco
bciStackUse (BCInstr
PUSH_PAD8)           = Word
1  -- overapproximation
bciStackUse (BCInstr
PUSH_PAD16)          = Word
1  -- overapproximation
bciStackUse (BCInstr
PUSH_PAD32)          = Word
1  -- overapproximation on 64bit arch
bciStackUse (PUSH_UBX8 Literal
_)         = Word
1  -- overapproximation
bciStackUse (PUSH_UBX16 Literal
_)        = Word
1  -- overapproximation
bciStackUse (PUSH_UBX32 Literal
_)        = Word
1  -- overapproximation on 64bit arch
bciStackUse (PUSH_UBX Literal
_ WordOff
nw)       = WordOff -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
nw
bciStackUse PUSH_ADDR{}           = Word
1
bciStackUse PUSH_APPLY_N{}        = Word
1
bciStackUse PUSH_APPLY_V{}        = Word
1
bciStackUse PUSH_APPLY_F{}        = Word
1
bciStackUse PUSH_APPLY_D{}        = Word
1
bciStackUse PUSH_APPLY_L{}        = Word
1
bciStackUse PUSH_APPLY_P{}        = Word
1
bciStackUse PUSH_APPLY_PP{}       = Word
1
bciStackUse PUSH_APPLY_PPP{}      = Word
1
bciStackUse PUSH_APPLY_PPPP{}     = Word
1
bciStackUse PUSH_APPLY_PPPPP{}    = Word
1
bciStackUse PUSH_APPLY_PPPPPP{}   = Word
1
bciStackUse ALLOC_AP{}            = Word
1
bciStackUse ALLOC_AP_NOUPD{}      = Word
1
bciStackUse ALLOC_PAP{}           = Word
1
bciStackUse (UNPACK WordOff
sz)           = WordOff -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordOff
sz
bciStackUse LABEL{}               = Word
0
bciStackUse TESTLT_I{}            = Word
0
bciStackUse TESTEQ_I{}            = Word
0
bciStackUse TESTLT_W{}            = Word
0
bciStackUse TESTEQ_W{}            = Word
0
bciStackUse TESTLT_I64{}          = Word
0
bciStackUse TESTEQ_I64{}          = Word
0
bciStackUse TESTLT_I32{}          = Word
0
bciStackUse TESTEQ_I32{}          = Word
0
bciStackUse TESTLT_I16{}          = Word
0
bciStackUse TESTEQ_I16{}          = Word
0
bciStackUse TESTLT_I8{}           = Word
0
bciStackUse TESTEQ_I8{}           = Word
0
bciStackUse TESTLT_W64{}          = Word
0
bciStackUse TESTEQ_W64{}          = Word
0
bciStackUse TESTLT_W32{}          = Word
0
bciStackUse TESTEQ_W32{}          = Word
0
bciStackUse TESTLT_W16{}          = Word
0
bciStackUse TESTEQ_W16{}          = Word
0
bciStackUse TESTLT_W8{}           = Word
0
bciStackUse TESTEQ_W8{}           = Word
0
bciStackUse TESTLT_F{}            = Word
0
bciStackUse TESTEQ_F{}            = Word
0
bciStackUse TESTLT_D{}            = Word
0
bciStackUse TESTEQ_D{}            = Word
0
bciStackUse TESTLT_P{}            = Word
0
bciStackUse TESTEQ_P{}            = Word
0
bciStackUse CASEFAIL{}            = Word
0
bciStackUse JMP{}                 = Word
0
bciStackUse ENTER{}               = Word
0
bciStackUse RETURN{}              = Word
1 -- pushes stg_ret_X for some X
bciStackUse RETURN_TUPLE{}        = Word
1 -- pushes stg_ret_t header
bciStackUse CCALL{}               = Word
0
bciStackUse PRIMCALL{}            = Word
1 -- pushes stg_primcall
bciStackUse SWIZZLE{}             = Word
0
bciStackUse BRK_FUN{}             = Word
0

-- These insns actually reduce stack use, but we need the high-tide level,
-- so can't use this info.  Not that it matters much.
bciStackUse SLIDE{}               = Word
0
bciStackUse MKAP{}                = Word
0
bciStackUse MKPAP{}               = Word
0
bciStackUse PACK{}                = Word
1 -- worst case is PACK 0 words