{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
--
--  (c) The University of Glasgow 2002-2006
--

-- | Bytecode assembler types
module GHC.ByteCode.Types
  ( CompiledByteCode(..), seqCompiledByteCode, FFIInfo(..)
  , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
  , ItblEnv, ItblPtr(..)
  , CgBreakInfo(..)
  , ModBreaks (..), BreakIndex, emptyModBreaks
  , CCostCentre
  ) where

import GHC.Prelude

import GHC.Data.FastString
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Utils.Outputable
import GHC.Builtin.PrimOps
import SizedSeq
import GHC.Core.Type
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 Data.Maybe (catMaybes)
import GHC.Exts.Heap
import GHC.Stack.CCS

-- -----------------------------------------------------------------------------
-- Compiled Byte Code

data CompiledByteCode = CompiledByteCode
  { CompiledByteCode -> [UnlinkedBCO]
bc_bcos   :: [UnlinkedBCO]  -- Bunch of interpretable bindings
  , CompiledByteCode -> ItblEnv
bc_itbls  :: ItblEnv        -- A mapping from DataCons to their itbls
  , CompiledByteCode -> [FFIInfo]
bc_ffis   :: [FFIInfo]      -- ffi blocks we allocated
  , CompiledByteCode -> [RemotePtr ()]
bc_strs   :: [RemotePtr ()] -- malloc'd strings
  , CompiledByteCode -> Maybe ModBreaks
bc_breaks :: Maybe ModBreaks -- breakpoint info (Nothing if we're not
                                 -- creating breakpoints, for some reason)
  }
                -- ToDo: we're not tracking strings that we malloc'd
newtype FFIInfo = FFIInfo (RemotePtr C_ffi_cif)
  deriving (BreakIndex -> FFIInfo -> ShowS
[FFIInfo] -> ShowS
FFIInfo -> String
(BreakIndex -> FFIInfo -> ShowS)
-> (FFIInfo -> String) -> ([FFIInfo] -> ShowS) -> Show FFIInfo
forall a.
(BreakIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FFIInfo] -> ShowS
$cshowList :: [FFIInfo] -> ShowS
show :: FFIInfo -> String
$cshow :: FFIInfo -> String
showsPrec :: BreakIndex -> FFIInfo -> ShowS
$cshowsPrec :: BreakIndex -> FFIInfo -> ShowS
External instance of the constraint type forall a. Show (RemotePtr a)
External instance of the constraint type Ord BreakIndex
Show, FFIInfo -> ()
(FFIInfo -> ()) -> NFData FFIInfo
forall a. (a -> ()) -> NFData a
rnf :: FFIInfo -> ()
$crnf :: FFIInfo -> ()
External instance of the constraint type forall a. NFData (RemotePtr a)
NFData)

instance Outputable CompiledByteCode where
  ppr :: CompiledByteCode -> SDoc
ppr CompiledByteCode{[RemotePtr ()]
[UnlinkedBCO]
[FFIInfo]
Maybe ModBreaks
ItblEnv
bc_breaks :: Maybe ModBreaks
bc_strs :: [RemotePtr ()]
bc_ffis :: [FFIInfo]
bc_itbls :: ItblEnv
bc_bcos :: [UnlinkedBCO]
bc_breaks :: CompiledByteCode -> Maybe ModBreaks
bc_strs :: CompiledByteCode -> [RemotePtr ()]
bc_ffis :: CompiledByteCode -> [FFIInfo]
bc_itbls :: CompiledByteCode -> ItblEnv
bc_bcos :: CompiledByteCode -> [UnlinkedBCO]
..} = [UnlinkedBCO] -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
Instance of class: Outputable of the constraint type Outputable UnlinkedBCO
ppr [UnlinkedBCO]
bc_bcos

-- Not a real NFData instance, because ModBreaks contains some things
-- we can't rnf
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode CompiledByteCode{[RemotePtr ()]
[UnlinkedBCO]
[FFIInfo]
Maybe ModBreaks
ItblEnv
bc_breaks :: Maybe ModBreaks
bc_strs :: [RemotePtr ()]
bc_ffis :: [FFIInfo]
bc_itbls :: ItblEnv
bc_bcos :: [UnlinkedBCO]
bc_breaks :: CompiledByteCode -> Maybe ModBreaks
bc_strs :: CompiledByteCode -> [RemotePtr ()]
bc_ffis :: CompiledByteCode -> [FFIInfo]
bc_itbls :: CompiledByteCode -> ItblEnv
bc_bcos :: CompiledByteCode -> [UnlinkedBCO]
..} =
  [UnlinkedBCO] -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData a => NFData [a]
Instance of class: NFData of the constraint type NFData UnlinkedBCO
rnf [UnlinkedBCO]
bc_bcos () -> () -> ()
`seq`
  [(Name, ItblPtr)] -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type forall a b. (NFData a, NFData b) => NFData (a, b)
External instance of the constraint type NFData Name
Instance of class: NFData of the constraint type NFData ItblPtr
rnf (ItblEnv -> [(Name, ItblPtr)]
forall a. NameEnv a -> [a]
nameEnvElts ItblEnv
bc_itbls) () -> () -> ()
`seq`
  [FFIInfo] -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData a => NFData [a]
Instance of class: NFData of the constraint type NFData FFIInfo
rnf [FFIInfo]
bc_ffis () -> () -> ()
`seq`
  [RemotePtr ()] -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type forall a. NFData (RemotePtr a)
rnf [RemotePtr ()]
bc_strs () -> () -> ()
`seq`
  Maybe () -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData a => NFData (Maybe a)
External instance of the constraint type NFData ()
rnf ((ModBreaks -> ()) -> Maybe ModBreaks -> Maybe ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor Maybe
fmap ModBreaks -> ()
seqModBreaks Maybe ModBreaks
bc_breaks)

type ItblEnv = NameEnv (Name, ItblPtr)
        -- We need the Name in the range so we know which
        -- elements to filter out when unloading a module

newtype ItblPtr = ItblPtr (RemotePtr StgInfoTable)
  deriving (BreakIndex -> ItblPtr -> ShowS
[ItblPtr] -> ShowS
ItblPtr -> String
(BreakIndex -> ItblPtr -> ShowS)
-> (ItblPtr -> String) -> ([ItblPtr] -> ShowS) -> Show ItblPtr
forall a.
(BreakIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItblPtr] -> ShowS
$cshowList :: [ItblPtr] -> ShowS
show :: ItblPtr -> String
$cshow :: ItblPtr -> String
showsPrec :: BreakIndex -> ItblPtr -> ShowS
$cshowsPrec :: BreakIndex -> ItblPtr -> ShowS
External instance of the constraint type forall a. Show (RemotePtr a)
External instance of the constraint type Ord BreakIndex
Show, ItblPtr -> ()
(ItblPtr -> ()) -> NFData ItblPtr
forall a. (a -> ()) -> NFData a
rnf :: ItblPtr -> ()
$crnf :: ItblPtr -> ()
External instance of the constraint type forall a. NFData (RemotePtr a)
NFData)

data UnlinkedBCO
   = UnlinkedBCO {
        UnlinkedBCO -> Name
unlinkedBCOName   :: !Name,
        UnlinkedBCO -> BreakIndex
unlinkedBCOArity  :: {-# UNPACK #-} !Int,
        UnlinkedBCO -> UArray BreakIndex Word16
unlinkedBCOInstrs :: !(UArray Int Word16),      -- insns
        UnlinkedBCO -> UArray BreakIndex Word64
unlinkedBCOBitmap :: !(UArray Int Word64),      -- bitmap
        UnlinkedBCO -> SizedSeq BCONPtr
unlinkedBCOLits   :: !(SizedSeq BCONPtr),       -- non-ptrs
        UnlinkedBCO -> SizedSeq BCOPtr
unlinkedBCOPtrs   :: !(SizedSeq BCOPtr)         -- ptrs
   }

instance NFData UnlinkedBCO where
  rnf :: UnlinkedBCO -> ()
rnf UnlinkedBCO{BreakIndex
UArray BreakIndex Word16
UArray BreakIndex Word64
SizedSeq BCONPtr
SizedSeq BCOPtr
Name
unlinkedBCOPtrs :: SizedSeq BCOPtr
unlinkedBCOLits :: SizedSeq BCONPtr
unlinkedBCOBitmap :: UArray BreakIndex Word64
unlinkedBCOInstrs :: UArray BreakIndex Word16
unlinkedBCOArity :: BreakIndex
unlinkedBCOName :: Name
unlinkedBCOPtrs :: UnlinkedBCO -> SizedSeq BCOPtr
unlinkedBCOLits :: UnlinkedBCO -> SizedSeq BCONPtr
unlinkedBCOBitmap :: UnlinkedBCO -> UArray BreakIndex Word64
unlinkedBCOInstrs :: UnlinkedBCO -> UArray BreakIndex Word16
unlinkedBCOArity :: UnlinkedBCO -> BreakIndex
unlinkedBCOName :: UnlinkedBCO -> Name
..} =
    SizedSeq BCONPtr -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData a => NFData (SizedSeq a)
Instance of class: NFData of the constraint type NFData BCONPtr
rnf SizedSeq BCONPtr
unlinkedBCOLits () -> () -> ()
`seq`
    SizedSeq BCOPtr -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData a => NFData (SizedSeq a)
Instance of class: NFData of the constraint type NFData BCOPtr
rnf SizedSeq BCOPtr
unlinkedBCOPtrs

data BCOPtr
  = BCOPtrName   !Name
  | BCOPtrPrimOp !PrimOp
  | BCOPtrBCO    !UnlinkedBCO
  | BCOPtrBreakArray  -- a pointer to this module's BreakArray

instance NFData BCOPtr where
  rnf :: BCOPtr -> ()
rnf (BCOPtrBCO UnlinkedBCO
bco) = UnlinkedBCO -> ()
forall a. NFData a => a -> ()
Instance of class: NFData of the constraint type NFData UnlinkedBCO
rnf UnlinkedBCO
bco
  rnf BCOPtr
x = BCOPtr
x BCOPtr -> () -> ()
`seq` ()

data BCONPtr
  = BCONPtrWord  {-# UNPACK #-} !Word
  | BCONPtrLbl   !FastString
  | BCONPtrItbl  !Name
  | BCONPtrStr   !ByteString

instance NFData BCONPtr where
  rnf :: BCONPtr -> ()
rnf BCONPtr
x = BCONPtr
x BCONPtr -> () -> ()
`seq` ()

-- | Information about a breakpoint that we know at code-generation time
data CgBreakInfo
   = CgBreakInfo
   { CgBreakInfo -> [Maybe (Id, Word16)]
cgb_vars   :: [Maybe (Id,Word16)]
   , CgBreakInfo -> Type
cgb_resty  :: Type
   }
-- See Note [Syncing breakpoint info] in GHC.Runtime.Eval

-- Not a real NFData instance because we can't rnf Id or Type
seqCgBreakInfo :: CgBreakInfo -> ()
seqCgBreakInfo :: CgBreakInfo -> ()
seqCgBreakInfo CgBreakInfo{[Maybe (Id, Word16)]
Type
cgb_resty :: Type
cgb_vars :: [Maybe (Id, Word16)]
cgb_resty :: CgBreakInfo -> Type
cgb_vars :: CgBreakInfo -> [Maybe (Id, Word16)]
..} =
  [Word16] -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Word16
rnf (((Id, Word16) -> Word16) -> [(Id, Word16)] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map (Id, Word16) -> Word16
forall a b. (a, b) -> b
snd ([Maybe (Id, Word16)] -> [(Id, Word16)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Id, Word16)]
cgb_vars))) () -> () -> ()
`seq`
  Type -> ()
seqType Type
cgb_resty

instance Outputable UnlinkedBCO where
   ppr :: UnlinkedBCO -> SDoc
ppr (UnlinkedBCO Name
nm BreakIndex
_arity UArray BreakIndex Word16
_insns UArray BreakIndex Word64
_bitmap SizedSeq BCONPtr
lits SizedSeq BCOPtr
ptrs)
      = [SDoc] -> SDoc
sep [String -> SDoc
text String
"BCO", Name -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Name
ppr Name
nm, String -> SDoc
text String
"with",
             Word -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Word
ppr (SizedSeq BCONPtr -> Word
forall a. SizedSeq a -> Word
sizeSS SizedSeq BCONPtr
lits), String -> SDoc
text String
"lits",
             Word -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Word
ppr (SizedSeq BCOPtr -> Word
forall a. SizedSeq a -> Word
sizeSS SizedSeq BCOPtr
ptrs), String -> SDoc
text String
"ptrs" ]

instance Outputable CgBreakInfo where
   ppr :: CgBreakInfo -> SDoc
ppr CgBreakInfo
info = String -> SDoc
text String
"CgBreakInfo" SDoc -> SDoc -> SDoc
<+>
              SDoc -> SDoc
parens ([Maybe (Id, Word16)] -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type forall a. Outputable a => Outputable [a]
External instance of the constraint type forall a. Outputable a => Outputable (Maybe a)
External instance of the constraint type forall a b. (Outputable a, Outputable b) => Outputable (a, b)
External instance of the constraint type Outputable Id
External instance of the constraint type Outputable Word16
ppr (CgBreakInfo -> [Maybe (Id, Word16)]
cgb_vars CgBreakInfo
info) SDoc -> SDoc -> SDoc
<+>
                      Type -> SDoc
forall a. Outputable a => a -> SDoc
External instance of the constraint type Outputable Type
ppr (CgBreakInfo -> Type
cgb_resty CgBreakInfo
info))

-- -----------------------------------------------------------------------------
-- Breakpoints

-- | Breakpoint index
type BreakIndex = Int

-- | C CostCentre type
data CCostCentre

-- | All the information about the breakpoints for a module
data ModBreaks
   = ModBreaks
   { ModBreaks -> ForeignRef BreakArray
modBreaks_flags :: ForeignRef BreakArray
        -- ^ The array of flags, one per breakpoint,
        -- indicating which breakpoints are enabled.
   , ModBreaks -> Array BreakIndex SrcSpan
modBreaks_locs :: !(Array BreakIndex SrcSpan)
        -- ^ An array giving the source span of each breakpoint.
   , ModBreaks -> Array BreakIndex [OccName]
modBreaks_vars :: !(Array BreakIndex [OccName])
        -- ^ An array giving the names of the free variables at each breakpoint.
   , ModBreaks -> Array BreakIndex [String]
modBreaks_decls :: !(Array BreakIndex [String])
        -- ^ An array giving the names of the declarations enclosing each breakpoint.
   , ModBreaks -> Array BreakIndex (RemotePtr CostCentre)
modBreaks_ccs :: !(Array BreakIndex (RemotePtr CostCentre))
        -- ^ Array pointing to cost centre for each breakpoint
   , ModBreaks -> IntMap CgBreakInfo
modBreaks_breakInfo :: IntMap CgBreakInfo
        -- ^ info about each breakpoint from the bytecode generator
   }

seqModBreaks :: ModBreaks -> ()
seqModBreaks :: ModBreaks -> ()
seqModBreaks ModBreaks{Array BreakIndex [String]
Array BreakIndex [OccName]
Array BreakIndex (RemotePtr CostCentre)
Array BreakIndex SrcSpan
IntMap CgBreakInfo
ForeignRef BreakArray
modBreaks_breakInfo :: IntMap CgBreakInfo
modBreaks_ccs :: Array BreakIndex (RemotePtr CostCentre)
modBreaks_decls :: Array BreakIndex [String]
modBreaks_vars :: Array BreakIndex [OccName]
modBreaks_locs :: Array BreakIndex SrcSpan
modBreaks_flags :: ForeignRef BreakArray
modBreaks_breakInfo :: ModBreaks -> IntMap CgBreakInfo
modBreaks_ccs :: ModBreaks -> Array BreakIndex (RemotePtr CostCentre)
modBreaks_decls :: ModBreaks -> Array BreakIndex [String]
modBreaks_vars :: ModBreaks -> Array BreakIndex [OccName]
modBreaks_locs :: ModBreaks -> Array BreakIndex SrcSpan
modBreaks_flags :: ModBreaks -> ForeignRef BreakArray
..} =
  ForeignRef BreakArray -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData (ForeignRef a)
rnf ForeignRef BreakArray
modBreaks_flags () -> () -> ()
`seq`
  Array BreakIndex SrcSpan -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a b. (NFData a, NFData b) => NFData (Array a b)
External instance of the constraint type NFData BreakIndex
External instance of the constraint type NFData SrcSpan
rnf Array BreakIndex SrcSpan
modBreaks_locs () -> () -> ()
`seq`
  Array BreakIndex [OccName] -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a b. (NFData a, NFData b) => NFData (Array a b)
External instance of the constraint type NFData BreakIndex
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData OccName
rnf Array BreakIndex [OccName]
modBreaks_vars () -> () -> ()
`seq`
  Array BreakIndex [String] -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a b. (NFData a, NFData b) => NFData (Array a b)
External instance of the constraint type NFData BreakIndex
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
rnf Array BreakIndex [String]
modBreaks_decls () -> () -> ()
`seq`
  Array BreakIndex (RemotePtr CostCentre) -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a b. (NFData a, NFData b) => NFData (Array a b)
External instance of the constraint type NFData BreakIndex
External instance of the constraint type forall a. NFData (RemotePtr a)
rnf Array BreakIndex (RemotePtr CostCentre)
modBreaks_ccs () -> () -> ()
`seq`
  IntMap () -> ()
forall a. NFData a => a -> ()
External instance of the constraint type forall a. NFData a => NFData (IntMap a)
External instance of the constraint type NFData ()
rnf ((CgBreakInfo -> ()) -> IntMap CgBreakInfo -> IntMap ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IntMap
fmap CgBreakInfo -> ()
seqCgBreakInfo IntMap CgBreakInfo
modBreaks_breakInfo)

-- | Construct an empty ModBreaks
emptyModBreaks :: ModBreaks
emptyModBreaks :: ModBreaks
emptyModBreaks = ModBreaks :: ForeignRef BreakArray
-> Array BreakIndex SrcSpan
-> Array BreakIndex [OccName]
-> Array BreakIndex [String]
-> Array BreakIndex (RemotePtr CostCentre)
-> IntMap CgBreakInfo
-> ModBreaks
ModBreaks
   { modBreaks_flags :: ForeignRef BreakArray
modBreaks_flags = String -> ForeignRef BreakArray
forall a. HasCallStack => String -> a
error String
"ModBreaks.modBreaks_array not initialised"
         -- ToDo: can we avoid this?
   , modBreaks_locs :: Array BreakIndex SrcSpan
modBreaks_locs  = (BreakIndex, BreakIndex)
-> [(BreakIndex, SrcSpan)] -> Array BreakIndex SrcSpan
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
External instance of the constraint type Ix BreakIndex
array (BreakIndex
0,-BreakIndex
1) []
   , modBreaks_vars :: Array BreakIndex [OccName]
modBreaks_vars  = (BreakIndex, BreakIndex)
-> [(BreakIndex, [OccName])] -> Array BreakIndex [OccName]
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
External instance of the constraint type Ix BreakIndex
array (BreakIndex
0,-BreakIndex
1) []
   , modBreaks_decls :: Array BreakIndex [String]
modBreaks_decls = (BreakIndex, BreakIndex)
-> [(BreakIndex, [String])] -> Array BreakIndex [String]
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
External instance of the constraint type Ix BreakIndex
array (BreakIndex
0,-BreakIndex
1) []
   , modBreaks_ccs :: Array BreakIndex (RemotePtr CostCentre)
modBreaks_ccs = (BreakIndex, BreakIndex)
-> [(BreakIndex, RemotePtr CostCentre)]
-> Array BreakIndex (RemotePtr CostCentre)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
External instance of the constraint type Ix BreakIndex
array (BreakIndex
0,-BreakIndex
1) []
   , modBreaks_breakInfo :: IntMap CgBreakInfo
modBreaks_breakInfo = IntMap CgBreakInfo
forall a. IntMap a
IntMap.empty
   }