module GHC.ByteCode.Types
( CompiledByteCode(..), seqCompiledByteCode
, FFIInfo(..)
, RegBitmap(..)
, TupleInfo(..), voidTupleInfo
, ByteOff(..), WordOff(..)
, UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
, ItblEnv, ItblPtr(..)
, CgBreakInfo(..)
, ModBreaks (..), BreakIndex, emptyModBreaks
, CCostCentre
) where
import GHC.Prelude
import GHC.Data.FastString
import GHC.Data.SizedSeq
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Utils.Outputable
import GHC.Builtin.PrimOps
import GHC.Types.SrcLoc
import GHCi.BreakArray
import GHCi.RemoteTypes
import GHCi.FFI
import Control.DeepSeq
import Foreign
import Data.Array
import Data.Array.Base ( UArray(..) )
import Data.ByteString (ByteString)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified GHC.Exts.Heap as Heap
import GHC.Stack.CCS
import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
import GHC.Iface.Syntax
data CompiledByteCode = CompiledByteCode
{ bc_bcos :: [UnlinkedBCO]
, bc_itbls :: ItblEnv
, bc_ffis :: [FFIInfo]
, bc_strs :: [RemotePtr ()]
, bc_breaks :: Maybe ModBreaks
}
newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)
deriving (Show, NFData)
instance Outputable CompiledByteCode where
ppr CompiledByteCode{..} = ppr bc_bcos
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode CompiledByteCode{..} =
rnf bc_bcos `seq`
seqEltsNameEnv rnf bc_itbls `seq`
rnf bc_ffis `seq`
rnf bc_strs `seq`
rnf (fmap seqModBreaks bc_breaks)
newtype ByteOff = ByteOff Int
deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable)
newtype WordOff = WordOff Int
deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable)
newtype RegBitmap = RegBitmap { unRegBitmap :: Word32 }
deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Bits, FiniteBits, Outputable)
data TupleInfo = TupleInfo
{ tupleSize :: !WordOff
, tupleRegs :: !GlobalRegSet
, tupleNativeStackSize :: !WordOff
} deriving (Show)
instance Outputable TupleInfo where
ppr TupleInfo{..} = text "<size" <+> ppr tupleSize <+>
text "stack" <+> ppr tupleNativeStackSize <+>
text "regs" <+>
ppr (map (text.show) $ regSetToList tupleRegs) <>
char '>'
voidTupleInfo :: TupleInfo
voidTupleInfo = TupleInfo 0 emptyRegSet 0
type ItblEnv = NameEnv (Name, ItblPtr)
newtype ItblPtr = ItblPtr (RemotePtr Heap.StgInfoTable)
deriving (Show, NFData)
data UnlinkedBCO
= UnlinkedBCO {
unlinkedBCOName :: !Name,
unlinkedBCOArity :: !Int,
unlinkedBCOInstrs :: !(UArray Int Word16),
unlinkedBCOBitmap :: !(UArray Int Word64),
unlinkedBCOLits :: !(SizedSeq BCONPtr),
unlinkedBCOPtrs :: !(SizedSeq BCOPtr)
}
instance NFData UnlinkedBCO where
rnf UnlinkedBCO{..} =
rnf unlinkedBCOLits `seq`
rnf unlinkedBCOPtrs
data BCOPtr
= BCOPtrName !Name
| BCOPtrPrimOp !PrimOp
| BCOPtrBCO !UnlinkedBCO
| BCOPtrBreakArray
instance NFData BCOPtr where
rnf (BCOPtrBCO bco) = rnf bco
rnf x = x `seq` ()
data BCONPtr
= BCONPtrWord !Word
| BCONPtrLbl !FastString
| BCONPtrItbl !Name
| BCONPtrStr !ByteString
instance NFData BCONPtr where
rnf x = x `seq` ()
data CgBreakInfo
= CgBreakInfo
{ cgb_tyvars :: ![IfaceTvBndr]
, cgb_vars :: ![Maybe (IfaceIdBndr, Word16)]
, cgb_resty :: !IfaceType
}
seqCgBreakInfo :: CgBreakInfo -> ()
seqCgBreakInfo CgBreakInfo{..} =
rnf cgb_tyvars `seq`
rnf cgb_vars `seq`
rnf cgb_resty
instance Outputable UnlinkedBCO where
ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
= sep [text "BCO", ppr nm, text "with",
ppr (sizeSS lits), text "lits",
ppr (sizeSS ptrs), text "ptrs" ]
instance Outputable CgBreakInfo where
ppr info = text "CgBreakInfo" <+>
parens (ppr (cgb_vars info) <+>
ppr (cgb_resty info))
type BreakIndex = Int
data CCostCentre
data ModBreaks
= ModBreaks
{ modBreaks_flags :: ForeignRef BreakArray
, modBreaks_locs :: !(Array BreakIndex SrcSpan)
, modBreaks_vars :: !(Array BreakIndex [OccName])
, modBreaks_decls :: !(Array BreakIndex [String])
, modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre))
, modBreaks_breakInfo :: IntMap CgBreakInfo
}
seqModBreaks :: ModBreaks -> ()
seqModBreaks ModBreaks{..} =
rnf modBreaks_flags `seq`
rnf modBreaks_locs `seq`
rnf modBreaks_vars `seq`
rnf modBreaks_decls `seq`
rnf modBreaks_ccs `seq`
rnf (fmap seqCgBreakInfo modBreaks_breakInfo)
emptyModBreaks :: ModBreaks
emptyModBreaks = ModBreaks
{ modBreaks_flags = error "ModBreaks.modBreaks_array not initialised"
, modBreaks_locs = array (0,1) []
, modBreaks_vars = array (0,1) []
, modBreaks_decls = array (0,1) []
, modBreaks_ccs = array (0,1) []
, modBreaks_breakInfo = IntMap.empty
}