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

-- | Bytecode assembler types
module GHC.ByteCode.Types
  ( CompiledByteCode(..), seqCompiledByteCode
  , BCOByteArray(..), mkBCOByteArray
  , FFIInfo(..)
  , RegBitmap(..)
  , NativeCallType(..), NativeCallInfo(..), voidTupleReturnInfo, voidPrimCallInfo
  , ByteOff(..), WordOff(..), HalfWord(..)
  , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..)
  , ItblEnv, ItblPtr(..)
  , AddrEnv, AddrPtr(..)
  , FlatBag, sizeFlatBag, fromSmallArray, elemsFlatBag

  -- * Mod Breaks
  , ModBreaks (..), BreakpointId(..), BreakTickIndex

  -- * Internal Mod Breaks
  , InternalModBreaks(..), CgBreakInfo(..), seqInternalModBreaks
  -- ** Internal breakpoint identifier
  , InternalBreakpointId(..), BreakInfoIndex
  ) where

import GHC.Prelude

import GHC.Data.FastString
import GHC.Data.FlatBag
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Utils.Outputable
import GHC.Builtin.PrimOps
import GHC.Types.SptEntry
import GHC.HsToCore.Breakpoints
import GHC.ByteCode.Breakpoints
import GHCi.Message
import GHCi.RemoteTypes
import GHCi.FFI
import Control.DeepSeq
import GHCi.ResolvedBCO ( BCOByteArray(..), mkBCOByteArray )

import Foreign
import Data.ByteString (ByteString)
import qualified GHC.Exts.Heap as Heap
import GHC.Cmm.Expr ( GlobalRegSet, emptyRegSet, regSetToList )
import GHC.Unit.Module

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

data CompiledByteCode = CompiledByteCode
  { CompiledByteCode -> FlatBag UnlinkedBCO
bc_bcos   :: FlatBag UnlinkedBCO
    -- ^ Bunch of interpretable bindings

  , CompiledByteCode -> [(Name, ConInfoTable)]
bc_itbls  :: [(Name, ConInfoTable)]
    -- ^ Mapping from DataCons to their info tables

  , CompiledByteCode -> [(Name, ByteString)]
bc_strs   :: [(Name, ByteString)]
    -- ^ top-level strings (heap allocated)

  , CompiledByteCode -> Maybe InternalModBreaks
bc_breaks :: Maybe InternalModBreaks
    -- ^ All breakpoint information (no information if breakpoints are disabled).
    --
    -- This information is used when loading a bytecode object: we will
    -- construct the arrays to be used at runtime to trigger breakpoints at load time
    -- from it (in 'allocateBreakArrays' and 'allocateCCS' in 'GHC.ByteCode.Loader').

  , CompiledByteCode -> [SptEntry]
bc_spt_entries :: ![SptEntry]
    -- ^ Static pointer table entries which should be loaded along with the
    -- BCOs. See Note [Grand plan for static forms] in
    -- "GHC.Iface.Tidy.StaticPtrTable".
  }

-- | A libffi ffi_cif function prototype.
data FFIInfo = FFIInfo { FFIInfo -> [FFIType]
ffiInfoArgs :: ![FFIType], FFIInfo -> FFIType
ffiInfoRet :: !FFIType }
  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
$cshowsPrec :: Int -> FFIInfo -> ShowS
showsPrec :: Int -> FFIInfo -> ShowS
$cshow :: FFIInfo -> String
show :: FFIInfo -> String
$cshowList :: [FFIInfo] -> ShowS
showList :: [FFIInfo] -> ShowS
Show)

instance Outputable CompiledByteCode where
  ppr :: CompiledByteCode -> SDoc
ppr CompiledByteCode{[(Name, ByteString)]
[(Name, ConInfoTable)]
[SptEntry]
Maybe InternalModBreaks
FlatBag UnlinkedBCO
bc_bcos :: CompiledByteCode -> FlatBag UnlinkedBCO
bc_itbls :: CompiledByteCode -> [(Name, ConInfoTable)]
bc_strs :: CompiledByteCode -> [(Name, ByteString)]
bc_breaks :: CompiledByteCode -> Maybe InternalModBreaks
bc_spt_entries :: CompiledByteCode -> [SptEntry]
bc_bcos :: FlatBag UnlinkedBCO
bc_itbls :: [(Name, ConInfoTable)]
bc_strs :: [(Name, ByteString)]
bc_breaks :: Maybe InternalModBreaks
bc_spt_entries :: [SptEntry]
..} = [UnlinkedBCO] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([UnlinkedBCO] -> SDoc) -> [UnlinkedBCO] -> SDoc
forall a b. (a -> b) -> a -> b
$ FlatBag UnlinkedBCO -> [UnlinkedBCO]
forall a. FlatBag a -> [a]
elemsFlatBag FlatBag UnlinkedBCO
bc_bcos

-- Not a real NFData instance, because ModBreaks contains some things
-- we can't rnf
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode :: CompiledByteCode -> ()
seqCompiledByteCode CompiledByteCode{[(Name, ByteString)]
[(Name, ConInfoTable)]
[SptEntry]
Maybe InternalModBreaks
FlatBag UnlinkedBCO
bc_bcos :: CompiledByteCode -> FlatBag UnlinkedBCO
bc_itbls :: CompiledByteCode -> [(Name, ConInfoTable)]
bc_strs :: CompiledByteCode -> [(Name, ByteString)]
bc_breaks :: CompiledByteCode -> Maybe InternalModBreaks
bc_spt_entries :: CompiledByteCode -> [SptEntry]
bc_bcos :: FlatBag UnlinkedBCO
bc_itbls :: [(Name, ConInfoTable)]
bc_strs :: [(Name, ByteString)]
bc_breaks :: Maybe InternalModBreaks
bc_spt_entries :: [SptEntry]
..} =
  FlatBag UnlinkedBCO -> ()
forall a. NFData a => a -> ()
rnf FlatBag UnlinkedBCO
bc_bcos () -> () -> ()
forall a b. a -> b -> b
`seq`
  [(Name, ConInfoTable)] -> ()
forall a. NFData a => a -> ()
rnf [(Name, ConInfoTable)]
bc_itbls () -> () -> ()
forall a b. a -> b -> b
`seq`
  [(Name, ByteString)] -> ()
