%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
Storage manager representation of closures
This is here, rather than in ClosureInfo, just to keep nhc happy.
Other modules should access this info through ClosureInfo.
\begin{code}
module SMRep (
StgWord, StgHalfWord,
hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
WordOff, ByteOff,
CgRep(..), nonVoidArg,
argMachRep, primRepToCgRep,
isFollowableArg, isVoidArg,
isFloatingArg, is64BitArg,
separateByPtrFollowness,
cgRepSizeW, cgRepSizeB,
retAddrSizeW,
typeCgRep, idCgRep, tyConCgRep,
SMRep(..), ClosureType(..),
isStaticRep,
fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
profHdrSize, thunkHdrSize,
smRepClosureType, smRepClosureTypeInt,
rET_SMALL, rET_BIG
) where
#include "../includes/MachDeps.h"
import CmmExpr
import Id
import Type
import TyCon
import StaticFlags
import Constants
import Outputable
import FastString
import Data.Word
\end{code}
%************************************************************************
%* *
Words and bytes
%* *
%************************************************************************
\begin{code}
type WordOff = Int
type ByteOff = Int
\end{code}
StgWord is a type representing an StgWord on the target platform.
\begin{code}
#if SIZEOF_HSWORD == 4
type StgWord = Word32
type StgHalfWord = Word16
hALF_WORD_SIZE :: ByteOff
hALF_WORD_SIZE = 2
hALF_WORD_SIZE_IN_BITS :: Int
hALF_WORD_SIZE_IN_BITS = 16
#elif SIZEOF_HSWORD == 8
type StgWord = Word64
type StgHalfWord = Word32
hALF_WORD_SIZE :: ByteOff
hALF_WORD_SIZE = 4
hALF_WORD_SIZE_IN_BITS :: Int
hALF_WORD_SIZE_IN_BITS = 32
#else
#error unknown SIZEOF_HSWORD
#endif
\end{code}
%************************************************************************
%* *
CgRep
%* *
%************************************************************************
An CgRep is an abstraction of a Type which tells the code generator
all it needs to know about the calling convention for arguments (and
results) of that type. In particular, the ArgReps of a function's
arguments are used to decide which of the RTS's generic apply
functions to call when applying an unknown function.
It contains more information than the back-end data type MachRep,
so one can easily convert from CgRep -> MachRep. (Except that
there's no MachRep for a VoidRep.)
It distinguishes
pointers from non-pointers (we sort the pointers together
when building closures)
void from other types: a void argument is different from no argument
All 64-bit types map to the same CgRep, because they're passed in the
same register, but a PtrArg is still different from an NonPtrArg
because the function's entry convention has to take into account the
pointer-hood of arguments for the purposes of describing the stack on
entry to the garbage collector.
\begin{code}
data CgRep
= VoidArg
| PtrArg
| NonPtrArg
| LongArg
| FloatArg
| DoubleArg
deriving Eq
instance Outputable CgRep where
ppr VoidArg = ptext (sLit "V_")
ppr PtrArg = ptext (sLit "P_")
ppr NonPtrArg = ptext (sLit "I_")
ppr LongArg = ptext (sLit "L_")
ppr FloatArg = ptext (sLit "F_")
ppr DoubleArg = ptext (sLit "D_")
argMachRep :: CgRep -> CmmType
argMachRep PtrArg = gcWord
argMachRep NonPtrArg = bWord
argMachRep LongArg = b64
argMachRep FloatArg = f32
argMachRep DoubleArg = f64
argMachRep VoidArg = panic "argMachRep:VoidRep"
primRepToCgRep :: PrimRep -> CgRep
primRepToCgRep VoidRep = VoidArg
primRepToCgRep PtrRep = PtrArg
primRepToCgRep IntRep = NonPtrArg
primRepToCgRep WordRep = NonPtrArg
primRepToCgRep Int64Rep = LongArg
primRepToCgRep Word64Rep = LongArg
primRepToCgRep AddrRep = NonPtrArg
primRepToCgRep FloatRep = FloatArg
primRepToCgRep DoubleRep = DoubleArg
idCgRep :: Id -> CgRep
idCgRep x = typeCgRep . idType $ x
tyConCgRep :: TyCon -> CgRep
tyConCgRep = primRepToCgRep . tyConPrimRep
typeCgRep :: Type -> CgRep
typeCgRep = primRepToCgRep . typePrimRep
\end{code}
Whether or not the thing is a pointer that the garbage-collector
should follow. Or, to put it another (less confusing) way, whether
the object in question is a heap object.
Depending on the outcome, this predicate determines what stack
the pointer/object possibly will have to be saved onto, and the
computation of GC liveness info.
\begin{code}
isFollowableArg :: CgRep -> Bool
isFollowableArg PtrArg = True
isFollowableArg _ = False
isVoidArg :: CgRep -> Bool
isVoidArg VoidArg = True
isVoidArg _ = False
nonVoidArg :: CgRep -> Bool
nonVoidArg VoidArg = False
nonVoidArg _ = True
isFloatingArg :: CgRep -> Bool
isFloatingArg DoubleArg = True
isFloatingArg FloatArg = True
isFloatingArg _ = False
is64BitArg :: CgRep -> Bool
is64BitArg LongArg = True
is64BitArg _ = False
\end{code}
\begin{code}
separateByPtrFollowness :: [(CgRep,a)] -> ([(CgRep,a)], [(CgRep,a)])
separateByPtrFollowness things
= sep_things things [] []
where
sep_things [] bs us = (reverse bs, reverse us)
sep_things ((PtrArg,a):ts) bs us = sep_things ts ((PtrArg,a):bs) us
sep_things (t :ts) bs us = sep_things ts bs (t:us)
\end{code}
\begin{code}
cgRepSizeB :: CgRep -> ByteOff
cgRepSizeB DoubleArg = dOUBLE_SIZE
cgRepSizeB LongArg = wORD64_SIZE
cgRepSizeB VoidArg = 0
cgRepSizeB _ = wORD_SIZE
cgRepSizeW :: CgRep -> ByteOff
cgRepSizeW DoubleArg = dOUBLE_SIZE `quot` wORD_SIZE
cgRepSizeW LongArg = wORD64_SIZE `quot` wORD_SIZE
cgRepSizeW VoidArg = 0
cgRepSizeW _ = 1
retAddrSizeW :: WordOff
retAddrSizeW = 1
\end{code}
%************************************************************************
%* *
\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
%* *
%************************************************************************
\begin{code}
data SMRep
= GenericRep
Bool
!Int
!Int
ClosureType
| BlackHoleRep
data ClosureType
= Constr
| ConstrNoCaf
| Fun
| Thunk
| ThunkSelector
\end{code}
Size of a closure header.
\begin{code}
fixedHdrSize :: WordOff
fixedHdrSize = sTD_HDR_SIZE + profHdrSize
profHdrSize :: WordOff
profHdrSize | opt_SccProfilingOn = pROF_HDR_SIZE
| otherwise = 0
arrWordsHdrSize :: ByteOff
arrWordsHdrSize = fixedHdrSize*wORD_SIZE + sIZEOF_StgArrWords_NoHdr
arrPtrsHdrSize :: ByteOff
arrPtrsHdrSize = fixedHdrSize*wORD_SIZE + sIZEOF_StgMutArrPtrs_NoHdr
thunkHdrSize :: WordOff
thunkHdrSize = fixedHdrSize + smp_hdr
where smp_hdr = sIZEOF_StgSMPThunkHeader `quot` wORD_SIZE
\end{code}
\begin{code}
isStaticRep :: SMRep -> Bool
isStaticRep (GenericRep is_static _ _ _) = is_static
isStaticRep BlackHoleRep = False
\end{code}
\begin{code}
#include "../includes/rts/storage/ClosureTypes.h"
smRepClosureType :: SMRep -> Maybe ClosureType
smRepClosureType (GenericRep _ _ _ ty) = Just ty
smRepClosureType BlackHoleRep = Nothing
smRepClosureTypeInt :: SMRep -> StgHalfWord
smRepClosureTypeInt (GenericRep False 1 0 Constr) = CONSTR_1_0
smRepClosureTypeInt (GenericRep False 0 1 Constr) = CONSTR_0_1
smRepClosureTypeInt (GenericRep False 2 0 Constr) = CONSTR_2_0
smRepClosureTypeInt (GenericRep False 1 1 Constr) = CONSTR_1_1
smRepClosureTypeInt (GenericRep False 0 2 Constr) = CONSTR_0_2
smRepClosureTypeInt (GenericRep False _ _ Constr) = CONSTR
smRepClosureTypeInt (GenericRep False 1 0 Fun) = FUN_1_0
smRepClosureTypeInt (GenericRep False 0 1 Fun) = FUN_0_1
smRepClosureTypeInt (GenericRep False 2 0 Fun) = FUN_2_0
smRepClosureTypeInt (GenericRep False 1 1 Fun) = FUN_1_1
smRepClosureTypeInt (GenericRep False 0 2 Fun) = FUN_0_2
smRepClosureTypeInt (GenericRep False _ _ Fun) = FUN
smRepClosureTypeInt (GenericRep False 1 0 Thunk) = THUNK_1_0
smRepClosureTypeInt (GenericRep False 0 1 Thunk) = THUNK_0_1
smRepClosureTypeInt (GenericRep False 2 0 Thunk) = THUNK_2_0
smRepClosureTypeInt (GenericRep False 1 1 Thunk) = THUNK_1_1
smRepClosureTypeInt (GenericRep False 0 2 Thunk) = THUNK_0_2
smRepClosureTypeInt (GenericRep False _ _ Thunk) = THUNK
smRepClosureTypeInt (GenericRep False _ _ ThunkSelector) = THUNK_SELECTOR
smRepClosureTypeInt (GenericRep True _ _ Constr) = CONSTR_STATIC
smRepClosureTypeInt (GenericRep True _ _ ConstrNoCaf) = CONSTR_NOCAF_STATIC
smRepClosureTypeInt (GenericRep True _ _ Fun) = FUN_STATIC
smRepClosureTypeInt (GenericRep True _ _ Thunk) = THUNK_STATIC
smRepClosureTypeInt BlackHoleRep = BLACKHOLE
smRepClosureTypeInt _ = panic "smRepClosuretypeint"
rET_SMALL, rET_BIG :: StgHalfWord
rET_SMALL = RET_SMALL
rET_BIG = RET_BIG
\end{code}