*/
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
mark_stack_bdescr = NULL;
}
+ eager_promotion = rtsTrue; // for now
+
/* -----------------------------------------------------------------------
* follow all the roots that we know about:
* - mutable lists from each generation > N
* 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;
switch (info->type) {
- case MUT_VAR:
+ case MUT_VAR_CLEAN:
+ case MUT_VAR_DIRTY:
case MVAR:
return copy(q,sizeW_fromITBL(info),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 += sizeofW(StgInd);
break;
- case MUT_VAR:
- evac_gen = 0;
+ case MUT_VAR_CLEAN:
+ case MUT_VAR_DIRTY: {
+ rtsBool saved_eager_promotion = eager_promotion;
+
+ eager_promotion = rtsFalse;
((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue; // mutable anyhow
+ eager_promotion = saved_eager_promotion;
+
+ if (failed_to_evac) {
+ ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
+ } else {
+ ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
+ }
p += sizeofW(StgMutVar);
break;
+ }
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
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;
}
case TSO:
{
StgTSO *tso = (StgTSO *)p;
- evac_gen = 0;
+ rtsBool saved_eager = eager_promotion;
+
+ eager_promotion = rtsFalse;
scavengeTSO(tso);
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue; // mutable anyhow.
+ eager_promotion = saved_eager;
+
+ if (failed_to_evac) {
+ tso->flags |= TSO_DIRTY;
+ } else {
+ tso->flags &= ~TSO_DIRTY;
+ }
+
+ failed_to_evac = rtsTrue; // always on the mutable list
p += tso_sizeW(tso);
break;
}
evacuate(((StgInd *)p)->indirectee);
break;
- case MUT_VAR:
- evac_gen = 0;
+ case MUT_VAR_CLEAN:
+ case MUT_VAR_DIRTY: {
+ rtsBool saved_eager_promotion = eager_promotion;
+
+ eager_promotion = rtsFalse;
((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue;
+ eager_promotion = saved_eager_promotion;
+
+ if (failed_to_evac) {
+ ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
+ } else {
+ ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
+ }
break;
+ }
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
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;
}
case TSO:
{
StgTSO *tso = (StgTSO *)p;
- evac_gen = 0;
+ rtsBool saved_eager = eager_promotion;
+
+ eager_promotion = rtsFalse;
scavengeTSO(tso);
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue;
+ eager_promotion = saved_eager;
+
+ if (failed_to_evac) {
+ tso->flags |= TSO_DIRTY;
+ } else {
+ tso->flags &= ~TSO_DIRTY;
+ }
+
+ failed_to_evac = rtsTrue; // always on the mutable list
break;
}
break;
}
- case MUT_VAR:
- evac_gen = 0;
+ case MUT_VAR_CLEAN:
+ case MUT_VAR_DIRTY: {
+ StgPtr q = p;
+ rtsBool saved_eager_promotion = eager_promotion;
+
+ eager_promotion = rtsFalse;
((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue; // mutable anyhow
+ eager_promotion = saved_eager_promotion;
+
+ if (failed_to_evac) {
+ ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
+ } else {
+ ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
+ }
break;
+ }
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
// 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;
}
case TSO:
{
StgTSO *tso = (StgTSO *)p;
-
- evac_gen = 0; // repeatedly mutable
+ rtsBool saved_eager = eager_promotion;
+
+ eager_promotion = rtsFalse;
scavengeTSO(tso);
- evac_gen = saved_evac_gen;
- failed_to_evac = rtsTrue;
+ eager_promotion = saved_eager;
+
+ if (failed_to_evac) {
+ tso->flags |= TSO_DIRTY;
+ } else {
+ tso->flags &= ~TSO_DIRTY;
+ }
+
+ failed_to_evac = rtsTrue; // always on the mutable list
break;
}
#ifdef DEBUG
switch (get_itbl((StgClosure *)p)->type) {
- case MUT_VAR:
+ case MUT_VAR_CLEAN:
+ barf("MUT_VAR_CLEAN on mutable list");
+ case MUT_VAR_DIRTY:
mutlist_MUTVARS++; break;
- case MUT_ARR_PTRS:
+ case MUT_ARR_PTRS_CLEAN:
+ case MUT_ARR_PTRS_DIRTY:
case MUT_ARR_PTRS_FROZEN:
case MUT_ARR_PTRS_FROZEN0:
mutlist_MUTARRS++; break;
}
#endif
+ // Check whether this object is "clean", that is it
+ // definitely doesn't point into a young generation.
+ // Clean objects don't need to be scavenged. Some clean
+ // objects (MUT_VAR_CLEAN) are not kept on the mutable
+ // list at all; others, such as MUT_ARR_PTRS_CLEAN and
+ // TSO, are always on the mutable list.
+ //
+ switch (get_itbl((StgClosure *)p)->type) {
+ case MUT_ARR_PTRS_CLEAN:
+ recordMutableGen((StgClosure *)p,gen);
+ continue;
+ case TSO: {
+ StgTSO *tso = (StgTSO *)p;
+ if ((tso->flags & TSO_DIRTY) == 0) {
+ // A clean TSO: we don't have to traverse its
+ // stack. However, we *do* follow the link field:
+ // we don't want to have to mark a TSO dirty just
+ // because we put it on a different queue.
+ if (tso->why_blocked != BlockedOnBlackHole) {
+ tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
+ }
+ recordMutableGen((StgClosure *)p,gen);
+ continue;
+ }
+ }
+ default:
+ ;
+ }
+
if (scavenge_one(p)) {
- /* didn't manage to promote everything, so put the
- * object back on the list.
- */
+ // didn't manage to promote everything, so put the
+ // object back on the list.
recordMutableGen((StgClosure *)p,gen);
}
}
projects / ghc-hetmet.git / blobdiff