-- (c) The University of Glasgow 2006
-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
--
-- Storage manager representation of closures

{-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}

module GHC.Runtime.Heap.Layout (
        -- * Words and bytes
        WordOff, ByteOff,
        wordsToBytes, bytesToWordsRoundUp,
        roundUpToWords, roundUpTo,

        StgWord, fromStgWord, toStgWord,
        StgHalfWord, fromStgHalfWord, toStgHalfWord,
        halfWordSize, halfWordSizeInBits,

        -- * Closure representation
        SMRep(..), -- CmmInfo sees the rep; no one else does
        IsStatic,
        ClosureTypeInfo(..), ArgDescr(..), Liveness,
        ConstrDescription,

        -- ** Construction
        mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,
        smallArrPtrsRep, arrWordsRep,

        -- ** Predicates
        isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
        isStackRep,

        -- ** Size-related things
        heapClosureSizeW,
        fixedHdrSizeW, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,
        arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW,
        smallArrPtrsHdrSize, smallArrPtrsHdrSizeW, hdrSize, hdrSizeW,
        fixedHdrSize,

        -- ** RTS closure types
        rtsClosureType, rET_SMALL, rET_BIG,
        aRG_GEN, aRG_GEN_BIG,

        -- ** Arrays
        card, cardRoundUp, cardTableSizeB, cardTableSizeW
    ) where

import GHC.Prelude

import GHC.Types.Basic( ConTagZ )
import GHC.Driver.Session
import GHC.Utils.Outputable
import GHC.Platform
import GHC.Data.FastString
import GHC.StgToCmm.Types

import Data.Word
import Data.Bits
import Data.ByteString (ByteString)

{-
************************************************************************
*                                                                      *
                Words and bytes
*                                                                      *
************************************************************************
-}

-- | Byte offset, or byte count
type ByteOff = Int

-- | Round up the given byte count to the next byte count that's a
-- multiple of the machine's word size.
roundUpToWords :: Platform -> ByteOff -> ByteOff
roundUpToWords :: Platform -> ConTagZ -> ConTagZ
roundUpToWords Platform
platform ConTagZ
n = ConTagZ -> ConTagZ -> ConTagZ
roundUpTo ConTagZ
n (Platform -> ConTagZ
platformWordSizeInBytes Platform
platform)

-- | Round up @base@ to a multiple of @size@.
roundUpTo :: ByteOff -> ByteOff -> ByteOff
roundUpTo :: ConTagZ -> ConTagZ -> ConTagZ
roundUpTo ConTagZ
base ConTagZ
size = (ConTagZ
base ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ (ConTagZ
size ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
- ConTagZ
1)) ConTagZ -> ConTagZ -> ConTagZ
forall a. Bits a => a -> a -> a
.&. (ConTagZ -> ConTagZ
forall a. Bits a => a -> a
complement (ConTagZ
size ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
- ConTagZ
1))