forall a. NFData a => a -> ()
rnf [(Name, ByteString)]
bc_strs () -> () -> ()
forall a b. a -> b -> b
`seq`
  case Maybe InternalModBreaks
bc_breaks of
    Maybe InternalModBreaks
Nothing -> ()
    Just InternalModBreaks
ibks -> InternalModBreaks -> ()
seqInternalModBreaks InternalModBreaks
ibks

newtype ByteOff = ByteOff Int
    deriving (Int -> ByteOff
ByteOff -> Int
ByteOff -> [ByteOff]
ByteOff -> ByteOff
ByteOff -> ByteOff -> [ByteOff]
ByteOff -> ByteOff -> ByteOff -> [ByteOff]
(ByteOff -> ByteOff)
-> (ByteOff -> ByteOff)
-> (Int -> ByteOff)
-> (ByteOff -> Int)
-> (ByteOff -> [ByteOff])
-> (ByteOff -> ByteOff -> [ByteOff])
-> (ByteOff -> ByteOff -> [ByteOff])
-> (ByteOff -> ByteOff -> ByteOff -> [ByteOff])
-> Enum ByteOff
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ByteOff -> ByteOff
succ :: ByteOff -> ByteOff
$cpred :: ByteOff -> ByteOff
pred :: ByteOff -> ByteOff
$ctoEnum :: Int -> ByteOff
toEnum :: Int -> ByteOff
$cfromEnum :: ByteOff -> Int
fromEnum :: ByteOff -> Int
$cenumFrom :: ByteOff -> [ByteOff]
enumFrom :: ByteOff -> [ByteOff]
$cenumFromThen :: ByteOff -> ByteOff -> [ByteOff]
enumFromThen :: ByteOff -> ByteOff -> [ByteOff]
$cenumFromTo :: ByteOff -> ByteOff -> [ByteOff]
enumFromTo :: ByteOff -> ByteOff -> [ByteOff]
$cenumFromThenTo :: ByteOff -> ByteOff -> ByteOff -> [ByteOff]
enumFromThenTo :: ByteOff -> ByteOff -> ByteOff -> [ByteOff]
Enum, ByteOff -> ByteOff -> Bool
(ByteOff -> ByteOff -> Bool)
-> (ByteOff -> ByteOff -> Bool) -> Eq ByteOff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByteOff -> ByteOff -> Bool
== :: ByteOff -> ByteOff -> Bool
$c/= :: ByteOff -> ByteOff -> Bool
/= :: ByteOff -> ByteOff -> Bool
Eq, Int -> ByteOff -> ShowS
[ByteOff] -> ShowS
ByteOff -> String
(Int -> ByteOff -> ShowS)
-> (ByteOff -> String) -> ([ByteOff] -> ShowS) -> Show ByteOff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByteOff -> ShowS
showsPrec :: Int -> ByteOff -> ShowS
$cshow :: ByteOff -> String
show :: ByteOff -> String
$cshowList :: [ByteOff] -> ShowS
showList :: [ByteOff] -> ShowS
Show, Enum ByteOff
Real ByteOff
(Real ByteOff, Enum ByteOff) =>
(ByteOff -> ByteOff -> ByteOff)
-> (ByteOff -> ByteOff -> ByteOff)
-> (ByteOff -> ByteOff -> ByteOff)
-> (ByteOff -> ByteOff -> ByteOff)
-> (ByteOff -> ByteOff -> (ByteOff, ByteOff))
-> (ByteOff -> ByteOff -> (ByteOff, ByteOff))
-> (ByteOff -> Integer)
-> Integral ByteOff
ByteOff -> Integer
ByteOff -> ByteOff -> (ByteOff, ByteOff)
ByteOff -> ByteOff -> ByteOff
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ByteOff -> ByteOff -> ByteOff
quot :: ByteOff -> ByteOff -> ByteOff
$crem :: ByteOff -> ByteOff -> ByteOff
rem :: ByteOff -> ByteOff -> ByteOff
$cdiv :: ByteOff -> ByteOff -> ByteOff
div :: ByteOff -> ByteOff -> ByteOff
$cmod :: ByteOff -> ByteOff -> ByteOff
mod :: ByteOff -> ByteOff -> ByteOff
$cquotRem :: ByteOff -> ByteOff -> (ByteOff, ByteOff)
quotRem :: ByteOff -> ByteOff -> (ByteOff, ByteOff)
$cdivMod :: ByteOff -> ByteOff -> (ByteOff, ByteOff)
divMod :: ByteOff -> ByteOff -> (ByteOff, ByteOff)
$ctoInteger :: ByteOff -> Integer
toInteger :: ByteOff -> Integer
Integral, Integer -> ByteOff
ByteOff -> ByteOff
ByteOff -> ByteOff -> ByteOff
(ByteOff -> ByteOff -> ByteOff)
-> (ByteOff -> ByteOff -> ByteOff)
-> (ByteOff -> ByteOff -> ByteOff)
-> (ByteOff -> ByteOff)
-> (ByteOff -> ByteOff)
-> (ByteOff -> ByteOff)
-> (Integer -> ByteOff)
-> Num ByteOff
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ByteOff -> ByteOff -> ByteOff
+ :: ByteOff -> ByteOff -> ByteOff
$c- :: ByteOff -> ByteOff -> ByteOff
- :: ByteOff -> ByteOff -> ByteOff
$c* :: ByteOff -> ByteOff -> ByteOff
* :: ByteOff -> ByteOff -> ByteOff
$cnegate :: ByteOff -> ByteOff
negate :: ByteOff -> ByteOff
$cabs :: ByteOff -> ByteOff
abs :: ByteOff -> ByteOff
$csignum :: ByteOff -> ByteOff
signum :: ByteOff -> ByteOff
$cfromInteger :: Integer -> ByteOff
fromInteger :: Integer -> ByteOff
Num, Eq ByteOff
Eq ByteOff =>
(ByteOff -> ByteOff -> Ordering)
-> (ByteOff -> ByteOff -> Bool)
-> (ByteOff -> ByteOff -> Bool)
-> (ByteOff -> ByteOff -> Bool)
-> (ByteOff -> ByteOff -> Bool)
-> (ByteOff -> ByteOff -> ByteOff)
-> (ByteOff -> ByteOff -> ByteOff)
-> Ord ByteOff
ByteOff -> ByteOff -> Bool
ByteOff -> ByteOff -> Ordering
ByteOff -> ByteOff -> ByteOff
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 :: ByteOff -> ByteOff -> Ordering
compare :: ByteOff -> ByteOff -> Ordering
$c< :: ByteOff -> ByteOff -> Bool
< :: ByteOff -> ByteOff -> Bool
$c<= :: ByteOff -> ByteOff -> Bool
<= :: ByteOff -> ByteOff -> Bool
$c> :: ByteOff -> ByteOff -> Bool
> :: ByteOff -> ByteOff -> Bool
$c>= :: ByteOff -> ByteOff -> Bool
>= :: ByteOff -> ByteOff -> Bool
$cmax :: ByteOff -> ByteOff -> ByteOff
max :: ByteOff -> ByteOff -> ByteOff
$cmin :: ByteOff -> ByteOff -> ByteOff
min :: ByteOff -> ByteOff -> ByteOff
Ord, Num ByteOff
Ord ByteOff
(Num ByteOff, Ord ByteOff) => (ByteOff -> Rational) -> Real ByteOff
ByteOff -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ByteOff -> Rational
toRational :: ByteOff -> Rational
Real, ByteOff -> SDoc
(ByteOff -> SDoc) -> Outputable ByteOff
forall a. (a -> SDoc) -> Outputable a
$cppr :: ByteOff -> SDoc
ppr :: ByteOff -> SDoc
Outputable)

