From: simonm Date: Tue, 26 Jan 1999 16:16:35 +0000 (+0000) Subject: [project @ 1999-01-26 16:16:19 by simonm] X-Git-Tag: Approximately_9120_patches~6682 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=723545930025a24708a8a0923435c95cc7f058c9;p=ghc-hetmet.git [project @ 1999-01-26 16:16:19 by simonm] - Add specialised closure types (CONSTR_p_n, THUNK_p_n, FUN_p_n) - Add -T RTS flag to specify the number of steps in younger generations. --- diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index d0b396e..63646ce 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -43,7 +43,7 @@ import Const ( Literal(..) ) import Maybes ( maybeToBool, catMaybes ) import PrimOp ( primOpNeedsWrapper, pprPrimOp, PrimOp(..) ) import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize, showPrimRep ) -import SMRep ( getSMRepStr ) +import SMRep ( pprSMRep ) import Unique ( pprUnique, Unique{-instance NamedThing-} ) import UniqSet ( emptyUniqSet, elementOfUniqSet, addOneToUniqSet, UniqSet @@ -450,7 +450,7 @@ pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast srt cl_descr) _ else empty, type_str ] - type_str = text (getSMRepStr (closureSMRep cl_info)) + type_str = pprSMRep (closureSMRep cl_info) pp_descr = hcat [char '"', text (stringToC cl_descr), char '"'] pp_type = hcat [char '"', text (stringToC (closureTypeDescr cl_info)), char '"'] diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs index f1a0ef2..c383998 100644 --- a/ghc/compiler/codeGen/CgHeapery.lhs +++ b/ghc/compiler/codeGen/CgHeapery.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: CgHeapery.lhs,v 1.12 1999/01/21 10:31:56 simonm Exp $ +% $Id: CgHeapery.lhs,v 1.13 1999/01/26 16:16:33 simonm Exp $ % \section[CgHeapery]{Heap management functions} @@ -21,7 +21,7 @@ import CLabel import CgMonad import CgStackery ( getFinalStackHW, mkTaggedStkAmodes, mkTagAssts ) -import SMRep ( fixedHdrSize, getSMRepStr ) +import SMRep ( fixedHdrSize ) import AbsCUtils ( mkAbstractCs, getAmodeRep ) import CgUsages ( getVirtAndRealHp, getRealSp, setVirtHp, setRealHp, initHeapUsage @@ -446,7 +446,6 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets -- GENERATE CC PROFILING MESSAGES costCentresC SLIT("CCS_ALLOC") [blame_cc, mkIntCLit closure_size] - -- CLitLit (_PK_ type_str) IntRep] -- not necessary? --SDM `thenC` -- BUMP THE VIRTUAL HEAP POINTER @@ -457,7 +456,6 @@ allocDynClosure closure_info use_cc blame_cc amodes_with_offsets where closure_size = closureSize closure_info slop_size = slopSize closure_info - type_str = getSMRepStr (closureSMRep closure_info) -- Avoid hanging on to anything in the CC field when we're not profiling. diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs index 9e99002..f64b8dc 100644 --- a/ghc/compiler/codeGen/ClosureInfo.lhs +++ b/ghc/compiler/codeGen/ClosureInfo.lhs @@ -1,7 +1,7 @@ % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -% $Id: ClosureInfo.lhs,v 1.32 1998/12/18 17:40:54 simonpj Exp $ +% $Id: ClosureInfo.lhs,v 1.33 1999/01/26 16:16:33 simonm Exp $ % \section[ClosureInfo]{Data structures which describe closures} @@ -59,7 +59,8 @@ import AbsCSyn ( MagicId, node, VirtualHeapOffset, HeapOffset ) import StgSyn import CgMonad -import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject ) +import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject, + mAX_SPEC_FUN_SIZE, mAX_SPEC_THUNK_SIZE, mAX_SPEC_CONSTR_SIZE ) import CgRetConv ( assignRegs ) import CLabel ( CLabel, mkStdEntryLabel, mkFastEntryLabel, mkInfoTableLabel, @@ -393,18 +394,19 @@ layOutStaticClosure name kind_fn things lf_info (tot_wds, -- #ptr_wds + #nonptr_wds ptr_wds, -- #ptr_wds things_w_offsets) = mkVirtHeapOffsets (StaticRep bot bot bot) kind_fn things + -- constructors with no pointer fields will definitely be NOCAF things. -- this is a compromise until we can generate both kinds of constructor -- (a normal static kind and the NOCAF_STATIC kind). closure_type = case lf_info of LFCon _ _ | ptr_wds == 0 -> CONSTR_NOCAF - _ -> getClosureType lf_info + _ -> getStaticClosureType lf_info bot = panic "layoutStaticClosure" layOutStaticNoFVClosure :: Name -> LambdaFormInfo -> ClosureInfo layOutStaticNoFVClosure name lf_info - = MkClosureInfo name lf_info (StaticRep 0 0 (getClosureType lf_info)) + = MkClosureInfo name lf_info (StaticRep 0 0 (getStaticClosureType lf_info)) \end{code} %************************************************************************ @@ -422,24 +424,48 @@ chooseDynSMRep chooseDynSMRep lf_info tot_wds ptr_wds = let nonptr_wds = tot_wds - ptr_wds - closure_type = getClosureType lf_info + closure_type = getClosureType tot_wds ptr_wds nonptr_wds lf_info in case lf_info of LFTuple _ True -> ConstantRep LFCon _ True -> ConstantRep _ -> GenericRep ptr_wds nonptr_wds closure_type -getClosureType :: LambdaFormInfo -> ClosureType -getClosureType lf_info = +getStaticClosureType :: LambdaFormInfo -> ClosureType +getStaticClosureType lf_info = case lf_info of LFCon con True -> CONSTR_NOCAF - LFCon con False -> CONSTR + LFCon con False -> CONSTR LFReEntrant _ _ _ _ -> FUN LFTuple _ _ -> CONSTR LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR LFThunk _ _ _ _ _ -> THUNK _ -> panic "getClosureType" - -- ToDo: could be anything else here? + +getClosureType :: Int -> Int -> Int -> LambdaFormInfo -> ClosureType +getClosureType tot_wds ptrs nptrs lf_info = + case lf_info of + LFCon con True -> CONSTR_NOCAF + + LFCon con False + | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs + | otherwise -> CONSTR + + LFReEntrant _ _ _ _ + | tot_wds > 0 && tot_wds <= mAX_SPEC_FUN_SIZE -> FUN_p_n ptrs nptrs + | otherwise -> FUN + + LFTuple _ _ + | tot_wds > 0 && tot_wds <= mAX_SPEC_CONSTR_SIZE -> CONSTR_p_n ptrs nptrs + | otherwise -> CONSTR + + LFThunk _ _ _ _ (SelectorThunk _) -> THUNK_SELECTOR + + LFThunk _ _ _ _ _ + | tot_wds > 0 && tot_wds <= mAX_SPEC_THUNK_SIZE -> THUNK_p_n ptrs nptrs + | otherwise -> THUNK + + _ -> panic "getClosureType" \end{code} %************************************************************************ diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs index fe46317..9a36a33 100644 --- a/ghc/compiler/codeGen/SMRep.lhs +++ b/ghc/compiler/codeGen/SMRep.lhs @@ -10,7 +10,7 @@ Other modules should access this info through ClosureInfo. module SMRep ( SMRep(..), ClosureType(..), isConstantRep, isStaticRep, - fixedHdrSize, arrHdrSize, fixedItblSize, getSMRepStr, getClosureTypeStr + fixedHdrSize, arrHdrSize, fixedItblSize, pprSMRep #ifndef OMIT_NATIVE_CODEGEN , getSMRepClosureTypeInt @@ -67,9 +67,12 @@ data SMRep data ClosureType = CONSTR + | CONSTR_p_n Int Int | CONSTR_NOCAF | FUN + | FUN_p_n Int Int | THUNK + | THUNK_p_n Int Int | THUNK_SELECTOR deriving (Eq,Ord) @@ -135,18 +138,22 @@ instance Text SMRep where ConstantRep -> "") instance Outputable SMRep where - ppr rep = text (show rep) - -getSMRepStr (GenericRep _ _ t) = getClosureTypeStr t -getSMRepStr (StaticRep _ _ t) = getClosureTypeStr t ++ "_STATIC" -getSMRepStr ConstantRep = "CONSTR_NOCAF_STATIC" -getSMRepStr BlackHoleRep = "BLACKHOLE" - -getClosureTypeStr CONSTR = "CONSTR" -getClosureTypeStr CONSTR_NOCAF = "CONSTR_NOCAF" -getClosureTypeStr FUN = "FUN" -getClosureTypeStr THUNK = "THUNK" -getClosureTypeStr THUNK_SELECTOR = "THUNK_SELECTOR" + ppr rep = pprSMRep rep + +pprSMRep :: SMRep -> SDoc +pprSMRep (GenericRep _ _ t) = pprClosureType t +pprSMRep (StaticRep _ _ t) = pprClosureType t <> ptext SLIT("_STATIC") +pprSMRep ConstantRep = ptext SLIT("CONSTR_NOCAF_STATIC") +pprSMRep BlackHoleRep = ptext SLIT("BLACKHOLE") + +pprClosureType CONSTR = ptext SLIT("CONSTR") +pprClosureType (CONSTR_p_n p n) = ptext SLIT("CONSTR_") <> int p <> char '_' <> int n +pprClosureType CONSTR_NOCAF = ptext SLIT("CONSTR_NOCAF") +pprClosureType FUN = ptext SLIT("FUN") +pprClosureType (FUN_p_n p n) = ptext SLIT("FUN_") <> int p <> char '_' <> int n +pprClosureType THUNK = ptext SLIT("THUNK") +pprClosureType (THUNK_p_n p n) = ptext SLIT("THUNK_") <> int p <> char '_' <> int n +pprClosureType THUNK_SELECTOR = ptext SLIT("THUNK_SELECTOR") #ifndef OMIT_NATIVE_CODEGEN getSMRepClosureTypeInt :: SMRep -> Int diff --git a/ghc/compiler/main/Constants.lhs b/ghc/compiler/main/Constants.lhs index c0bf487..d30a976 100644 --- a/ghc/compiler/main/Constants.lhs +++ b/ghc/compiler/main/Constants.lhs @@ -18,6 +18,9 @@ module Constants ( mAX_CONTEXT_REDUCTION_DEPTH, mAX_TUPLE_SIZE, + mAX_SPEC_THUNK_SIZE, + mAX_SPEC_FUN_SIZE, + mAX_SPEC_CONSTR_SIZE, mAX_SPEC_SELECTEE_SIZE, mAX_SPEC_AP_SIZE, @@ -107,6 +110,11 @@ uNFOLDING_KEENESS_FACTOR = ( 2.0 :: Float) \begin{code} +-- specialised fun/thunk/constr closure types +mAX_SPEC_THUNK_SIZE = (MAX_SPEC_THUNK_SIZE :: Int) +mAX_SPEC_FUN_SIZE = (MAX_SPEC_FUN_SIZE :: Int) +mAX_SPEC_CONSTR_SIZE = (MAX_SPEC_CONSTR_SIZE :: Int) + -- pre-compiled thunk types mAX_SPEC_SELECTEE_SIZE = (MAX_SPEC_SELECTEE_SIZE :: Int) mAX_SPEC_AP_SIZE = (MAX_SPEC_AP_SIZE :: Int) diff --git a/ghc/includes/ClosureTypes.h b/ghc/includes/ClosureTypes.h index 9ae6332..24d4189 100644 --- a/ghc/includes/ClosureTypes.h +++ b/ghc/includes/ClosureTypes.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $Id: ClosureTypes.h,v 1.6 1999/01/26 11:12:55 simonm Exp $ + * $Id: ClosureTypes.h,v 1.7 1999/01/26 16:16:19 simonm Exp $ * * Closure Type Constants * @@ -13,52 +13,65 @@ /* Object tag 0 raises an internal error */ #define INVALID_OBJECT 0 #define CONSTR 1 -/* #define CONSTR_p_np */ -#define CONSTR_INTLIKE 2 -#define CONSTR_CHARLIKE 3 -#define CONSTR_STATIC 4 -#define CONSTR_NOCAF_STATIC 5 -#define FUN 6 -#define FUN_STATIC 7 -#define THUNK 8 -/* #define THUNK_p_np */ -#define THUNK_STATIC 9 -#define THUNK_SELECTOR 10 -#define BCO 11 -#define AP_UPD 12 -#define PAP 13 -#define IND 14 -#define IND_OLDGEN 15 -#define IND_PERM 16 -#define IND_OLDGEN_PERM 17 -#define IND_STATIC 18 -#define CAF_UNENTERED 19 -#define CAF_ENTERED 20 -#define CAF_BLACKHOLE 21 -#define RET_BCO 22 -#define RET_SMALL 23 -#define RET_VEC_SMALL 24 -#define RET_BIG 25 -#define RET_VEC_BIG 26 -#define RET_DYN 27 -#define UPDATE_FRAME 28 -#define CATCH_FRAME 29 -#define STOP_FRAME 30 -#define SEQ_FRAME 31 -#define BLACKHOLE 32 -#define BLACKHOLE_BQ 33 -#define MVAR 34 -#define ARR_WORDS 35 -#define MUT_ARR_WORDS 36 -#define MUT_ARR_PTRS 37 -#define MUT_ARR_PTRS_FROZEN 38 -#define MUT_VAR 49 -#define WEAK 40 -#define FOREIGN 41 -#define STABLE_NAME 42 -#define TSO 43 -#define BLOCKED_FETCH 44 -#define FETCH_ME 45 -#define EVACUATED 46 +#define CONSTR_1_0 2 +#define CONSTR_0_1 3 +#define CONSTR_2_0 4 +#define CONSTR_1_1 5 +#define CONSTR_0_2 6 +#define CONSTR_INTLIKE 7 +#define CONSTR_CHARLIKE 8 +#define CONSTR_STATIC 9 +#define CONSTR_NOCAF_STATIC 10 +#define FUN 11 +#define FUN_1_0 12 +#define FUN_0_1 13 +#define FUN_2_0 14 +#define FUN_1_1 15 +#define FUN_0_2 16 +#define FUN_STATIC 17 +#define THUNK 18 +#define THUNK_1_0 19 +#define THUNK_0_1 20 +#define THUNK_2_0 21 +#define THUNK_1_1 22 +#define THUNK_0_2 23 +#define THUNK_STATIC 24 +#define THUNK_SELECTOR 25 +#define BCO 26 +#define AP_UPD 27 +#define PAP 28 +#define IND 29 +#define IND_OLDGEN 30 +#define IND_PERM 31 +#define IND_OLDGEN_PERM 32 +#define IND_STATIC 33 +#define CAF_UNENTERED 34 +#define CAF_ENTERED 35 +#define CAF_BLACKHOLE 36 +#define RET_BCO 37 +#define RET_SMALL 38 +#define RET_VEC_SMALL 39 +#define RET_BIG 40 +#define RET_VEC_BIG 41 +#define RET_DYN 42 +#define UPDATE_FRAME 43 +#define CATCH_FRAME 44 +#define STOP_FRAME 45 +#define SEQ_FRAME 46 +#define BLACKHOLE 47 +#define BLACKHOLE_BQ 48 +#define MVAR 49 +#define ARR_WORDS 50 +#define MUT_ARR_WORDS 51 +#define MUT_ARR_PTRS 52 +#define MUT_ARR_PTRS_FROZEN 53 +#define MUT_VAR 54 +#define WEAK 55 +#define FOREIGN 56 +#define STABLE_NAME 57 +#define TSO 58 +#define BLOCKED_FETCH 59 +#define FETCH_ME 60 +#define EVACUATED 61 #endif CLOSURETYPES_H diff --git a/ghc/includes/Constants.h b/ghc/includes/Constants.h index d970160..fbb3dbf 100644 --- a/ghc/includes/Constants.h +++ b/ghc/includes/Constants.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $Id: Constants.h,v 1.3 1999/01/21 10:31:41 simonm Exp $ + * $Id: Constants.h,v 1.4 1999/01/26 16:16:20 simonm Exp $ * * Constants * @@ -88,6 +88,12 @@ #define MAX_SPEC_AP_SIZE 8 +/* Specialised FUN/THUNK/CONSTR closure types */ + +#define MAX_SPEC_THUNK_SIZE 2 +#define MAX_SPEC_FUN_SIZE 2 +#define MAX_SPEC_CONSTR_SIZE 2 + /* ----------------------------------------------------------------------------- Update Frame Layout -------------------------------------------------------------------------- */ diff --git a/ghc/includes/InfoTables.h b/ghc/includes/InfoTables.h index fb1640d..9c71d61 100644 --- a/ghc/includes/InfoTables.h +++ b/ghc/includes/InfoTables.h @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $Id: InfoTables.h,v 1.6 1999/01/26 11:12:55 simonm Exp $ + * $Id: InfoTables.h,v 1.7 1999/01/26 16:16:21 simonm Exp $ * * Info Tables * @@ -85,18 +85,32 @@ typedef struct { typedef enum { INVALID_OBJECT /* Object tag 0 raises an internal error */ + , CONSTR - /* CONSTR_p_np */ + , CONSTR_1_0 + , CONSTR_0_1 + , CONSTR_2_0 + , CONSTR_1_1 + , CONSTR_0_2 , CONSTR_INTLIKE , CONSTR_CHARLIKE , 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_p_np */ + , THUNK_1_0 + , THUNK_0_1 + , THUNK_2_0 + , THUNK_1_1 + , THUNK_0_2 , THUNK_STATIC , THUNK_SELECTOR @@ -176,11 +190,26 @@ typedef enum { /* HNF BTM NS STA THU MUT UPT SRT */ #define FLAGS_CONSTR (_HNF| _NS ) +#define FLAGS_CONSTR_1_0 (_HNF| _NS ) +#define FLAGS_CONSTR_0_1 (_HNF| _NS ) +#define FLAGS_CONSTR_2_0 (_HNF| _NS ) +#define FLAGS_CONSTR_1_1 (_HNF| _NS ) +#define FLAGS_CONSTR_0_2 (_HNF| _NS ) #define FLAGS_CONSTR_STATIC (_HNF| _NS|_STA ) #define FLAGS_CONSTR_NOCAF_STATIC (_HNF| _NS|_STA ) #define FLAGS_FUN (_HNF| _NS| _SRT ) +#define FLAGS_FUN_1_0 (_HNF| _NS ) +#define FLAGS_FUN_0_1 (_HNF| _NS ) +#define FLAGS_FUN_2_0 (_HNF| _NS ) +#define FLAGS_FUN_1_1 (_HNF| _NS ) +#define FLAGS_FUN_0_2 (_HNF| _NS ) #define FLAGS_FUN_STATIC (_HNF| _NS|_STA| _SRT ) #define FLAGS_THUNK ( _BTM| _THU| _SRT ) +#define FLAGS_THUNK_1_0 ( _BTM| _THU| _SRT ) +#define FLAGS_THUNK_0_1 ( _BTM| _THU| _SRT ) +#define FLAGS_THUNK_2_0 ( _BTM| _THU| _SRT ) +#define FLAGS_THUNK_1_1 ( _BTM| _THU| _SRT ) +#define FLAGS_THUNK_0_2 ( _BTM| _THU| _SRT ) #define FLAGS_THUNK_STATIC ( _BTM| _STA|_THU| _SRT ) #define FLAGS_THUNK_SELECTOR ( _BTM| _THU| _SRT ) #define FLAGS_BCO (_HNF| _NS ) diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 619aa5c..fa52dda 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.19 1999/01/26 11:12:43 simonm Exp $ + * $Id: GC.c,v 1.20 1999/01/26 16:16:22 simonm Exp $ * * Two-space garbage collector * @@ -807,7 +807,7 @@ MarkRoot(StgClosure *root) return evacuate(root); } -static inline void addBlock(step *step) +static void addBlock(step *step) { bdescr *bd = allocBlock(); bd->gen = step->gen; @@ -828,9 +828,8 @@ static inline void addBlock(step *step) } static __inline__ StgClosure * -copy(StgClosure *src, nat size, bdescr *bd) +copy(StgClosure *src, nat size, step *step) { - step *step; P_ to, from, dest; /* Find out where we're going, using the handy "to" pointer in @@ -838,7 +837,6 @@ copy(StgClosure *src, nat size, bdescr *bd) * evacuate to an older generation, adjust it here (see comment * by evacuate()). */ - step = bd->step->to; if (step->gen->no < evac_gen) { step = &generations[evac_gen].steps[0]; } @@ -850,11 +848,12 @@ copy(StgClosure *src, nat size, bdescr *bd) addBlock(step); } - dest = step->hp; - step->hp += size; - for(to = dest, from = (P_)src; size>0; --size) { + for(to = step->hp, from = (P_)src; size>0; --size) { *to++ = *from++; } + + dest = step->hp; + step->hp = to; return (StgClosure *)dest; } @@ -864,12 +863,10 @@ copy(StgClosure *src, nat size, bdescr *bd) */ static __inline__ StgClosure * -copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, bdescr *bd) +copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *step) { - step *step; P_ dest, to, from; - step = bd->step->to; if (step->gen->no < evac_gen) { step = &generations[evac_gen].steps[0]; } @@ -878,12 +875,12 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, bdescr *bd) addBlock(step); } - dest = step->hp; - step->hp += size_to_reserve; - for(to = dest, from = (P_)src; size_to_copy>0; --size_to_copy) { + for(to = step->hp, from = (P_)src; size_to_copy>0; --size_to_copy) { *to++ = *from++; } + dest = step->hp; + step->hp += size_to_reserve; return (StgClosure *)dest; } @@ -942,6 +939,7 @@ evacuate_large(StgPtr p, rtsBool mutable) */ if (bd->gen->no < evac_gen) { failed_to_evac = rtsTrue; + TICK_GC_FAILED_PROMOTION(); } return; } @@ -1039,6 +1037,7 @@ evacuate(StgClosure *q) { StgClosure *to; bdescr *bd = NULL; + step *step; const StgInfoTable *info; loop: @@ -1052,9 +1051,11 @@ loop: if (bd->gen->no < evac_gen) { /* nope */ failed_to_evac = rtsTrue; + TICK_GC_FAILED_PROMOTION(); } return q; } + step = bd->step->to; } /* make sure the info pointer is into text space */ @@ -1065,20 +1066,43 @@ loop: switch (info -> type) { case BCO: - to = copy(q,bco_sizeW(stgCast(StgBCO*,q)),bd); + to = copy(q,bco_sizeW(stgCast(StgBCO*,q)),step); upd_evacuee(q,to); return to; case MUT_VAR: case MVAR: - to = copy(q,sizeW_fromITBL(info),bd); + to = copy(q,sizeW_fromITBL(info),step); upd_evacuee(q,to); evacuate_mutable((StgMutClosure *)to); return to; case STABLE_NAME: stable_ptr_table[((StgStableName *)q)->sn].keep = rtsTrue; - to = copy(q,sizeofW(StgStableName),bd); + to = copy(q,sizeofW(StgStableName),step); + upd_evacuee(q,to); + return to; + + case FUN_1_0: + case FUN_0_1: + case CONSTR_1_0: + case CONSTR_0_1: + to = copy(q,sizeofW(StgHeader)+1,step); + upd_evacuee(q,to); + return to; + + case THUNK_1_0: /* here because of MIN_UPD_SIZE */ + case THUNK_0_1: + case FUN_1_1: + case FUN_0_2: + case FUN_2_0: + case THUNK_1_1: + case THUNK_0_2: + case THUNK_2_0: + case CONSTR_1_1: + case CONSTR_0_2: + case CONSTR_2_0: + to = copy(q,sizeofW(StgHeader)+2,step); upd_evacuee(q,to); return to; @@ -1091,18 +1115,18 @@ loop: case CAF_ENTERED: case WEAK: case FOREIGN: - to = copy(q,sizeW_fromITBL(info),bd); + to = copy(q,sizeW_fromITBL(info),step); upd_evacuee(q,to); return to; case CAF_BLACKHOLE: case BLACKHOLE: - to = copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),bd); + to = copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),step); upd_evacuee(q,to); return to; case BLACKHOLE_BQ: - to = copy(q,BLACKHOLE_sizeW(),bd); + to = copy(q,BLACKHOLE_sizeW(),step); upd_evacuee(q,to); evacuate_mutable((StgMutClosure *)to); return to; @@ -1116,6 +1140,11 @@ loop: selectee_info = get_itbl(selectee); switch (selectee_info->type) { case CONSTR: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_2_0: + case CONSTR_1_1: + case CONSTR_0_2: case CONSTR_STATIC: { StgNat32 offset = info->layout.selector_offset; @@ -1137,6 +1166,7 @@ loop: if (bd->evacuated) { if (bd->gen->no < evac_gen) { failed_to_evac = rtsTrue; + TICK_GC_FAILED_PROMOTION(); } return q; } @@ -1165,6 +1195,11 @@ loop: goto selector_loop; case THUNK: + case THUNK_1_0: + case THUNK_0_1: + case THUNK_2_0: + case THUNK_1_1: + case THUNK_0_2: case THUNK_STATIC: case THUNK_SELECTOR: /* aargh - do recursively???? */ @@ -1179,7 +1214,7 @@ loop: barf("evacuate: THUNK_SELECTOR: strange selectee"); } } - to = copy(q,THUNK_SELECTOR_sizeW(),bd); + to = copy(q,THUNK_SELECTOR_sizeW(),step); upd_evacuee(q,to); return to; @@ -1239,7 +1274,7 @@ loop: case PAP: /* these are special - the payload is a copy of a chunk of stack, tagging and all. */ - to = copy(q,pap_sizeW(stgCast(StgPAP*,q)),bd); + to = copy(q,pap_sizeW(stgCast(StgPAP*,q)),step); upd_evacuee(q,to); return to; @@ -1256,6 +1291,7 @@ loop: if (Bdescr((P_)p)->gen->no < evac_gen) { /* fprintf(stderr,"evac failed!\n");*/ failed_to_evac = rtsTrue; + TICK_GC_FAILED_PROMOTION(); } } return ((StgEvacuated*)q)->evacuee; @@ -1270,7 +1306,7 @@ loop: return q; } else { /* just copy the block */ - to = copy(q,size,bd); + to = copy(q,size,step); upd_evacuee(q,to); return to; } @@ -1286,7 +1322,7 @@ loop: to = q; } else { /* just copy the block */ - to = copy(q,size,bd); + to = copy(q,size,step); upd_evacuee(q,to); if (info->type == MUT_ARR_PTRS) { evacuate_mutable((StgMutClosure *)to); @@ -1311,7 +1347,7 @@ loop: * list it contains. */ } else { - StgTSO *new_tso = (StgTSO *)copy((StgClosure *)tso,tso_sizeW(tso),bd); + StgTSO *new_tso = (StgTSO *)copy((StgClosure *)tso,tso_sizeW(tso),step); diff = (StgPtr)new_tso - (StgPtr)tso; /* In *words* */ @@ -1482,6 +1518,54 @@ scavenge(step *step) break; } + case THUNK_2_0: + case FUN_2_0: + scavenge_srt(info); + case CONSTR_2_0: + ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]); + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 2; + break; + + case THUNK_1_0: + scavenge_srt(info); + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */ + break; + + case FUN_1_0: + scavenge_srt(info); + case CONSTR_1_0: + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 1; + break; + + case THUNK_0_1: + scavenge_srt(info); + p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */ + break; + + case FUN_0_1: + scavenge_srt(info); + case CONSTR_0_1: + p += sizeofW(StgHeader) + 1; + break; + + case THUNK_0_2: + case FUN_0_2: + scavenge_srt(info); + case CONSTR_0_2: + p += sizeofW(StgHeader) + 2; + break; + + case THUNK_1_1: + case FUN_1_1: + scavenge_srt(info); + case CONSTR_1_1: + ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 2; + break; + case FUN: case THUNK: scavenge_srt(info); @@ -1679,8 +1763,23 @@ scavenge_one(StgPtr p) switch (info -> type) { case FUN: + case FUN_1_0: /* hardly worth specialising these guys */ + case FUN_0_1: + case FUN_1_1: + case FUN_0_2: + case FUN_2_0: case THUNK: + case THUNK_1_0: + case THUNK_0_1: + case THUNK_1_1: + case THUNK_0_2: + case THUNK_2_0: case CONSTR: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_1_1: + case CONSTR_0_2: + case CONSTR_2_0: case WEAK: case FOREIGN: case IND_PERM: @@ -2066,22 +2165,24 @@ scavenge_stack(StgPtr p, StgPtr stack_end) continue; } else { bdescr *bd = Bdescr((P_)frame->updatee); + step *step; if (bd->gen->no > N) { if (bd->gen->no < evac_gen) { failed_to_evac = rtsTrue; } continue; } + step = bd->step->to; switch (type) { case BLACKHOLE: case CAF_BLACKHOLE: to = copyPart(frame->updatee, BLACKHOLE_sizeW(), - sizeofW(StgHeader), bd); + sizeofW(StgHeader), step); upd_evacuee(frame->updatee,to); frame->updatee = to; continue; case BLACKHOLE_BQ: - to = copy(frame->updatee, BLACKHOLE_sizeW(), bd); + to = copy(frame->updatee, BLACKHOLE_sizeW(), step); upd_evacuee(frame->updatee,to); frame->updatee = to; evacuate_mutable((StgMutClosure *)to); diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index ae40080..784c6a1 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.7 1999/01/26 11:12:46 simonm Exp $ + * $Id: PrimOps.hc,v 1.8 1999/01/26 16:16:25 simonm Exp $ * * Primitive functions / data * @@ -871,3 +871,4 @@ FN_(makeStableNameZh_fast) } #endif /* COMPILER */ + diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c index 089efd2..bcba5d1 100644 --- a/ghc/rts/RtsFlags.c +++ b/ghc/rts/RtsFlags.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsFlags.c,v 1.6 1999/01/21 10:31:48 simonm Exp $ + * $Id: RtsFlags.c,v 1.7 1999/01/26 16:16:28 simonm Exp $ * * Functions for parsing the argument list. * @@ -67,6 +67,7 @@ void initRtsFlagsDefaults(void) RtsFlags.GcFlags.pcFreeHeap = 3; /* 3% */ RtsFlags.GcFlags.oldGenFactor = 2; RtsFlags.GcFlags.generations = 2; + RtsFlags.GcFlags.steps = 2; RtsFlags.GcFlags.forceGC = rtsFalse; RtsFlags.GcFlags.forcingInterval = 5000000; /* 5MB (or words?) */ @@ -214,6 +215,7 @@ usage_text[] = { " -M Sets the maximum heap size (default 64M) Egs: -H256k -H1G", " -m% Minimum % of heap which must be available (default 3%)", " -G Number of generations (default: 2)", +" -T Number of steps in younger generations (default: 2)", " -s Summary GC statistics (default file: .stat)", " -S Detailed GC statistics (with -Sstderr going to stderr)", "", @@ -265,8 +267,6 @@ usage_text[] = { " -r Produce reduction profiling statistics (with -rstderr for stderr)", "", #endif -" -T Trace garbage collection execution (debugging)", -"", # ifdef PAR " -N Use PVMish processors in parallel (default: 2)", /* NB: the -N is implemented by the driver!! */ @@ -484,6 +484,13 @@ error = rtsTrue; } break; + case 'T': + RtsFlags.GcFlags.steps = decode(rts_argv[arg]+2); + if (RtsFlags.GcFlags.steps < 1) { + bad_option(rts_argv[arg]); + } + break; + case 'H': /* ignore for compatibility with older versions */ break; diff --git a/ghc/rts/RtsFlags.h b/ghc/rts/RtsFlags.h index da65c5b..9678a98 100644 --- a/ghc/rts/RtsFlags.h +++ b/ghc/rts/RtsFlags.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsFlags.h,v 1.6 1999/01/26 11:12:46 simonm Exp $ + * $Id: RtsFlags.h,v 1.7 1999/01/26 16:16:29 simonm Exp $ * * Datatypes that holds the command-line flag settings. * @@ -26,6 +26,7 @@ struct GC_FLAGS { double pcFreeHeap; nat generations; + nat steps; rtsBool forceGC; /* force a major GC every bytes */ int forcingInterval; /* actually, stored as a number of *words* */ diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index 6b44104..5117375 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.c,v 1.6 1999/01/21 10:31:51 simonm Exp $ + * $Id: Storage.c,v 1.7 1999/01/26 16:16:30 simonm Exp $ * * Storage manager front end * @@ -82,9 +82,10 @@ initStorage (void) /* set up all except the oldest generation with 2 steps */ for(g = 0; g < RtsFlags.GcFlags.generations-1; g++) { - generations[g].n_steps = 2; - generations[g].steps = stgMallocBytes (2 * sizeof(struct _step), - "initStorage: steps"); + generations[g].n_steps = RtsFlags.GcFlags.steps; + generations[g].steps = + stgMallocBytes (RtsFlags.GcFlags.steps * sizeof(struct _step), + "initStorage: steps"); } } else { @@ -112,14 +113,10 @@ initStorage (void) /* Set up the destination pointers in each younger gen. step */ for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) { - for (s = 0; s < generations[g].n_steps; s++) { - step = &generations[g].steps[s]; - if ( s == 1 ) { - step->to = &generations[g+1].steps[0]; - } else { - step->to = &generations[g].steps[s+1]; - } + for (s = 0; s < generations[g].n_steps-1; s++) { + generations[g].steps[s].to = &generations[g].steps[s+1]; } + generations[g].steps[s].to = &generations[g+1].steps[0]; } /* The oldest generation has one step and its destination is the