-- | Convert the given number of words to a number of bytes.
--
-- This function morally has type @WordOff -> ByteOff@, but uses @Num
-- a@ to allow for overloading.
wordsToBytes :: Num a => Platform -> a -> a
wordsToBytes :: forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform a
n = ConTagZ -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Platform -> ConTagZ
platformWordSizeInBytes Platform
platform) a -> a -> a
forall a. Num a => a -> a -> a
* a
n
{-# SPECIALIZE wordsToBytes :: Platform -> Int -> Int #-}
{-# SPECIALIZE wordsToBytes :: Platform -> Word -> Word #-}
{-# SPECIALIZE wordsToBytes :: Platform -> Integer -> Integer #-}

-- | First round the given byte count up to a multiple of the
-- machine's word size and then convert the result to words.
bytesToWordsRoundUp :: Platform -> ByteOff -> WordOff
bytesToWordsRoundUp :: Platform -> ConTagZ -> ConTagZ
bytesToWordsRoundUp Platform
platform ConTagZ
n = (ConTagZ
n ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
word_size ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
- ConTagZ
1) ConTagZ -> ConTagZ -> ConTagZ
forall a. Integral a => a -> a -> a
`quot` ConTagZ
word_size
 where word_size :: ConTagZ
word_size = Platform -> ConTagZ
platformWordSizeInBytes Platform
platform
-- StgWord is a type representing an StgWord on the target platform.
-- A Word64 is large enough to hold a Word for either a 32bit or 64bit platform
newtype StgWord = StgWord Word64
    deriving (StgWord -> StgWord -> Bool
(StgWord -> StgWord -> Bool)
-> (StgWord -> StgWord -> Bool) -> Eq StgWord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StgWord -> StgWord -> Bool
$c/= :: StgWord -> StgWord -> Bool
== :: StgWord -> StgWord -> Bool
$c== :: StgWord -> StgWord -> Bool
Eq, Eq StgWord
StgWord
Eq StgWord
-> (StgWord -> StgWord -> StgWord)
-> (StgWord -> StgWord -> StgWord)
-> (StgWord -> StgWord -> StgWord)
-> (StgWord -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> StgWord
-> (ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> Bool)
-> (StgWord -> Maybe ConTagZ)
-> (StgWord -> ConTagZ)
-> (StgWord -> Bool)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ -> StgWord)
-> (StgWord -> ConTagZ)
-> Bits StgWord
ConTagZ -> StgWord
StgWord -> Bool
StgWord -> ConTagZ
StgWord -> Maybe ConTagZ
StgWord -> StgWord
StgWord -> ConTagZ -> Bool
StgWord -> ConTagZ -> StgWord
StgWord -> StgWord -> StgWord
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ -> a)
-> a
-> (ConTagZ -> a)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ -> Bool)
-> (a -> Maybe ConTagZ)
-> (a -> ConTagZ)
-> (a -> Bool)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ -> a)
-> (a -> ConTagZ)
-> Bits a
popCount :: StgWord -> ConTagZ
$cpopCount :: StgWord -> ConTagZ
rotateR :: StgWord -> ConTagZ -> StgWord
$crotateR :: StgWord -> ConTagZ -> StgWord
rotateL :: StgWord -> ConTagZ -> StgWord
$crotateL :: StgWord -> ConTagZ -> StgWord
unsafeShiftR :: StgWord -> ConTagZ -> StgWord
$cunsafeShiftR :: StgWord -> ConTagZ -> StgWord
shiftR :: StgWord -> ConTagZ -> StgWord
$cshiftR :: StgWord -> ConTagZ -> StgWord
unsafeShiftL :: StgWord -> ConTagZ -> StgWord
$cunsafeShiftL :: StgWord -> ConTagZ -> StgWord
shiftL :: StgWord -> ConTagZ -> StgWord
$cshiftL :: StgWord -> ConTagZ -> StgWord
isSigned :: StgWord -> Bool
$cisSigned :: StgWord -> Bool
bitSize :: StgWord -> ConTagZ
$cbitSize :: StgWord -> ConTagZ
bitSizeMaybe :: StgWord -> Maybe ConTagZ
$cbitSizeMaybe :: StgWord -> Maybe ConTagZ
testBit :: StgWord -> ConTagZ -> Bool
$ctestBit :: StgWord -> ConTagZ -> Bool
complementBit :: StgWord -> ConTagZ -> StgWord
$ccomplementBit :: StgWord -> ConTagZ -> StgWord
clearBit :: StgWord -> ConTagZ -> StgWord
$cclearBit :: StgWord -> ConTagZ -> StgWord
setBit :: StgWord -> ConTagZ -> StgWord
$csetBit :: StgWord -> ConTagZ -> StgWord
bit :: ConTagZ -> StgWord
$cbit :: ConTagZ -> StgWord
zeroBits :: StgWord
$czeroBits :: StgWord
rotate :: StgWord -> ConTagZ -> StgWord
$crotate :: StgWord -> ConTagZ -> StgWord
shift :: StgWord -> ConTagZ -> StgWord
$cshift :: StgWord -> ConTagZ -> StgWord
complement :: StgWord -> StgWord
$ccomplement :: StgWord -> StgWord
xor :: StgWord -> StgWord -> StgWord
$cxor :: StgWord -> StgWord -> StgWord
.|. :: StgWord -> StgWord -> StgWord
$c.|. :: StgWord -> StgWord -> StgWord
.&. :: StgWord -> StgWord -> StgWord
$c.&. :: StgWord -> StgWord -> StgWord
Bits)

fromStgWord :: StgWord -> Integer
fromStgWord :: StgWord -> Integer
fromStgWord (StgWord Word64
i) = Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
i

toStgWord :: Platform -> Integer -> StgWord
toStgWord :: Platform -> Integer -> StgWord
toStgWord Platform
platform Integer
i
    = case Platform -> PlatformWordSize
platformWordSize Platform
platform of
      -- These conversions mean that things like toStgWord (-1)
      -- do the right thing
      PlatformWordSize
PW4 -> Word64 -> StgWord
StgWord (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
i :: Word32))
      PlatformWordSize
PW8 -> Word64 -> StgWord
StgWord (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
i)

instance Outputable StgWord where
    ppr :: StgWord -> SDoc
ppr (StgWord Word64
i) = Integer -> SDoc
integer (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
i)

--

-- A Word32 is large enough to hold half a Word for either a 32bit or
-- 64bit platform
newtype StgHalfWord = StgHalfWord Word32
    deriving StgHalfWord -> StgHalfWord -> Bool
(StgHalfWord -> StgHalfWord -> Bool)
-> (StgHalfWord -> StgHalfWord -> Bool) -> Eq StgHalfWord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StgHalfWord -> StgHalfWord -> Bool
$c/= :: StgHalfWord -> StgHalfWord -> Bool
== :: StgHalfWord -> StgHalfWord -> Bool
$c== :: StgHalfWord -> StgHalfWord -> Bool
Eq

fromStgHalfWord :: StgHalfWord -> Integer
fromStgHalfWord :: StgHalfWord -> Integer
fromStgHalfWord (StgHalfWord Word32
w) = Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
w

toStgHalfWord :: Platform -> Integer -> StgHalfWord
toStgHalfWord :: Platform -> Integer -> StgHalfWord
toStgHalfWord Platform
platform Integer
i
    = case Platform -> PlatformWordSize
platformWordSize Platform
platform of
      -- These conversions mean that things like toStgHalfWord (-1)
      -- do the right thing
      PlatformWordSize
PW4 -> Word32 -> StgHalfWord
StgHalfWord (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a. Num a => Integer -> a
fromInteger Integer
i :: Word16))
      PlatformWordSize