newtype WordOff = WordOff Int
    deriving (Int -> WordOff
WordOff -> Int
WordOff -> [WordOff]
WordOff -> WordOff
WordOff -> WordOff -> [WordOff]
WordOff -> WordOff -> WordOff -> [WordOff]
(WordOff -> WordOff)
-> (WordOff -> WordOff)
-> (Int -> WordOff)
-> (WordOff -> Int)
-> (WordOff -> [WordOff])
-> (WordOff -> WordOff -> [WordOff])
-> (WordOff -> WordOff -> [WordOff])
-> (WordOff -> WordOff -> WordOff -> [WordOff])
-> Enum WordOff
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: WordOff -> WordOff
succ :: WordOff -> WordOff
$cpred :: WordOff -> WordOff
pred :: WordOff -> WordOff
$ctoEnum :: Int -> WordOff
toEnum :: Int -> WordOff
$cfromEnum :: WordOff -> Int
fromEnum :: WordOff -> Int
$cenumFrom :: WordOff -> [WordOff]
enumFrom :: WordOff -> [WordOff]
$cenumFromThen :: WordOff -> WordOff -> [WordOff]
enumFromThen :: WordOff -> WordOff -> [WordOff]
$cenumFromTo :: WordOff -> WordOff -> [WordOff]
enumFromTo :: WordOff -> WordOff -> [WordOff]
$cenumFromThenTo :: WordOff -> WordOff -> WordOff -> [WordOff]
enumFromThenTo :: WordOff -> WordOff -> WordOff -> [WordOff]
Enum, WordOff -> WordOff -> Bool
(WordOff -> WordOff -> Bool)
-> (WordOff -> WordOff -> Bool) -> Eq WordOff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WordOff -> WordOff -> Bool
== :: WordOff -> WordOff -> Bool
$c/= :: WordOff -> WordOff -> Bool
/= :: WordOff -> WordOff -> Bool
Eq, Int -> WordOff -> ShowS
[WordOff] -> ShowS
WordOff -> String
(Int -> WordOff -> ShowS)
-> (WordOff -> String) -> ([WordOff] -> ShowS) -> Show WordOff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WordOff -> ShowS
showsPrec :: Int -> WordOff -> ShowS
$cshow :: WordOff -> String
show :: WordOff -> String
$cshowList :: [WordOff] -> ShowS
showList :: [WordOff] -> ShowS
Show, Enum WordOff
Real WordOff
(Real WordOff, Enum WordOff) =>
(WordOff -> WordOff -> WordOff)
-> (WordOff -> WordOff -> WordOff)
-> (WordOff -> WordOff -> WordOff)
-> (WordOff -> WordOff -> WordOff)
-> (WordOff -> WordOff -> (WordOff, WordOff))
-> (WordOff -> WordOff -> (WordOff, WordOff))
-> (WordOff -> Integer)
-> Integral WordOff
WordOff -> Integer
WordOff -> WordOff -> (WordOff, WordOff)
WordOff -> WordOff -> WordOff
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: WordOff -> WordOff -> WordOff
quot :: WordOff -> WordOff -> WordOff
$crem :: WordOff -> WordOff -> WordOff
rem :: WordOff -> WordOff -> WordOff
$cdiv :: WordOff -> WordOff -> WordOff
div :: WordOff -> WordOff -> WordOff
$cmod :: WordOff -> WordOff -> WordOff
mod :: WordOff -> WordOff -> WordOff
$cquotRem :: WordOff -> WordOff -> (WordOff, WordOff)
quotRem :: WordOff -> WordOff -> (WordOff, WordOff)
$cdivMod :: WordOff -> WordOff -> (WordOff, WordOff)
divMod :: WordOff -> WordOff -> (WordOff, WordOff)
$ctoInteger :: WordOff -> Integer
toInteger :: WordOff -> Integer
Integral, Integer -> WordOff
WordOff -> WordOff
WordOff -> WordOff -> WordOff
(WordOff -> WordOff -> WordOff)
-> (WordOff -> WordOff -> WordOff)
-> (WordOff -> WordOff -> WordOff)
-> (WordOff -> WordOff)
-> (WordOff -> WordOff)
-> (WordOff -> WordOff)
-> (Integer -> WordOff)
-> Num WordOff
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: WordOff -> WordOff -> WordOff
+ :: WordOff -> WordOff -> WordOff
$c- :: WordOff -> WordOff -> WordOff
- :: WordOff -> WordOff -> WordOff
$c* :: WordOff -> WordOff -> WordOff
* :: WordOff -> WordOff -> WordOff
$cnegate :: WordOff -> WordOff
negate :: WordOff -> WordOff
$cabs :: WordOff -> WordOff
abs :: WordOff -> WordOff
$csignum :: WordOff -> WordOff
signum :: WordOff -> WordOff
$cfromInteger :: Integer -> WordOff
fromInteger :: Integer -> WordOff
Num, Eq WordOff
Eq WordOff =>
(WordOff -> WordOff -> Ordering)
-> (WordOff -> WordOff -> Bool)
-> (WordOff -> WordOff -> Bool)
-> (WordOff -> WordOff -> Bool)
-> (WordOff -> WordOff -> Bool)
-> (WordOff -> WordOff -> WordOff)
-> (WordOff -> WordOff -> WordOff)
-> Ord WordOff
WordOff -> WordOff -> Bool
WordOff -> WordOff -> Ordering
WordOff -> WordOff -> WordOff
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 :: WordOff -> WordOff -> Ordering
compare :: WordOff -> WordOff -> Ordering
$c< :: WordOff -> WordOff -> Bool
< :: WordOff -> WordOff -> Bool
$c<= :: WordOff -> WordOff -> Bool
<= :: WordOff -> WordOff -> Bool
$c> :: WordOff -> WordOff -> Bool
> :: WordOff -> WordOff -> Bool
$c>= :: WordOff -> WordOff -> Bool
>= :: WordOff -> WordOff -> Bool
$cmax :: WordOff -> WordOff -> WordOff
max :: WordOff -> WordOff -> WordOff
$cmin :: WordOff -> WordOff -> WordOff
min :: WordOff -> WordOff -> WordOff
Ord, Num WordOff
Ord WordOff
(Num WordOff, Ord WordOff) => (WordOff -> Rational) -> Real WordOff
WordOff -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: WordOff -> Rational
toRational :: WordOff -> Rational
Real, WordOff -> SDoc
(WordOff -> SDoc) -> Outputable WordOff
forall a. (a -> SDoc) -> Outputable a
$cppr :: WordOff -> SDoc
ppr :: WordOff -> SDoc
Outputable)

