X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcodeGen%2FSMRep.lhs;h=c338cf8b3f3b7ae51b850a99bd27ffcb4be55ccb;hb=9bedea20f62a1da832c69833c39dd1d15e6ee9a3;hp=7c46adff06c59f682b824fd081ed6a8b96a2d952;hpb=e7498a3ee1d0484d02a9e86633cc179c76ebf36e;p=ghc-hetmet.git diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs index 7c46adf..c338cf8 100644 --- a/ghc/compiler/codeGen/SMRep.lhs +++ b/ghc/compiler/codeGen/SMRep.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[SMRep]{Storage manager representations of closure} @@ -7,20 +7,56 @@ This is here, rather than in ClosureInfo, just to keep nhc happy. Other modules should access this info through ClosureInfo. \begin{code} -#include "HsVersions.h" - module SMRep ( - SMRep(..), SMSpecRepKind(..), SMUpdateKind(..), - getSMInfoStr, getSMInitHdrStr, getSMUpdInplaceHdrStr, - ltSMRepHdr, - isConstantRep, isSpecRep, isStaticRep, isPhantomRep, - isIntLikeRep + SMRep(..), ClosureType(..), + isStaticRep, + fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize, + fixedItblSize, pprSMRep + +#ifndef OMIT_NATIVE_CODEGEN + , getSMRepClosureTypeInt + , cONSTR + , cONSTR_1_0 + , cONSTR_0_1 + , cONSTR_2_0 + , cONSTR_1_1 + , cONSTR_0_2 + , cONSTR_STATIC + , cONSTR_NOCAF_STATIC + , fUN + , fUN_1_0 + , fUN_0_1 + , fUN_2_0 + , fUN_1_1 + , fUN_0_2 + , fUN_STATIC + , tHUNK + , tHUNK_1_0 + , tHUNK_0_1 + , tHUNK_2_0 + , tHUNK_1_1 + , tHUNK_0_2 + , tHUNK_STATIC + , tHUNK_SELECTOR + , rET_SMALL + , rET_VEC_SMALL + , rET_BIG + , rET_VEC_BIG + , bLACKHOLE +#endif ) where -IMP_Ubiq(){-uitous-} +#include "HsVersions.h" -import Pretty ( ppStr ) -import Util ( panic ) +import CmdLineOpts +import AbsCSyn ( Liveness(..) ) +import Constants ( sTD_HDR_SIZE, pROF_HDR_SIZE, + gRAN_HDR_SIZE, tICKY_HDR_SIZE, + aRR_WORDS_HDR_SIZE, aRR_PTRS_HDR_SIZE, + sTD_ITBL_SIZE, pROF_ITBL_SIZE, + gRAN_ITBL_SIZE, tICKY_ITBL_SIZE ) +import Outputable +import GlaExts ( Int(..), Int#, (<#), (==#), (<#), (>#) ) \end{code} %************************************************************************ @@ -29,244 +65,167 @@ import Util ( panic ) %* * %************************************************************************ -Ways in which a closure may be represented by the storage manager; -this list slavishly follows the storage-manager interface document. - \begin{code} -data SMSpecRepKind - = SpecRep -- Normal Spec representation - - | ConstantRep -- Common me up with single global copy - -- Used for nullary constructors - - | CharLikeRep -- Common me up with entry from global table - - | IntLikeRep -- Common me up with entry from global table, - -- if the intlike field is in range. - -data SMUpdateKind - = SMNormalForm -- Normal form, no update - | SMSingleEntry -- Single entry thunk, non-updatable - | SMUpdatable -- Shared thunk, updatable - data SMRep - = StaticRep -- Don't move me, Oh garbage collector! - -- Used for all statically-allocated closures. - Int -- # ptr words (useful for interpreter, debugger, etc) - Int -- # non-ptr words - - | SpecialisedRep -- GC routines know size etc - -- All have same _HS = SPEC_HS and no _VHS - SMSpecRepKind -- Which kind of specialised representation + -- 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 - SMUpdateKind -- Updatable? - - | GenericRep -- GC routines consult sizes in info tbl - Int -- # ptr words - Int -- # non-ptr words - SMUpdateKind -- Updatable? + ClosureType -- closure type + + | BlackHoleRep + +data ClosureType -- Corresponds 1-1 with the varieties of closures + -- implemented by the RTS. Compare with ghc/includes/ClosureTypes.h + = CONSTR + | CONSTR_p_n -- The p_n variants have more efficient GC, but we + -- only provide them for dynamically-allocated closures + -- (We could do them for static ones, but we don't) + | CONSTR_NOCAF + | FUN + | FUN_p_n + | THUNK + | THUNK_p_n + | THUNK_SELECTOR + deriving (Eq,Ord) +\end{code} - | BigTupleRep -- All ptrs, size in var-hdr field - -- Used for big tuples - Int -- # ptr words +Size of a closure header. - | DataRep -- All non-ptrs, size in var-hdr field - -- Used for arbitrary-precision integers, strings - Int -- # non-ptr words +\begin{code} +fixedHdrSize :: Int{-words-} +fixedHdrSize = sTD_HDR_SIZE + profHdrSize + granHdrSize + tickyHdrSize - | DynamicRep -- Size and # ptrs in var-hdr field - -- Used by RTS for partial applications +profHdrSize :: Int{-words-} +profHdrSize | opt_SccProfilingOn = pROF_HDR_SIZE + | otherwise = 0 - | BlackHoleRep -- for black hole closures +granHdrSize :: Int{-words-} +granHdrSize | opt_GranMacros = gRAN_HDR_SIZE + | otherwise = 0 - | PhantomRep -- for "phantom" closures that only exist in registers +tickyHdrSize :: Int{-words-} +tickyHdrSize | opt_DoTickyProfiling = tICKY_HDR_SIZE + | otherwise = 0 - | MuTupleRep -- All ptrs, size in var-hdr field - -- Used for mutable tuples - Int -- # ptr words +arrWordsHdrSize :: Int{-words-} +arrWordsHdrSize = fixedHdrSize + aRR_WORDS_HDR_SIZE -{- Mattson review: - -To: simonpj@dcs.gla.ac.uk, partain@dcs.gla.ac.uk -Cc: kh@dcs.gla.ac.uk, trinder@dcs.gla.ac.uk, areid@dcs.gla.ac.uk -Subject: Correct me if I'm wrong... -Date: Fri, 17 Feb 1995 18:09:00 +0000 -From: Jim Mattson - -BigTupleRep == TUPLE - - Never generated by the compiler, and only used in the RTS when - mutuples don't require special attention at GC time (e.g. 2s) - When it is used, it is a primitive object (never entered). - May be mutable...probably should never be used in the parallel - system, since we need to distinguish mutables from immutables when - deciding whether to copy or move closures across processors. - -DataRep == DATA (aka MutableByteArray & ByteArray) - Never generated by the compiler, and only used in the RTS for - ArrayOfData. Always a primitive object (never entered). May - be mutable...though we don't distinguish between mutable and - immutable data arrays in the sequential world, it would probably - be useful in the parallel world to know when it is safe to just - copy one of these. I believe the hooks are in place for changing - the InfoPtr on a MutableByteArray when it's frozen to a ByteArray - if we want to do so. - -DynamicRep == DYN - Never generated by the compiler, and only used in the RTS for - PAPs and the Stable Pointer table. PAPs are non-primitive, - non-updatable, normal-form objects, but the SPT is a primitive, - mutable object. At the moment, there is no SPT in the parallel - world. Presumably, it would be possible to have an SPT on each - processor, and we could identify a stable pointer as a (processor, - SPT-entry) pair, but would it be worth it? - -MuTupleRep == MUTUPLE - Never generated by the compiler, and only used in the RTS when - mutuples *do* require special attention at GC time. - When it is used, it is a primitive object (never entered). - Always mutable...there is an IMMUTUPLE in the RTS, but no - corresponding type in the compiler. - ---jim --} +arrPtrsHdrSize :: Int{-words-} +arrPtrsHdrSize = fixedHdrSize + aRR_PTRS_HDR_SIZE \end{code} -\begin{code} -isConstantRep, isSpecRep, isStaticRep, isPhantomRep, isIntLikeRep :: SMRep -> Bool -isConstantRep (SpecialisedRep ConstantRep _ _ _) = True -isConstantRep other = False +Size of an info table. -isSpecRep (SpecialisedRep kind _ _ _) = True -- All the kinds of Spec closures -isSpecRep other = False -- True indicates that the _VHS is 0 ! +\begin{code} +fixedItblSize :: Int{-words-} +fixedItblSize = sTD_ITBL_SIZE + profItblSize + granItblSize + tickyItblSize -isStaticRep (StaticRep _ _) = True -isStaticRep _ = False +profItblSize :: Int{-words-} +profItblSize | opt_SccProfilingOn = pROF_ITBL_SIZE + | otherwise = 0 -isPhantomRep PhantomRep = True -isPhantomRep _ = False +granItblSize :: Int{-words-} +granItblSize | opt_GranMacros = gRAN_ITBL_SIZE + | otherwise = 0 -isIntLikeRep (SpecialisedRep IntLikeRep _ _ _) = True -isIntLikeRep other = False +tickyItblSize :: Int{-words-} +tickyItblSize | opt_DoTickyProfiling = tICKY_ITBL_SIZE + | otherwise = 0 \end{code} \begin{code} -instance Eq SMRep where - (SpecialisedRep k1 a1 b1 _) == (SpecialisedRep k2 a2 b2 _) = (tagOf_SMSpecRepKind k1) _EQ_ (tagOf_SMSpecRepKind k2) - && a1 == a2 && b1 == b2 - (GenericRep a1 b1 _) == (GenericRep a2 b2 _) = a1 == a2 && b1 == b2 - (BigTupleRep a1) == (BigTupleRep a2) = a1 == a2 - (MuTupleRep a1) == (MuTupleRep a2) = a1 == a2 - (DataRep a1) == (DataRep a2) = a1 == a2 - a == b = (tagOf_SMRep a) _EQ_ (tagOf_SMRep b) - -ltSMRepHdr :: SMRep -> SMRep -> Bool -a `ltSMRepHdr` b = (tagOf_SMRep a) _LT_ (tagOf_SMRep b) - -instance Ord SMRep where - -- ToDo: cmp-ify? This instance seems a bit weird (WDP 94/10) - rep1 <= rep2 = rep1 < rep2 || rep1 == rep2 - rep1 < rep2 - = let tag1 = tagOf_SMRep rep1 - tag2 = tagOf_SMRep rep2 - in - if tag1 _LT_ tag2 then True - else if tag1 _GT_ tag2 then False - else {- tags equal -} rep1 `lt` rep2 - where - (SpecialisedRep k1 a1 b1 _) `lt` (SpecialisedRep k2 a2 b2 _) = - t1 _LT_ t2 || (t1 _EQ_ t2 && (a1 < a2 || (a1 == a2 && b1 < b2))) - where t1 = tagOf_SMSpecRepKind k1 - t2 = tagOf_SMSpecRepKind k2 - (GenericRep a1 b1 _) `lt` (GenericRep a2 b2 _) = a1 < a2 || (a1 == a2 && b1 < b2) - (BigTupleRep a1) `lt` (BigTupleRep a2) = a1 < a2 - (MuTupleRep a1) `lt` (MuTupleRep a2) = a1 < a2 - (DataRep a1) `lt` (DataRep a2) = a1 < a2 - a `lt` b = True - -tagOf_SMSpecRepKind SpecRep = (ILIT(1) :: FAST_INT) -tagOf_SMSpecRepKind ConstantRep = ILIT(2) -tagOf_SMSpecRepKind CharLikeRep = ILIT(3) -tagOf_SMSpecRepKind IntLikeRep = ILIT(4) - -tagOf_SMRep (StaticRep _ _) = (ILIT(1) :: FAST_INT) -tagOf_SMRep (SpecialisedRep k _ _ _) = ILIT(2) -tagOf_SMRep (GenericRep _ _ _) = ILIT(3) -tagOf_SMRep (BigTupleRep _) = ILIT(4) -tagOf_SMRep (DataRep _) = ILIT(5) -tagOf_SMRep DynamicRep = ILIT(6) -tagOf_SMRep BlackHoleRep = ILIT(7) -tagOf_SMRep PhantomRep = ILIT(8) -tagOf_SMRep (MuTupleRep _) = ILIT(9) - -instance Text SMRep where - showsPrec d rep - = showString (case rep of - StaticRep _ _ -> "STATIC" - SpecialisedRep kind _ _ SMNormalForm -> "SPEC_N" - SpecialisedRep kind _ _ SMSingleEntry -> "SPEC_S" - SpecialisedRep kind _ _ SMUpdatable -> "SPEC_U" - GenericRep _ _ SMNormalForm -> "GEN_N" - GenericRep _ _ SMSingleEntry -> "GEN_S" - GenericRep _ _ SMUpdatable -> "GEN_U" - BigTupleRep _ -> "TUPLE" - DataRep _ -> "DATA" - DynamicRep -> "DYN" - BlackHoleRep -> "BH" - PhantomRep -> "INREGS" - MuTupleRep _ -> "MUTUPLE") +isStaticRep :: SMRep -> Bool +isStaticRep (GenericRep is_static _ _ _) = is_static +isStaticRep BlackHoleRep = False +\end{code} +\begin{code} instance Outputable SMRep where - ppr sty rep = ppStr (show rep) - -getSMInfoStr :: SMRep -> String -getSMInfoStr (StaticRep _ _) = "STATIC" -getSMInfoStr (SpecialisedRep ConstantRep _ _ _) = "CONST" -getSMInfoStr (SpecialisedRep CharLikeRep _ _ _) = "CHARLIKE" -getSMInfoStr (SpecialisedRep IntLikeRep _ _ _) = "INTLIKE" -getSMInfoStr (SpecialisedRep SpecRep _ _ SMNormalForm) = "SPEC_N" -getSMInfoStr (SpecialisedRep SpecRep _ _ SMSingleEntry) = "SPEC_S" -getSMInfoStr (SpecialisedRep SpecRep _ _ SMUpdatable) = "SPEC_U" -getSMInfoStr (GenericRep _ _ SMNormalForm) = "GEN_N" -getSMInfoStr (GenericRep _ _ SMSingleEntry) = "GEN_S" -getSMInfoStr (GenericRep _ _ SMUpdatable) = "GEN_U" -getSMInfoStr (BigTupleRep _) = "TUPLE" -getSMInfoStr (DataRep _ ) = "DATA" -getSMInfoStr DynamicRep = "DYN" -getSMInfoStr BlackHoleRep = panic "getSMInfoStr.BlackHole" -getSMInfoStr PhantomRep = "INREGS" -getSMInfoStr (MuTupleRep _) = "MUTUPLE" - -getSMInitHdrStr :: SMRep -> String -getSMInitHdrStr (SpecialisedRep IntLikeRep _ _ _) = "SET_INTLIKE" -getSMInitHdrStr (SpecialisedRep SpecRep _ _ _) = "SET_SPEC" -getSMInitHdrStr (GenericRep _ _ _) = "SET_GEN" -getSMInitHdrStr (BigTupleRep _) = "SET_TUPLE" -getSMInitHdrStr (DataRep _ ) = "SET_DATA" -getSMInitHdrStr DynamicRep = "SET_DYN" -getSMInitHdrStr BlackHoleRep = "SET_BH" -#ifdef DEBUG -getSMInitHdrStr (StaticRep _ _) = panic "getSMInitHdrStr.Static" -getSMInitHdrStr PhantomRep = panic "getSMInitHdrStr.Phantom" -getSMInitHdrStr (MuTupleRep _) = panic "getSMInitHdrStr.Mutuple" -getSMInitHdrStr (SpecialisedRep ConstantRep _ _ _) = panic "getSMInitHdrStr.Constant" -getSMInitHdrStr (SpecialisedRep CharLikeRep _ _ _) = panic "getSMInitHdrStr.CharLike" -#endif - -getSMUpdInplaceHdrStr :: SMRep -> String -getSMUpdInplaceHdrStr (SpecialisedRep ConstantRep _ _ _) = "INPLACE_UPD" -getSMUpdInplaceHdrStr (SpecialisedRep CharLikeRep _ _ _) = "INPLACE_UPD" -getSMUpdInplaceHdrStr (SpecialisedRep IntLikeRep _ _ _) = "INPLACE_UPD" -getSMUpdInplaceHdrStr (SpecialisedRep SpecRep _ _ _) = "INPLACE_UPD" -#ifdef DEBUG -getSMUpdInplaceHdrStr (StaticRep _ _) = panic "getSMUpdInplaceHdrStr.Static" -getSMUpdInplaceHdrStr (GenericRep _ _ _) = panic "getSMUpdInplaceHdrStr.Generic" -getSMUpdInplaceHdrStr (BigTupleRep _ ) = panic "getSMUpdInplaceHdrStr.BigTuple" -getSMUpdInplaceHdrStr (DataRep _ ) = panic "getSMUpdInplaceHdrStr.Data" -getSMUpdInplaceHdrStr DynamicRep = panic "getSMUpdInplaceHdrStr.Dynamic" -getSMUpdInplaceHdrStr BlackHoleRep = panic "getSMUpdInplaceHdrStr.BlackHole" -getSMUpdInplaceHdrStr PhantomRep = panic "getSMUpdInplaceHdrStr.Phantom" -getSMUpdInplaceHdrStr (MuTupleRep _ ) = panic "getSMUpdInplaceHdrStr.MuTuple" -#endif + ppr rep = pprSMRep rep + +pprSMRep :: SMRep -> SDoc +pprSMRep (GenericRep True ptrs nptrs clo_ty) = pprClosureType clo_ty ptrs nptrs <> ptext SLIT("_STATIC") +pprSMRep (GenericRep False ptrs nptrs clo_ty) = pprClosureType clo_ty ptrs nptrs + +pprClosureType CONSTR p n = ptext SLIT("CONSTR") +pprClosureType CONSTR_p_n p n = ptext SLIT("CONSTR_") <> int p <> char '_' <> int n +pprClosureType CONSTR_NOCAF p n = ptext SLIT("CONSTR_NOCAF") +pprClosureType FUN p n = ptext SLIT("FUN") +pprClosureType FUN_p_n p n = ptext SLIT("FUN_") <> int p <> char '_' <> int n +pprClosureType THUNK p n = ptext SLIT("THUNK") +pprClosureType THUNK_p_n p n = ptext SLIT("THUNK_") <> int p <> char '_' <> int n +pprClosureType THUNK_SELECTOR p n = ptext SLIT("THUNK_SELECTOR") + +#ifndef OMIT_NATIVE_CODEGEN +getSMRepClosureTypeInt :: SMRep -> Int +getSMRepClosureTypeInt (GenericRep False _ _ CONSTR) = cONSTR +getSMRepClosureTypeInt (GenericRep False 1 0 CONSTR_p_n) = cONSTR_1_0 +getSMRepClosureTypeInt (GenericRep False 0 1 CONSTR_p_n) = cONSTR_0_1 +getSMRepClosureTypeInt (GenericRep False 2 0 CONSTR_p_n) = cONSTR_2_0 +getSMRepClosureTypeInt (GenericRep False 1 1 CONSTR_p_n) = cONSTR_1_1 +getSMRepClosureTypeInt (GenericRep False 0 2 CONSTR_p_n) = cONSTR_0_2 + +getSMRepClosureTypeInt (GenericRep False _ _ FUN) = fUN +getSMRepClosureTypeInt (GenericRep False 1 0 FUN_p_n) = fUN_1_0 +getSMRepClosureTypeInt (GenericRep False 0 1 FUN_p_n) = fUN_0_1 +getSMRepClosureTypeInt (GenericRep False 2 0 FUN_p_n) = fUN_2_0 +getSMRepClosureTypeInt (GenericRep False 1 1 FUN_p_n) = fUN_1_1 +getSMRepClosureTypeInt (GenericRep False 0 2 FUN_p_n) = fUN_0_2 + +getSMRepClosureTypeInt (GenericRep False _ _ THUNK) = tHUNK +getSMRepClosureTypeInt (GenericRep False 1 0 THUNK_p_n) = tHUNK_1_0 +getSMRepClosureTypeInt (GenericRep False 0 1 THUNK_p_n) = tHUNK_0_1 +getSMRepClosureTypeInt (GenericRep False 2 0 THUNK_p_n) = tHUNK_2_0 +getSMRepClosureTypeInt (GenericRep False 1 1 THUNK_p_n) = tHUNK_1_1 +getSMRepClosureTypeInt (GenericRep False 0 2 THUNK_p_n) = tHUNK_0_2 + +getSMRepClosureTypeInt (GenericRep False _ _ THUNK_SELECTOR) = tHUNK_SELECTOR + +getSMRepClosureTypeInt (GenericRep True _ _ CONSTR) = cONSTR_STATIC +getSMRepClosureTypeInt (GenericRep True _ _ CONSTR_NOCAF) = cONSTR_NOCAF_STATIC +getSMRepClosureTypeInt (GenericRep True _ _ FUN) = fUN_STATIC +getSMRepClosureTypeInt (GenericRep True _ _ THUNK) = tHUNK_STATIC + +getSMRepClosureTypeInt BlackHoleRep = bLACKHOLE + +getSMRepClosureTypeInt rep = pprPanic "getSMRepClosureTypeInt:" (pprSMRep rep) + + +-- Just the ones we need: + +#include "../includes/ClosureTypes.h" + +cONSTR = (CONSTR :: Int) +cONSTR_1_0 = (CONSTR_1_0 :: Int) +cONSTR_0_1 = (CONSTR_0_1 :: Int) +cONSTR_2_0 = (CONSTR_2_0 :: Int) +cONSTR_1_1 = (CONSTR_1_1 :: Int) +cONSTR_0_2 = (CONSTR_0_2 :: Int) +cONSTR_STATIC = (CONSTR_STATIC :: Int) +cONSTR_NOCAF_STATIC = (CONSTR_NOCAF_STATIC :: Int) +fUN = (FUN :: Int) +fUN_1_0 = (FUN_1_0 :: Int) +fUN_0_1 = (FUN_0_1 :: Int) +fUN_2_0 = (FUN_2_0 :: Int) +fUN_1_1 = (FUN_1_1 :: Int) +fUN_0_2 = (FUN_0_2 :: Int) +fUN_STATIC = (FUN_STATIC :: Int) +tHUNK = (THUNK :: Int) +tHUNK_1_0 = (THUNK_1_0 :: Int) +tHUNK_0_1 = (THUNK_0_1 :: Int) +tHUNK_2_0 = (THUNK_2_0 :: Int) +tHUNK_1_1 = (THUNK_1_1 :: Int) +tHUNK_0_2 = (THUNK_0_2 :: Int) +tHUNK_STATIC = (THUNK_STATIC :: Int) +tHUNK_SELECTOR = (THUNK_SELECTOR :: Int) +rET_SMALL = (RET_SMALL :: Int) +rET_VEC_SMALL = (RET_VEC_SMALL :: Int) +rET_BIG = (RET_BIG :: Int) +rET_VEC_BIG = (RET_VEC_BIG :: Int) +bLACKHOLE = (BLACKHOLE :: Int) + +#endif OMIT_NATIVE_CODEGEN \end{code}