PW8 -> Word32 -> StgHalfWord
StgHalfWord (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
i :: Word32)

instance Outputable StgHalfWord where
    ppr :: StgHalfWord -> SDoc
ppr (StgHalfWord Word32
w) = Integer -> SDoc
integer (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
w)

-- | Half word size in bytes
halfWordSize :: Platform -> ByteOff
halfWordSize :: Platform -> ConTagZ
halfWordSize Platform
platform = Platform -> ConTagZ
platformWordSizeInBytes Platform
platform ConTagZ -> ConTagZ -> ConTagZ
forall a. Integral a => a -> a -> a
`div` ConTagZ
2

halfWordSizeInBits :: Platform -> Int
halfWordSizeInBits :: Platform -> ConTagZ
halfWordSizeInBits Platform
platform = Platform -> ConTagZ
platformWordSizeInBits Platform
platform ConTagZ -> ConTagZ -> ConTagZ
forall a. Integral a => a -> a -> a
`div` ConTagZ
2

{-
************************************************************************
*                                                                      *
\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
*                                                                      *
************************************************************************
-}

-- | A description of the layout of a closure.  Corresponds directly
-- to the closure types in includes\/rts\/storage\/ClosureTypes.h.
data SMRep
  = HeapRep              -- GC routines consult sizes in info tbl
        IsStatic
        !WordOff         --  # ptr words
        !WordOff         --  # non-ptr words INCLUDING SLOP (see mkHeapRep below)
        ClosureTypeInfo  -- type-specific info

  | ArrayPtrsRep
        !WordOff        -- # ptr words
        !WordOff        -- # card table words

  | SmallArrayPtrsRep
        !WordOff        -- # ptr words

  | ArrayWordsRep
        !WordOff        -- # bytes expressed in words, rounded up

  | StackRep            -- Stack frame (RET_SMALL or RET_BIG)
        Liveness

  | RTSRep              -- The RTS needs to declare info tables with specific
        Int             -- type tags, so this form lets us override the default
        SMRep           -- tag for an SMRep.

-- | True \<=> This is a static closure.  Affects how we garbage-collect it.
-- Static closure have an extra static link field at the end.
-- Constructors do not have a static variant; see Note [static constructors]
type IsStatic = Bool

-- From an SMRep you can get to the closure type defined in
-- includes/rts/storage/ClosureTypes.h. Described by the function
-- rtsClosureType below.

data ClosureTypeInfo
  = Constr        ConTagZ ConstrDescription
  | Fun           FunArity ArgDescr
  | Thunk
  | ThunkSelector SelectorOffset
  | BlackHole
  | IndStatic

type ConstrDescription = ByteString -- result of dataConIdentity
type FunArity          = Int
type SelectorOffset    = Int

-----------------------------------------------------------------------------
-- Construction

mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
          -> SMRep
mkHeapRep :: DynFlags -> Bool -> ConTagZ -> ConTagZ -> ClosureTypeInfo -> SMRep
mkHeapRep DynFlags
dflags Bool
is_static ConTagZ
ptr_wds ConTagZ
nonptr_wds ClosureTypeInfo
cl_type_info
  = Bool -> ConTagZ -> ConTagZ -> ClosureTypeInfo -> SMRep
HeapRep Bool
is_static
            ConTagZ
ptr_wds
            (ConTagZ
nonptr_wds ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
slop_wds)
            ClosureTypeInfo
cl_type_info
  where
     slop_wds :: ConTagZ
slop_wds
      | Bool
is_static = ConTagZ
0
      | Bool
otherwise = ConTagZ -> ConTagZ -> ConTagZ
forall a. Ord a => a -> a -> a
max ConTagZ
0 (DynFlags -> ConTagZ
minClosureSize DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
- (ConTagZ
hdr_size ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
payload_size))

     hdr_size :: ConTagZ
hdr_size     = DynFlags -> ClosureTypeInfo -> ConTagZ
closureTypeHdrSize DynFlags
dflags ClosureTypeInfo
cl_type_info
     payload_size :: ConTagZ
payload_size = ConTagZ
ptr_wds ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
nonptr_wds

mkRTSRep :: Int -> SMRep -> SMRep
mkRTSRep :: ConTagZ -> SMRep -> SMRep
mkRTSRep = ConTagZ -> SMRep -> SMRep
RTSRep

mkStackRep :: [Bool] -> SMRep
mkStackRep :: [Bool] -> SMRep
mkStackRep [Bool]
liveness = [Bool] -> SMRep
StackRep [Bool]
liveness

blackHoleRep :: SMRep
blackHoleRep :: SMRep
blackHoleRep = Bool -> ConTagZ -> ConTagZ -> ClosureTypeInfo -> SMRep
HeapRep Bool
False ConTagZ
0 ConTagZ
0 ClosureTypeInfo
BlackHole

indStaticRep :: SMRep
indStaticRep :: SMRep
indStaticRep = Bool -> ConTagZ -> ConTagZ -> ClosureTypeInfo -> SMRep
HeapRep Bool
True ConTagZ
1 ConTagZ
0 ClosureTypeInfo
IndStatic

