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

{-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}

module SMRep (
        -- * Words and bytes
        WordOff, ByteOff,
        wordsToBytes, bytesToWordsRoundUp,
        roundUpToWords, roundUpTo,

        StgWord, fromStgWord, toStgWord,
        StgHalfWord, fromStgHalfWord, toStgHalfWord,
        hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,

        -- * Closure repesentation
        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,

        -- * Operations over [Word8] strings that don't belong here
        pprWord8String, stringToWord8s
    ) where

import GhcPrelude

import BasicTypes( ConTagZ )
import DynFlags
import Outputable
import Platform
import FastString

import Data.Char( ord )
import Data.Word
import Data.Bits

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

-- | Word offset, or word count
type WordOff = Int

-- | 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 :: DynFlags -> ByteOff -> ByteOff
roundUpToWords :: DynFlags -> ByteOff -> ByteOff
roundUpToWords dflags :: DynFlags
dflags n :: ByteOff
n = ByteOff -> ByteOff -> ByteOff
roundUpTo ByteOff
n (DynFlags -> ByteOff
wORD_SIZE DynFlags
dflags)

-- | Round up @base@ to a multiple of @size@.
roundUpTo :: ByteOff -> ByteOff -> ByteOff
roundUpTo :: ByteOff -> ByteOff -> ByteOff
roundUpTo base :: ByteOff
base size :: ByteOff
size = (ByteOff
base ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+ (ByteOff
size ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
- 1)) ByteOff -> ByteOff -> ByteOff
forall a. Bits a => a -> a -> a
.&. (ByteOff -> ByteOff
forall a. Bits a => a -> a
complement (ByteOff
size ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
- 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 => DynFlags -> a -> a
wordsToBytes :: DynFlags -> a -> a
wordsToBytes dflags :: DynFlags
dflags n :: a
n = ByteOff -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DynFlags -> ByteOff
wORD_SIZE DynFlags
dflags) a -> a -> a
forall a. Num a => a -> a -> a
* a
n
{-# SPECIALIZE wordsToBytes :: DynFlags -> Int -> Int #-}
{-# SPECIALIZE wordsToBytes :: DynFlags -> Word -> Word #-}
{-# SPECIALIZE wordsToBytes :: DynFlags -> 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 :: DynFlags -> ByteOff -> WordOff
bytesToWordsRoundUp :: DynFlags -> ByteOff -> ByteOff
bytesToWordsRoundUp dflags :: DynFlags
dflags n :: ByteOff
n = (ByteOff
n ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+ ByteOff
word_size ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
- 1) ByteOff -> ByteOff -> ByteOff
forall a. Integral a => a -> a -> a
`quot` ByteOff
word_size
 where word_size :: ByteOff
word_size = DynFlags -> ByteOff
wORD_SIZE DynFlags
dflags
-- 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 -> ByteOff -> StgWord)
-> (StgWord -> ByteOff -> StgWord)
-> StgWord
-> (ByteOff -> StgWord)
-> (StgWord -> ByteOff -> StgWord)
-> (StgWord -> ByteOff -> StgWord)
-> (StgWord -> ByteOff -> StgWord)
-> (StgWord -> ByteOff -> Bool)
-> (StgWord -> Maybe ByteOff)
-> (StgWord -> ByteOff)
-> (StgWord -> Bool)
-> (StgWord -> ByteOff -> StgWord)
-> (StgWord -> ByteOff -> StgWord)
-> (StgWord -> ByteOff -> StgWord)
-> (StgWord -> ByteOff -> StgWord)
-> (StgWord -> ByteOff -> StgWord)
-> (StgWord -> ByteOff -> StgWord)
-> (StgWord -> ByteOff)
-> Bits StgWord
ByteOff -> StgWord
StgWord -> Bool
StgWord -> ByteOff
StgWord -> Maybe ByteOff
StgWord -> StgWord
StgWord -> ByteOff -> Bool
StgWord -> ByteOff -> StgWord
StgWord -> StgWord -> StgWord
forall a.
Eq a =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> ByteOff -> a)
-> (a -> ByteOff -> a)
-> a
-> (ByteOff -> a)
-> (a -> ByteOff -> a)
-> (a -> ByteOff -> a)
-> (a -> ByteOff -> a)
-> (a -> ByteOff -> Bool)
-> (a -> Maybe ByteOff)
-> (a -> ByteOff)
-> (a -> Bool)
-> (a -> ByteOff -> a)
-> (a -> ByteOff -> a)
-> (a -> ByteOff -> a)
-> (a -> ByteOff -> a)
-> (a -> ByteOff -> a)
-> (a -> ByteOff -> a)
-> (a -> ByteOff)
-> Bits a
popCount :: StgWord -> ByteOff
$cpopCount :: StgWord -> ByteOff
rotateR :: StgWord -> ByteOff -> StgWord
$crotateR :: StgWord -> ByteOff -> StgWord
rotateL :: StgWord -> ByteOff -> StgWord
$crotateL :: StgWord -> ByteOff -> StgWord
unsafeShiftR :: StgWord -> ByteOff -> StgWord
$cunsafeShiftR :: StgWord -> ByteOff -> StgWord
shiftR :: StgWord -> ByteOff -> StgWord
$cshiftR :: StgWord -> ByteOff -> StgWord
unsafeShiftL :: StgWord -> ByteOff -> StgWord
$cunsafeShiftL :: StgWord -> ByteOff -> StgWord
shiftL :: StgWord -> ByteOff -> StgWord
$cshiftL :: StgWord -> ByteOff -> StgWord
isSigned :: StgWord -> Bool
$cisSigned :: StgWord -> Bool
bitSize :: StgWord -> ByteOff
$cbitSize :: StgWord -> ByteOff
bitSizeMaybe :: StgWord -> Maybe ByteOff
$cbitSizeMaybe :: StgWord -> Maybe ByteOff
testBit :: StgWord -> ByteOff -> Bool
$ctestBit :: StgWord -> ByteOff -> Bool
complementBit :: StgWord -> ByteOff -> StgWord
$ccomplementBit :: StgWord -> ByteOff -> StgWord
clearBit :: StgWord -> ByteOff -> StgWord
$cclearBit :: StgWord -> ByteOff -> StgWord
setBit :: StgWord -> ByteOff -> StgWord
$csetBit :: StgWord -> ByteOff -> StgWord
bit :: ByteOff -> StgWord
$cbit :: ByteOff -> StgWord
zeroBits :: StgWord
$czeroBits :: StgWord
rotate :: StgWord -> ByteOff -> StgWord
$crotate :: StgWord -> ByteOff -> StgWord
shift :: StgWord -> ByteOff -> StgWord
$cshift :: StgWord -> ByteOff -> 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
$cp1Bits :: Eq StgWord
Bits)

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

toStgWord :: DynFlags -> Integer -> StgWord
toStgWord :: DynFlags -> Integer -> StgWord
toStgWord dflags :: DynFlags
dflags i :: Integer
i
    = case Platform -> ByteOff
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
      -- These conversions mean that things like toStgWord (-1)
      -- do the right thing
      4 -> 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))
      8 -> Word64 -> StgWord
