*/
static nat evac_gen;
+/* Whether to do eager promotion or not.
+ */
+static rtsBool eager_promotion;
+
/* Weak pointers
*/
StgWeak *old_weak_ptr_list; // also pending finaliser list
static lnat thunk_selector_depth = 0;
#define MAX_THUNK_SELECTOR_DEPTH 8
+/* Mut-list stats */
+#ifdef DEBUG
+static nat
+ mutlist_MUTVARS,
+ mutlist_MUTARRS,
+ mutlist_OTHERS;
+#endif
+
/* -----------------------------------------------------------------------------
Static function declarations
-------------------------------------------------------------------------- */
{
bdescr *bd;
step *stp;
- lnat live, allocated, collected = 0, copied = 0, scavd_copied = 0;
+ lnat live, allocated, copied = 0, scavd_copied = 0;
lnat oldgen_saved_blocks = 0;
nat g, s, i;
memInventory();
#endif
+#ifdef DEBUG
+ mutlist_MUTVARS = 0;
+ mutlist_MUTARRS = 0;
+ mutlist_OTHERS = 0;
+#endif
+
// Init stats and print par specific (timing) info
PAR_TICKY_PAR_START();
mark_stack_bdescr = NULL;
}
+ eager_promotion = rtsTrue; // for now
+
/* -----------------------------------------------------------------------
* follow all the roots that we know about:
* - mutable lists from each generation > N
// Count the mutable list as bytes "copied" for the purposes of
// stats. Every mutable list is copied during every GC.
if (g > 0) {
+ nat mut_list_size = 0;
for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
- copied += bd->free - bd->start;
+ mut_list_size += bd->free - bd->start;
}
+ copied += mut_list_size;
+
+ IF_DEBUG(gc, debugBelch("mut_list_size: %d (%d vars, %d arrays, %d others)\n", mut_list_size * sizeof(W_), mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS));
}
for (s = 0; s < generations[g].n_steps; s++) {
// for generations we collected...
if (g <= N) {
- // rough calculation of garbage collected, for stats output
- if (stp->is_compacted) {
- collected += (oldgen_saved_blocks - stp->n_old_blocks) * BLOCK_SIZE_W;
- } else {
- if (g == 0 && s == 0) {
- collected += countNurseryBlocks() * BLOCK_SIZE_W;
- collected += alloc_blocks;
- } else {
- collected += stp->n_old_blocks * BLOCK_SIZE_W;
- }
- }
-
/* free old memory and shift to-space into from-space for all
* the collected steps (except the allocation area). These
* freed blocks will probaby be quickly recycled.
#endif
// ok, GC over: tell the stats department what happened.
- stat_endGC(allocated, collected, live, copied, scavd_copied, N);
+ stat_endGC(allocated, live, copied, scavd_copied, N);
#if defined(RTS_USER_SIGNALS)
// unblock signals again
* by evacuate()).
*/
if (stp->gen_no < evac_gen) {
-#ifdef NO_EAGER_PROMOTION
- failed_to_evac = rtsTrue;
-#else
- stp = &generations[evac_gen].steps[0];
-#endif
+ if (eager_promotion) {
+ stp = &generations[evac_gen].steps[0];
+ } else {
+ failed_to_evac = rtsTrue;
+ }
}
/* chain a new block onto the to-space for the destination step if
* by evacuate()).
*/
if (stp->gen_no < evac_gen) {
-#ifdef NO_EAGER_PROMOTION
- failed_to_evac = rtsTrue;
-#else
- stp = &generations[evac_gen].steps[0];
-#endif
+ if (eager_promotion) {
+ stp = &generations[evac_gen].steps[0];
+ } else {
+ failed_to_evac = rtsTrue;
+ }
}
/* chain a new block onto the to-space for the destination step if
TICK_GC_WORDS_COPIED(size_to_copy);
if (stp->gen_no < evac_gen) {
-#ifdef NO_EAGER_PROMOTION
- failed_to_evac = rtsTrue;
-#else
- stp = &generations[evac_gen].steps[0];
-#endif
+ if (eager_promotion) {
+ stp = &generations[evac_gen].steps[0];
+ } else {
+ failed_to_evac = rtsTrue;
+ }
}
if (stp->hp + size_to_reserve >= stp->hpLim) {
*/
stp = bd->step->to;
if (stp->gen_no < evac_gen) {
-#ifdef NO_EAGER_PROMOTION
- failed_to_evac = rtsTrue;
-#else
- stp = &generations[evac_gen].steps[0];
-#endif
+ if (eager_promotion) {
+ stp = &generations[evac_gen].steps[0];
+ } else {
+ failed_to_evac = rtsTrue;
+ }
}
bd->step = stp;
// just copy the block
return copy_noscav(q,arr_words_sizeW((StgArrWords *)q),stp);
- case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
case MUT_ARR_PTRS_FROZEN:
case MUT_ARR_PTRS_FROZEN0:
// just copy the block
p += arr_words_sizeW((StgArrWords *)p);
break;
- case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
// follow everything
{
StgPtr next;
-
- evac_gen = 0; // repeatedly mutable
+ rtsBool saved_eager;
+
+ // We don't eagerly promote objects pointed to by a mutable
+ // array, but if we find the array only points to objects in
+ // the same or an older generation, we mark it "clean" and
+ // avoid traversing it during minor GCs.
+ saved_eager = eager_promotion;
+ eager_promotion = rtsFalse;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue; // mutable anyhow.
+ eager_promotion = saved_eager;
+
+ if (failed_to_evac) {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
+ } else {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
+ }
+
+ failed_to_evac = rtsTrue; // always put it on the mutable list.
break;
}
scavenge_AP((StgAP *)p);
break;
- case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
// follow everything
{
StgPtr next;
-
- evac_gen = 0; // repeatedly mutable
+ rtsBool saved_eager;
+
+ // We don't eagerly promote objects pointed to by a mutable
+ // array, but if we find the array only points to objects in
+ // the same or an older generation, we mark it "clean" and
+ // avoid traversing it during minor GCs.
+ saved_eager = eager_promotion;
+ eager_promotion = rtsFalse;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
- evac_gen = saved_evac_gen;
+ eager_promotion = saved_eager;
+
+ if (failed_to_evac) {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
+ } else {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
+ }
+
failed_to_evac = rtsTrue; // mutable anyhow.
break;
}
// nothing to follow
break;
- case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
{
- // follow everything
- StgPtr next;
-
- evac_gen = 0; // repeatedly mutable
+ StgPtr next, q;
+ rtsBool saved_eager;
+
+ // We don't eagerly promote objects pointed to by a mutable
+ // array, but if we find the array only points to objects in
+ // the same or an older generation, we mark it "clean" and
+ // avoid traversing it during minor GCs.
+ saved_eager = eager_promotion;
+ eager_promotion = rtsFalse;
+ q = p;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
- evac_gen = saved_evac_gen;
+ eager_promotion = saved_eager;
+
+ if (failed_to_evac) {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
+ } else {
+ ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
+ }
+
failed_to_evac = rtsTrue;
break;
}
for (q = bd->start; q < bd->free; q++) {
p = (StgPtr)*q;
ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
+
+#ifdef DEBUG
+ switch (get_itbl((StgClosure *)p)->type) {
+ case MUT_VAR:
+ mutlist_MUTVARS++; break;
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
+ case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
+ mutlist_MUTARRS++; break;
+ default:
+ mutlist_OTHERS++; break;
+ }
+#endif
+
+ // We don't need to scavenge clean arrays. This is the
+ // Whole Point of MUT_ARR_PTRS_CLEAN.
+ if (get_itbl((StgClosure *)p)->type == MUT_ARR_PTRS_CLEAN) {
+ recordMutableGen((StgClosure *)p,gen);
+ continue;
+ }
+
if (scavenge_one(p)) {
/* didn't manage to promote everything, so put the
* object back on the list.
projects / ghc-hetmet.git / blobdiff