arrPtrsRep :: DynFlags -> WordOff -> SMRep
arrPtrsRep :: DynFlags -> ConTagZ -> SMRep
arrPtrsRep DynFlags
dflags ConTagZ
elems = ConTagZ -> ConTagZ -> SMRep
ArrayPtrsRep ConTagZ
elems (DynFlags -> ConTagZ -> ConTagZ
cardTableSizeW DynFlags
dflags ConTagZ
elems)

smallArrPtrsRep :: WordOff -> SMRep
smallArrPtrsRep :: ConTagZ -> SMRep
smallArrPtrsRep ConTagZ
elems = ConTagZ -> SMRep
SmallArrayPtrsRep ConTagZ
elems

arrWordsRep :: Platform -> ByteOff -> SMRep
arrWordsRep :: Platform -> ConTagZ -> SMRep
arrWordsRep Platform
platform ConTagZ
bytes = ConTagZ -> SMRep
ArrayWordsRep (Platform -> ConTagZ -> ConTagZ
bytesToWordsRoundUp Platform
platform ConTagZ
bytes)

-----------------------------------------------------------------------------
-- Predicates

isStaticRep :: SMRep -> IsStatic
isStaticRep :: SMRep -> Bool
isStaticRep (HeapRep Bool
is_static ConTagZ
_ ConTagZ
_ ClosureTypeInfo
_) = Bool
is_static
isStaticRep (RTSRep ConTagZ
_ SMRep
rep)            = SMRep -> Bool
isStaticRep SMRep
rep
isStaticRep SMRep
_                         = Bool
False

isStackRep :: SMRep -> Bool
isStackRep :: SMRep -> Bool
isStackRep StackRep{}     = Bool
True
isStackRep (RTSRep ConTagZ
_ SMRep
rep) = SMRep -> Bool
isStackRep SMRep
rep
isStackRep SMRep
_              = Bool
False

isConRep :: SMRep -> Bool
isConRep :: SMRep -> Bool
isConRep (HeapRep Bool
_ ConTagZ
_ ConTagZ
_ Constr{}) = Bool
True
isConRep SMRep
_                        = Bool
False

isThunkRep :: SMRep -> Bool
isThunkRep :: SMRep -> Bool
isThunkRep (HeapRep Bool
_ ConTagZ
_ ConTagZ
_ ClosureTypeInfo
Thunk)           = Bool
True
isThunkRep (HeapRep Bool
_ ConTagZ
_ ConTagZ
_ ThunkSelector{}) = Bool
True
isThunkRep (HeapRep Bool
_ ConTagZ
_ ConTagZ
_ ClosureTypeInfo
BlackHole)       = Bool
True
isThunkRep (HeapRep Bool
_ ConTagZ
_ ConTagZ
_ ClosureTypeInfo
IndStatic)       = Bool
True
isThunkRep SMRep
_                               = Bool
False

isFunRep :: SMRep -> Bool
isFunRep :: SMRep -> Bool
isFunRep (HeapRep Bool
_ ConTagZ
_ ConTagZ
_ Fun{}) = Bool
True
isFunRep SMRep
_                     = Bool
False

isStaticNoCafCon :: SMRep -> Bool
-- This should line up exactly with CONSTR_NOCAF below
-- See Note [Static NoCaf constructors]
isStaticNoCafCon :: SMRep -> Bool
isStaticNoCafCon (HeapRep Bool
_ ConTagZ
0 ConTagZ
_ Constr{}) = Bool
True
isStaticNoCafCon SMRep
_                        = Bool
False


-----------------------------------------------------------------------------
-- Size-related things

fixedHdrSize :: DynFlags -> ByteOff
fixedHdrSize :: DynFlags -> ConTagZ
fixedHdrSize DynFlags
dflags = Platform -> ConTagZ -> ConTagZ
forall a. Num a => Platform -> a -> a
wordsToBytes (DynFlags -> Platform
targetPlatform DynFlags
dflags) (DynFlags -> ConTagZ
fixedHdrSizeW DynFlags
dflags)

-- | Size of a closure header (StgHeader in includes\/rts\/storage\/Closures.h)
fixedHdrSizeW :: DynFlags -> WordOff
fixedHdrSizeW :: DynFlags -> ConTagZ
fixedHdrSizeW DynFlags
dflags = DynFlags -> ConTagZ
sTD_HDR_SIZE DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ DynFlags -> ConTagZ
profHdrSize DynFlags
dflags

-- | Size of the profiling part of a closure header
-- (StgProfHeader in includes\/rts\/storage\/Closures.h)
profHdrSize  :: DynFlags -> WordOff
profHdrSize :: DynFlags -> ConTagZ
profHdrSize DynFlags
dflags
 | DynFlags -> Bool
sccProfilingEnabled DynFlags
dflags = DynFlags -> ConTagZ
pROF_HDR_SIZE DynFlags
dflags
 | Bool
otherwise                  = ConTagZ
0

-- | The garbage collector requires that every closure is at least as
--   big as this.
minClosureSize :: DynFlags -> WordOff
minClosureSize :: DynFlags -> ConTagZ
minClosureSize DynFlags
dflags = DynFlags -> ConTagZ
fixedHdrSizeW DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ DynFlags -> ConTagZ
mIN_PAYLOAD_SIZE DynFlags
dflags