StgWord (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
i :: Word64)
      w :: ByteOff
w -> String -> StgWord
forall a. String -> a
panic ("toStgWord: Unknown platformWordSize: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteOff -> String
forall a. Show a => a -> String
show ByteOff
w)

instance Outputable StgWord where
    ppr :: StgWord -> SDoc
ppr (StgWord i :: 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 w :: Word32
w) = Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
w

toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
toStgHalfWord dflags :: DynFlags
dflags i :: Integer
i
    = case Platform -> ByteOff
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
      -- These conversions mean that things like toStgHalfWord (-1)
      -- do the right thing
      4 -> 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))
      8 -> Word32 -> StgHalfWord
StgHalfWord (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
i :: Word32)
      w :: ByteOff
w -> String -> StgHalfWord
forall a. String -> a
panic ("toStgHalfWord: Unknown platformWordSize: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteOff -> String
forall a. Show a => a -> String
show ByteOff
w)

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

hALF_WORD_SIZE :: DynFlags -> ByteOff
hALF_WORD_SIZE :: DynFlags -> ByteOff
hALF_WORD_SIZE dflags :: DynFlags
dflags = Platform -> ByteOff
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) ByteOff -> ByteOff -> ByteOff
forall a. Bits a => a -> ByteOff -> a
`shiftR` 1
hALF_WORD_SIZE_IN_BITS :: DynFlags -> Int
hALF_WORD_SIZE_IN_BITS :: DynFlags -> ByteOff
hALF_WORD_SIZE_IN_BITS dflags :: DynFlags
dflags = Platform -> ByteOff
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) ByteOff -> ByteOff -> ByteOff
forall a. Bits a => a -> ByteOff -> a
`shiftL` 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 = [Word8] -- result of dataConIdentity
type FunArity          = Int
type SelectorOffset    = Int