-- A type for values that are half the size of a word on the target
-- platform where the interpreter runs (which may be a different
-- wordsize than the compiler).
newtype HalfWord = HalfWord Word
    deriving (Int -> HalfWord
HalfWord -> Int
HalfWord -> [HalfWord]
HalfWord -> HalfWord
HalfWord -> HalfWord -> [HalfWord]
HalfWord -> HalfWord -> HalfWord -> [HalfWord]
(HalfWord -> HalfWord)
-> (HalfWord -> HalfWord)
-> (Int -> HalfWord)
-> (HalfWord -> Int)
-> (HalfWord -> [HalfWord])
-> (HalfWord -> HalfWord -> [HalfWord])
-> (HalfWord -> HalfWord -> [HalfWord])
-> (HalfWord -> HalfWord -> HalfWord -> [HalfWord])
-> Enum HalfWord
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: HalfWord -> HalfWord
succ :: HalfWord -> HalfWord
$cpred :: HalfWord -> HalfWord
pred :: HalfWord -> HalfWord
$ctoEnum :: Int -> HalfWord
toEnum :: Int -> HalfWord
$cfromEnum :: HalfWord -> Int
fromEnum :: HalfWord -> Int
$cenumFrom :: HalfWord -> [HalfWord]
enumFrom :: HalfWord -> [HalfWord]
$cenumFromThen :: HalfWord -> HalfWord -> [HalfWord]
enumFromThen :: HalfWord -> HalfWord -> [HalfWord]
$cenumFromTo :: HalfWord -> HalfWord -> [HalfWord]
enumFromTo :: HalfWord -> HalfWord -> [HalfWord]
$cenumFromThenTo :: HalfWord -> HalfWord -> HalfWord -> [HalfWord]
enumFromThenTo :: HalfWord -> HalfWord -> HalfWord -> [HalfWord]
Enum, HalfWord -> HalfWord -> Bool
(HalfWord -> HalfWord -> Bool)
-> (HalfWord -> HalfWord -> Bool) -> Eq HalfWord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HalfWord -> HalfWord -> Bool
== :: HalfWord -> HalfWord -> Bool
$c/= :: HalfWord -> HalfWord -> Bool
/= :: HalfWord -> HalfWord -> Bool
Eq, Int -> HalfWord -> ShowS
[HalfWord] -> ShowS
HalfWord -> String
(Int -> HalfWord -> ShowS)
-> (HalfWord -> String) -> ([HalfWord] -> ShowS) -> Show HalfWord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HalfWord -> ShowS
showsPrec :: Int -> HalfWord -> ShowS
$cshow :: HalfWord -> String
show :: HalfWord -> String
$cshowList :: [HalfWord] -> ShowS
showList :: [HalfWord] -> ShowS
Show, Enum HalfWord
Real HalfWord
(Real HalfWord, Enum HalfWord) =>
(HalfWord -> HalfWord -> HalfWord)
-> (HalfWord -> HalfWord -> HalfWord)
-> (HalfWord -> HalfWord -> HalfWord)
-> (HalfWord -> HalfWord -> HalfWord)
-> (HalfWord -> HalfWord -> (HalfWord, HalfWord))
-> (HalfWord -> HalfWord -> (HalfWord, HalfWord))
-> (HalfWord -> Integer)
-> Integral HalfWord
HalfWord -> Integer
HalfWord -> HalfWord -> (HalfWord, HalfWord)
HalfWord -> HalfWord -> HalfWord
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: HalfWord -> HalfWord -> HalfWord
quot :: HalfWord -> HalfWord -> HalfWord
$crem :: HalfWord -> HalfWord -> HalfWord
rem :: HalfWord -> HalfWord -> HalfWord
$cdiv :: HalfWord -> HalfWord -> HalfWord
div :: HalfWord -> HalfWord -> HalfWord
$cmod :: HalfWord -> HalfWord -> HalfWord
mod :: HalfWord -> HalfWord -> HalfWord
$cquotRem :: HalfWord -> HalfWord -> (HalfWord, HalfWord)
quotRem :: HalfWord -> HalfWord -> (HalfWord, HalfWord)
$cdivMod :: HalfWord -> HalfWord -> (HalfWord, HalfWord)
divMod :: HalfWord -> HalfWord -> (HalfWord, HalfWord)
$ctoInteger :: HalfWord -> Integer
toInteger :: HalfWord -> Integer
Integral, Integer -> HalfWord
HalfWord -> HalfWord
HalfWord -> HalfWord -> HalfWord
(HalfWord -> HalfWord -> HalfWord)
-> (HalfWord -> HalfWord -> HalfWord)
-> (HalfWord -> HalfWord -> HalfWord)
-> (HalfWord -> HalfWord)
-> (HalfWord -> HalfWord)
-> (HalfWord -> HalfWord)
-> (Integer -> HalfWord)
-> Num HalfWord
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: HalfWord -> HalfWord -> HalfWord
+ :: HalfWord -> HalfWord -> HalfWord
$c- :: HalfWord -> HalfWord -> HalfWord
- :: HalfWord -> HalfWord -> HalfWord
$c* :: HalfWord -> HalfWord -> HalfWord
* :: HalfWord -> HalfWord -> HalfWord
$cnegate :: HalfWord -> HalfWord
negate :: HalfWord -> HalfWord
$cabs :: HalfWord -> HalfWord
abs :: HalfWord -> HalfWord
$csignum :: HalfWord -> HalfWord
signum :: HalfWord -> HalfWord
$cfromInteger :: Integer -> HalfWord
fromInteger :: Integer -> HalfWord
Num, Eq HalfWord
Eq HalfWord =>
(HalfWord -> HalfWord -> Ordering)
-> (HalfWord -> HalfWord -> Bool)
-> (HalfWord -> HalfWord -> Bool)
-> (HalfWord -> HalfWord -> Bool)
-> (HalfWord -> HalfWord -> Bool)
-> (HalfWord -> HalfWord -> HalfWord)
-> (HalfWord -> HalfWord -> HalfWord)
-> Ord HalfWord
HalfWord -> HalfWord -> Bool
HalfWord -> HalfWord -> Ordering
HalfWord -> HalfWord -> HalfWord
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 :: HalfWord -> HalfWord -> Ordering
compare :: HalfWord -> HalfWord -> Ordering
$c< :: HalfWord -> HalfWord -> Bool
< :: HalfWord -> HalfWord -> Bool
$c<= :: HalfWord -> HalfWord -> Bool
<= :: HalfWord -> HalfWord -> Bool
$c> :: HalfWord -> HalfWord -> Bool
> :: HalfWord -> HalfWord -> Bool
$c>= :: HalfWord -> HalfWord -> Bool
>= :: HalfWord -> HalfWord -> Bool
$cmax :: HalfWord -> HalfWord -> HalfWord
max :: HalfWord -> HalfWord -> HalfWord
$cmin :: HalfWord -> HalfWord -> HalfWord
min :: HalfWord -> HalfWord -> HalfWord
Ord, Num HalfWord
Ord HalfWord
(Num HalfWord, Ord HalfWord) =>
(HalfWord -> Rational) -> Real HalfWord
HalfWord -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: HalfWord -> Rational
toRational :: HalfWord -> Rational
Real, HalfWord -> SDoc
(HalfWord -> SDoc) -> Outputable HalfWord
forall a. (a -> SDoc) -> Outputable a
$cppr :: HalfWord -> SDoc
ppr :: HalfWord -> SDoc
Outputable)