arrWordsHdrSize :: DynFlags -> ByteOff
arrWordsHdrSize :: DynFlags -> ConTagZ
arrWordsHdrSize DynFlags
dflags
 = DynFlags -> ConTagZ
fixedHdrSize DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ DynFlags -> ConTagZ
sIZEOF_StgArrBytes_NoHdr DynFlags
dflags

arrWordsHdrSizeW :: DynFlags -> WordOff
arrWordsHdrSizeW :: DynFlags -> ConTagZ
arrWordsHdrSizeW DynFlags
dflags =
    DynFlags -> ConTagZ
fixedHdrSizeW DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+
    (DynFlags -> ConTagZ
sIZEOF_StgArrBytes_NoHdr DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Integral a => a -> a -> a
`quot`
      Platform -> ConTagZ
platformWordSizeInBytes (DynFlags -> Platform
targetPlatform DynFlags
dflags))

arrPtrsHdrSize :: DynFlags -> ByteOff
arrPtrsHdrSize :: DynFlags -> ConTagZ
arrPtrsHdrSize DynFlags
dflags
 = DynFlags -> ConTagZ
fixedHdrSize DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ DynFlags -> ConTagZ
sIZEOF_StgMutArrPtrs_NoHdr DynFlags
dflags

arrPtrsHdrSizeW :: DynFlags -> WordOff
arrPtrsHdrSizeW :: DynFlags -> ConTagZ
arrPtrsHdrSizeW DynFlags
dflags =
    DynFlags -> ConTagZ
fixedHdrSizeW DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+
    (DynFlags -> ConTagZ
sIZEOF_StgMutArrPtrs_NoHdr DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Integral a => a -> a -> a
`quot`
      Platform -> ConTagZ
platformWordSizeInBytes (DynFlags -> Platform
targetPlatform DynFlags
dflags))

smallArrPtrsHdrSize :: DynFlags -> ByteOff
smallArrPtrsHdrSize :: DynFlags -> ConTagZ
smallArrPtrsHdrSize DynFlags
dflags
 = DynFlags -> ConTagZ
fixedHdrSize DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ DynFlags -> ConTagZ
sIZEOF_StgSmallMutArrPtrs_NoHdr DynFlags
dflags

smallArrPtrsHdrSizeW :: DynFlags -> WordOff
smallArrPtrsHdrSizeW :: DynFlags -> ConTagZ
smallArrPtrsHdrSizeW DynFlags
dflags =
    DynFlags -> ConTagZ
fixedHdrSizeW DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+
    (DynFlags -> ConTagZ
sIZEOF_StgSmallMutArrPtrs_NoHdr DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Integral a => a -> a -> a
`quot`
      Platform -> ConTagZ
platformWordSizeInBytes (DynFlags -> Platform
targetPlatform DynFlags
dflags))

-- Thunks have an extra header word on SMP, so the update doesn't
-- splat the payload.
thunkHdrSize :: DynFlags -> WordOff
thunkHdrSize :: DynFlags -> ConTagZ
thunkHdrSize DynFlags
dflags = DynFlags -> ConTagZ
fixedHdrSizeW DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
smp_hdr
        where smp_hdr :: ConTagZ
smp_hdr = DynFlags -> ConTagZ
sIZEOF_StgSMPThunkHeader DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Integral a => a -> a -> a
`quot`
                         Platform -> ConTagZ
platformWordSizeInBytes (DynFlags -> Platform
targetPlatform DynFlags
dflags)

hdrSize :: DynFlags -> SMRep -> ByteOff
hdrSize :: DynFlags -> SMRep -> ConTagZ
hdrSize DynFlags
dflags SMRep
rep = Platform -> ConTagZ -> ConTagZ
forall a. Num a => Platform -> a -> a
wordsToBytes (DynFlags -> Platform
targetPlatform DynFlags
dflags) (DynFlags -> SMRep -> ConTagZ
hdrSizeW DynFlags
dflags SMRep
rep)

hdrSizeW :: DynFlags -> SMRep -> WordOff
hdrSizeW :: DynFlags -> SMRep -> ConTagZ
hdrSizeW DynFlags
dflags (HeapRep Bool
_ ConTagZ
_ ConTagZ
_ ClosureTypeInfo
ty)    = DynFlags -> ClosureTypeInfo -> ConTagZ
closureTypeHdrSize DynFlags
dflags ClosureTypeInfo
ty
hdrSizeW DynFlags
dflags (ArrayPtrsRep ConTagZ
_ ConTagZ
_)    = DynFlags -> ConTagZ
arrPtrsHdrSizeW DynFlags
dflags
hdrSizeW DynFlags
dflags (SmallArrayPtrsRep ConTagZ
_) = DynFlags -> ConTagZ
smallArrPtrsHdrSizeW DynFlags
dflags
hdrSizeW DynFlags
dflags (ArrayWordsRep ConTagZ
_)     = DynFlags -> ConTagZ
arrWordsHdrSizeW DynFlags
dflags
hdrSizeW DynFlags
_ SMRep
_                          = String -> ConTagZ
forall a. String -> a
panic String
"SMRep.hdrSizeW"

nonHdrSize :: Platform -> SMRep -> ByteOff
nonHdrSize :: Platform -> SMRep -> ConTagZ
nonHdrSize Platform
platform SMRep
rep = Platform -> ConTagZ -> ConTagZ
forall a. Num a => Platform -> a -> a
wordsToBytes Platform
platform (SMRep -> ConTagZ
nonHdrSizeW SMRep
rep)