-------------------------
-- We represent liveness bitmaps as a Bitmap (whose internal
-- representation really is a bitmap).  These are pinned onto case return
-- vectors to indicate the state of the stack for the garbage collector.
--
-- In the compiled program, liveness bitmaps that fit inside a single
-- word (StgWord) are stored as a single word, while larger bitmaps are
-- stored as a pointer to an array of words.

type Liveness = [Bool]   -- One Bool per word; True  <=> non-ptr or dead
                         --                    False <=> ptr

-------------------------
-- An ArgDescr describes the argument pattern of a function

data ArgDescr
  = ArgSpec             -- Fits one of the standard patterns
        !Int            -- RTS type identifier ARG_P, ARG_N, ...

  | ArgGen              -- General case
        Liveness        -- Details about the arguments


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

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

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

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

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

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

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

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

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

arrWordsRep :: DynFlags -> ByteOff -> SMRep
arrWordsRep :: DynFlags -> ByteOff -> SMRep
arrWordsRep dflags :: DynFlags
dflags bytes :: ByteOff
bytes = ByteOff -> SMRep
ArrayWordsRep (DynFlags -> ByteOff -> ByteOff
bytesToWordsRoundUp DynFlags
dflags ByteOff
bytes)

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

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

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

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

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

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

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


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

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

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

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

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

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

arrWordsHdrSizeW :: DynFlags -> WordOff
arrWordsHdrSizeW :: DynFlags -> ByteOff
arrWordsHdrSizeW dflags :: DynFlags
dflags =
    DynFlags -> ByteOff
fixedHdrSizeW DynFlags
dflags ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+
    (DynFlags -> ByteOff
sIZEOF_StgArrBytes_NoHdr DynFlags
dflags ByteOff -> ByteOff -> ByteOff
forall a. Integral a => a -> a -> a
`quot` DynFlags -> ByteOff
wORD_SIZE DynFlags
dflags)

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

arrPtrsHdrSizeW :: DynFlags -> WordOff
arrPtrsHdrSizeW :: DynFlags -> ByteOff
arrPtrsHdrSizeW dflags :: DynFlags
dflags =
    DynFlags -> ByteOff
fixedHdrSizeW DynFlags
dflags ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+
    (DynFlags -> ByteOff
sIZEOF_StgMutArrPtrs_NoHdr DynFlags
dflags ByteOff -> ByteOff -> ByteOff
forall a. Integral a => a -> a -> a
`quot` DynFlags -> ByteOff
wORD_SIZE DynFlags
dflags)

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

smallArrPtrsHdrSizeW :: DynFlags -> WordOff
smallArrPtrsHdrSizeW :: DynFlags -> ByteOff
smallArrPtrsHdrSizeW dflags :: DynFlags
dflags =
    DynFlags -> ByteOff
fixedHdrSizeW DynFlags
dflags ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+
    (DynFlags -> ByteOff
sIZEOF_StgSmallMutArrPtrs_NoHdr DynFlags
dflags ByteOff -> ByteOff -> ByteOff
forall a. Integral a => a -> a -> a
`quot` DynFlags -> ByteOff
wORD_SIZE DynFlags
dflags)

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

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

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

nonHdrSize :: DynFlags -> SMRep -> ByteOff
nonHdrSize :: DynFlags -> SMRep -> ByteOff
nonHdrSize dflags :: DynFlags
dflags rep :: SMRep
rep = DynFlags -> ByteOff -> ByteOff
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (SMRep -> ByteOff
nonHdrSizeW SMRep
rep)

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

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

closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> ByteOff
closureTypeHdrSize dflags :: DynFlags
dflags ty :: ClosureTypeInfo
ty = case ClosureTypeInfo
ty of
                  Thunk           -> DynFlags -> ByteOff
thunkHdrSize DynFlags
dflags
                  ThunkSelector{} -> DynFlags -> ByteOff
thunkHdrSize DynFlags
dflags
                  BlackHole       -> DynFlags -> ByteOff
thunkHdrSize DynFlags
dflags
                  IndStatic       -> DynFlags -> ByteOff
thunkHdrSize DynFlags
dflags
                  _               -> DynFlags -> ByteOff
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 -> ByteOff -> ByteOff
card dflags :: DynFlags
dflags i :: ByteOff
i = ByteOff
i ByteOff -> ByteOff -> ByteOff
forall a. Bits a => a -> ByteOff -> a
`shiftR` DynFlags -> ByteOff
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 -> ByteOff -> ByteOff
cardRoundUp dflags :: DynFlags
dflags i :: ByteOff
i =
  DynFlags -> ByteOff -> ByteOff
card DynFlags
dflags (ByteOff
i ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+ ((1 ByteOff -> ByteOff -> ByteOff
forall a. Bits a => a -> ByteOff -> a
`shiftL` DynFlags -> ByteOff
mUT_ARR_PTRS_CARD_BITS DynFlags
dflags) ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
- 1))

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

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

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

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

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

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

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

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

      HeapRep False _ _ ThunkSelector{} ->  THUNK_SELECTOR

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

      _ -> String -> ByteOff
forall a. String -> a
panic "rtsClosureType"

-- We export these ones
rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: Int
rET_SMALL :: ByteOff
rET_SMALL   = RET_SMALL
rET_BIG :: ByteOff
rET_BIG     = RET_BIG
aRG_GEN :: ByteOff
aRG_GEN     = ARG_GEN
aRG_GEN_BIG :: ByteOff
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 static :: Bool
static ps :: ByteOff
ps nps :: ByteOff
nps tyinfo :: ClosureTypeInfo
tyinfo)
     = SDoc -> ByteOff -> SDoc -> SDoc
hang (SDoc
header SDoc -> SDoc -> SDoc
<+> SDoc
lbrace) 2 (ClosureTypeInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr ClosureTypeInfo
tyinfo SDoc -> SDoc -> SDoc
<+> SDoc
rbrace)
     where
       header :: SDoc
header = String -> SDoc
text "HeapRep"
                SDoc -> SDoc -> SDoc
<+> if Bool
static then String -> SDoc
text "static" else SDoc
empty
                SDoc -> SDoc -> SDoc
<+> String -> ByteOff -> SDoc
pp_n "ptrs" ByteOff
ps SDoc -> SDoc -> SDoc
<+> String -> ByteOff -> SDoc
pp_n "nonptrs" ByteOff
nps
       pp_n :: String -> Int -> SDoc
       pp_n :: String -> ByteOff -> SDoc
pp_n _ 0 = SDoc
empty
       pp_n s :: String
s n :: ByteOff
n = ByteOff -> SDoc
int ByteOff
n SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
s

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

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

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

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

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

instance Outputable ArgDescr where
  ppr :: ArgDescr -> SDoc
ppr (ArgSpec n :: ByteOff
n) = String -> SDoc
text "ArgSpec" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
n
  ppr (ArgGen ls :: [Bool]
ls) = String -> SDoc
text "ArgGen" SDoc -> SDoc -> SDoc
<+> [Bool] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Bool]
ls

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

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

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

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

-- XXX Does not belong here!!
stringToWord8s :: String -> [Word8]
stringToWord8s :: String -> ConstrDescription
stringToWord8s s :: String
s = (Char -> Word8) -> String -> ConstrDescription
forall a b. (a -> b) -> [a] -> [b]
map (ByteOff -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteOff -> Word8) -> (Char -> ByteOff) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteOff
ord) String
s

pprWord8String :: [Word8] -> SDoc
-- Debug printing.  Not very clever right now.
pprWord8String :: ConstrDescription -> SDoc
pprWord8String ws :: ConstrDescription
ws = String -> SDoc
text (ConstrDescription -> String
forall a. Show a => a -> String
show ConstrDescription
ws)