newtype RegBitmap = RegBitmap { RegBitmap -> Word32
unRegBitmap :: Word32 }
    deriving (Int -> RegBitmap
RegBitmap -> Int
RegBitmap -> [RegBitmap]
RegBitmap -> RegBitmap
RegBitmap -> RegBitmap -> [RegBitmap]
RegBitmap -> RegBitmap -> RegBitmap -> [RegBitmap]
(RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap)
-> (Int -> RegBitmap)
-> (RegBitmap -> Int)
-> (RegBitmap -> [RegBitmap])
-> (RegBitmap -> RegBitmap -> [RegBitmap])
-> (RegBitmap -> RegBitmap -> [RegBitmap])
-> (RegBitmap -> RegBitmap -> RegBitmap -> [RegBitmap])
-> Enum RegBitmap
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: RegBitmap -> RegBitmap
succ :: RegBitmap -> RegBitmap
$cpred :: RegBitmap -> RegBitmap
pred :: RegBitmap -> RegBitmap
$ctoEnum :: Int -> RegBitmap
toEnum :: Int -> RegBitmap
$cfromEnum :: RegBitmap -> Int
fromEnum :: RegBitmap -> Int
$cenumFrom :: RegBitmap -> [RegBitmap]
enumFrom :: RegBitmap -> [RegBitmap]
$cenumFromThen :: RegBitmap -> RegBitmap -> [RegBitmap]
enumFromThen :: RegBitmap -> RegBitmap -> [RegBitmap]
$cenumFromTo :: RegBitmap -> RegBitmap -> [RegBitmap]
enumFromTo :: RegBitmap -> RegBitmap -> [RegBitmap]
$cenumFromThenTo :: RegBitmap -> RegBitmap -> RegBitmap -> [RegBitmap]
enumFromThenTo :: RegBitmap -> RegBitmap -> RegBitmap -> [RegBitmap]
Enum, RegBitmap -> RegBitmap -> Bool
(RegBitmap -> RegBitmap -> Bool)
-> (RegBitmap -> RegBitmap -> Bool) -> Eq RegBitmap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegBitmap -> RegBitmap -> Bool
== :: RegBitmap -> RegBitmap -> Bool
$c/= :: RegBitmap -> RegBitmap -> Bool
/= :: RegBitmap -> RegBitmap -> Bool
Eq, Int -> RegBitmap -> ShowS
[RegBitmap] -> ShowS
RegBitmap -> String
(Int -> RegBitmap -> ShowS)
-> (RegBitmap -> String)
-> ([RegBitmap] -> ShowS)
-> Show RegBitmap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegBitmap -> ShowS
showsPrec :: Int -> RegBitmap -> ShowS
$cshow :: RegBitmap -> String
show :: RegBitmap -> String
$cshowList :: [RegBitmap] -> ShowS
showList :: [RegBitmap] -> ShowS
Show, Enum RegBitmap
Real RegBitmap
(Real RegBitmap, Enum RegBitmap) =>
(RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap -> (RegBitmap, RegBitmap))
-> (RegBitmap -> RegBitmap -> (RegBitmap, RegBitmap))
-> (RegBitmap -> Integer)
-> Integral RegBitmap
RegBitmap -> Integer
RegBitmap -> RegBitmap -> (RegBitmap, RegBitmap)
RegBitmap -> RegBitmap -> RegBitmap
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: RegBitmap -> RegBitmap -> RegBitmap
quot :: RegBitmap -> RegBitmap -> RegBitmap
$crem :: RegBitmap -> RegBitmap -> RegBitmap
rem :: RegBitmap -> RegBitmap -> RegBitmap
$cdiv :: RegBitmap -> RegBitmap -> RegBitmap
div :: RegBitmap -> RegBitmap -> RegBitmap
$cmod :: RegBitmap -> RegBitmap -> RegBitmap
mod :: RegBitmap -> RegBitmap -> RegBitmap
$cquotRem :: RegBitmap -> RegBitmap -> (RegBitmap, RegBitmap)
quotRem :: RegBitmap -> RegBitmap -> (RegBitmap, RegBitmap)
$cdivMod :: RegBitmap -> RegBitmap -> (RegBitmap, RegBitmap)
divMod :: RegBitmap -> RegBitmap -> (RegBitmap, RegBitmap)
$ctoInteger :: RegBitmap -> Integer
toInteger :: RegBitmap -> Integer
Integral, Integer -> RegBitmap
RegBitmap -> RegBitmap
RegBitmap -> RegBitmap -> RegBitmap
(RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap)
-> (Integer -> RegBitmap)
-> Num RegBitmap
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: RegBitmap -> RegBitmap -> RegBitmap
+ :: RegBitmap -> RegBitmap -> RegBitmap
$c- :: RegBitmap -> RegBitmap -> RegBitmap
- :: RegBitmap -> RegBitmap -> RegBitmap
$c* :: RegBitmap -> RegBitmap -> RegBitmap
* :: RegBitmap -> RegBitmap -> RegBitmap
$cnegate :: RegBitmap -> RegBitmap
negate :: RegBitmap -> RegBitmap
$cabs :: RegBitmap -> RegBitmap
abs :: RegBitmap -> RegBitmap
$csignum :: RegBitmap -> RegBitmap
signum :: RegBitmap -> RegBitmap
$cfromInteger :: Integer -> RegBitmap
fromInteger :: Integer -> RegBitmap
Num, Eq RegBitmap
Eq RegBitmap =>
(RegBitmap -> RegBitmap -> Ordering)
-> (RegBitmap -> RegBitmap -> Bool)
-> (RegBitmap -> RegBitmap -> Bool)
-> (RegBitmap -> RegBitmap -> Bool)
-> (RegBitmap -> RegBitmap -> Bool)
-> (RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap -> RegBitmap)
-> Ord RegBitmap
RegBitmap -> RegBitmap -> Bool
RegBitmap -> RegBitmap -> Ordering
RegBitmap -> RegBitmap -> RegBitmap
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 :: RegBitmap -> RegBitmap -> Ordering
compare :: RegBitmap -> RegBitmap -> Ordering
$c< :: RegBitmap -> RegBitmap -> Bool
< :: RegBitmap -> RegBitmap -> Bool
$c<= :: RegBitmap -> RegBitmap -> Bool
<= :: RegBitmap -> RegBitmap -> Bool
$c> :: RegBitmap -> RegBitmap -> Bool
> :: RegBitmap -> RegBitmap -> Bool
$c>= :: RegBitmap -> RegBitmap -> Bool
>= :: RegBitmap -> RegBitmap -> Bool
$cmax :: RegBitmap -> RegBitmap -> RegBitmap
max :: RegBitmap -> RegBitmap -> RegBitmap
$cmin :: RegBitmap -> RegBitmap -> RegBitmap
min :: RegBitmap -> RegBitmap -> RegBitmap
Ord, Num RegBitmap
Ord RegBitmap
(Num RegBitmap, Ord RegBitmap) =>
(RegBitmap -> Rational) -> Real RegBitmap
RegBitmap -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: RegBitmap -> Rational
toRational :: RegBitmap -> Rational
Real, Eq RegBitmap
RegBitmap
Eq RegBitmap =>
(RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap -> RegBitmap)
-> (RegBitmap -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> RegBitmap
-> (Int -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int -> Bool)
-> (RegBitmap -> Maybe Int)
-> (RegBitmap -> Int)
-> (RegBitmap -> Bool)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int -> RegBitmap)
-> (RegBitmap -> Int)
-> Bits RegBitmap
Int -> RegBitmap
RegBitmap -> Bool
RegBitmap -> Int
RegBitmap -> Maybe Int
RegBitmap -> RegBitmap
RegBitmap -> Int -> Bool
RegBitmap -> Int -> RegBitmap
RegBitmap -> RegBitmap -> RegBitmap
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
$c.&. :: RegBitmap -> RegBitmap -> RegBitmap
.&. :: RegBitmap -> RegBitmap -> RegBitmap
$c.|. :: RegBitmap -> RegBitmap -> RegBitmap
.|. :: RegBitmap -> RegBitmap -> RegBitmap
$cxor :: RegBitmap -> RegBitmap -> RegBitmap
xor :: RegBitmap -> RegBitmap -> RegBitmap
$ccomplement :: RegBitmap -> RegBitmap
complement :: RegBitmap -> RegBitmap
$cshift :: RegBitmap -> Int -> RegBitmap
shift :: RegBitmap -> Int -> RegBitmap
$crotate :: RegBitmap -> Int -> RegBitmap
rotate :: RegBitmap -> Int -> RegBitmap
$czeroBits :: RegBitmap
zeroBits :: RegBitmap
$cbit :: Int -> RegBitmap
bit :: Int -> RegBitmap
$csetBit :: RegBitmap -> Int -> RegBitmap
setBit :: RegBitmap -> Int -> RegBitmap
$cclearBit :: RegBitmap -> Int -> RegBitmap
clearBit :: RegBitmap -> Int -> RegBitmap
$ccomplementBit :: RegBitmap -> Int -> RegBitmap
complementBit :: RegBitmap -> Int -> RegBitmap
$ctestBit :: RegBitmap -> Int -> Bool
testBit :: RegBitmap -> Int -> Bool
$cbitSizeMaybe :: RegBitmap -> Maybe Int
bitSizeMaybe :: RegBitmap -> Maybe Int
$cbitSize :: RegBitmap -> Int
bitSize :: RegBitmap -> Int
$cisSigned :: RegBitmap -> Bool
isSigned :: RegBitmap -> Bool
$cshiftL :: RegBitmap -> Int -> RegBitmap
shiftL :: RegBitmap -> Int -> RegBitmap
$cunsafeShiftL :: RegBitmap -> Int -> RegBitmap
unsafeShiftL :: RegBitmap -> Int -> RegBitmap
$cshiftR :: RegBitmap -> Int -> RegBitmap
shiftR :: RegBitmap -> Int -> RegBitmap
$cunsafeShiftR :: RegBitmap -> Int -> RegBitmap
unsafeShiftR :: RegBitmap -> Int -> RegBitmap
$crotateL :: RegBitmap -> Int -> RegBitmap
rotateL :: RegBitmap -> Int -> RegBitmap
$crotateR :: RegBitmap -> Int -> RegBitmap
rotateR :: RegBitmap -> Int -> RegBitmap
$cpopCount :: RegBitmap -> Int
popCount :: RegBitmap -> Int
Bits, Bits RegBitmap
Bits RegBitmap =>
(RegBitmap -> Int)
-> (RegBitmap -> Int) -> (RegBitmap -> Int) -> FiniteBits RegBitmap
RegBitmap -> Int
forall b.
Bits b =>
(b -> Int) -> (b -> Int) -> (b -> Int) -> FiniteBits b
$cfiniteBitSize :: RegBitmap -> Int
finiteBitSize :: RegBitmap -> Int
$ccountLeadingZeros :: RegBitmap -> Int
countLeadingZeros :: RegBitmap -> Int
$ccountTrailingZeros :: RegBitmap -> Int
countTrailingZeros :: RegBitmap -> Int
FiniteBits, RegBitmap -> SDoc
(RegBitmap -> SDoc) -> Outputable RegBitmap
forall a. (a -> SDoc) -> Outputable a
$cppr :: RegBitmap -> SDoc
ppr :: RegBitmap -> SDoc
Outputable)