nonHdrSizeW :: SMRep -> WordOff
nonHdrSizeW :: SMRep -> ConTagZ
nonHdrSizeW (HeapRep Bool
_ ConTagZ
p ConTagZ
np ClosureTypeInfo
_) = ConTagZ
p ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
np
nonHdrSizeW (ArrayPtrsRep ConTagZ
elems ConTagZ
ct) = ConTagZ
elems ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
ct
nonHdrSizeW (SmallArrayPtrsRep ConTagZ
elems) = ConTagZ
elems
nonHdrSizeW (ArrayWordsRep ConTagZ
words) = ConTagZ
words
nonHdrSizeW (StackRep [Bool]
bs)      = [Bool] -> ConTagZ
forall (t :: * -> *) a. Foldable t => t a -> ConTagZ
length [Bool]
bs
nonHdrSizeW (RTSRep ConTagZ
_ SMRep
rep)     = SMRep -> ConTagZ
nonHdrSizeW SMRep
rep

-- | The total size of the closure, in words.
heapClosureSizeW :: DynFlags -> SMRep -> WordOff
heapClosureSizeW :: DynFlags -> SMRep -> ConTagZ
heapClosureSizeW DynFlags
dflags (HeapRep Bool
_ ConTagZ
p ConTagZ
np ClosureTypeInfo
ty)
 = DynFlags -> ClosureTypeInfo -> ConTagZ
closureTypeHdrSize DynFlags
dflags ClosureTypeInfo
ty ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
p ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
np
heapClosureSizeW DynFlags
dflags (ArrayPtrsRep ConTagZ
elems ConTagZ
ct)
 = DynFlags -> ConTagZ
arrPtrsHdrSizeW DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
elems ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
ct
heapClosureSizeW DynFlags
dflags (SmallArrayPtrsRep ConTagZ
elems)
 = DynFlags -> ConTagZ
smallArrPtrsHdrSizeW DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
elems
heapClosureSizeW DynFlags
dflags (ArrayWordsRep ConTagZ
words)
 = DynFlags -> ConTagZ
arrWordsHdrSizeW DynFlags
dflags ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ConTagZ
words
heapClosureSizeW DynFlags
_ SMRep
_ = String -> ConTagZ
forall a. String -> a
panic String
"SMRep.heapClosureSize"

closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> ConTagZ
closureTypeHdrSize DynFlags
dflags ClosureTypeInfo
ty = case ClosureTypeInfo
ty of
                  ClosureTypeInfo
Thunk           -> DynFlags -> ConTagZ
thunkHdrSize DynFlags
dflags
                  ThunkSelector{} -> DynFlags -> ConTagZ
thunkHdrSize DynFlags
dflags
                  ClosureTypeInfo
BlackHole       -> DynFlags -> ConTagZ
thunkHdrSize DynFlags
dflags
                  ClosureTypeInfo
IndStatic       -> DynFlags -> ConTagZ
thunkHdrSize DynFlags
dflags
                  ClosureTypeInfo
_               -> DynFlags -> ConTagZ
fixedHdrSizeW DynFlags
dflags
        -- All thunks use thunkHdrSize, even if they are non-updatable.
        -- this is because we don't have separate closure types for
        -- updatable vs. non-updatable thunks, so the GC can't tell the
        -- difference.  If we ever have significant numbers of non-
        -- updatable thunks, it might be worth fixing this.

-- ---------------------------------------------------------------------------
-- Arrays

-- | The byte offset into the card table of the card for a given element
card :: DynFlags -> Int -> Int
card :: DynFlags -> ConTagZ -> ConTagZ
card DynFlags
dflags ConTagZ
i = ConTagZ
i ConTagZ -> ConTagZ -> ConTagZ
forall a. Bits a => a -> ConTagZ -> a
`shiftR` DynFlags -> ConTagZ
mUT_ARR_PTRS_CARD_BITS DynFlags
dflags

-- | Convert a number of elements to a number of cards, rounding up
cardRoundUp :: DynFlags -> Int -> Int
cardRoundUp :: DynFlags -> ConTagZ -> ConTagZ
cardRoundUp DynFlags
dflags ConTagZ
i =
  DynFlags -> ConTagZ -> ConTagZ
card DynFlags
dflags (ConTagZ
i ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
+ ((ConTagZ
1 ConTagZ -> ConTagZ -> ConTagZ
forall a. Bits a => a -> ConTagZ -> a
`shiftL` DynFlags -> ConTagZ
mUT_ARR_PTRS_CARD_BITS DynFlags
dflags) ConTagZ -> ConTagZ -> ConTagZ
forall a. Num a => a -> a -> a
- ConTagZ
1))

-- | The size of a card table, in bytes
cardTableSizeB :: DynFlags -> Int -> ByteOff
cardTableSizeB :: DynFlags -> ConTagZ -> ConTagZ
cardTableSizeB DynFlags
dflags ConTagZ
elems = DynFlags -> ConTagZ -> ConTagZ
cardRoundUp DynFlags
dflags ConTagZ
elems

