X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=a470f32c0822ed31238cc8649638a1bad11f11d2;hb=9492466167fd396aef8c51704ecd4d65b970d6dc;hp=66c53c4e2e086ef00d5d1cba2f8cf5b4e0c5cc8b;hpb=b61f70ce5ff947642c96b1ad980351691bb1e07a;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 66c53c4..a470f32 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -148,7 +148,6 @@ static void mark_root ( StgClosure **root ); REGPARM1 static StgClosure * evacuate (StgClosure *q); static void zero_static_object_list ( StgClosure* first_static ); -static void zero_mutable_list ( StgMutClosure *first ); static rtsBool traverse_weak_ptr_list ( void ); static void mark_weak_ptr_list ( StgWeak **list ); @@ -163,7 +162,6 @@ static rtsBool scavenge_one ( StgPtr p ); static void scavenge_large ( step * ); static void scavenge_static ( void ); static void scavenge_mutable_list ( generation *g ); -static void scavenge_mut_once_list ( generation *g ); static void scavenge_large_bitmap ( StgPtr p, StgLargeBitmap *large_bitmap, @@ -265,7 +263,7 @@ gc_alloc_block(step *stp) (and all younger generations): - follow all pointers in the root set. the root set includes all - mutable objects in all generations (mutable_list and mut_once_list). + mutable objects in all generations (mutable_list). - for each pointer, evacuate the object it points to into either @@ -277,7 +275,7 @@ gc_alloc_block(step *stp) When we evacuate an object we attempt to evacuate everything it points to into the same generation - this is achieved by setting evac_gen to the desired generation. If - we can't do this, then an entry in the mut_once list has to + we can't do this, then an entry in the mut list has to be made for the cross-generation pointer. + if the object is already in a generation > N, then leave @@ -369,13 +367,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) static_objects = END_OF_STATIC_LIST; scavenged_static_objects = END_OF_STATIC_LIST; - /* zero the mutable list for the oldest generation (see comment by - * zero_mutable_list below). - */ - if (major_gc) { - zero_mutable_list(generations[RtsFlags.GcFlags.generations-1].mut_once_list); - } - /* Save the old to-space if we're doing a two-space collection */ if (RtsFlags.GcFlags.generations == 1) { @@ -393,8 +384,14 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) // collecting. // for (g = 0; g <= N; g++) { - generations[g].mut_once_list = END_MUT_LIST; - generations[g].mut_list = END_MUT_LIST; + + // throw away the mutable list. Invariant: the mutable list + // always has at least one block; this means we can avoid a check for + // NULL in recordMutable(). + if (g != 0) { + freeChain(generations[g].mut_list); + generations[g].mut_list = allocBlock(); + } for (s = 0; s < generations[g].n_steps; s++) { @@ -517,23 +514,12 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) int st; for (g = RtsFlags.GcFlags.generations-1; g > N; g--) { generations[g].saved_mut_list = generations[g].mut_list; - generations[g].mut_list = END_MUT_LIST; - } - - // Do the mut-once lists first - for (g = RtsFlags.GcFlags.generations-1; g > N; g--) { - IF_PAR_DEBUG(verbose, - printMutOnceList(&generations[g])); - scavenge_mut_once_list(&generations[g]); - evac_gen = g; - for (st = generations[g].n_steps-1; st >= 0; st--) { - scavenge(&generations[g].steps[st]); - } + generations[g].mut_list = allocBlock(); + // mut_list always has at least one block. } for (g = RtsFlags.GcFlags.generations-1; g > N; g--) { - IF_PAR_DEBUG(verbose, - printMutableList(&generations[g])); + IF_PAR_DEBUG(verbose, printMutableList(&generations[g])); scavenge_mutable_list(&generations[g]); evac_gen = g; for (st = generations[g].n_steps-1; st >= 0; st--) { @@ -719,6 +705,14 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) generations[g].collections++; // for stats } + // Count the mutable list as bytes "copied" for the purposes of + // stats. Every mutable list is copied during every GC. + if (g > 0) { + for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) { + copied += (bd->free - bd->start) * sizeof(StgWord); + } + } + for (s = 0; s < generations[g].n_steps; s++) { bdescr *next; stp = &generations[g].steps[s]; @@ -1240,7 +1234,7 @@ traverse_weak_ptr_list(void) prev = &old_all_threads; for (t = old_all_threads; t != END_TSO_QUEUE; t = next) { - (StgClosure *)tmp = isAlive((StgClosure *)t); + tmp = (StgTSO *)isAlive((StgClosure *)t); if (tmp != NULL) { t = tmp; @@ -1287,7 +1281,7 @@ traverse_weak_ptr_list(void) StgTSO *t, *tmp, *next; for (t = old_all_threads; t != END_TSO_QUEUE; t = next) { next = t->global_link; - (StgClosure *)tmp = evacuate((StgClosure *)t); + tmp = (StgTSO *)evacuate((StgClosure *)t); tmp->global_link = resurrected_threads; resurrected_threads = tmp; } @@ -1326,7 +1320,7 @@ mark_weak_ptr_list ( StgWeak **list ) // w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here ASSERT(w->header.info == &stg_DEAD_WEAK_info || get_itbl(w)->type == WEAK || get_itbl(w)->type == EVACUATED); - (StgClosure *)w = evacuate((StgClosure *)w); + w = (StgWeak *)evacuate((StgClosure *)w); *last_w = w; last_w = &(w->link); } @@ -1421,8 +1415,6 @@ mark_root(StgClosure **root) STATIC_INLINE void upd_evacuee(StgClosure *p, StgClosure *dest) { - // Source object must be in from-space: - ASSERT((Bdescr((P_)p)->flags & BF_EVACUATED) == 0); // not true: (ToDo: perhaps it should be) // ASSERT(Bdescr((P_)dest)->flags & BF_EVACUATED); SET_INFO(p, &stg_EVACUATED_info); @@ -1588,39 +1580,6 @@ evacuate_large(StgPtr p) } /* ----------------------------------------------------------------------------- - Adding a MUT_CONS to an older generation. - - This is necessary from time to time when we end up with an - old-to-new generation pointer in a non-mutable object. We defer - the promotion until the next GC. - -------------------------------------------------------------------------- */ - -static StgClosure * -mkMutCons(StgClosure *ptr, generation *gen) -{ - StgMutVar *q; - step *stp; - - stp = &gen->steps[0]; - - /* chain a new block onto the to-space for the destination step if - * necessary. - */ - if (stp->hp + sizeofW(StgIndOldGen) >= stp->hpLim) { - gc_alloc_block(stp); - } - - q = (StgMutVar *)stp->hp; - stp->hp += sizeofW(StgMutVar); - - SET_HDR(q,&stg_MUT_CONS_info,CCS_GC); - q->var = ptr; - recordOldToNewPtrs((StgMutClosure *)q); - - return (StgClosure *)q; -} - -/* ----------------------------------------------------------------------------- Evacuate This is called (eventually) for every live object in the system. @@ -1716,6 +1675,9 @@ loop: return q; } + /* Object is not already evacuated. */ + ASSERT((bd->flags & BF_EVACUATED) == 0); + stp = bd->step->to; } #ifdef DEBUG @@ -1750,10 +1712,10 @@ loop: case FUN_1_0: case FUN_0_1: case CONSTR_1_0: + case THUNK_1_0: + case THUNK_0_1: return copy(q,sizeofW(StgHeader)+1,stp); - case THUNK_1_0: // here because of MIN_UPD_SIZE - case THUNK_0_1: case THUNK_1_1: case THUNK_0_2: case THUNK_2_0: @@ -1921,6 +1883,7 @@ loop: case MUT_ARR_PTRS: case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: // just copy the block return copy(q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp); @@ -2155,10 +2118,10 @@ selector_loop: // check that we don't recurse too much, re-using the // depth bound also used in evacuate(). - thunk_selector_depth++; - if (thunk_selector_depth > MAX_THUNK_SELECTOR_DEPTH) { + if (thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) { break; } + thunk_selector_depth++; val = eval_thunk_selector(info->layout.selector_offset, (StgSelector *)selectee); @@ -2351,7 +2314,7 @@ static void scavengeTSO (StgTSO *tso) { // chase the link field for any TSOs on the same queue - (StgClosure *)tso->link = evacuate((StgClosure *)tso->link); + tso->link = (StgTSO *)evacuate((StgClosure *)tso->link); if ( tso->why_blocked == BlockedOnMVar || tso->why_blocked == BlockedOnBlackHole || tso->why_blocked == BlockedOnException @@ -2368,7 +2331,7 @@ scavengeTSO (StgTSO *tso) } // scavange current transaction record - (StgClosure *)tso->trec = evacuate((StgClosure *)tso->trec); + tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec); // scavenge this thread's stack scavenge_stack(tso->sp, &(tso->stack[tso->stack_size])); @@ -2403,7 +2366,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args) small_bitmap: while (size > 0) { if ((bitmap & 1) == 0) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } p++; bitmap = bitmap >> 1; @@ -2446,7 +2409,7 @@ scavenge_PAP (StgPAP *pap) size = pap->n_args; while (size > 0) { if ((bitmap & 1) == 0) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } p++; bitmap = bitmap >> 1; @@ -2505,18 +2468,14 @@ scavenge(step *stp) switch (info->type) { case MVAR: - /* treat MVars specially, because we don't want to evacuate the - * mut_link field in the middle of the closure. - */ { StgMVar *mvar = ((StgMVar *)p); evac_gen = 0; - (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head); - (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail); - (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value); + mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head); + mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail); + mvar->value = evacuate((StgClosure *)mvar->value); evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)mvar); - failed_to_evac = rtsFalse; // mutable. + failed_to_evac = rtsTrue; // mutable. p += sizeofW(StgMVar); break; } @@ -2539,7 +2498,7 @@ scavenge(step *stp) case THUNK_1_0: scavenge_thunk_srt(info); ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); - p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE + p += sizeofW(StgHeader) + 1; break; case FUN_1_0: @@ -2551,7 +2510,7 @@ scavenge(step *stp) case THUNK_0_1: scavenge_thunk_srt(info); - p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE + p += sizeofW(StgHeader) + 1; break; case FUN_0_1: @@ -2602,7 +2561,7 @@ scavenge(step *stp) end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } p += info->layout.payload.nptrs; break; @@ -2610,10 +2569,10 @@ scavenge(step *stp) case BCO: { StgBCO *bco = (StgBCO *)p; - (StgClosure *)bco->instrs = evacuate((StgClosure *)bco->instrs); - (StgClosure *)bco->literals = evacuate((StgClosure *)bco->literals); - (StgClosure *)bco->ptrs = evacuate((StgClosure *)bco->ptrs); - (StgClosure *)bco->itbls = evacuate((StgClosure *)bco->itbls); + bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs); + bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals); + bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs); + bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls); p += bco_sizeW(bco); break; } @@ -2636,27 +2595,15 @@ scavenge(step *stp) } // fall through case IND_OLDGEN_PERM: - ((StgIndOldGen *)p)->indirectee = - evacuate(((StgIndOldGen *)p)->indirectee); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordOldToNewPtrs((StgMutClosure *)p); - } - p += sizeofW(StgIndOldGen); + ((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee); + p += sizeofW(StgInd); break; case MUT_VAR: evac_gen = 0; ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)p); - failed_to_evac = rtsFalse; // mutable anyhow - p += sizeofW(StgMutVar); - break; - - case MUT_CONS: - // ignore these - failed_to_evac = rtsFalse; // mutable anyhow + failed_to_evac = rtsTrue; // mutable anyhow p += sizeofW(StgMutVar); break; @@ -2670,10 +2617,9 @@ scavenge(step *stp) case BLACKHOLE_BQ: { StgBlockingQueue *bh = (StgBlockingQueue *)p; - (StgClosure *)bh->blocking_queue = - evacuate((StgClosure *)bh->blocking_queue); - recordMutable((StgMutClosure *)bh); - failed_to_evac = rtsFalse; + bh->blocking_queue = + (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); + failed_to_evac = rtsTrue; p += BLACKHOLE_sizeW(); break; } @@ -2715,27 +2661,22 @@ scavenge(step *stp) evac_gen = 0; // repeatedly mutable next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)q); - failed_to_evac = rtsFalse; // mutable anyhow. + failed_to_evac = rtsTrue; // mutable anyhow. break; } case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: // follow everything { StgPtr next; - // Set the mut_link field to NULL, so that we will put this - // array back on the mutable list if it is subsequently thawed - // by unsafeThaw#. - ((StgMutArrPtrs*)p)->mut_link = NULL; - next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } // it's tempting to recordMutable() if failed_to_evac is // false, but that breaks some assumptions (eg. every @@ -2750,8 +2691,7 @@ scavenge(step *stp) evac_gen = 0; scavengeTSO(tso); evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)tso); - failed_to_evac = rtsFalse; // mutable anyhow. + failed_to_evac = rtsTrue; // mutable anyhow. p += tso_sizeW(tso); break; } @@ -2767,8 +2707,7 @@ scavenge(step *stp) StgRBH *rbh = (StgRBH *)p; (StgClosure *)rbh->blocking_queue = evacuate((StgClosure *)rbh->blocking_queue); - recordMutable((StgMutClosure *)to); - failed_to_evac = rtsFalse; // mutable anyhow. + failed_to_evac = rtsTrue; // mutable anyhow. IF_DEBUG(gc, debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", p, info_type(p), (StgClosure *)rbh->blocking_queue)); @@ -2786,10 +2725,6 @@ scavenge(step *stp) // follow the link to the rest of the blocking queue (StgClosure *)bf->link = evacuate((StgClosure *)bf->link); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordMutable((StgMutClosure *)bf); - } IF_DEBUG(gc, debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", bf, info_type((StgClosure *)bf), @@ -2810,10 +2745,6 @@ scavenge(step *stp) StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; (StgClosure *)fmbq->blocking_queue = evacuate((StgClosure *)fmbq->blocking_queue); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordMutable((StgMutClosure *)fmbq); - } IF_DEBUG(gc, debugBelch("@@ scavenge: %p (%s) exciting, isn't it", p, info_type((StgClosure *)p))); @@ -2826,12 +2757,11 @@ scavenge(step *stp) { StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p); evac_gen = 0; - (StgClosure *)wq->waiting_tso = evacuate((StgClosure*)wq->waiting_tso); - (StgClosure *)wq->next_queue_entry = evacuate((StgClosure*)wq->next_queue_entry); - (StgClosure *)wq->prev_queue_entry = evacuate((StgClosure*)wq->prev_queue_entry); + wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso); + wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry); + wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry); evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)wq); - failed_to_evac = rtsFalse; // mutable + failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTVarWaitQueue); break; } @@ -2840,11 +2770,10 @@ scavenge(step *stp) { StgTVar *tvar = ((StgTVar *) p); evac_gen = 0; - (StgClosure *)tvar->current_value = evacuate((StgClosure*)tvar->current_value); - (StgClosure *)tvar->first_wait_queue_entry = evacuate((StgClosure*)tvar->first_wait_queue_entry); + tvar->current_value = evacuate((StgClosure*)tvar->current_value); + tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry); evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)tvar); - failed_to_evac = rtsFalse; // mutable + failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTVar); break; } @@ -2853,11 +2782,10 @@ scavenge(step *stp) { StgTRecHeader *trec = ((StgTRecHeader *) p); evac_gen = 0; - (StgClosure *)trec->enclosing_trec = evacuate((StgClosure*)trec->enclosing_trec); - (StgClosure *)trec->current_chunk = evacuate((StgClosure*)trec->current_chunk); + trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec); + trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk); evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)trec); - failed_to_evac = rtsFalse; // mutable + failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTRecHeader); break; } @@ -2868,15 +2796,14 @@ scavenge(step *stp) StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); evac_gen = 0; - (StgClosure *)tc->prev_chunk = evacuate((StgClosure*)tc->prev_chunk); + tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk); for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { - (StgClosure *)e->tvar = evacuate((StgClosure*)e->tvar); - (StgClosure *)e->expected_value = evacuate((StgClosure*)e->expected_value); - (StgClosure *)e->new_value = evacuate((StgClosure*)e->new_value); + e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar); + e->expected_value = evacuate((StgClosure*)e->expected_value); + e->new_value = evacuate((StgClosure*)e->new_value); } evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)tc); - failed_to_evac = rtsFalse; // mutable + failed_to_evac = rtsTrue; // mutable p += sizeofW(StgTRecChunk); break; } @@ -2886,13 +2813,16 @@ scavenge(step *stp) info->type, p); } - /* If we didn't manage to promote all the objects pointed to by - * the current object, then we have to designate this object as - * mutable (because it contains old-to-new generation pointers). + /* + * We need to record the current object on the mutable list if + * (a) It is actually mutable, or + * (b) It contains pointers to a younger generation. + * Case (b) arises if we didn't manage to promote everything that + * the current object points to into the current generation. */ if (failed_to_evac) { failed_to_evac = rtsFalse; - mkMutCons((StgClosure *)q, &generations[evac_gen]); + recordMutableGen((StgClosure *)q, stp->gen); } } @@ -2929,17 +2859,14 @@ linear_scan: switch (info->type) { case MVAR: - /* treat MVars specially, because we don't want to evacuate the - * mut_link field in the middle of the closure. - */ { StgMVar *mvar = ((StgMVar *)p); evac_gen = 0; - (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head); - (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail); - (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value); + mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head); + mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail); + mvar->value = evacuate((StgClosure *)mvar->value); evac_gen = saved_evac_gen; - failed_to_evac = rtsFalse; // mutable. + failed_to_evac = rtsTrue; // mutable. break; } @@ -3002,17 +2929,17 @@ linear_scan: end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } break; } case BCO: { StgBCO *bco = (StgBCO *)p; - (StgClosure *)bco->instrs = evacuate((StgClosure *)bco->instrs); - (StgClosure *)bco->literals = evacuate((StgClosure *)bco->literals); - (StgClosure *)bco->ptrs = evacuate((StgClosure *)bco->ptrs); - (StgClosure *)bco->itbls = evacuate((StgClosure *)bco->itbls); + bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs); + bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals); + bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs); + bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls); break; } @@ -3024,24 +2951,15 @@ linear_scan: case IND_OLDGEN: case IND_OLDGEN_PERM: - ((StgIndOldGen *)p)->indirectee = - evacuate(((StgIndOldGen *)p)->indirectee); - if (failed_to_evac) { - recordOldToNewPtrs((StgMutClosure *)p); - } - failed_to_evac = rtsFalse; + ((StgInd *)p)->indirectee = + evacuate(((StgInd *)p)->indirectee); break; case MUT_VAR: evac_gen = 0; ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); evac_gen = saved_evac_gen; - failed_to_evac = rtsFalse; - break; - - case MUT_CONS: - // ignore these - failed_to_evac = rtsFalse; + failed_to_evac = rtsTrue; break; case CAF_BLACKHOLE: @@ -3054,9 +2972,9 @@ linear_scan: case BLACKHOLE_BQ: { StgBlockingQueue *bh = (StgBlockingQueue *)p; - (StgClosure *)bh->blocking_queue = - evacuate((StgClosure *)bh->blocking_queue); - failed_to_evac = rtsFalse; + bh->blocking_queue = + (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); + failed_to_evac = rtsTrue; break; } @@ -3090,26 +3008,22 @@ linear_scan: evac_gen = 0; // repeatedly mutable next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } evac_gen = saved_evac_gen; - failed_to_evac = rtsFalse; // mutable anyhow. + failed_to_evac = rtsTrue; // mutable anyhow. break; } case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: // follow everything { StgPtr next; - // Set the mut_link field to NULL, so that we will put this - // array on the mutable list if it is subsequently thawed - // by unsafeThaw#. - ((StgMutArrPtrs*)p)->mut_link = NULL; - next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } break; } @@ -3120,7 +3034,7 @@ linear_scan: evac_gen = 0; scavengeTSO(tso); evac_gen = saved_evac_gen; - failed_to_evac = rtsFalse; + failed_to_evac = rtsTrue; break; } @@ -3133,10 +3047,9 @@ linear_scan: StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); #endif StgRBH *rbh = (StgRBH *)p; - (StgClosure *)rbh->blocking_queue = - evacuate((StgClosure *)rbh->blocking_queue); - recordMutable((StgMutClosure *)rbh); - failed_to_evac = rtsFalse; // mutable anyhow. + bh->blocking_queue = + (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); + failed_to_evac = rtsTrue; // mutable anyhow. IF_DEBUG(gc, debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", p, info_type(p), (StgClosure *)rbh->blocking_queue)); @@ -3152,10 +3065,6 @@ linear_scan: // follow the link to the rest of the blocking queue (StgClosure *)bf->link = evacuate((StgClosure *)bf->link); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordMutable((StgMutClosure *)bf); - } IF_DEBUG(gc, debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", bf, info_type((StgClosure *)bf), @@ -3174,10 +3083,6 @@ linear_scan: StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; (StgClosure *)fmbq->blocking_queue = evacuate((StgClosure *)fmbq->blocking_queue); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordMutable((StgMutClosure *)fmbq); - } IF_DEBUG(gc, debugBelch("@@ scavenge: %p (%s) exciting, isn't it", p, info_type((StgClosure *)p))); @@ -3189,12 +3094,11 @@ linear_scan: { StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p); evac_gen = 0; - (StgClosure *)wq->waiting_tso = evacuate((StgClosure*)wq->waiting_tso); - (StgClosure *)wq->next_queue_entry = evacuate((StgClosure*)wq->next_queue_entry); - (StgClosure *)wq->prev_queue_entry = evacuate((StgClosure*)wq->prev_queue_entry); + wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso); + wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry); + wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry); evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)wq); - failed_to_evac = rtsFalse; // mutable + failed_to_evac = rtsTrue; // mutable break; } @@ -3202,11 +3106,10 @@ linear_scan: { StgTVar *tvar = ((StgTVar *) p); evac_gen = 0; - (StgClosure *)tvar->current_value = evacuate((StgClosure*)tvar->current_value); - (StgClosure *)tvar->first_wait_queue_entry = evacuate((StgClosure*)tvar->first_wait_queue_entry); + tvar->current_value = evacuate((StgClosure*)tvar->current_value); + tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry); evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)tvar); - failed_to_evac = rtsFalse; // mutable + failed_to_evac = rtsTrue; // mutable break; } @@ -3216,15 +3119,14 @@ linear_scan: StgTRecChunk *tc = ((StgTRecChunk *) p); TRecEntry *e = &(tc -> entries[0]); evac_gen = 0; - (StgClosure *)tc->prev_chunk = evacuate((StgClosure*)tc->prev_chunk); + tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk); for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { - (StgClosure *)e->tvar = evacuate((StgClosure*)e->tvar); - (StgClosure *)e->expected_value = evacuate((StgClosure*)e->expected_value); - (StgClosure *)e->new_value = evacuate((StgClosure*)e->new_value); + e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar); + e->expected_value = evacuate((StgClosure*)e->expected_value); + e->new_value = evacuate((StgClosure*)e->new_value); } evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)tc); - failed_to_evac = rtsFalse; // mutable + failed_to_evac = rtsTrue; // mutable break; } @@ -3232,11 +3134,10 @@ linear_scan: { StgTRecHeader *trec = ((StgTRecHeader *) p); evac_gen = 0; - (StgClosure *)trec->enclosing_trec = evacuate((StgClosure*)trec->enclosing_trec); - (StgClosure *)trec->current_chunk = evacuate((StgClosure*)trec->current_chunk); + trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec); + trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk); evac_gen = saved_evac_gen; - recordMutable((StgMutClosure *)trec); - failed_to_evac = rtsFalse; // mutable + failed_to_evac = rtsTrue; // mutable break; } @@ -3247,7 +3148,7 @@ linear_scan: if (failed_to_evac) { failed_to_evac = rtsFalse; - mkMutCons((StgClosure *)q, &generations[evac_gen]); + recordMutableGen((StgClosure *)q, &generations[evac_gen]); } // mark the next bit to indicate "scavenged" @@ -3314,6 +3215,18 @@ scavenge_one(StgPtr p) switch (info->type) { + case MVAR: + { + StgMVar *mvar = ((StgMVar *)p); + evac_gen = 0; + mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head); + mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail); + mvar->value = evacuate((StgClosure *)mvar->value); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable. + break; + } + case FUN: case FUN_1_0: // hardly worth specialising these guys case FUN_0_1: @@ -3335,23 +3248,39 @@ scavenge_one(StgPtr p) case WEAK: case FOREIGN: case IND_PERM: - case IND_OLDGEN_PERM: { StgPtr q, end; end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs; for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) { - (StgClosure *)*q = evacuate((StgClosure *)*q); + *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q); } break; } + case MUT_VAR: + evac_gen = 0; + ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable anyhow + break; + case CAF_BLACKHOLE: case SE_CAF_BLACKHOLE: case SE_BLACKHOLE: case BLACKHOLE: break; + case BLACKHOLE_BQ: + { + StgBlockingQueue *bh = (StgBlockingQueue *)p; + evac_gen = 0; // repeatedly mutable + bh->blocking_queue = + (StgTSO *)evacuate((StgClosure *)bh->blocking_queue); + failed_to_evac = rtsTrue; + break; + } + case THUNK_SELECTOR: { StgSelector *s = (StgSelector *)p; @@ -3359,6 +3288,21 @@ scavenge_one(StgPtr p) break; } + case AP_STACK: + { + StgAP_STACK *ap = (StgAP_STACK *)p; + + ap->fun = evacuate(ap->fun); + scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); + p = (StgPtr)ap->payload + ap->size; + break; + } + + case PAP: + case AP: + p = scavenge_PAP((StgPAP *)p); + break; + case ARR_WORDS: // nothing to follow break; @@ -3369,29 +3313,24 @@ scavenge_one(StgPtr p) StgPtr next; evac_gen = 0; // repeatedly mutable - recordMutable((StgMutClosure *)p); next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } evac_gen = saved_evac_gen; - failed_to_evac = rtsFalse; + failed_to_evac = rtsTrue; break; } case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: { // follow everything StgPtr next; - // Set the mut_link field to NULL, so that we will put this - // array on the mutable list if it is subsequently thawed - // by unsafeThaw#. - ((StgMutArrPtrs*)p)->mut_link = NULL; - next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } break; } @@ -3402,83 +3341,133 @@ scavenge_one(StgPtr p) evac_gen = 0; // repeatedly mutable scavengeTSO(tso); - recordMutable((StgMutClosure *)tso); evac_gen = saved_evac_gen; - failed_to_evac = rtsFalse; + failed_to_evac = rtsTrue; break; } - case AP_STACK: - { - StgAP_STACK *ap = (StgAP_STACK *)p; - - ap->fun = evacuate(ap->fun); - scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); - p = (StgPtr)ap->payload + ap->size; +#if defined(PAR) + case RBH: // cf. BLACKHOLE_BQ + { +#if 0 + nat size, ptrs, nonptrs, vhs; + char str[80]; + StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); +#endif + StgRBH *rbh = (StgRBH *)p; + (StgClosure *)rbh->blocking_queue = + evacuate((StgClosure *)rbh->blocking_queue); + failed_to_evac = rtsTrue; // mutable anyhow. + IF_DEBUG(gc, + debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", + p, info_type(p), (StgClosure *)rbh->blocking_queue)); + // ToDo: use size of reverted closure here! break; } - case PAP: - case AP: - p = scavenge_PAP((StgPAP *)p); - break; - - case IND_OLDGEN: - // This might happen if for instance a MUT_CONS was pointing to a - // THUNK which has since been updated. The IND_OLDGEN will - // be on the mutable list anyway, so we don't need to do anything - // here. + case BLOCKED_FETCH: + { + StgBlockedFetch *bf = (StgBlockedFetch *)p; + // follow the pointer to the node which is being demanded + (StgClosure *)bf->node = + evacuate((StgClosure *)bf->node); + // follow the link to the rest of the blocking queue + (StgClosure *)bf->link = + evacuate((StgClosure *)bf->link); + IF_DEBUG(gc, + debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", + bf, info_type((StgClosure *)bf), + bf->node, info_type(bf->node))); break; + } - default: - barf("scavenge_one: strange object %d", (int)(info->type)); - } - - no_luck = failed_to_evac; - failed_to_evac = rtsFalse; - return (no_luck); -} - -/* ----------------------------------------------------------------------------- - Scavenging mutable lists. +#ifdef DIST + case REMOTE_REF: +#endif + case FETCH_ME: + break; // nothing to do in this case - We treat the mutable list of each generation > N (i.e. all the - generations older than the one being collected) as roots. We also - remove non-mutable objects from the mutable list at this point. - -------------------------------------------------------------------------- */ + case FETCH_ME_BQ: // cf. BLACKHOLE_BQ + { + StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; + (StgClosure *)fmbq->blocking_queue = + evacuate((StgClosure *)fmbq->blocking_queue); + IF_DEBUG(gc, + debugBelch("@@ scavenge: %p (%s) exciting, isn't it", + p, info_type((StgClosure *)p))); + break; + } +#endif -static void -scavenge_mut_once_list(generation *gen) -{ - const StgInfoTable *info; - StgMutClosure *p, *next, *new_list; + case TVAR_WAIT_QUEUE: + { + StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p); + evac_gen = 0; + wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso); + wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry); + wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } - p = gen->mut_once_list; - new_list = END_MUT_LIST; - next = p->mut_link; + case TVAR: + { + StgTVar *tvar = ((StgTVar *) p); + evac_gen = 0; + tvar->current_value = evacuate((StgClosure*)tvar->current_value); + tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } - evac_gen = gen->no; - failed_to_evac = rtsFalse; + case TREC_HEADER: + { + StgTRecHeader *trec = ((StgTRecHeader *) p); + evac_gen = 0; + trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec); + trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk); + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } - for (; p != END_MUT_LIST; p = next, next = p->mut_link) { + case TREC_CHUNK: + { + StgWord i; + StgTRecChunk *tc = ((StgTRecChunk *) p); + TRecEntry *e = &(tc -> entries[0]); + evac_gen = 0; + tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk); + for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { + e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar); + e->expected_value = evacuate((StgClosure*)e->expected_value); + e->new_value = evacuate((StgClosure*)e->new_value); + } + evac_gen = saved_evac_gen; + failed_to_evac = rtsTrue; // mutable + break; + } - ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); - info = get_itbl(p); - /* - if (info->type==RBH) - info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure - */ - switch(info->type) { - case IND_OLDGEN: case IND_OLDGEN_PERM: case IND_STATIC: - /* Try to pull the indirectee into this generation, so we can - * remove the indirection from the mutable list. - */ - ((StgIndOldGen *)p)->indirectee = - evacuate(((StgIndOldGen *)p)->indirectee); - + { + /* Careful here: a THUNK can be on the mutable list because + * it contains pointers to young gen objects. If such a thunk + * is updated, the IND_OLDGEN will be added to the mutable + * list again, and we'll scavenge it twice. evacuate() + * doesn't check whether the object has already been + * evacuated, so we perform that check here. + */ + StgClosure *q = ((StgInd *)p)->indirectee; + if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) { + break; + } + ((StgInd *)p)->indirectee = evacuate(q); + } + #if 0 && defined(DEBUG) if (RtsFlags.DebugFlags.gc) /* Debugging code to print out the size of the thing we just @@ -3504,284 +3493,50 @@ scavenge_mut_once_list(generation *gen) debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_)); } #endif - - /* failed_to_evac might happen if we've got more than two - * generations, we're collecting only generation 0, the - * indirection resides in generation 2 and the indirectee is - * in generation 1. - */ - if (failed_to_evac) { - failed_to_evac = rtsFalse; - p->mut_link = new_list; - new_list = p; - } else { - /* the mut_link field of an IND_STATIC is overloaded as the - * static link field too (it just so happens that we don't need - * both at the same time), so we need to NULL it out when - * removing this object from the mutable list because the static - * link fields are all assumed to be NULL before doing a major - * collection. - */ - p->mut_link = NULL; - } - continue; - - case MUT_CONS: - /* MUT_CONS is a kind of MUT_VAR, except it that we try to remove - * it from the mutable list if possible by promoting whatever it - * points to. - */ - if (scavenge_one((StgPtr)((StgMutVar *)p)->var)) { - /* didn't manage to promote everything, so put the - * MUT_CONS back on the list. - */ - p->mut_link = new_list; - new_list = p; - } - continue; + break; default: - // shouldn't have anything else on the mutables list - barf("scavenge_mut_once_list: strange object? %d", (int)(info->type)); - } - } + barf("scavenge_one: strange object %d", (int)(info->type)); + } - gen->mut_once_list = new_list; + no_luck = failed_to_evac; + failed_to_evac = rtsFalse; + return (no_luck); } +/* ----------------------------------------------------------------------------- + Scavenging mutable lists. + + We treat the mutable list of each generation > N (i.e. all the + generations older than the one being collected) as roots. We also + remove non-mutable objects from the mutable list at this point. + -------------------------------------------------------------------------- */ static void scavenge_mutable_list(generation *gen) { - const StgInfoTable *info; - StgMutClosure *p, *next; - - p = gen->saved_mut_list; - next = p->mut_link; - - evac_gen = 0; - failed_to_evac = rtsFalse; - - for (; p != END_MUT_LIST; p = next, next = p->mut_link) { - - ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); - info = get_itbl(p); - /* - if (info->type==RBH) - info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure - */ - switch(info->type) { - - case MUT_ARR_PTRS: - // follow everything - p->mut_link = gen->mut_list; - gen->mut_list = p; - { - StgPtr end, q; - - end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); - for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) { - (StgClosure *)*q = evacuate((StgClosure *)*q); - } - continue; - } - - // Happens if a MUT_ARR_PTRS in the old generation is frozen - case MUT_ARR_PTRS_FROZEN: - { - StgPtr end, q; - - evac_gen = gen->no; - end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); - for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) { - (StgClosure *)*q = evacuate((StgClosure *)*q); - } - evac_gen = 0; - // Set the mut_link field to NULL, so that we will put this - // array back on the mutable list if it is subsequently thawed - // by unsafeThaw#. - p->mut_link = NULL; - if (failed_to_evac) { - failed_to_evac = rtsFalse; - mkMutCons((StgClosure *)p, gen); - } - continue; - } - - case MUT_VAR: - ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); - p->mut_link = gen->mut_list; - gen->mut_list = p; - continue; - - case MVAR: - { - StgMVar *mvar = (StgMVar *)p; - (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head); - (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail); - (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value); - p->mut_link = gen->mut_list; - gen->mut_list = p; - continue; - } - - case TSO: - { - StgTSO *tso = (StgTSO *)p; - - scavengeTSO(tso); - - /* Don't take this TSO off the mutable list - it might still - * point to some younger objects (because we set evac_gen to 0 - * above). - */ - tso->mut_link = gen->mut_list; - gen->mut_list = (StgMutClosure *)tso; - continue; - } - - case BLACKHOLE_BQ: - { - StgBlockingQueue *bh = (StgBlockingQueue *)p; - (StgClosure *)bh->blocking_queue = - evacuate((StgClosure *)bh->blocking_queue); - p->mut_link = gen->mut_list; - gen->mut_list = p; - continue; - } - - /* Happens if a BLACKHOLE_BQ in the old generation is updated: - */ - case IND_OLDGEN: - case IND_OLDGEN_PERM: - /* Try to pull the indirectee into this generation, so we can - * remove the indirection from the mutable list. - */ - evac_gen = gen->no; - ((StgIndOldGen *)p)->indirectee = - evacuate(((StgIndOldGen *)p)->indirectee); - evac_gen = 0; - - if (failed_to_evac) { - failed_to_evac = rtsFalse; - p->mut_link = gen->mut_once_list; - gen->mut_once_list = p; - } else { - p->mut_link = NULL; - } - continue; - -#if defined(PAR) - // HWL: check whether all of these are necessary - - case RBH: // cf. BLACKHOLE_BQ - { - // nat size, ptrs, nonptrs, vhs; - // char str[80]; - // StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); - StgRBH *rbh = (StgRBH *)p; - (StgClosure *)rbh->blocking_queue = - evacuate((StgClosure *)rbh->blocking_queue); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordMutable((StgMutClosure *)rbh); - } - // ToDo: use size of reverted closure here! - p += BLACKHOLE_sizeW(); - break; - } - - case BLOCKED_FETCH: - { - StgBlockedFetch *bf = (StgBlockedFetch *)p; - // follow the pointer to the node which is being demanded - (StgClosure *)bf->node = - evacuate((StgClosure *)bf->node); - // follow the link to the rest of the blocking queue - (StgClosure *)bf->link = - evacuate((StgClosure *)bf->link); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordMutable((StgMutClosure *)bf); - } - p += sizeofW(StgBlockedFetch); - break; - } - -#ifdef DIST - case REMOTE_REF: - barf("scavenge_mutable_list: REMOTE_REF %d", (int)(info->type)); -#endif - case FETCH_ME: - p += sizeofW(StgFetchMe); - break; // nothing to do in this case - - case FETCH_ME_BQ: // cf. BLACKHOLE_BQ - { - StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; - (StgClosure *)fmbq->blocking_queue = - evacuate((StgClosure *)fmbq->blocking_queue); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordMutable((StgMutClosure *)fmbq); - } - p += sizeofW(StgFetchMeBlockingQueue); - break; - } -#endif - - case TVAR_WAIT_QUEUE: - { - StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p); - (StgClosure *)wq->waiting_tso = evacuate((StgClosure*)wq->waiting_tso); - (StgClosure *)wq->next_queue_entry = evacuate((StgClosure*)wq->next_queue_entry); - (StgClosure *)wq->prev_queue_entry = evacuate((StgClosure*)wq->prev_queue_entry); - p->mut_link = gen->mut_list; - gen->mut_list = p; - continue; - } + bdescr *bd; + StgPtr p, q; - case TVAR: - { - StgTVar *tvar = ((StgTVar *) p); - (StgClosure *)tvar->current_value = evacuate((StgClosure*)tvar->current_value); - (StgClosure *)tvar->first_wait_queue_entry = evacuate((StgClosure*)tvar->first_wait_queue_entry); - p->mut_link = gen->mut_list; - gen->mut_list = p; - continue; - } + bd = gen->saved_mut_list; - case TREC_CHUNK: - { - StgWord i; - StgTRecChunk *tc = ((StgTRecChunk *) p); - TRecEntry *e = &(tc -> entries[0]); - (StgClosure *)tc->prev_chunk = evacuate((StgClosure*)tc->prev_chunk); - for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { - (StgClosure *)e->tvar = evacuate((StgClosure*)e->tvar); - (StgClosure *)e->expected_value = evacuate((StgClosure*)e->expected_value); - (StgClosure *)e->new_value = evacuate((StgClosure*)e->new_value); + evac_gen = gen->no; + for (; bd != NULL; bd = bd->link) { + for (q = bd->start; q < bd->free; q++) { + p = (StgPtr)*q; + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + if (scavenge_one(p)) { + /* didn't manage to promote everything, so put the + * object back on the list. + */ + recordMutableGen((StgClosure *)p,gen); + } } - p->mut_link = gen->mut_list; - gen->mut_list = p; - continue; - } - - case TREC_HEADER: - { - StgTRecHeader *trec = ((StgTRecHeader *) p); - (StgClosure *)trec->enclosing_trec = evacuate((StgClosure*)trec->enclosing_trec); - (StgClosure *)trec->current_chunk = evacuate((StgClosure*)trec->current_chunk); - p->mut_link = gen->mut_list; - gen->mut_list = p; - continue; - } - - default: - // shouldn't have anything else on the mutables list - barf("scavenge_mutable_list: strange object? %d", (int)(info->type)); } - } + + // free the old mut_list + freeChain(gen->saved_mut_list); + gen->saved_mut_list = NULL; } @@ -3822,15 +3577,13 @@ scavenge_static(void) ind->indirectee = evacuate(ind->indirectee); /* might fail to evacuate it, in which case we have to pop it - * back on the mutable list (and take it off the - * scavenged_static list because the static link and mut link - * pointers are one and the same). + * back on the mutable list of the oldest generation. We + * leave it *on* the scavenged_static_objects list, though, + * in case we visit this object again. */ if (failed_to_evac) { failed_to_evac = rtsFalse; - scavenged_static_objects = IND_STATIC_LINK(p); - ((StgMutClosure *)ind)->mut_link = oldest_gen->mut_once_list; - oldest_gen->mut_once_list = (StgMutClosure *)ind; + recordMutableGen((StgClosure *)p,oldest_gen); } break; } @@ -3850,7 +3603,7 @@ scavenge_static(void) next = (P_)p->payload + info->layout.payload.ptrs; // evacuate the pointers for (q = (P_)p->payload; q < next; q++) { - (StgClosure *)*q = evacuate((StgClosure *)*q); + *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q); } break; } @@ -3883,7 +3636,7 @@ scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size ) bitmap = large_bitmap->bitmap[b]; for (i = 0; i < size; ) { if ((bitmap & 1) == 0) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } i++; p++; @@ -3901,7 +3654,7 @@ scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap) { while (size > 0) { if ((bitmap & 1) == 0) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); } p++; bitmap = bitmap >> 1; @@ -3966,7 +3719,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) nat size; p++; - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); bco = (StgBCO *)*p; p++; size = BCO_BITMAP_SIZE(bco); @@ -4009,7 +3762,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) // follow the ptr words for (size = RET_DYN_PTRS(dyn); size > 0; size--) { - (StgClosure *)*p = evacuate((StgClosure *)*p); + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); p++; } continue; @@ -4064,7 +3817,7 @@ scavenge_large(step *stp) p = bd->start; if (scavenge_one(p)) { - mkMutCons((StgClosure *)p, stp->gen); + recordMutableGen((StgClosure *)p, stp->gen); } } } @@ -4087,26 +3840,6 @@ zero_static_object_list(StgClosure* first_static) } } -/* This function is only needed because we share the mutable link - * field with the static link field in an IND_STATIC, so we have to - * zero the mut_link field before doing a major GC, which needs the - * static link field. - * - * It doesn't do any harm to zero all the mutable link fields on the - * mutable list. - */ - -static void -zero_mutable_list( StgMutClosure *first ) -{ - StgMutClosure *next, *c; - - for (c = first; c != END_MUT_LIST; c = next) { - next = c->mut_link; - c->mut_link = NULL; - } -} - /* ----------------------------------------------------------------------------- Reverting CAFs -------------------------------------------------------------------------- */ @@ -4253,7 +3986,7 @@ threadLazyBlackHole(StgTSO *tso) // normal stack frames; do nothing except advance the pointer default: - (StgPtr)frame += stack_frame_sizeW(frame); + frame = (StgClosure *)((StgPtr)frame + stack_frame_sizeW(frame)); } } } @@ -4457,7 +4190,7 @@ done_traversing: next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame)); chunk_size = (unsigned char*)gap_end - (unsigned char*)next_gap_start; - (unsigned char*)sp -= chunk_size; + sp -= chunk_size; memmove(sp, next_gap_start, chunk_size); } @@ -4487,35 +4220,19 @@ threadPaused(StgTSO *tso) #if DEBUG void -printMutOnceList(generation *gen) -{ - StgMutClosure *p, *next; - - p = gen->mut_once_list; - next = p->mut_link; - - debugBelch("@@ Mut once list %p: ", gen->mut_once_list); - for (; p != END_MUT_LIST; p = next, next = p->mut_link) { - debugBelch("%p (%s), ", - p, info_type((StgClosure *)p)); - } - debugBelch("\n"); -} - -void printMutableList(generation *gen) { - StgMutClosure *p, *next; + bdescr *bd; + StgPtr p; - p = gen->mut_list; - next = p->mut_link; + debugBelch("@@ Mutable list %p: ", gen->mut_list); - debugBelch("@@ Mutable list %p: ", gen->mut_list); - for (; p != END_MUT_LIST; p = next, next = p->mut_link) { - debugBelch("%p (%s), ", - p, info_type((StgClosure *)p)); - } - debugBelch("\n"); + for (bd = gen->mut_list; bd != NULL; bd = bd->link) { + for (p = bd->start; p < bd->free; p++) { + debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p)); + } + } + debugBelch("\n"); } STATIC_INLINE rtsBool @@ -4527,6 +4244,7 @@ maybeLarge(StgClosure *closure) see scavenge_large */ return (info->type == MUT_ARR_PTRS || info->type == MUT_ARR_PTRS_FROZEN || + info->type == MUT_ARR_PTRS_FROZEN0 || info->type == TSO || info->type == ARR_WORDS); }