{- Note [GHCi TupleInfo]
~~~~~~~~~~~~~~~~~~~~~~~~
   This contains the data we need for passing unboxed tuples between
   bytecode and native code

   In general we closely follow the native calling convention that
   GHC uses for unboxed tuples, but we don't use any registers in
   bytecode. All tuple elements are expanded to use a full register
   or a full word on the stack.

   The position of tuple elements that are returned on the stack in
   the native calling convention is unchanged when returning the same
   tuple in bytecode.

   The order of the remaining elements is determined by the register in
   which they would have been returned, rather than by their position in
   the tuple in the Haskell source code. This makes jumping between bytecode
   and native code easier: A map of live registers is enough to convert the
   tuple.

   See GHC.StgToByteCode.layoutTuple for more details.
-}

data NativeCallType = NativePrimCall
                    | NativeTupleReturn
  deriving (NativeCallType -> NativeCallType -> Bool
(NativeCallType -> NativeCallType -> Bool)
-> (NativeCallType -> NativeCallType -> Bool) -> Eq NativeCallType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NativeCallType -> NativeCallType -> Bool
== :: NativeCallType -> NativeCallType -> Bool
$c/= :: NativeCallType -> NativeCallType -> Bool
/= :: NativeCallType -> NativeCallType -> Bool
Eq)

