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
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 '"']
%
% (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}
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
-- 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
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.
%
% (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}
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,
(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}
%************************************************************************
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}
%************************************************************************
module SMRep (
SMRep(..), ClosureType(..),
isConstantRep, isStaticRep,
- fixedHdrSize, arrHdrSize, fixedItblSize, getSMRepStr, getClosureTypeStr
+ fixedHdrSize, arrHdrSize, fixedItblSize, pprSMRep
#ifndef OMIT_NATIVE_CODEGEN
, getSMRepClosureTypeInt
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)
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
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,
\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)
/* ----------------------------------------------------------------------------
- * $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
*
/* 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
/* ----------------------------------------------------------------------------
- * $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
*
#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
-------------------------------------------------------------------------- */
/* ----------------------------------------------------------------------------
- * $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
*
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
/* 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 )
/* -----------------------------------------------------------------------------
- * $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
*
return evacuate(root);
}
-static inline void addBlock(step *step)
+static void addBlock(step *step)
{
bdescr *bd = allocBlock();
bd->gen = step->gen;
}
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
* 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];
}
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;
}
*/
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];
}
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;
}
*/
if (bd->gen->no < evac_gen) {
failed_to_evac = rtsTrue;
+ TICK_GC_FAILED_PROMOTION();
}
return;
}
{
StgClosure *to;
bdescr *bd = NULL;
+ step *step;
const StgInfoTable *info;
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 */
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;
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;
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;
if (bd->evacuated) {
if (bd->gen->no < evac_gen) {
failed_to_evac = rtsTrue;
+ TICK_GC_FAILED_PROMOTION();
}
return q;
}
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???? */
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;
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;
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;
return q;
} else {
/* just copy the block */
- to = copy(q,size,bd);
+ to = copy(q,size,step);
upd_evacuee(q,to);
return to;
}
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);
* 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* */
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);
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:
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);
/* -----------------------------------------------------------------------------
- * $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
*
}
#endif /* COMPILER */
+
/* -----------------------------------------------------------------------------
- * $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.
*
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?) */
" -M<size> Sets the maximum heap size (default 64M) Egs: -H256k -H1G",
" -m<n>% Minimum % of heap which must be available (default 3%)",
" -G<n> Number of generations (default: 2)",
+" -T<n> Number of steps in younger generations (default: 2)",
" -s<file> Summary GC statistics (default file: <program>.stat)",
" -S<file> Detailed GC statistics (with -Sstderr going to stderr)",
"",
" -r<file> Produce reduction profiling statistics (with -rstderr for stderr)",
"",
#endif
-" -T<level> Trace garbage collection execution (debugging)",
-"",
# ifdef PAR
" -N<n> Use <n> PVMish processors in parallel (default: 2)",
/* NB: the -N<n> is implemented by the driver!! */
}
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;
/* -----------------------------------------------------------------------------
- * $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.
*
double pcFreeHeap;
nat generations;
+ nat steps;
rtsBool forceGC; /* force a major GC every <interval> bytes */
int forcingInterval; /* actually, stored as a number of *words* */
/* -----------------------------------------------------------------------------
- * $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
*
/* 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 {
/* 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
projects / ghc-hetmet.git / commitdiff