{-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}
module SMRep (
WordOff, ByteOff,
wordsToBytes, bytesToWordsRoundUp,
roundUpToWords, roundUpTo,
StgWord, fromStgWord, toStgWord,
StgHalfWord, fromStgHalfWord, toStgHalfWord,
halfWordSize, halfWordSizeInBits,
SMRep(..),
IsStatic,
ClosureTypeInfo(..), ArgDescr(..), Liveness,
ConstrDescription,
mkHeapRep, blackHoleRep, indStaticRep, mkStackRep, mkRTSRep, arrPtrsRep,
smallArrPtrsRep, arrWordsRep,
isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
isStackRep,
heapClosureSizeW,
fixedHdrSizeW, arrWordsHdrSize, arrWordsHdrSizeW, arrPtrsHdrSize,
arrPtrsHdrSizeW, profHdrSize, thunkHdrSize, nonHdrSize, nonHdrSizeW,
smallArrPtrsHdrSize, smallArrPtrsHdrSizeW, hdrSize, hdrSizeW,
fixedHdrSize,
rtsClosureType, rET_SMALL, rET_BIG,
aRG_GEN, aRG_GEN_BIG,
card, cardRoundUp, cardTableSizeB, cardTableSizeW
) where
import GhcPrelude
import BasicTypes( ConTagZ )
import DynFlags
import Outputable
import GHC.Platform
import FastString
import Data.Word
import Data.Bits
import Data.ByteString (ByteString)
type WordOff = Int
type ByteOff = Int
roundUpToWords :: DynFlags -> ByteOff -> ByteOff
roundUpToWords :: DynFlags -> ByteOff -> ByteOff
roundUpToWords DynFlags
dflags ByteOff
n = ByteOff -> ByteOff -> ByteOff
roundUpTo ByteOff
n (DynFlags -> ByteOff
wORD_SIZE DynFlags
dflags)
roundUpTo :: ByteOff -> ByteOff -> ByteOff
roundUpTo :: ByteOff -> ByteOff -> ByteOff
roundUpTo ByteOff
base 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
- ByteOff
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
- ByteOff
1))
wordsToBytes :: Num a => DynFlags -> a -> a
wordsToBytes :: DynFlags -> a -> a
wordsToBytes DynFlags
dflags 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 #-}
bytesToWordsRoundUp :: DynFlags -> ByteOff -> WordOff
bytesToWordsRoundUp :: DynFlags -> ByteOff -> ByteOff
bytesToWordsRoundUp DynFlags
dflags 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
- ByteOff
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
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 Word64
i) = Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
i
toStgWord :: DynFlags -> Integer -> StgWord
toStgWord :: DynFlags -> Integer -> StgWord
toStgWord DynFlags
dflags Integer
i
= case Platform -> PlatformWordSize
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
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)
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 :: DynFlags -> Integer -> StgHalfWord
toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
toStgHalfWord DynFlags
dflags Integer
i
= case Platform -> PlatformWordSize
platformWordSize (DynFlags -> Platform
targetPlatform DynFlags
dflags) of
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)
halfWordSize :: DynFlags -> ByteOff
halfWordSize :: DynFlags -> ByteOff
halfWordSize DynFlags
dflags = Platform -> ByteOff
platformWordSizeInBytes (DynFlags -> Platform
targetPlatform DynFlags
dflags) ByteOff -> ByteOff -> ByteOff
forall a. Integral a => a -> a -> a
`div` ByteOff
2
halfWordSizeInBits :: DynFlags -> Int
halfWordSizeInBits :: DynFlags -> ByteOff
halfWordSizeInBits DynFlags
dflags = Platform -> ByteOff
platformWordSizeInBits (DynFlags -> Platform
targetPlatform DynFlags
dflags) ByteOff -> ByteOff -> ByteOff
forall a. Integral a => a -> a -> a
`div` ByteOff
2
data SMRep
= HeapRep
IsStatic
!WordOff
!WordOff
ClosureTypeInfo
| ArrayPtrsRep
!WordOff
!WordOff
| SmallArrayPtrsRep
!WordOff
| ArrayWordsRep
!WordOff
| StackRep
Liveness
| RTSRep
Int
SMRep
type IsStatic = Bool
data ClosureTypeInfo
= Constr ConTagZ ConstrDescription
| Fun FunArity ArgDescr
| Thunk
| ThunkSelector SelectorOffset
| BlackHole
| IndStatic
type ConstrDescription = ByteString
type FunArity = Int
type SelectorOffset = Int
type Liveness = [Bool]
data ArgDescr
= ArgSpec
!Int
| ArgGen
Liveness
mkHeapRep :: DynFlags -> IsStatic -> WordOff -> WordOff -> ClosureTypeInfo
-> SMRep
mkHeapRep :: DynFlags -> Bool -> ByteOff -> ByteOff -> ClosureTypeInfo -> SMRep
mkHeapRep DynFlags
dflags Bool
is_static ByteOff
ptr_wds ByteOff
nonptr_wds 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 = ByteOff
0
| Bool
otherwise = ByteOff -> ByteOff -> ByteOff
forall a. Ord a => a -> a -> a
max ByteOff
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 [Bool]
liveness = [Bool] -> SMRep
StackRep [Bool]
liveness
blackHoleRep :: SMRep
blackHoleRep :: SMRep
blackHoleRep = Bool -> ByteOff -> ByteOff -> ClosureTypeInfo -> SMRep
HeapRep Bool
False ByteOff
0 ByteOff
0 ClosureTypeInfo
BlackHole
indStaticRep :: SMRep
indStaticRep :: SMRep
indStaticRep = Bool -> ByteOff -> ByteOff -> ClosureTypeInfo -> SMRep
HeapRep Bool
True ByteOff
1 ByteOff
0 ClosureTypeInfo
IndStatic
arrPtrsRep :: DynFlags -> WordOff -> SMRep
arrPtrsRep :: DynFlags -> ByteOff -> SMRep
arrPtrsRep DynFlags
dflags ByteOff
elems = ByteOff -> ByteOff -> SMRep
ArrayPtrsRep ByteOff
elems (DynFlags -> ByteOff -> ByteOff
cardTableSizeW DynFlags
dflags ByteOff
elems)
smallArrPtrsRep :: WordOff -> SMRep
smallArrPtrsRep :: ByteOff -> SMRep
smallArrPtrsRep ByteOff
elems = ByteOff -> SMRep
SmallArrayPtrsRep ByteOff
elems
arrWordsRep :: DynFlags -> ByteOff -> SMRep
arrWordsRep :: DynFlags -> ByteOff -> SMRep
arrWordsRep DynFlags
dflags ByteOff
bytes = ByteOff -> SMRep
ArrayWordsRep (DynFlags -> ByteOff -> ByteOff
bytesToWordsRoundUp DynFlags
dflags ByteOff
bytes)
isStaticRep :: SMRep -> IsStatic
isStaticRep :: SMRep -> Bool
isStaticRep (HeapRep Bool
is_static ByteOff
_ ByteOff
_ ClosureTypeInfo
_) = Bool
is_static
isStaticRep (RTSRep ByteOff
_ SMRep
rep) = SMRep -> Bool
isStaticRep SMRep
rep
isStaticRep SMRep
_ = Bool
False
isStackRep :: SMRep -> Bool
isStackRep :: SMRep -> Bool
isStackRep StackRep{} = Bool
True
isStackRep (RTSRep ByteOff
_ SMRep
rep) = SMRep -> Bool
isStackRep SMRep
rep
isStackRep SMRep
_ = Bool
False
isConRep :: SMRep -> Bool
isConRep :: SMRep -> Bool
isConRep (HeapRep Bool
_ ByteOff
_ ByteOff
_ Constr{}) = Bool
True
isConRep SMRep
_ = Bool
False
isThunkRep :: SMRep -> Bool
isThunkRep :: SMRep -> Bool
isThunkRep (HeapRep Bool
_ ByteOff
_ ByteOff
_ ClosureTypeInfo
Thunk) = Bool
True
isThunkRep (HeapRep Bool
_ ByteOff
_ ByteOff
_ ThunkSelector{}) = Bool
True
isThunkRep (HeapRep Bool
_ ByteOff
_ ByteOff
_ ClosureTypeInfo
BlackHole) = Bool
True
isThunkRep (HeapRep Bool
_ ByteOff
_ ByteOff
_ ClosureTypeInfo
IndStatic) = Bool
True
isThunkRep SMRep
_ = Bool
False
isFunRep :: SMRep -> Bool
isFunRep :: SMRep -> Bool
isFunRep (HeapRep Bool
_ ByteOff
_ ByteOff
_ Fun{}) = Bool
True
isFunRep SMRep
_ = Bool
False
isStaticNoCafCon :: SMRep -> Bool
isStaticNoCafCon :: SMRep -> Bool
isStaticNoCafCon (HeapRep Bool
_ ByteOff
0 ByteOff
_ Constr{}) = Bool
True
isStaticNoCafCon SMRep
_ = Bool
False
fixedHdrSize :: DynFlags -> ByteOff
fixedHdrSize :: DynFlags -> ByteOff
fixedHdrSize DynFlags
dflags = DynFlags -> ByteOff -> ByteOff
forall a. Num a => DynFlags -> a -> a
wordsToBytes DynFlags
dflags (DynFlags -> ByteOff
fixedHdrSizeW DynFlags
dflags)
fixedHdrSizeW :: DynFlags -> WordOff
fixedHdrSizeW :: DynFlags -> ByteOff
fixedHdrSizeW DynFlags
dflags = DynFlags -> ByteOff
sTD_HDR_SIZE DynFlags
dflags ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+ DynFlags -> ByteOff
profHdrSize DynFlags
dflags
profHdrSize :: DynFlags -> WordOff
profHdrSize :: DynFlags -> ByteOff
profHdrSize DynFlags
dflags
| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SccProfilingOn DynFlags
dflags = DynFlags -> ByteOff
pROF_HDR_SIZE DynFlags
dflags
| Bool
otherwise = ByteOff
0
minClosureSize :: DynFlags -> WordOff
minClosureSize :: DynFlags -> ByteOff
minClosureSize 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 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 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 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 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 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 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)
thunkHdrSize :: DynFlags -> WordOff
thunkHdrSize :: DynFlags -> ByteOff
thunkHdrSize 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 DynFlags
dflags 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 DynFlags
dflags (HeapRep Bool
_ ByteOff
_ ByteOff
_ ClosureTypeInfo
ty) = DynFlags -> ClosureTypeInfo -> ByteOff
closureTypeHdrSize DynFlags
dflags ClosureTypeInfo
ty
hdrSizeW DynFlags
dflags (ArrayPtrsRep ByteOff
_ ByteOff
_) = DynFlags -> ByteOff
arrPtrsHdrSizeW DynFlags
dflags
hdrSizeW DynFlags
dflags (SmallArrayPtrsRep ByteOff
_) = DynFlags -> ByteOff
smallArrPtrsHdrSizeW DynFlags
dflags
hdrSizeW DynFlags
dflags (ArrayWordsRep ByteOff
_) = DynFlags -> ByteOff
arrWordsHdrSizeW DynFlags
dflags
hdrSizeW DynFlags
_ SMRep
_ = String -> ByteOff
forall a. String -> a
panic String
"SMRep.hdrSizeW"
nonHdrSize :: DynFlags -> SMRep -> ByteOff
nonHdrSize :: DynFlags -> SMRep -> ByteOff
nonHdrSize DynFlags
dflags 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 Bool
_ ByteOff
p ByteOff
np ClosureTypeInfo
_) = ByteOff
p ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+ ByteOff
np
nonHdrSizeW (ArrayPtrsRep ByteOff
elems ByteOff
ct) = ByteOff
elems ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+ ByteOff
ct
nonHdrSizeW (SmallArrayPtrsRep ByteOff
elems) = ByteOff
elems
nonHdrSizeW (ArrayWordsRep ByteOff
words) = ByteOff
words
nonHdrSizeW (StackRep [Bool]
bs) = [Bool] -> ByteOff
forall (t :: * -> *) a. Foldable t => t a -> ByteOff
length [Bool]
bs
nonHdrSizeW (RTSRep ByteOff
_ SMRep
rep) = SMRep -> ByteOff
nonHdrSizeW SMRep
rep
heapClosureSizeW :: DynFlags -> SMRep -> WordOff
heapClosureSizeW :: DynFlags -> SMRep -> ByteOff
heapClosureSizeW DynFlags
dflags (HeapRep Bool
_ ByteOff
p ByteOff
np 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 DynFlags
dflags (ArrayPtrsRep ByteOff
elems 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 DynFlags
dflags (SmallArrayPtrsRep ByteOff
elems)
= DynFlags -> ByteOff
smallArrPtrsHdrSizeW DynFlags
dflags ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+ ByteOff
elems
heapClosureSizeW DynFlags
dflags (ArrayWordsRep ByteOff
words)
= DynFlags -> ByteOff
arrWordsHdrSizeW DynFlags
dflags ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+ ByteOff
words
heapClosureSizeW DynFlags
_ SMRep
_ = String -> ByteOff
forall a. String -> a
panic String
"SMRep.heapClosureSize"
closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> WordOff
closureTypeHdrSize :: DynFlags -> ClosureTypeInfo -> ByteOff
closureTypeHdrSize DynFlags
dflags ClosureTypeInfo
ty = case ClosureTypeInfo
ty of
ClosureTypeInfo
Thunk -> DynFlags -> ByteOff
thunkHdrSize DynFlags
dflags
ThunkSelector{} -> DynFlags -> ByteOff
thunkHdrSize DynFlags
dflags
ClosureTypeInfo
BlackHole -> DynFlags -> ByteOff
thunkHdrSize DynFlags
dflags
ClosureTypeInfo
IndStatic -> DynFlags -> ByteOff
thunkHdrSize DynFlags
dflags
ClosureTypeInfo
_ -> DynFlags -> ByteOff
fixedHdrSizeW DynFlags
dflags
card :: DynFlags -> Int -> Int
card :: DynFlags -> ByteOff -> ByteOff
card DynFlags
dflags ByteOff
i = ByteOff
i ByteOff -> ByteOff -> ByteOff
forall a. Bits a => a -> ByteOff -> a
`shiftR` DynFlags -> ByteOff
mUT_ARR_PTRS_CARD_BITS DynFlags
dflags
cardRoundUp :: DynFlags -> Int -> Int
cardRoundUp :: DynFlags -> ByteOff -> ByteOff
cardRoundUp DynFlags
dflags ByteOff
i =
DynFlags -> ByteOff -> ByteOff
card DynFlags
dflags (ByteOff
i ByteOff -> ByteOff -> ByteOff
forall a. Num a => a -> a -> a
+ ((ByteOff
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
- ByteOff
1))
cardTableSizeB :: DynFlags -> Int -> ByteOff
cardTableSizeB :: DynFlags -> ByteOff -> ByteOff
cardTableSizeB DynFlags
dflags ByteOff
elems = DynFlags -> ByteOff -> ByteOff
cardRoundUp DynFlags
dflags ByteOff
elems
cardTableSizeW :: DynFlags -> Int -> WordOff
cardTableSizeW :: DynFlags -> ByteOff -> ByteOff
cardTableSizeW DynFlags
dflags ByteOff
elems =
DynFlags -> ByteOff -> ByteOff
bytesToWordsRoundUp DynFlags
dflags (DynFlags -> ByteOff -> ByteOff
cardTableSizeB DynFlags
dflags ByteOff
elems)
#include "rts/storage/ClosureTypes.h"
#include "rts/storage/FunTypes.h"
rtsClosureType :: SMRep -> Int
rtsClosureType :: SMRep -> ByteOff
rtsClosureType SMRep
rep
= case SMRep
rep of
RTSRep ByteOff
ty SMRep
_ -> ByteOff
ty
HeapRep Bool
_ ByteOff
1 ByteOff
0 Constr{} -> CONSTR_1_0
HeapRep Bool
_ ByteOff
0 ByteOff
1 Constr{} -> CONSTR_0_1
HeapRep Bool
_ ByteOff
2 ByteOff
0 Constr{} -> CONSTR_2_0
HeapRep Bool
_ ByteOff
1 ByteOff
1 Constr{} -> CONSTR_1_1
HeapRep Bool
_ ByteOff
0 ByteOff
2 Constr{} -> CONSTR_0_2
HeapRep Bool
_ ByteOff
0 ByteOff
_ Constr{} -> CONSTR_NOCAF
HeapRep Bool
_ ByteOff
_ ByteOff
_ Constr{} -> CONSTR
HeapRep Bool
False ByteOff
1 ByteOff
0 Fun{} -> FUN_1_0
HeapRep Bool
False ByteOff
0 ByteOff
1 Fun{} -> FUN_0_1
HeapRep Bool
False ByteOff
2 ByteOff
0 Fun{} -> FUN_2_0
HeapRep Bool
False ByteOff
1 ByteOff
1 Fun{} -> FUN_1_1
HeapRep Bool
False ByteOff
0 ByteOff
2 Fun{} -> FUN_0_2
HeapRep Bool
False ByteOff
_ ByteOff
_ Fun{} -> FUN
HeapRep Bool
False ByteOff
1 ByteOff
0 ClosureTypeInfo
Thunk -> THUNK_1_0
HeapRep Bool
False ByteOff
0 ByteOff
1 ClosureTypeInfo
Thunk -> THUNK_0_1
HeapRep Bool
False ByteOff
2 ByteOff
0 ClosureTypeInfo
Thunk -> THUNK_2_0
HeapRep Bool
False ByteOff
1 ByteOff
1 ClosureTypeInfo
Thunk -> THUNK_1_1
HeapRep Bool
False ByteOff
0 ByteOff
2 ClosureTypeInfo
Thunk -> THUNK_0_2
HeapRep Bool
False ByteOff
_ ByteOff
_ ClosureTypeInfo
Thunk -> THUNK
HeapRep Bool
False ByteOff
_ ByteOff
_ ThunkSelector{} -> THUNK_SELECTOR
HeapRep Bool
True ByteOff
_ ByteOff
_ Fun{} -> FUN_STATIC
HeapRep Bool
True ByteOff
_ ByteOff
_ ClosureTypeInfo
Thunk -> THUNK_STATIC
HeapRep Bool
False ByteOff
_ ByteOff
_ ClosureTypeInfo
BlackHole -> BLACKHOLE
HeapRep Bool
False ByteOff
_ ByteOff
_ ClosureTypeInfo
IndStatic -> IND_STATIC
SMRep
_ -> String -> ByteOff
forall a. String -> a
panic String
"rtsClosureType"
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
instance Outputable ClosureTypeInfo where
ppr :: ClosureTypeInfo -> SDoc
ppr = ClosureTypeInfo -> SDoc
pprTypeInfo
instance Outputable SMRep where
ppr :: SMRep -> SDoc
ppr (HeapRep Bool
static ByteOff
ps ByteOff
nps ClosureTypeInfo
tyinfo)
= SDoc -> ByteOff -> SDoc -> SDoc
hang (SDoc
header SDoc -> SDoc -> SDoc
<+> SDoc
lbrace) ByteOff
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 -> ByteOff -> SDoc
pp_n String
"ptrs" ByteOff
ps SDoc -> SDoc -> SDoc
<+> String -> ByteOff -> SDoc
pp_n String
"nonptrs" ByteOff
nps
pp_n :: String -> Int -> SDoc
pp_n :: String -> ByteOff -> SDoc
pp_n String
_ ByteOff
0 = SDoc
empty
pp_n String
s ByteOff
n = ByteOff -> SDoc
int ByteOff
n SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
s
ppr (ArrayPtrsRep ByteOff
size ByteOff
_) = String -> SDoc
text String
"ArrayPtrsRep" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
size
ppr (SmallArrayPtrsRep ByteOff
size) = String -> SDoc
text String
"SmallArrayPtrsRep" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
size
ppr (ArrayWordsRep ByteOff
words) = String -> SDoc
text String
"ArrayWordsRep" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
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 ByteOff
ty SMRep
rep) = String -> SDoc
text String
"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 ByteOff
n) = String -> SDoc
text String
"ArgSpec" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
n
ppr (ArgGen [Bool]
ls) = String -> SDoc
text String
"ArgGen" SDoc -> SDoc -> SDoc
<+> [Bool] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Bool]
ls
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo :: ClosureTypeInfo -> SDoc
pprTypeInfo (Constr ByteOff
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
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
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 ByteOff
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
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
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 ByteOff
offset)
= String -> SDoc
text String
"ThunkSel" SDoc -> SDoc -> SDoc
<+> ByteOff -> SDoc
forall a. Outputable a => a -> SDoc
ppr ByteOff
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"