-- | The size of a card table, in words
cardTableSizeW :: DynFlags -> Int -> WordOff
cardTableSizeW :: DynFlags -> ConTagZ -> ConTagZ
cardTableSizeW DynFlags
dflags ConTagZ
elems =
  Platform -> ConTagZ -> ConTagZ
bytesToWordsRoundUp (DynFlags -> Platform
targetPlatform DynFlags
dflags)
                      (DynFlags -> ConTagZ -> ConTagZ
cardTableSizeB DynFlags
dflags ConTagZ
elems)

-----------------------------------------------------------------------------
-- deriving the RTS closure type from an SMRep

#include "../includes/rts/storage/ClosureTypes.h"
#include "../includes/rts/storage/FunTypes.h"
-- Defines CONSTR, CONSTR_1_0 etc

-- | Derives the RTS closure type from an 'SMRep'
rtsClosureType :: SMRep -> Int
rtsClosureType :: SMRep -> ConTagZ
rtsClosureType SMRep
rep
    = case SMRep
rep of
      RTSRep ConTagZ
ty SMRep
_ -> ConTagZ
ty

      -- See Note [static constructors]
      HeapRep Bool
_     ConTagZ
1 ConTagZ
0 Constr{} -> CONSTR_1_0
      HeapRep Bool
_     ConTagZ
0 ConTagZ
1 Constr{} -> CONSTR_0_1
      HeapRep Bool
_     ConTagZ
2 ConTagZ
0 Constr{} -> CONSTR_2_0
      HeapRep Bool
_     ConTagZ
1 ConTagZ
1 Constr{} -> CONSTR_1_1
      HeapRep Bool
_     ConTagZ
0 ConTagZ
2 Constr{} -> CONSTR_0_2
      HeapRep Bool
_     ConTagZ
0 ConTagZ
_ Constr{} -> CONSTR_NOCAF
           -- See Note [Static NoCaf constructors]
      HeapRep Bool
_     ConTagZ
_ ConTagZ
_ Constr{} -> CONSTR

      HeapRep Bool
False ConTagZ
1 ConTagZ
0 Fun{} -> FUN_1_0
      HeapRep Bool
False ConTagZ
0 ConTagZ
1 Fun{} -> FUN_0_1
      HeapRep Bool
False ConTagZ
2 ConTagZ
0 Fun{} -> FUN_2_0
      HeapRep Bool
False ConTagZ
1 ConTagZ
1 Fun{} -> FUN_1_1
      HeapRep Bool
False ConTagZ
0 ConTagZ
2 Fun{} -> FUN_0_2
      HeapRep Bool
False ConTagZ
_ ConTagZ
_ Fun{} -> FUN

      HeapRep Bool
False ConTagZ
1 ConTagZ
0 ClosureTypeInfo
Thunk -> THUNK_1_0
      HeapRep Bool
False ConTagZ
0 ConTagZ
1 ClosureTypeInfo
Thunk -> THUNK_0_1
      HeapRep Bool
False ConTagZ
2 ConTagZ
0 ClosureTypeInfo
Thunk -> THUNK_2_0
      HeapRep Bool
False ConTagZ
1 ConTagZ
1 ClosureTypeInfo
Thunk -> THUNK_1_1
      HeapRep Bool
False ConTagZ
0 ConTagZ
2 ClosureTypeInfo
Thunk -> THUNK_0_2
      HeapRep Bool
False ConTagZ
_ ConTagZ
_ ClosureTypeInfo
Thunk -> THUNK

      HeapRep Bool
False ConTagZ
_ ConTagZ
_ ThunkSelector{} ->  THUNK_SELECTOR

      HeapRep Bool
True ConTagZ
_ ConTagZ
_ Fun{}      -> FUN_STATIC
      HeapRep Bool
True ConTagZ
_ ConTagZ
_ ClosureTypeInfo
Thunk      -> THUNK_STATIC
      HeapRep Bool
False ConTagZ
_ ConTagZ
_ ClosureTypeInfo
BlackHole -> BLACKHOLE
      HeapRep Bool
False ConTagZ
_ ConTagZ
_ ClosureTypeInfo
IndStatic -> IND_STATIC

      SMRep
_ -> String -> ConTagZ
forall a. String -> a
panic String
"rtsClosureType"

-- We export these ones
rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: Int
rET_SMALL :: ConTagZ
rET_SMALL   = RET_SMALL
rET_BIG :: ConTagZ
rET_BIG     = RET_BIG
aRG_GEN :: ConTagZ
aRG_GEN     = ARG_GEN
aRG_GEN_BIG :: ConTagZ
aRG_GEN_BIG = ARG_GEN_BIG

