X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2Fsm%2FCompact.c;h=315eda732d7fca2bfa5498eb2627dcb2ac41daaa;hp=b8a40d47e9a202ac6aced8d7988289d9e61d1a8c;hb=57cf387c0c7e321bb0696685d94e3b1c316c13c0;hpb=1ed01a871030f05905a9595e4837dfffc087ef64 diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c index b8a40d4..315eda7 100644 --- a/rts/sm/Compact.c +++ b/rts/sm/Compact.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team 2001-2006 + * (c) The GHC Team 2001-2008 * * Compacting garbage collector * @@ -13,16 +13,18 @@ #include "PosixSource.h" #include "Rts.h" + +#include "Storage.h" #include "RtsUtils.h" -#include "RtsFlags.h" -#include "OSThreads.h" #include "BlockAlloc.h" -#include "MBlock.h" #include "GC.h" #include "Compact.h" #include "Schedule.h" #include "Apply.h" #include "Trace.h" +#include "Weak.h" +#include "MarkWeak.h" +#include "Stable.h" // Turn off inlining when debugging - it obfuscates things #ifdef DEBUG @@ -83,11 +85,8 @@ thread (StgClosure **p) if (HEAP_ALLOCED(q)) { bd = Bdescr(q); - // a handy way to discover whether the ptr is into the - // compacted area of the old gen, is that the EVACUATED flag - // is zero (it's non-zero for all the other areas of live - // memory). - if ((bd->flags & BF_EVACUATED) == 0) + + if (bd->flags & BF_MARKED) { iptr = *q; switch (GET_CLOSURE_TAG((StgClosure *)iptr)) @@ -109,6 +108,12 @@ thread (StgClosure **p) } } +static void +thread_root (void *user STG_UNUSED, StgClosure **p) +{ + thread(p); +} + // This version of thread() takes a (void *), used to circumvent // warnings from gcc about pointer punning and strict aliasing. STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); } @@ -163,7 +168,7 @@ loop: case 1: { StgWord r = *(StgPtr)(q-1); - ASSERT(LOOKS_LIKE_INFO_PTR(UNTAG_CLOSURE((StgClosure *)r))); + ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)UNTAG_CLOSURE((StgClosure *)r))); return r; } case 2: @@ -461,7 +466,7 @@ thread_AP_STACK (StgAP_STACK *ap) static StgPtr thread_TSO (StgTSO *tso) { - thread_(&tso->link); + thread_(&tso->_link); thread_(&tso->global_link); if ( tso->why_blocked == BlockedOnMVar @@ -487,6 +492,10 @@ update_fwd_large( bdescr *bd ) for (; bd != NULL; bd = bd->link) { + // nothing to do in a pinned block; it might not even have an object + // at the beginning. + if (bd->flags & BF_PINNED) continue; + p = bd->start; info = get_itbl((StgClosure *)p); @@ -502,13 +511,13 @@ update_fwd_large( bdescr *bd ) case MUT_ARR_PTRS_FROZEN0: // follow everything { - StgPtr next; + StgMutArrPtrs *a; - next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); - for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - thread((StgClosure **)p); - } - continue; + a = (StgMutArrPtrs*)p; + for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) { + thread((StgClosure **)p); + } + continue; } case TSO: @@ -618,8 +627,6 @@ thread_obj (StgInfoTable *info, StgPtr p) case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: case CAF_BLACKHOLE: - case SE_CAF_BLACKHOLE: - case SE_BLACKHOLE: case BLACKHOLE: { StgPtr end; @@ -635,6 +642,7 @@ thread_obj (StgInfoTable *info, StgPtr p) case WEAK: { StgWeak *w = (StgWeak *)p; + thread(&w->cfinalizer); thread(&w->key); thread(&w->value); thread(&w->finalizer); @@ -684,13 +692,14 @@ thread_obj (StgInfoTable *info, StgPtr p) case MUT_ARR_PTRS_FROZEN0: // follow everything { - StgPtr next; - - next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); - for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { + StgMutArrPtrs *a; + + a = (StgMutArrPtrs *)p; + for (p = (P_)a->payload; p < (P_)&a->payload[a->ptrs]; p++) { thread((StgClosure **)p); } - return p; + + return (StgPtr)a + mut_arr_ptrs_sizeW(a); } case TSO: @@ -846,15 +855,15 @@ update_fwd_compact( bdescr *blocks ) size = p - q; if (free + size > free_bd->start + BLOCK_SIZE_W) { - // unset the next bit in the bitmap to indicate that + // set the next bit in the bitmap to indicate that // this object needs to be pushed into the next // block. This saves us having to run down the // threaded info pointer list twice during the next pass. - unmark(q+1,bd); + mark(q+1,bd); free_bd = free_bd->link; free = free_bd->start; } else { - ASSERT(is_marked(q+1,bd)); + ASSERT(!is_marked(q+1,bd)); } unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr)); @@ -867,7 +876,7 @@ update_fwd_compact( bdescr *blocks ) } static nat -update_bkwd_compact( step *stp ) +update_bkwd_compact( generation *gen ) { StgPtr p, free; #if 0 @@ -878,7 +887,7 @@ update_bkwd_compact( step *stp ) nat size, free_blocks; StgWord iptr; - bd = free_bd = stp->old_blocks; + bd = free_bd = gen->old_blocks; free = free_bd->start; free_blocks = 1; @@ -913,7 +922,7 @@ update_bkwd_compact( step *stp ) } #endif - if (!is_marked(p+1,bd)) { + if (is_marked(p+1,bd)) { // don't forget to update the free ptr in the block desc. free_bd->free = free; free_bd = free_bd->link; @@ -923,7 +932,7 @@ update_bkwd_compact( step *stp ) iptr = get_threaded_info(p); unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr)); - ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info)); + ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)((StgClosure *)p)->header.info)); info = get_itbl((StgClosure *)p); size = closure_sizeW_((StgClosure *)p,info); @@ -955,13 +964,13 @@ update_bkwd_compact( step *stp ) } void -compact(void) +compact(StgClosure *static_objects) { - nat g, s, blocks; - step *stp; + nat g, blocks; + generation *gen; // 1. thread the roots - GetRoots((evac_fn)thread); + markCapabilities((evac_fn)thread_root, NULL); // the weak pointer lists... if (weak_ptr_list != NULL) { @@ -975,19 +984,33 @@ compact(void) for (g = 1; g < RtsFlags.GcFlags.generations; g++) { bdescr *bd; StgPtr p; + nat n; for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) { for (p = bd->start; p < bd->free; p++) { thread((StgClosure **)p); } } + for (n = 0; n < n_capabilities; n++) { + for (bd = capabilities[n].mut_lists[g]; + bd != NULL; bd = bd->link) { + for (p = bd->start; p < bd->free; p++) { + thread((StgClosure **)p); + } + } + } } // the global thread list - thread((void *)&all_threads); + for (g = 0; g < RtsFlags.GcFlags.generations; g++) { + thread((void *)&generations[g].threads); + } // any threads resurrected during this GC thread((void *)&resurrected_threads); + // the blackhole queue + thread((void *)&blackhole_queue); + // the task list { Task *task; @@ -999,40 +1022,34 @@ compact(void) } // the static objects - thread_static(scavenged_static_objects); + thread_static(static_objects /* ToDo: ok? */); // the stable pointer table - threadStablePtrTable((evac_fn)thread); + threadStablePtrTable((evac_fn)thread_root, NULL); // the CAF list (used by GHCi) - markCAFs((evac_fn)thread); + markCAFs((evac_fn)thread_root, NULL); // 2. update forward ptrs for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - for (s = 0; s < generations[g].n_steps; s++) { - if (g==0 && s ==0) continue; - stp = &generations[g].steps[s]; - debugTrace(DEBUG_gc, "update_fwd: %d.%d", - stp->gen->no, stp->no); - - update_fwd(stp->blocks); - update_fwd_large(stp->scavenged_large_objects); - if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) { - debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)", - stp->gen->no, stp->no); - update_fwd_compact(stp->old_blocks); - } + gen = &generations[g]; + debugTrace(DEBUG_gc, "update_fwd: %d", g); + + update_fwd(gen->blocks); + update_fwd_large(gen->scavenged_large_objects); + if (g == RtsFlags.GcFlags.generations-1 && gen->old_blocks != NULL) { + debugTrace(DEBUG_gc, "update_fwd: %d (compact)", g); + update_fwd_compact(gen->old_blocks); } } // 3. update backward ptrs - stp = &oldest_gen->steps[0]; - if (stp->old_blocks != NULL) { - blocks = update_bkwd_compact(stp); + gen = oldest_gen; + if (gen->old_blocks != NULL) { + blocks = update_bkwd_compact(gen); debugTrace(DEBUG_gc, - "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)", - stp->gen->no, stp->no, - stp->n_old_blocks, blocks); - stp->n_old_blocks = blocks; + "update_bkwd: %d (compact, old: %d blocks, now %d blocks)", + gen->no, gen->n_old_blocks, blocks); + gen->n_old_blocks = blocks; } }