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

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

import GhcPrelude

import FastString
import Id
import Name
import NameEnv
import Outputable
import PrimOp
import SizedSeq
import Type
import 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 (Int -> FFIInfo -> ShowS
[FFIInfo] -> ShowS
FFIInfo -> String
(Int -> FFIInfo -> ShowS)
-> (FFIInfo -> String) -> ([FFIInfo] -> ShowS) -> Show FFIInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FFIInfo] -> ShowS
$cshowList :: [FFIInfo] -> ShowS
show :: FFIInfo -> String
$cshow :: FFIInfo -> String
showsPrec :: Int -> FFIInfo -> ShowS
$cshowsPrec :: Int -> FFIInfo -> ShowS
Show, FFIInfo -> ()
(FFIInfo -> ()) -> NFData FFIInfo
forall a. (a -> ()) -> NFData a
rnf :: FFIInfo -> ()
$crnf :: FFIInfo -> ()
NFData)

instance Outputable CompiledByteCode where
  ppr :: CompiledByteCode -> SDoc
ppr CompiledByteCode{..} = [UnlinkedBCO] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [UnlinkedBCO]
bc_bcos

-- Not a real NFData instance, because ModBreaks contains some things
-- we can't rnf
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode CompiledByteCode{..} =
  [UnlinkedBCO] -> ()
forall a. NFData a => a -> ()
rnf [UnlinkedBCO]
bc_bcos () -> () -> ()
forall a b. a -> b -> b
`seq`
  [(Name, ItblPtr)] -> ()
forall a. NFData a => a -> ()
rnf (ItblEnv -> [(Name, ItblPtr)]
forall a. NameEnv a -> [a]
nameEnvElts ItblEnv
bc_itbls) () -> () -> ()
forall a b. a -> b -> b
`seq`
  [FFIInfo] -> ()
forall a. NFData a => a -> ()
rnf [FFIInfo]
bc_ffis () -> () -> ()
forall a b. a -> b -> b
`seq`
  [RemotePtr ()] -> ()
forall a. NFData a => a -> ()
rnf [RemotePtr ()]
bc_strs () -> () -> ()
forall a b. a -> b -> b
`seq`
  Maybe () -> ()
forall a. NFData a => a -> ()
rnf ((ModBreaks -> ()) -> Maybe ModBreaks -> Maybe ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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 (Int -> ItblPtr -> ShowS
[ItblPtr] -> ShowS
ItblPtr -> String
(Int -> ItblPtr -> ShowS)
-> (ItblPtr -> String) -> ([ItblPtr] -> ShowS) -> Show ItblPtr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItblPtr] -> ShowS
$cshowList :: [ItblPtr] -> ShowS
show :: ItblPtr -> String
$cshow :: ItblPtr -> String
showsPrec :: Int -> ItblPtr -> ShowS
$cshowsPrec :: Int -> ItblPtr -> ShowS
Show, ItblPtr -> ()
(ItblPtr -> ()) -> NFData ItblPtr
forall a. (a -> ()) -> NFData a
rnf :: ItblPtr -> ()
$crnf :: ItblPtr -> ()
NFData)

data UnlinkedBCO
   = UnlinkedBCO {
        UnlinkedBCO -> Name
unlinkedBCOName   :: !Name,
        UnlinkedBCO -> Int
unlinkedBCOArity  :: {-# UNPACK #-} !Int,
        UnlinkedBCO -> UArray Int Word16
unlinkedBCOInstrs :: !(UArray Int Word16),      -- insns
        UnlinkedBCO -> UArray Int 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{..} =
    SizedSeq BCONPtr -> ()
forall a. NFData a => a -> ()
rnf SizedSeq BCONPtr
unlinkedBCOLits () -> () -> ()
forall a b. a -> b -> b
`seq`
    SizedSeq BCOPtr -> ()
forall a. NFData a => a -> ()
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 bco :: UnlinkedBCO
bco) = UnlinkedBCO -> ()
forall a. NFData a => a -> ()
rnf UnlinkedBCO
bco
  rnf x :: BCOPtr
x = BCOPtr
x BCOPtr -> () -> ()
forall a b. a -> b -> b
`seq` ()

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

instance NFData BCONPtr where
  rnf :: BCONPtr -> ()
rnf x :: BCONPtr
x = BCONPtr
x BCONPtr -> () -> ()
forall a b. a -> b -> b
`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 compiler/main/InteractiveEval.hs

-- Not a real NFData instance because we can't rnf Id or Type
seqCgBreakInfo :: CgBreakInfo -> ()
seqCgBreakInfo :: CgBreakInfo -> ()
seqCgBreakInfo CgBreakInfo{..} =
  [Word16] -> ()
forall a. NFData a => a -> ()
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))) () -> () -> ()
forall a b. a -> b -> b
`seq`
  Type -> ()
seqType Type
cgb_resty

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

instance Outputable CgBreakInfo where
   ppr :: CgBreakInfo -> SDoc
ppr info :: CgBreakInfo
info = String -> SDoc
text "CgBreakInfo" SDoc -> SDoc -> SDoc
<+>
              SDoc -> SDoc
parens ([Maybe (Id, Word16)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CgBreakInfo -> [Maybe (Id, Word16)]
cgb_vars CgBreakInfo
info) SDoc -> SDoc -> SDoc
<+>
                      Type -> SDoc
forall a. Outputable a => a -> SDoc
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 Int SrcSpan
modBreaks_locs :: !(Array BreakIndex SrcSpan)
        -- ^ An array giving the source span of each breakpoint.
   , ModBreaks -> Array Int [OccName]
modBreaks_vars :: !(Array BreakIndex [OccName])
        -- ^ An array giving the names of the free variables at each breakpoint.
   , ModBreaks -> Array Int [String]
modBreaks_decls :: !(Array BreakIndex [String])
        -- ^ An array giving the names of the declarations enclosing each breakpoint.
   , ModBreaks -> Array Int (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{..} =
  ForeignRef BreakArray -> ()
forall a. NFData a => a -> ()
rnf ForeignRef BreakArray
modBreaks_flags () -> () -> ()
forall a b. a -> b -> b
`seq`
  Array Int SrcSpan -> ()
forall a. NFData a => a -> ()
rnf Array Int SrcSpan
modBreaks_locs () -> () -> ()
forall a b. a -> b -> b
`seq`
  Array Int [OccName] -> ()
forall a. NFData a => a -> ()
rnf Array Int [OccName]
modBreaks_vars () -> () -> ()
forall a b. a -> b -> b
`seq`
  Array Int [String] -> ()
forall a. NFData a => a -> ()
rnf Array Int [String]
modBreaks_decls () -> () -> ()
forall a b. a -> b -> b
`seq`
  Array Int (RemotePtr CostCentre) -> ()
forall a. NFData a => a -> ()
rnf Array Int (RemotePtr CostCentre)
modBreaks_ccs () -> () -> ()
forall a b. a -> b -> b
`seq`
  IntMap () -> ()
forall a. NFData a => a -> ()
rnf ((CgBreakInfo -> ()) -> IntMap CgBreakInfo -> IntMap ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CgBreakInfo -> ()
seqCgBreakInfo IntMap CgBreakInfo
modBreaks_breakInfo)

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