{-
Note [static constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~

We used to have a CONSTR_STATIC closure type, and each constructor had
two info tables: one with CONSTR (or CONSTR_1_0 etc.), and one with
CONSTR_STATIC.

This distinction was removed, because when copying a data structure
into a compact region, we must copy static constructors into the
compact region too.  If we didn't do this, we would need to track the
references from the compact region out to the static constructors,
because they might (indirectly) refer to CAFs.

Since static constructors will be copied to the heap, if we wanted to
use different info tables for static and dynamic constructors, we
would have to switch the info pointer when copying the constructor
into the compact region, which means we would need an extra field of
the static info table to point to the dynamic one.

However, since the distinction between static and dynamic closure
types is never actually needed (other than for assertions), we can
just drop the distinction and use the same info table for both.

The GC *does* need to distinguish between static and dynamic closures,
but it does this using the HEAP_ALLOCED() macro which checks whether
the address of the closure resides within the dynamic heap.
HEAP_ALLOCED() doesn't read the closure's info table.

Note [Static NoCaf constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
reachable from 'x'), then a statically allocated constructor (Just x)
is also not Caffy, and the garbage collector need not follow its
argument fields.  Exploiting this would require two static info tables
for Just, for the two cases where the argument was Caffy or non-Caffy.

Currently we don't do this; instead we treat nullary constructors
as non-Caffy, and the others as potentially Caffy.


************************************************************************
*                                                                      *
             Pretty printing of SMRep and friends
*                                                                      *
************************************************************************
-}

instance Outputable ClosureTypeInfo where
   ppr :: ClosureTypeInfo -> SDoc
ppr = ClosureTypeInfo -> SDoc
pprTypeInfo

instance Outputable SMRep where
   ppr :: SMRep -> SDoc
ppr (HeapRep Bool
static ConTagZ
ps ConTagZ
nps ClosureTypeInfo
tyinfo)
     = SDoc -> ConTagZ -> SDoc -> SDoc
hang (SDoc
header SDoc -> SDoc -> SDoc
<+> SDoc
lbrace) ConTagZ
2 (ClosureTypeInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr ClosureTypeInfo
tyinfo SDoc -> SDoc -> SDoc
<+> SDoc
rbrace)
     where
       header :: SDoc
header = String -> SDoc
text String
"HeapRep"
                SDoc -> SDoc -> SDoc
<+> if Bool
static then String -> SDoc
text String
"static" else SDoc
empty
                SDoc -> SDoc -> SDoc
<+> String -> ConTagZ -> SDoc
pp_n String
"ptrs" ConTagZ
ps SDoc -> SDoc -> SDoc
<+> String -> ConTagZ -> SDoc
pp_n String
"nonptrs" ConTagZ
nps
       pp_n :: String -> Int -> SDoc
       pp_n :: String -> ConTagZ -> SDoc
pp_n String
_ ConTagZ
0 = SDoc
empty
       pp_n String
s ConTagZ
n = ConTagZ -> SDoc
int ConTagZ
n SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
s

   ppr (ArrayPtrsRep ConTagZ
size ConTagZ
_) = String -> SDoc
text String
"ArrayPtrsRep" SDoc -> SDoc -> SDoc
<+> ConTagZ -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConTagZ
size

   ppr (SmallArrayPtrsRep ConTagZ
size) = String -> SDoc
text String
"SmallArrayPtrsRep" SDoc -> SDoc -> SDoc
<+> ConTagZ -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConTagZ
size

   ppr (ArrayWordsRep ConTagZ
words) = String -> SDoc
text String
"ArrayWordsRep" SDoc -> SDoc -> SDoc
<+> ConTagZ -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConTagZ
words

   ppr (StackRep [Bool]
bs) = String -> SDoc
text String
"StackRep" SDoc -> SDoc -> SDoc
<+> [Bool] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Bool]
bs

   ppr (RTSRep ConTagZ
ty SMRep
rep) = String -> SDoc
text String
"tag:" SDoc -> SDoc -> SDoc
<> ConTagZ -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConTagZ
ty SDoc -> SDoc -> SDoc
<+> SMRep -> SDoc
forall a. Outputable a => a -> SDoc
ppr SMRep
rep

pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr ConTagZ
tag ConstrDescription
descr)
  = String -> SDoc
text String
"Con" SDoc -> SDoc -> SDoc
<+>
    SDoc -> SDoc
braces ([SDoc] -> SDoc
sep [ String -> SDoc
text String
"tag:" SDoc -> SDoc -> SDoc
<+> ConTagZ -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConTagZ
tag
                , String -> SDoc
text String
"descr:" SDoc -> SDoc -> SDoc
<> String -> SDoc
text (ConstrDescription -> String
forall a. Show a => a -> String
show ConstrDescription
descr) ])

pprTypeInfo (Fun ConTagZ
arity ArgDescr
args)
  = String -> SDoc
text String
"Fun" SDoc -> SDoc -> SDoc
<+>
    SDoc -> SDoc
braces ([SDoc] -> SDoc
sep [ String -> SDoc
text String
"arity:" SDoc -> SDoc -> SDoc
<+> ConTagZ -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConTagZ
arity
                , PtrString -> SDoc
ptext (String -> PtrString
sLit (String
"fun_type:")) SDoc -> SDoc -> SDoc
<+> ArgDescr -> SDoc
forall a. Outputable a => a -> SDoc
ppr ArgDescr
args ])

pprTypeInfo (ThunkSelector ConTagZ
offset)
  = String -> SDoc
text String
"ThunkSel" SDoc -> SDoc -> SDoc
<+> ConTagZ -> SDoc
forall a. Outputable a => a -> SDoc
ppr ConTagZ
offset

pprTypeInfo ClosureTypeInfo
Thunk     = String -> SDoc
text String
"Thunk"
pprTypeInfo ClosureTypeInfo
BlackHole = String -> SDoc
text String
"BlackHole"
pprTypeInfo ClosureTypeInfo
IndStatic = String -> SDoc
text String
"IndStatic"