data NativeCallInfo = NativeCallInfo
  { NativeCallInfo -> NativeCallType
nativeCallType           :: !NativeCallType
  , NativeCallInfo -> WordOff
nativeCallSize           :: !WordOff   -- total size of arguments in words
  , NativeCallInfo -> GlobalRegSet
nativeCallRegs           :: !GlobalRegSet
  , NativeCallInfo -> WordOff
nativeCallStackSpillSize :: !WordOff {- words spilled on the stack by
                                            GHCs native calling convention -}
  }

instance Outputable NativeCallInfo where
  ppr :: NativeCallInfo -> SDoc
ppr NativeCallInfo{GlobalRegSet
NativeCallType
WordOff
nativeCallType :: NativeCallInfo -> NativeCallType
nativeCallSize :: NativeCallInfo -> WordOff
nativeCallRegs :: NativeCallInfo -> GlobalRegSet
nativeCallStackSpillSize :: NativeCallInfo -> WordOff
nativeCallType :: NativeCallType
nativeCallSize :: WordOff
nativeCallRegs :: GlobalRegSet
nativeCallStackSpillSize :: WordOff
..} = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<arg_size" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
nativeCallSize SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"stack" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> WordOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr WordOff
nativeCallStackSpillSize SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"regs"  SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>
                           [SDoc] -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((GlobalReg -> SDoc) -> [GlobalReg] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (forall doc. IsLine doc => String -> doc
text @SDoc (String -> SDoc) -> (GlobalReg -> String) -> GlobalReg -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalReg -> String
forall a. Show a => a -> String
show) ([GlobalReg] -> [SDoc]) -> [GlobalReg] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ GlobalRegSet -> [GlobalReg]
forall r. RegSet r -> [r]
regSetToList GlobalRegSet
nativeCallRegs) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                           Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'>'


voidTupleReturnInfo :: NativeCallInfo
voidTupleReturnInfo :: NativeCallInfo
voidTupleReturnInfo = NativeCallType
-> WordOff -> GlobalRegSet -> WordOff -> NativeCallInfo
NativeCallInfo NativeCallType
NativeTupleReturn WordOff
0 GlobalRegSet
forall r. RegSet r
emptyRegSet WordOff
0

voidPrimCallInfo :: NativeCallInfo
voidPrimCallInfo :: NativeCallInfo
voidPrimCallInfo = NativeCallType
-> WordOff -> GlobalRegSet -> WordOff -> NativeCallInfo
NativeCallInfo NativeCallType
NativePrimCall WordOff
0 GlobalRegSet
forall r. RegSet r
emptyRegSet WordOff
0

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

