/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.31 1999/02/15 14:27:19 simonm Exp $
+ * $Id: GC.c,v 1.45 1999/02/26 17:46:08 simonm Exp $
*
* (c) The GHC Team 1998-1999
*
*/
bdescr *old_to_space;
+/* Data used for allocation area sizing.
+ */
+lnat new_blocks; /* blocks allocated during this GC */
+lnat g0s0_pcnt_kept = 30; /* percentage of g0s0 live at last minor GC */
+
/* -----------------------------------------------------------------------------
Static function declarations
-------------------------------------------------------------------------- */
-static StgClosure *evacuate(StgClosure *q);
-static void zeroStaticObjectList(StgClosure* first_static);
-static rtsBool traverse_weak_ptr_list(void);
-static void zeroMutableList(StgMutClosure *first);
-static void revertDeadCAFs(void);
+static StgClosure * evacuate ( StgClosure *q );
+static void zero_static_object_list ( StgClosure* first_static );
+static void zero_mutable_list ( StgMutClosure *first );
+static void revert_dead_CAFs ( void );
-static void scavenge_stack(StgPtr p, StgPtr stack_end);
-static void scavenge_large(step *step);
-static void scavenge(step *step);
-static void scavenge_static(void);
-static void scavenge_mutable_list(generation *g);
-static void scavenge_mut_once_list(generation *g);
+static rtsBool traverse_weak_ptr_list ( void );
+static void cleanup_weak_ptr_list ( void );
+
+static void scavenge_stack ( StgPtr p, StgPtr stack_end );
+static void scavenge_large ( step *step );
+static void scavenge ( step *step );
+static void scavenge_static ( void );
+static void scavenge_mutable_list ( generation *g );
+static void scavenge_mut_once_list ( generation *g );
#ifdef DEBUG
-static void gcCAFs(void);
+static void gcCAFs ( void );
#endif
/* -----------------------------------------------------------------------------
{
bdescr *bd;
step *step;
- lnat live, allocated, collected = 0;
+ lnat live, allocated, collected = 0, copied = 0;
nat g, s;
#ifdef PROFILING
scavenged_static_objects = END_OF_STATIC_LIST;
/* zero the mutable list for the oldest generation (see comment by
- * zeroMutableList below).
+ * zero_mutable_list below).
*/
if (major_gc) {
- zeroMutableList(generations[RtsFlags.GcFlags.generations-1].mut_once_list);
+ zero_mutable_list(generations[RtsFlags.GcFlags.generations-1].mut_once_list);
}
/* Save the old to-space if we're doing a two-space collection
g0s0->to_space = NULL;
}
+ /* Keep a count of how many new blocks we allocated during this GC
+ * (used for resizing the allocation area, later).
+ */
+ new_blocks = 0;
+
/* Initialise to-space in all the generations/steps that we're
* collecting.
*/
step->hpLim = step->hp + BLOCK_SIZE_W;
step->hp_bd = bd;
step->to_space = bd;
- step->to_blocks = 1; /* ???? */
+ step->to_blocks = 1;
step->scan = bd->start;
step->scan_bd = bd;
step->new_large_objects = NULL;
step->scavenged_large_objects = NULL;
+ new_blocks++;
/* mark the large objects as not evacuated yet */
for (bd = step->large_objects; bd; bd = bd->link) {
bd->evacuated = 0;
step->hp_bd = bd;
step->blocks = bd;
step->n_blocks = 1;
+ new_blocks++;
}
/* Set the scan pointer for older generations: remember we
* still have to scavenge objects that have been promoted. */
/* Mark the weak pointer list, and prepare to detect dead weak
* pointers.
*/
- markWeakList();
old_weak_ptr_list = weak_ptr_list;
weak_ptr_list = NULL;
weak_done = rtsFalse;
*/
scavengeEverything();
/* revert dead CAFs and update enteredCAFs list */
- revertDeadCAFs();
+ revert_dead_CAFs();
#endif
markHugsObjects();
#if 0
loop2:
for (gen = RtsFlags.GcFlags.generations-1; gen >= 0; gen--) {
for (st = generations[gen].n_steps-1; st >= 0 ; st--) {
+ if (gen == 0 && st == 0 && RtsFlags.GcFlags.generations > 1) {
+ continue;
+ }
step = &generations[gen].steps[st];
evac_gen = gen;
if (step->hp_bd != step->scan_bd || step->scan < step->hp) {
}
}
- /* Now see which stable names are still alive
+ /* Final traversal of the weak pointer list (see comment by
+ * cleanUpWeakPtrList below).
+ */
+ cleanup_weak_ptr_list();
+
+ /* Now see which stable names are still alive.
*/
gcStablePtrTable(major_gc);
/* run through all the generations/steps and tidy up
*/
+ copied = new_blocks * BLOCK_SIZE_W;
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
if (g <= N) {
/* Tidy the end of the to-space chains */
step->hp_bd->free = step->hp;
step->hp_bd->link = NULL;
+ /* stats information: how much we copied */
+ if (g <= N) {
+ copied -= step->hp_bd->start + BLOCK_SIZE_W -
+ step->hp_bd->free;
+ }
}
/* for generations we collected... */
* oldest_gen
*/
if (g != 0) {
+#if 0
generations[g].max_blocks = (oldest_gen->max_blocks * g)
/ (RtsFlags.GcFlags.generations-1);
+#endif
+ generations[g].max_blocks = oldest_gen->max_blocks;
}
/* for older generations... */
/* Guess the amount of live data for stats. */
live = calcLive();
+ /* Free the small objects allocated via allocate(), since this will
+ * all have been copied into G0S1 now.
+ */
+ if (small_alloc_list != NULL) {
+ freeChain(small_alloc_list);
+ }
+ small_alloc_list = NULL;
+ alloc_blocks = 0;
+ alloc_Hp = NULL;
+ alloc_HpLim = NULL;
+ alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
+
/* Two-space collector:
* Free the old to-space, and estimate the amount of live data.
*/
nat needed = calcNeeded(); /* approx blocks needed at next GC */
/* Guess how much will be live in generation 0 step 0 next time.
- * A good approximation is the amount of data that was live this
- * time: this assumes (1) that the size of G0S0 will be roughly
- * the same as last time, and (2) that the promotion rate will be
- * constant.
- *
- * If we don't know how much was live in G0S0 (because there's no
- * step 1), then assume 30% (which is usually an overestimate).
+ * A good approximation is the obtained by finding the
+ * percentage of g0s0 that was live at the last minor GC.
*/
- if (g0->n_steps == 1) {
- needed += (g0s0->n_blocks * 30) / 100;
- } else {
- needed += g0->steps[1].n_blocks;
+ if (N == 0) {
+ g0s0_pcnt_kept = (new_blocks * 100) / g0s0->n_blocks;
}
- /* Now we have a rough guess at the number of blocks needed for
- * the next GC, subtract this from the user's suggested heap size
- * and use the rest for the allocation area.
+ /* Estimate a size for the allocation area based on the
+ * information available. We might end up going slightly under
+ * or over the suggested heap size, but we should be pretty
+ * close on average.
+ *
+ * Formula: suggested - needed
+ * ----------------------------
+ * 1 + g0s0_pcnt_kept/100
+ *
+ * where 'needed' is the amount of memory needed at the next
+ * collection for collecting all steps except g0s0.
*/
- blocks = (int)RtsFlags.GcFlags.heapSizeSuggestion - (int)needed;
+ blocks =
+ (((int)RtsFlags.GcFlags.heapSizeSuggestion - (int)needed) * 100) /
+ (100 + (int)g0s0_pcnt_kept);
if (blocks < (int)RtsFlags.GcFlags.minAllocAreaSize) {
blocks = RtsFlags.GcFlags.minAllocAreaSize;
}
/* revert dead CAFs and update enteredCAFs list */
- revertDeadCAFs();
+ revert_dead_CAFs();
/* mark the garbage collected CAFs as dead */
#ifdef DEBUG
/* zero the scavenged static object list */
if (major_gc) {
- zeroStaticObjectList(scavenged_static_objects);
+ zero_static_object_list(scavenged_static_objects);
}
/* Reset the nursery
bd->free = bd->start;
ASSERT(bd->gen == g0);
ASSERT(bd->step == g0s0);
+ IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
}
current_nursery = g0s0->blocks;
- /* Free the small objects allocated via allocate(), since this will
- * all have been copied into G0S1 now.
- */
- if (small_alloc_list != NULL) {
- freeChain(small_alloc_list);
- }
- small_alloc_list = NULL;
- alloc_blocks = 0;
- alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
-
/* start any pending finalizers */
scheduleFinalizers(old_weak_ptr_list);
IF_DEBUG(sanity, memInventory());
/* ok, GC over: tell the stats department what happened. */
- stat_endGC(allocated, collected, live, N);
+ stat_endGC(allocated, collected, live, copied, N);
}
/* -----------------------------------------------------------------------------
last_w = &old_weak_ptr_list;
for (w = old_weak_ptr_list; w; w = next_w) {
+ /* First, this weak pointer might have been evacuated. If so,
+ * remove the forwarding pointer from the weak_ptr_list.
+ */
+ if (get_itbl(w)->type == EVACUATED) {
+ w = (StgWeak *)((StgEvacuated *)w)->evacuee;
+ *last_w = w;
+ }
+
+ /* There might be a DEAD_WEAK on the list if finalizeWeak# was
+ * called on a live weak pointer object. Just remove it.
+ */
+ if (w->header.info == &DEAD_WEAK_info) {
+ next_w = ((StgDeadWeak *)w)->link;
+ *last_w = next_w;
+ continue;
+ }
+
+ ASSERT(get_itbl(w)->type == WEAK);
+
+ /* Now, check whether the key is reachable.
+ */
if ((new = isAlive(w->key))) {
w->key = new;
/* evacuate the value and finalizer */
}
/* -----------------------------------------------------------------------------
+ After GC, the live weak pointer list may have forwarding pointers
+ on it, because a weak pointer object was evacuated after being
+ moved to the live weak pointer list. We remove those forwarding
+ pointers here.
+
+ Also, we don't consider weak pointer objects to be reachable, but
+ we must nevertheless consider them to be "live" and retain them.
+ Therefore any weak pointer objects which haven't as yet been
+ evacuated need to be evacuated now.
+ -------------------------------------------------------------------------- */
+
+static void
+cleanup_weak_ptr_list ( void )
+{
+ StgWeak *w, **last_w;
+
+ last_w = &weak_ptr_list;
+ for (w = weak_ptr_list; w; w = w->link) {
+
+ if (get_itbl(w)->type == EVACUATED) {
+ w = (StgWeak *)((StgEvacuated *)w)->evacuee;
+ *last_w = w;
+ }
+
+ if (Bdescr((P_)w)->evacuated == 0) {
+ (StgClosure *)w = evacuate((StgClosure *)w);
+ *last_w = w;
+ }
+ last_w = &(w->link);
+ }
+}
+
+/* -----------------------------------------------------------------------------
isAlive determines whether the given closure is still alive (after
a garbage collection) or not. It returns the new address of the
closure if it is alive, or NULL otherwise.
step->hpLim = step->hp + BLOCK_SIZE_W;
step->hp_bd = bd;
step->to_blocks++;
+ new_blocks++;
+}
+
+static __inline__ void
+upd_evacuee(StgClosure *p, StgClosure *dest)
+{
+ p->header.info = &EVACUATED_info;
+ ((StgEvacuated *)p)->evacuee = dest;
}
static __inline__ StgClosure *
* by evacuate()).
*/
if (step->gen->no < evac_gen) {
+#ifdef NO_EAGER_PROMOTION
+ failed_to_evac = rtsTrue;
+#else
step = &generations[evac_gen].steps[0];
+#endif
}
/* chain a new block onto the to-space for the destination step if
dest = step->hp;
step->hp = to;
+ upd_evacuee(src,(StgClosure *)dest);
return (StgClosure *)dest;
}
TICK_GC_WORDS_COPIED(size_to_copy);
if (step->gen->no < evac_gen) {
+#ifdef NO_EAGER_PROMOTION
+ failed_to_evac = rtsTrue;
+#else
step = &generations[evac_gen].steps[0];
+#endif
}
if (step->hp + size_to_reserve >= step->hpLim) {
dest = step->hp;
step->hp += size_to_reserve;
+ upd_evacuee(src,(StgClosure *)dest);
return (StgClosure *)dest;
}
-static __inline__ void
-upd_evacuee(StgClosure *p, StgClosure *dest)
-{
- StgEvacuated *q = (StgEvacuated *)p;
-
- SET_INFO(q,&EVACUATED_info);
- q->evacuee = dest;
-}
-
/* -----------------------------------------------------------------------------
Evacuate a large object
*/
step = bd->step->to;
if (step->gen->no < evac_gen) {
+#ifdef NO_EAGER_PROMOTION
+ failed_to_evac = rtsTrue;
+#else
step = &generations[evac_gen].steps[0];
+#endif
}
bd->step = step;
switch (info -> type) {
case BCO:
- to = copy(q,bco_sizeW(stgCast(StgBCO*,q)),step);
- upd_evacuee(q,to);
- return to;
+ return copy(q,bco_sizeW(stgCast(StgBCO*,q)),step);
case MUT_VAR:
ASSERT(q->header.info != &MUT_CONS_info);
case MVAR:
to = copy(q,sizeW_fromITBL(info),step);
- upd_evacuee(q,to);
recordMutable((StgMutClosure *)to);
return to;
- case STABLE_NAME:
- stable_ptr_table[((StgStableName *)q)->sn].keep = rtsTrue;
- 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;
+ return copy(q,sizeofW(StgHeader)+1,step);
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:
+#ifdef NO_PROMOTE_THUNKS
+ if (bd->gen->no == 0 &&
+ bd->step->no != 0 &&
+ bd->step->no == bd->gen->n_steps-1) {
+ step = bd->step;
+ }
+#endif
+ return copy(q,sizeofW(StgHeader)+2,step);
+
+ case FUN_1_1:
+ case FUN_0_2:
+ case FUN_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;
+ return copy(q,sizeofW(StgHeader)+2,step);
case FUN:
case THUNK:
case CAF_ENTERED:
case WEAK:
case FOREIGN:
- to = copy(q,sizeW_fromITBL(info),step);
- upd_evacuee(q,to);
- return to;
+ case STABLE_NAME:
+ return copy(q,sizeW_fromITBL(info),step);
case CAF_BLACKHOLE:
case BLACKHOLE:
- to = copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),step);
- upd_evacuee(q,to);
- return to;
+ return copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),step);
case BLACKHOLE_BQ:
to = copy(q,BLACKHOLE_sizeW(),step);
- upd_evacuee(q,to);
recordMutable((StgMutClosure *)to);
return to;
barf("evacuate: THUNK_SELECTOR: strange selectee");
}
}
- to = copy(q,THUNK_SELECTOR_sizeW(),step);
- upd_evacuee(q,to);
- return to;
+ return copy(q,THUNK_SELECTOR_sizeW(),step);
case IND:
case IND_OLDGEN:
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)),step);
- upd_evacuee(q,to);
- return to;
+ return copy(q,pap_sizeW(stgCast(StgPAP*,q)),step);
case EVACUATED:
/* Already evacuated, just return the forwarding address.
return q;
} else {
/* just copy the block */
- to = copy(q,size,step);
- upd_evacuee(q,to);
- return to;
+ return copy(q,size,step);
}
}
} else {
/* just copy the block */
to = copy(q,size,step);
- upd_evacuee(q,to);
if (info->type == MUT_ARR_PTRS) {
recordMutable((StgMutClosure *)to);
}
new_tso->splim = (StgPtr)new_tso->splim + diff;
relocate_TSO(tso, new_tso);
- upd_evacuee(q,(StgClosure *)new_tso);
recordMutable((StgMutClosure *)new_tso);
return (StgClosure *)new_tso;
((StgIndOldGen *)p)->indirectee =
evacuate(((StgIndOldGen *)p)->indirectee);
-#if 0
+#if 0
/* Debugging code to print out the size of the thing we just
* promoted
*/
}
continue;
}
- step = bd->step->to;
+
+ /* Don't promote blackholes */
+ step = bd->step;
+ if (!(step->gen->no == 0 &&
+ step->no != 0 &&
+ step->no == step->gen->n_steps-1)) {
+ step = step->to;
+ }
+
switch (type) {
case BLACKHOLE:
case CAF_BLACKHOLE:
to = copyPart(frame->updatee, BLACKHOLE_sizeW(),
sizeofW(StgHeader), step);
- upd_evacuee(frame->updatee,to);
frame->updatee = to;
continue;
case BLACKHOLE_BQ:
to = copy(frame->updatee, BLACKHOLE_sizeW(), step);
- upd_evacuee(frame->updatee,to);
frame->updatee = to;
recordMutable((StgMutClosure *)to);
continue;
}
static void
-zeroStaticObjectList(StgClosure* first_static)
+zero_static_object_list(StgClosure* first_static)
{
StgClosure* p;
StgClosure* link;
* mutable list.
*/
static void
-zeroMutableList(StgMutClosure *first)
+zero_mutable_list( StgMutClosure *first )
{
StgMutClosure *next, *c;
}
}
-void revertDeadCAFs(void)
+void revert_dead_CAFs(void)
{
StgCAF* caf = enteredCAFs;
enteredCAFs = END_CAF_LIST;
break;
}
default:
- barf("revertDeadCAFs: enteredCAFs list corrupted");
+ barf("revert_dead_CAFs: enteredCAFs list corrupted");
}
caf = next;
}