X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=883058234e181881c39554078a6fc094406a7f24;hb=a186d6f72aa221772ffeccb99c6c538c4505b0d7;hp=adb36cc21538f1e833e5004467ac58d67c06ee75;hpb=423d477bfecd490de1449c59325c8776f91d7aac;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index adb36cc..8830582 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.168 2004/08/13 13:09:49 simonmar Exp $ * * (c) The GHC Team 1998-2003 * @@ -17,7 +16,6 @@ #include "Updates.h" #include "Stats.h" #include "Schedule.h" -#include "SchedAPI.h" // for ReverCAFs prototype #include "Sanity.h" #include "BlockAlloc.h" #include "MBlock.h" @@ -28,6 +26,7 @@ #include "ParTicky.h" // ToDo: move into Rts.h #include "GCCompact.h" #include "Signals.h" +#include "STM.h" #if defined(GRAN) || defined(PAR) # include "GranSimRts.h" # include "ParallelRts.h" @@ -149,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 ); @@ -164,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, @@ -266,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 @@ -278,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 @@ -307,7 +304,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) #endif #if defined(DEBUG) && defined(GRAN) - IF_DEBUG(gc, belch("@@ Starting garbage collection at %ld (%lx)\n", + IF_DEBUG(gc, debugBelch("@@ Starting garbage collection at %ld (%lx)\n", Now, Now)); #endif @@ -316,6 +313,9 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) blockUserSignals(); #endif + // tell the STM to discard any cached closures its hoping to re-use + stmPreGCHook(); + // tell the stats department that we've started a GC stat_startGC(); @@ -367,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) { @@ -391,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++) { @@ -440,7 +439,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) stp->bitmap = bitmap_bdescr; bitmap = bitmap_bdescr->start; - IF_DEBUG(gc, belch("bitmap_size: %d, bitmap: %p", + IF_DEBUG(gc, debugBelch("bitmap_size: %d, bitmap: %p", bitmap_size, bitmap);); // don't forget to fill it with zeros! @@ -515,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--) { @@ -717,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]; @@ -851,10 +847,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) oldest_gen->steps[0].n_blocks > (RtsFlags.GcFlags.compactThreshold * max) / 100))) { oldest_gen->steps[0].is_compacted = 1; -// fprintf(stderr,"compaction: on\n", live); +// debugBelch("compaction: on\n", live); } else { oldest_gen->steps[0].is_compacted = 0; -// fprintf(stderr,"compaction: off\n", live); +// debugBelch("compaction: off\n", live); } // if we're going to go over the maximum heap size, reduce the @@ -886,7 +882,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } #if 0 - fprintf(stderr,"live: %d, min_alloc: %d, size : %d, max = %d\n", live, + debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live, min_alloc, size, max); #endif @@ -968,7 +964,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) int pc_free; adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks); - IF_DEBUG(gc, belch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks)); + IF_DEBUG(gc, debugBelch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks)); pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize; if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ { heapOverflow(); @@ -1196,7 +1192,7 @@ traverse_weak_ptr_list(void) w->link = weak_ptr_list; weak_ptr_list = w; flag = rtsTrue; - IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p", + IF_DEBUG(weak, debugBelch("Weak pointer still alive at %p -> %p", w, w->key)); continue; } @@ -1238,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; @@ -1285,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; } @@ -1324,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); } @@ -1586,39 +1582,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. @@ -1748,10 +1711,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: @@ -1883,6 +1846,9 @@ loop: case UPDATE_FRAME: case STOP_FRAME: case CATCH_FRAME: + case CATCH_STM_FRAME: + case CATCH_RETRY_FRAME: + case ATOMICALLY_FRAME: // shouldn't see these barf("evacuate: stack frame at %p\n", q); @@ -1916,6 +1882,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); @@ -1958,7 +1925,7 @@ loop: //ToDo: derive size etc from reverted IP //to = copy(q,size,stp); IF_DEBUG(gc, - belch("@@ evacuate: RBH %p (%s) to %p (%s)", + debugBelch("@@ evacuate: RBH %p (%s) to %p (%s)", q, info_type(q), to, info_type(to))); return to; } @@ -1967,7 +1934,7 @@ loop: ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE); to = copy(q,sizeofW(StgBlockedFetch),stp); IF_DEBUG(gc, - belch("@@ evacuate: %p (%s) to %p (%s)", + debugBelch("@@ evacuate: %p (%s) to %p (%s)", q, info_type(q), to, info_type(to))); return to; @@ -1978,7 +1945,7 @@ loop: ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); to = copy(q,sizeofW(StgFetchMe),stp); IF_DEBUG(gc, - belch("@@ evacuate: %p (%s) to %p (%s)", + debugBelch("@@ evacuate: %p (%s) to %p (%s)", q, info_type(q), to, info_type(to))); return to; @@ -1986,11 +1953,23 @@ loop: ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp); IF_DEBUG(gc, - belch("@@ evacuate: %p (%s) to %p (%s)", + debugBelch("@@ evacuate: %p (%s) to %p (%s)", q, info_type(q), to, info_type(to))); return to; #endif + case TREC_HEADER: + return copy(q,sizeofW(StgTRecHeader),stp); + + case TVAR_WAIT_QUEUE: + return copy(q,sizeofW(StgTVarWaitQueue),stp); + + case TVAR: + return copy(q,sizeofW(StgTVar),stp); + + case TREC_CHUNK: + return copy(q,sizeofW(StgTRecChunk),stp); + default: barf("evacuate: strange closure type %d", (int)(info->type)); } @@ -2138,10 +2117,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); @@ -2305,7 +2284,7 @@ scavenge_thunk_srt(const StgInfoTable *info) StgThunkInfoTable *thunk_info; thunk_info = itbl_to_thunk_itbl(info); - scavenge_srt((StgClosure **)thunk_info->srt, thunk_info->i.srt_bitmap); + scavenge_srt((StgClosure **)GET_SRT(thunk_info), thunk_info->i.srt_bitmap); } STATIC_INLINE void @@ -2314,7 +2293,7 @@ scavenge_fun_srt(const StgInfoTable *info) StgFunInfoTable *fun_info; fun_info = itbl_to_fun_itbl(info); - scavenge_srt((StgClosure **)fun_info->f.srt, fun_info->i.srt_bitmap); + scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap); } STATIC_INLINE void @@ -2323,7 +2302,7 @@ scavenge_ret_srt(const StgInfoTable *info) StgRetInfoTable *ret_info; ret_info = itbl_to_ret_itbl(info); - scavenge_srt((StgClosure **)ret_info->srt, ret_info->i.srt_bitmap); + scavenge_srt((StgClosure **)GET_SRT(ret_info), ret_info->i.srt_bitmap); } /* ----------------------------------------------------------------------------- @@ -2334,7 +2313,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 @@ -2350,6 +2329,9 @@ scavengeTSO (StgTSO *tso) (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions); } + // scavange current transaction record + tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec); + // scavenge this thread's stack scavenge_stack(tso->sp, &(tso->stack[tso->stack_size])); } @@ -2373,8 +2355,8 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args) size = BITMAP_SIZE(fun_info->f.bitmap); goto small_bitmap; case ARG_GEN_BIG: - size = ((StgLargeBitmap *)fun_info->f.bitmap)->size; - scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size); + size = GET_FUN_LARGE_BITMAP(fun_info)->size; + scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size); p += size; break; default: @@ -2383,7 +2365,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; @@ -2413,7 +2395,7 @@ scavenge_PAP (StgPAP *pap) bitmap = BITMAP_BITS(fun_info->f.bitmap); goto small_bitmap; case ARG_GEN_BIG: - scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size); + scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size); p += size; break; case ARG_BCO: @@ -2426,7 +2408,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; @@ -2485,18 +2467,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; } @@ -2519,7 +2497,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: @@ -2531,7 +2509,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: @@ -2582,7 +2560,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; @@ -2590,10 +2568,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; } @@ -2616,27 +2594,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; @@ -2650,10 +2616,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; } @@ -2695,27 +2660,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 @@ -2730,8 +2690,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; } @@ -2747,10 +2706,9 @@ 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, - belch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", + 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! p += BLACKHOLE_sizeW(); @@ -2766,12 +2724,8 @@ 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, - belch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", + debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", bf, info_type((StgClosure *)bf), bf->node, info_type(bf->node))); p += sizeofW(StgBlockedFetch); @@ -2790,30 +2744,84 @@ 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, - belch("@@ scavenge: %p (%s) exciting, isn't it", + debugBelch("@@ scavenge: %p (%s) exciting, isn't it", p, info_type((StgClosure *)p))); p += sizeofW(StgFetchMeBlockingQueue); break; } #endif + 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 + p += sizeofW(StgTVarWaitQueue); + break; + } + + 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 + p += sizeofW(StgTVar); + break; + } + + 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 + p += sizeofW(StgTRecHeader); + break; + } + + 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 + p += sizeofW(StgTRecChunk); + break; + } + default: barf("scavenge: unimplemented/strange closure type %d @ %p", 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); } } @@ -2850,17 +2858,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; } @@ -2923,17 +2928,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; } @@ -2945,24 +2950,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: @@ -2975,9 +2971,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; } @@ -3011,26 +3007,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; } @@ -3041,7 +3033,7 @@ linear_scan: evac_gen = 0; scavengeTSO(tso); evac_gen = saved_evac_gen; - failed_to_evac = rtsFalse; + failed_to_evac = rtsTrue; break; } @@ -3054,12 +3046,11 @@ 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, - belch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", + debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", p, info_type(p), (StgClosure *)rbh->blocking_queue)); break; } @@ -3073,12 +3064,8 @@ 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, - belch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", + debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", bf, info_type((StgClosure *)bf), bf->node, info_type(bf->node))); break; @@ -3095,17 +3082,64 @@ 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, - belch("@@ scavenge: %p (%s) exciting, isn't it", + debugBelch("@@ scavenge: %p (%s) exciting, isn't it", p, info_type((StgClosure *)p))); break; } #endif // PAR + 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; + } + + 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; + } + + 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; + } + + 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; + } + default: barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p", info->type, p); @@ -3113,7 +3147,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" @@ -3123,7 +3157,7 @@ linear_scan: // start a new linear scan if the mark stack overflowed at some point if (mark_stack_overflowed && oldgen_scan_bd == NULL) { - IF_DEBUG(gc, belch("scavenge_mark_stack: starting linear scan")); + IF_DEBUG(gc, debugBelch("scavenge_mark_stack: starting linear scan")); mark_stack_overflowed = rtsFalse; oldgen_scan_bd = oldest_gen->steps[0].blocks; oldgen_scan = oldgen_scan_bd->start; @@ -3180,6 +3214,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: @@ -3201,23 +3247,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; @@ -3225,6 +3287,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; @@ -3235,29 +3312,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; } @@ -3268,82 +3340,122 @@ 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); + ((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee); #if 0 && defined(DEBUG) if (RtsFlags.DebugFlags.gc) @@ -3367,240 +3479,53 @@ scavenge_mut_once_list(generation *gen) } else { size = gen->steps[0].scan - start; } - belch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_)); + 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; - } + bdescr *bd; + StgPtr p, q; -#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 + bd = gen->saved_mut_list; - 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); + 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 += sizeofW(StgFetchMeBlockingQueue); - break; - } -#endif - - 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; } @@ -3641,15 +3566,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; } @@ -3669,7 +3592,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; } @@ -3702,7 +3625,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++; @@ -3720,7 +3643,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; @@ -3743,7 +3666,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) StgWord bitmap; nat size; - //IF_DEBUG(sanity, belch(" scavenging stack between %p and %p", p, stack_end)); + //IF_DEBUG(sanity, debugBelch(" scavenging stack between %p and %p", p, stack_end)); /* * Each time around this loop, we are looking at a chunk of stack @@ -3762,6 +3685,9 @@ scavenge_stack(StgPtr p, StgPtr stack_end) continue; // small bitmap (< 32 entries, or 64 on a 64-bit machine) + case CATCH_STM_FRAME: + case CATCH_RETRY_FRAME: + case ATOMICALLY_FRAME: case STOP_FRAME: case CATCH_FRAME: case RET_SMALL: @@ -3774,7 +3700,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) p = scavenge_small_bitmap(p, size, bitmap); follow_srt: - scavenge_srt((StgClosure **)info->srt, info->i.srt_bitmap); + scavenge_srt((StgClosure **)GET_SRT(info), info->i.srt_bitmap); continue; case RET_BCO: { @@ -3782,7 +3708,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); @@ -3797,9 +3723,9 @@ scavenge_stack(StgPtr p, StgPtr stack_end) { nat size; - size = info->i.layout.large_bitmap->size; + size = GET_LARGE_BITMAP(&info->i)->size; p++; - scavenge_large_bitmap(p, info->i.layout.large_bitmap, size); + scavenge_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size); p += size; // and don't forget to follow the SRT goto follow_srt; @@ -3825,7 +3751,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; @@ -3880,7 +3806,7 @@ scavenge_large(step *stp) p = bd->start; if (scavenge_one(p)) { - mkMutCons((StgClosure *)p, stp->gen); + recordMutableGen((StgClosure *)p, stp->gen); } } } @@ -3903,26 +3829,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 -------------------------------------------------------------------------- */ @@ -3987,7 +3893,7 @@ gcCAFs(void) ASSERT(info->type == IND_STATIC); if (STATIC_LINK(info,p) == NULL) { - IF_DEBUG(gccafs, belch("CAF gc'd at 0x%04lx", (long)p)); + IF_DEBUG(gccafs, debugBelch("CAF gc'd at 0x%04lx", (long)p)); // black hole it SET_INFO(p,&stg_BLACKHOLE_info); p = STATIC_LINK2(info,p); @@ -4001,7 +3907,7 @@ gcCAFs(void) } - // belch("%d CAFs live", i); + // debugBelch("%d CAFs live", i); } #endif @@ -4048,7 +3954,7 @@ threadLazyBlackHole(StgTSO *tso) if (bh->header.info != &stg_BLACKHOLE_BQ_info && bh->header.info != &stg_CAF_BLACKHOLE_info) { #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) - belch("Unexpected lazy BHing required at 0x%04x",(int)bh); + debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh); #endif #ifdef PROFILING // @LDV profiling @@ -4069,7 +3975,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)); } } } @@ -4175,7 +4081,7 @@ threadSqueezeStack(StgTSO *tso) bh->header.info != &stg_BLACKHOLE_BQ_info && bh->header.info != &stg_CAF_BLACKHOLE_info) { #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) - belch("Unexpected lazy BHing required at 0x%04x",(int)bh); + debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh); #endif #ifdef DEBUG /* zero out the slop so that the sanity checker can tell @@ -4191,8 +4097,8 @@ threadSqueezeStack(StgTSO *tso) * same size as a BLACKHOLE in any case. */ if (bh_info->type != THUNK_SELECTOR) { - for (i = np; i < np + nw; i++) { - ((StgClosure *)bh)->payload[i] = 0; + for (i = 0; i < np + nw; i++) { + ((StgClosure *)bh)->payload[i] = INVALID_OBJECT; } } } @@ -4273,7 +4179,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); } @@ -4303,35 +4209,19 @@ threadPaused(StgTSO *tso) #if DEBUG void -printMutOnceList(generation *gen) -{ - StgMutClosure *p, *next; - - p = gen->mut_once_list; - next = p->mut_link; - - fprintf(stderr, "@@ Mut once list %p: ", gen->mut_once_list); - for (; p != END_MUT_LIST; p = next, next = p->mut_link) { - fprintf(stderr, "%p (%s), ", - p, info_type((StgClosure *)p)); - } - fputc('\n', stderr); -} - -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); - fprintf(stderr, "@@ Mutable list %p: ", gen->mut_list); - for (; p != END_MUT_LIST; p = next, next = p->mut_link) { - fprintf(stderr, "%p (%s), ", - p, info_type((StgClosure *)p)); - } - fputc('\n', stderr); + 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 @@ -4343,6 +4233,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); }