newtype ItblPtr = ItblPtr (RemotePtr Heap.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
$cshowsPrec :: Int -> ItblPtr -> ShowS
showsPrec :: Int -> ItblPtr -> ShowS
$cshow :: ItblPtr -> String
show :: ItblPtr -> String
$cshowList :: [ItblPtr] -> ShowS
showList :: [ItblPtr] -> ShowS
Show, ItblPtr -> ()
(ItblPtr -> ()) -> NFData ItblPtr
forall a. (a -> ()) -> NFData a
$crnf :: ItblPtr -> ()
rnf :: ItblPtr -> ()
NFData)
newtype AddrPtr = AddrPtr (RemotePtr ())
  deriving (AddrPtr -> ()
(AddrPtr -> ()) -> NFData AddrPtr
forall a. (a -> ()) -> NFData a
$crnf :: AddrPtr -> ()
rnf :: AddrPtr -> ()
NFData)

{-
--------------------------------------------------------------------------------
-- * Byte Code Objects (BCOs)
--------------------------------------------------------------------------------

Note [Case continuation BCOs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

A stack with a BCO stack frame at the top looks like:

                                      (an StgBCO)
         |       ...        |      +---> +---------[1]--+
         +------------------+      |     | info_tbl_ptr | ------+
         |    OTHER FRAME   |      |     +--------------+       |
         +------------------+      |     | StgArrBytes* | <--- the byte code
         |       ...        |      |     +--------------+       |
         +------------------+      |     |     ...      |       |
         |       fvs1       |      |                            |
         +------------------+      |                            |
         |       ...        |      |        (StgInfoTable)      |
         +------------------+      |           +----------+ <---+
         |      args1       |      |           |    ...   |
         +------------------+      |           +----------+
         |   some StgBCO*   | -----+           | type=BCO |
         +------------------+                  +----------+
      Sp | stg_apply_interp | -----+           |   ...    |
         +------------------+      |
                                   |
                                   |   (StgInfoTable)
                                   +----> +--------------+
                                          |     ...      |
                                          +--------------+
                                          | type=RET_BCO |
                                          +--------------+
                                          |     ...      |


In the case of bytecode objects found on the heap (e.g. thunks and functions),
the bytecode may refer to free variables recorded in the BCO closure itself.
By contrast, in /case continuation/ BCOs the code may additionally refer to free
variables in their stack frame. These are references by way of statically known
stack offsets (tracked using `BCEnv` in `StgToByteCode`).

For instance, consider the function:

    f x y = case y of ... -> g x

Here the RHS of the alternative refers to `x`, which will be recorded in the
continuation stack frame of the `case`.

Even less obvious is that case continuation BCOs may also refer to free
variables in *parent* stack frames. For instance,

    f x y = case y of
      ... -> case g x of
        ... -> x

Here, the RHS of the first alternative still refers to the `x` in the stack
frame of the `case`. Additionally, the RHS of the second alternative also
refers to `x` but it must traverse to its case's *parent* stack frame to find `x`.

However, in /case continuation/ BCOs, the code may additionally refer to free
variables that are outside of that BCO's stack frame -- some free variables of a
case continuation BCO may only be found in the stack frame of a parent BCO.

Yet, references to these out-of-frame variables are also done in terms of stack
offsets. Thus, they rely on the position of /another frame/ to be fixed. (See
Note [PUSH_L underflow] for more information about references to previous
frames and nested BCOs)

This makes case continuation BCOs special: unlike normal BCOs, case cont BCO
frames cannot be moved on the stack independently from their parent BCOs.
-}

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

instance NFData UnlinkedBCO where
  rnf :: UnlinkedBCO -> ()
rnf UnlinkedBCO{Int
BCOByteArray Word
BCOByteArray Word16
Name
FlatBag BCONPtr
FlatBag BCOPtr
unlinkedBCOName :: UnlinkedBCO -> Name
unlinkedBCOArity :: UnlinkedBCO -> Int
unlinkedBCOInstrs :: UnlinkedBCO -> BCOByteArray Word16
unlinkedBCOBitmap :: UnlinkedBCO -> BCOByteArray Word
unlinkedBCOLits :: UnlinkedBCO -> FlatBag BCONPtr
unlinkedBCOPtrs :: UnlinkedBCO -> FlatBag BCOPtr
unlinkedBCOName :: Name
unlinkedBCOArity :: Int
unlinkedBCOInstrs :: BCOByteArray Word16
unlinkedBCOBitmap :: BCOByteArray Word
unlinkedBCOLits :: FlatBag BCONPtr
unlinkedBCOPtrs :: FlatBag BCOPtr
..} =
    FlatBag BCONPtr -> ()
forall a. NFData a => a -> ()
rnf FlatBag BCONPtr
unlinkedBCOLits () -> () -> ()
forall a b. a -> b -> b
`seq`
    FlatBag BCOPtr -> ()
forall a. NFData a => a -> ()
rnf FlatBag BCOPtr
unlinkedBCOPtrs

data BCOPtr
  = BCOPtrName   !Name
  | BCOPtrPrimOp !PrimOp
  | BCOPtrBCO    !UnlinkedBCO
  | BCOPtrBreakArray !Module
    -- ^ Converted to the actual 'BreakArray' remote pointer at link-time

instance NFData BCOPtr where
  rnf :: BCOPtr -> ()
rnf (BCOPtrBCO UnlinkedBCO
bco) = UnlinkedBCO -> ()
forall a. NFData a => a -> ()
rnf UnlinkedBCO
bco
  rnf BCOPtr
x = BCOPtr
x BCOPtr -> () -> ()
forall a b. a -> b -> b
`seq` ()

data BCONPtr
  = BCONPtrWord  {-# UNPACK #-} !Word
  | BCONPtrLbl   !FastString
  | BCONPtrItbl  !Name
  -- | A reference to a top-level string literal; see
  -- Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode.
  | BCONPtrAddr  !Name
  -- | A top-level string literal.
  -- Also see Note [Allocating string literals] in GHC.ByteCode.Asm.
  | BCONPtrStr   !ByteString
  -- | Same as 'BCONPtrStr' but with benefits of 'FastString' interning logic.
  | BCONPtrFS    !FastString
  -- | A libffi ffi_cif function prototype.
  | BCONPtrFFIInfo !FFIInfo
  -- | A 'CostCentre' remote pointer array's respective 'BreakpointId'
  | BCONPtrCostCentre !BreakpointId

instance NFData BCONPtr where
  rnf :: BCONPtr -> ()
rnf BCONPtr
x = BCONPtr
x BCONPtr -> () -> ()
forall a b. a -> b -> b
`seq` ()

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