diff options
Diffstat (limited to 'compiler/codeGen/SMRep.lhs')
| -rw-r--r-- | compiler/codeGen/SMRep.lhs | 310 |
1 files changed, 238 insertions, 72 deletions
diff --git a/compiler/codeGen/SMRep.lhs b/compiler/codeGen/SMRep.lhs index f35118d1c9..fea9e4b2fc 100644 --- a/compiler/codeGen/SMRep.lhs +++ b/compiler/codeGen/SMRep.lhs @@ -28,15 +28,25 @@ module SMRep ( typeCgRep, idCgRep, tyConCgRep, -- Closure repesentation - SMRep(..), ClosureType(..), - isStaticRep, - fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize, - profHdrSize, thunkHdrSize, - smRepClosureType, smRepClosureTypeInt, - - rET_SMALL, rET_BIG + SMRep(..), -- CmmInfo sees the rep; no one else does + IsStatic, + ClosureTypeInfo(..), ArgDescr(..), Liveness, + ConstrDescription, + mkHeapRep, blackHoleRep, mkStackRep, + + isStaticRep, isStaticNoCafCon, + heapClosureSize, + fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize, + profHdrSize, thunkHdrSize, nonHdrSize, + + rtsClosureType, rET_SMALL, rET_BIG, + aRG_GEN, aRG_GEN_BIG, + + -- Operations over [Word8] strings + pprWord8String, stringToWord8s ) where +#include "../HsVersions.h" #include "../includes/MachDeps.h" import CmmType @@ -48,6 +58,7 @@ import Constants import Outputable import FastString +import Data.Char( ord ) import Data.Word \end{code} @@ -234,36 +245,102 @@ retAddrSizeW = 1 -- One word %************************************************************************ \begin{code} +-- | A description of the layout of a closure. Corresponds directly +-- to the closure types in includes/rts/storage/ClosureTypes.h. data SMRep - -- static closure have an extra static link field at the end. - = GenericRep -- GC routines consult sizes in info tbl - Bool -- True <=> This is a static closure. Affects how - -- we garbage-collect it - !Int -- # ptr words - !Int -- # non-ptr words - ClosureType -- closure type - - | BlackHoleRep - -data ClosureType -- Corresponds 1-1 with the varieties of closures - -- implemented by the RTS. Compare with includes/rts/storage/ClosureTypes.h - = Constr - | ConstrNoCaf - | Fun - | Thunk - | ThunkSelector -\end{code} + = 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 + + | StackRep -- Stack frame (RET_SMALL or RET_BIG) + Liveness + +-- | True <=> This is a static closure. Affects how we garbage-collect it. +-- Static closure have an extra static link field at the end. +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 ConstrTag ConstrDescription + | Fun FunArity ArgDescr + | Thunk + | ThunkSelector SelectorOffset + | BlackHole + +type ConstrTag = StgHalfWord +type ConstrDescription = [Word8] -- result of dataConIdentity +type FunArity = StgHalfWord +type SelectorOffset = StgWord + +------------------------- +-- 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 + !StgHalfWord -- RTS type identifier ARG_P, ARG_N, ... + + | ArgGen -- General case + Liveness -- Details about the arguments + + +----------------------------------------------------------------------------- +-- Construction + +mkHeapRep :: IsStatic -> WordOff -> WordOff -> ClosureTypeInfo -> SMRep +mkHeapRep is_static ptr_wds nonptr_wds cl_type_info + = HeapRep is_static + ptr_wds + (nonptr_wds + slop_wds) + cl_type_info + where + slop_wds + | is_static = 0 + | otherwise = max 0 (minClosureSize - (hdr_size + payload_size)) -Size of a closure header. + hdr_size = closureTypeHdrSize cl_type_info + payload_size = ptr_wds + nonptr_wds -\begin{code} + +mkStackRep :: [Bool] -> SMRep +mkStackRep = StackRep + +blackHoleRep :: SMRep +blackHoleRep = HeapRep False 0 0 BlackHole + +----------------------------------------------------------------------------- +-- Size-related things + +-- | Size of a closure header (StgHeader in includes/rts/storage/Closures.h) fixedHdrSize :: WordOff fixedHdrSize = sTD_HDR_SIZE + profHdrSize +-- | Size of the profiling part of a closure header +-- (StgProfHeader in includes/rts/storage/Closures.h) profHdrSize :: WordOff profHdrSize | opt_SccProfilingOn = pROF_HDR_SIZE | otherwise = 0 +-- | The garbage collector requires that every closure is at least as big as this. +minClosureSize :: WordOff +minClosureSize = fixedHdrSize + mIN_PAYLOAD_SIZE + arrWordsHdrSize :: ByteOff arrWordsHdrSize = fixedHdrSize*wORD_SIZE + sIZEOF_StgArrWords_NoHdr @@ -275,61 +352,150 @@ 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" --- Defines CONSTR, CONSTR_1_0 etc +isStaticRep :: SMRep -> IsStatic +isStaticRep (HeapRep is_static _ _ _) = is_static +isStaticRep (StackRep {}) = False --- krc: only called by tickyDynAlloc in CgTicky; return --- Nothing for a black hole so we can at least make something work. -smRepClosureType :: SMRep -> Maybe ClosureType -smRepClosureType (GenericRep _ _ _ ty) = Just ty -smRepClosureType BlackHoleRep = Nothing +nonHdrSize :: SMRep -> WordOff +nonHdrSize (HeapRep _ p np _) = p + np +nonHdrSize (StackRep bs) = length bs -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 +heapClosureSize :: SMRep -> WordOff +heapClosureSize (HeapRep _ p np ty) = closureTypeHdrSize ty + p + np +heapClosureSize _ = panic "SMRep.heapClosureSize" -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 +closureTypeHdrSize :: ClosureTypeInfo -> WordOff +closureTypeHdrSize ty = case ty of + Thunk{} -> thunkHdrSize + ThunkSelector{} -> thunkHdrSize + BlackHole{} -> thunkHdrSize + _ -> fixedHdrSize + -- 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. -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 +----------------------------------------------------------------------------- +-- deriving the RTS closure type from an SMRep -smRepClosureTypeInt (GenericRep False _ _ ThunkSelector) = THUNK_SELECTOR +#include "../includes/rts/storage/ClosureTypes.h" +#include "../includes/rts/storage/FunTypes.h" +-- Defines CONSTR, CONSTR_1_0 etc -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 +-- | Derives the RTS closure type from an 'SMRep' +rtsClosureType :: SMRep -> StgHalfWord +rtsClosureType (HeapRep False 1 0 Constr{}) = CONSTR_1_0 +rtsClosureType (HeapRep False 0 1 Constr{}) = CONSTR_0_1 +rtsClosureType (HeapRep False 2 0 Constr{}) = CONSTR_2_0 +rtsClosureType (HeapRep False 1 1 Constr{}) = CONSTR_1_1 +rtsClosureType (HeapRep False 0 2 Constr{}) = CONSTR_0_2 +rtsClosureType (HeapRep False _ _ Constr{}) = CONSTR + +rtsClosureType (HeapRep False 1 0 Fun{}) = FUN_1_0 +rtsClosureType (HeapRep False 0 1 Fun{}) = FUN_0_1 +rtsClosureType (HeapRep False 2 0 Fun{}) = FUN_2_0 +rtsClosureType (HeapRep False 1 1 Fun{}) = FUN_1_1 +rtsClosureType (HeapRep False 0 2 Fun{}) = FUN_0_2 +rtsClosureType (HeapRep False _ _ Fun{}) = FUN + +rtsClosureType (HeapRep False 1 0 Thunk{}) = THUNK_1_0 +rtsClosureType (HeapRep False 0 1 Thunk{}) = THUNK_0_1 +rtsClosureType (HeapRep False 2 0 Thunk{}) = THUNK_2_0 +rtsClosureType (HeapRep False 1 1 Thunk{}) = THUNK_1_1 +rtsClosureType (HeapRep False 0 2 Thunk{}) = THUNK_0_2 +rtsClosureType (HeapRep False _ _ Thunk{}) = THUNK + +rtsClosureType (HeapRep False _ _ ThunkSelector{}) = THUNK_SELECTOR + +-- Approximation: we use the CONSTR_NOCAF_STATIC type for static constructors +-- that have no pointer words only. +rtsClosureType (HeapRep True 0 _ Constr{}) = CONSTR_NOCAF_STATIC -- See isStaticNoCafCon below +rtsClosureType (HeapRep True _ _ Constr{}) = CONSTR_STATIC +rtsClosureType (HeapRep True _ _ Fun{}) = FUN_STATIC +rtsClosureType (HeapRep True _ _ Thunk{}) = THUNK_STATIC + +rtsClosureType (HeapRep False _ _ BlackHole{}) = BLACKHOLE + +rtsClosureType _ = panic "rtsClosureType" + +isStaticNoCafCon :: SMRep -> Bool +-- This should line up exactly with CONSTR_NOCAF_STATIC above +-- See Note [Static NoCaf constructors] +isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True +isStaticNoCafCon _ = False -smRepClosureTypeInt BlackHoleRep = BLACKHOLE +-- We export these ones +rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: StgHalfWord +rET_SMALL = RET_SMALL +rET_BIG = RET_BIG +aRG_GEN = ARG_GEN +aRG_GEN_BIG = ARG_GEN_BIG +\end{code} -smRepClosureTypeInt _ = panic "smRepClosuretypeint" +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. --- We export these ones -rET_SMALL, rET_BIG :: StgHalfWord -rET_SMALL = RET_SMALL -rET_BIG = RET_BIG -\end{code} +%************************************************************************ +%* * + Pretty printing of SMRep and friends +%* * +%************************************************************************ + +\begin{code} +instance Outputable ClosureTypeInfo where + ppr = pprTypeInfo + +instance Outputable SMRep where + ppr (HeapRep static ps nps tyinfo) + = hang (header <+> lbrace) 2 (ppr tyinfo <+> rbrace) + where + header = ptext (sLit "HeapRep") + <+> if static then ptext (sLit "static") else empty + <+> pp_n "ptrs" ps <+> pp_n "nonptrs" nps + pp_n :: String -> Int -> SDoc + pp_n _ 0 = empty + pp_n s n = int n <+> text s + + ppr (StackRep bs) = ptext (sLit "StackRep") <+> ppr bs + +instance Outputable ArgDescr where + ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> integer (toInteger n) + ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls + +pprTypeInfo :: ClosureTypeInfo -> SDoc +pprTypeInfo (Constr tag descr) + = ptext (sLit "Con") <+> + braces (sep [ ptext (sLit "tag:") <+> integer (toInteger tag) + , ptext (sLit "descr:") <> text (show descr) ]) + +pprTypeInfo (Fun arity args) + = ptext (sLit "Fun") <+> + braces (sep [ ptext (sLit "arity:") <+> integer (toInteger arity) + , ptext (sLit ("fun_type:")) <+> ppr args ]) + +pprTypeInfo (ThunkSelector offset) + = ptext (sLit "ThunkSel") <+> integer (toInteger offset) + +pprTypeInfo Thunk = ptext (sLit "Thunk") +pprTypeInfo BlackHole = ptext (sLit "BlackHole") + + +stringToWord8s :: String -> [Word8] +stringToWord8s s = map (fromIntegral . ord) s + +pprWord8String :: [Word8] -> SDoc +-- Debug printing. Not very clever right now. +pprWord8String ws = text (show ws) +\end{code} |