%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 19921998
%
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 backend data type MachRep,
so one can easily convert from CgRep -> MachRep. (Except that
there's no MachRep for a VoidRep.)
It distinguishes
pointers from nonpointers (we sort the pointers together
when building closures)
void from other types: a void argument is different from no argument
All 64bit 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
pointerhood 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 garbagecollector
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[SMRepdatatype]{@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}