X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2Fsm%2FCompact.c;h=6de42efae482e7274cc70774490f276eddc8ab51;hp=5cef8168f02bec22e875bd56af138bfc7770c9ed;hb=5d52d9b64c21dcf77849866584744722f8121389;hpb=4564c1125761e50897d7542aeb7a5a296965d71e diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c index 5cef816..6de42ef 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 @@ -30,7 +32,7 @@ # define STATIC_INLINE static #endif -/* ----------------------------------------------------------------------------- +/* ---------------------------------------------------------------------------- Threading / unthreading pointers. The basic idea here is to chain together all the fields pointing at @@ -46,65 +48,135 @@ the chain with the new location of the object. We stop when we reach the info pointer at the end. - We use a trick to identify the info pointer: when swapping pointers - for threading, we set the low bit of the original pointer, with the - result that all the pointers in the chain have their low bits set - except for the info pointer. - -------------------------------------------------------------------------- */ + The main difficulty here is that we need to be able to identify the + info pointer at the end of the chain. We can't use the low bits of + the pointer for this; they are already being used for + pointer-tagging. What's more, we need to retain the + pointer-tagging tag bits on each pointer during the + threading/unthreading process. + + Our solution is as follows: + - an info pointer (chain length zero) is identified by having tag 0 + - in a threaded chain of length > 0: + - the pointer-tagging tag bits are attached to the info pointer + - the first entry in the chain has tag 1 + - second and subsequent entries in the chain have tag 2 + + This exploits the fact that the tag on each pointer to a given + closure is normally the same (if they are not the same, then + presumably the tag is not essential and it therefore doesn't matter + if we throw away some of the tags). + ------------------------------------------------------------------------- */ STATIC_INLINE void thread (StgClosure **p) { - StgPtr q = *(StgPtr *)p; + StgClosure *q0; + StgPtr q; + StgWord iptr; bdescr *bd; + q0 = *p; + q = (StgPtr)UNTAG_CLOSURE(q0); + // It doesn't look like a closure at the moment, because the info // ptr is possibly threaded: // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); - + 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) { - - *(StgPtr)p = (StgWord)*q; - *q = (StgWord)p + 1; // set the low bit - } + + if (bd->flags & BF_MARKED) + { + iptr = *q; + switch (GET_CLOSURE_TAG((StgClosure *)iptr)) + { + case 0: + // this is the info pointer; we are creating a new chain. + // save the original tag at the end of the chain. + *p = (StgClosure *)((StgWord)iptr + GET_CLOSURE_TAG(q0)); + *q = (StgWord)p + 1; + break; + case 1: + case 2: + // this is a chain of length 1 or more + *p = (StgClosure *)iptr; + *q = (StgWord)p + 2; + break; + } + } } } +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); } STATIC_INLINE void -unthread( StgPtr p, StgPtr free ) +unthread( StgPtr p, StgWord free ) { - StgWord q = *p, r; - - while ((q & 1) != 0) { - q -= 1; // unset the low bit again - r = *((StgPtr)q); - *((StgPtr)q) = (StgWord)free; - q = r; + StgWord q, r; + StgPtr q0; + + q = *p; +loop: + switch (GET_CLOSURE_TAG((StgClosure *)q)) + { + case 0: + // nothing to do; the chain is length zero + return; + case 1: + q0 = (StgPtr)(q-1); + r = *q0; // r is the info ptr, tagged with the pointer-tag + *q0 = free; + *p = (StgWord)UNTAG_CLOSURE((StgClosure *)r); + return; + case 2: + q0 = (StgPtr)(q-2); + r = *q0; + *q0 = free; + q = r; + goto loop; + default: + barf("unthread"); } - *p = q; } -STATIC_INLINE StgInfoTable * +// Traverse a threaded chain and pull out the info pointer at the end. +// The info pointer is also tagged with the appropriate pointer tag +// for this closure, which should be attached to the pointer +// subsequently passed to unthread(). +STATIC_INLINE StgWord get_threaded_info( StgPtr p ) { - StgPtr q = (P_)GET_INFO((StgClosure *)p); + StgWord q; + + q = (W_)GET_INFO(UNTAG_CLOSURE((StgClosure *)p)); - while (((StgWord)q & 1) != 0) { - q = (P_)*((StgPtr)((StgWord)q-1)); +loop: + switch (GET_CLOSURE_TAG((StgClosure *)q)) + { + case 0: + ASSERT(LOOKS_LIKE_INFO_PTR(q)); + return q; + case 1: + { + StgWord r = *(StgPtr)(q-1); + ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)UNTAG_CLOSURE((StgClosure *)r))); + return r; + } + case 2: + q = *(StgPtr)(q-2); + goto loop; + default: + barf("get_threaded_info"); } - - ASSERT(LOOKS_LIKE_INFO_PTR(q)); - return INFO_PTR_TO_STRUCT((StgInfoTable *)q); } // A word-aligned memmove will be faster for small objects than libc's or gcc's. @@ -266,7 +338,6 @@ thread_stack(StgPtr p, StgPtr stack_end) case STOP_FRAME: case CATCH_FRAME: case RET_SMALL: - case RET_VEC_SMALL: bitmap = BITMAP_BITS(info->i.layout.bitmap); size = BITMAP_SIZE(info->i.layout.bitmap); p++; @@ -298,7 +369,6 @@ thread_stack(StgPtr p, StgPtr stack_end) // large bitmap (> 32 entries, or 64 on a 64-bit machine) case RET_BIG: - case RET_VEC_BIG: p++; size = GET_LARGE_BITMAP(&info->i)->size; thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size); @@ -310,8 +380,8 @@ thread_stack(StgPtr p, StgPtr stack_end) StgRetFun *ret_fun = (StgRetFun *)p; StgFunInfoTable *fun_info; - fun_info = itbl_to_fun_itbl( - get_threaded_info((StgPtr)ret_fun->fun)); + fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *) + get_threaded_info((StgPtr)ret_fun->fun))); // *before* threading it! thread(&ret_fun->fun); p = thread_arg_block(fun_info, ret_fun->payload); @@ -332,7 +402,8 @@ thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size) StgWord bitmap; StgFunInfoTable *fun_info; - fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun)); + fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *) + get_threaded_info((StgPtr)fun))); ASSERT(fun_info->i.type != PAP); p = (StgPtr)payload; @@ -395,12 +466,13 @@ 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 || tso->why_blocked == BlockedOnBlackHole - || tso->why_blocked == BlockedOnException + || tso->why_blocked == BlockedOnMsgThrowTo + || tso->why_blocked == BlockedOnMsgWakeup ) { thread_(&tso->block_info.closure); } @@ -421,6 +493,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); @@ -436,13 +512,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: @@ -530,7 +606,6 @@ thread_obj (StgInfoTable *info, StgPtr p) thread_(&bco->instrs); thread_(&bco->literals); thread_(&bco->ptrs); - thread_(&bco->itbls); return p + bco_sizeW(bco); } @@ -548,14 +623,13 @@ thread_obj (StgInfoTable *info, StgPtr p) case FUN: case CONSTR: - case STABLE_NAME: + case PRIM: + case MUT_PRIM: case IND_PERM: case MUT_VAR_CLEAN: case MUT_VAR_DIRTY: - case CAF_BLACKHOLE: - case SE_CAF_BLACKHOLE: - case SE_BLACKHOLE: case BLACKHOLE: + case BLOCKING_QUEUE: { StgPtr end; @@ -570,6 +644,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); @@ -579,7 +654,8 @@ thread_obj (StgInfoTable *info, StgPtr p) return p + sizeofW(StgWeak); } - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: { StgMVar *mvar = (StgMVar *)p; thread_(&mvar->head); @@ -618,44 +694,19 @@ 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: return thread_TSO((StgTSO *)p); - case TVAR_WATCH_QUEUE: - { - StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p; - thread_(&wq->closure); - thread_(&wq->next_queue_entry); - thread_(&wq->prev_queue_entry); - return p + sizeofW(StgTVarWatchQueue); - } - - case TVAR: - { - StgTVar *tvar = (StgTVar *)p; - thread((void *)&tvar->current_value); - thread((void *)&tvar->first_watch_queue_entry); - return p + sizeofW(StgTVar); - } - - case TREC_HEADER: - { - StgTRecHeader *trec = (StgTRecHeader *)p; - thread_(&trec->enclosing_trec); - thread_(&trec->current_chunk); - thread_(&trec->invariants_to_check); - return p + sizeofW(StgTRecHeader); - } - case TREC_CHUNK: { StgWord i; @@ -670,23 +721,6 @@ thread_obj (StgInfoTable *info, StgPtr p) return p + sizeofW(StgTRecChunk); } - case ATOMIC_INVARIANT: - { - StgAtomicInvariant *invariant = (StgAtomicInvariant *)p; - thread_(&invariant->code); - thread_(&invariant->last_execution); - return p + sizeofW(StgAtomicInvariant); - } - - case INVARIANT_CHECK_QUEUE: - { - StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p; - thread_(&queue->invariant); - thread_(&queue->my_execution); - thread_(&queue->next_queue_entry); - return p + sizeofW(StgInvariantCheckQueue); - } - default: barf("update_fwd: unknown/strange object %d", (int)(info->type)); return NULL; @@ -725,6 +759,7 @@ update_fwd_compact( bdescr *blocks ) bdescr *bd, *free_bd; StgInfoTable *info; nat size; + StgWord iptr; bd = blocks; free_bd = blocks; @@ -770,7 +805,8 @@ update_fwd_compact( bdescr *blocks ) // ToDo: one possible avenue of attack is to use the fact // that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we // definitely have enough room. Also see bug #1147. - info = get_threaded_info(p); + iptr = get_threaded_info(p); + info = INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)iptr)); q = p; @@ -778,18 +814,18 @@ 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,free); + unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr)); free += size; #if 0 goto next; @@ -799,7 +835,7 @@ update_fwd_compact( bdescr *blocks ) } static nat -update_bkwd_compact( step *stp ) +update_bkwd_compact( generation *gen ) { StgPtr p, free; #if 0 @@ -808,8 +844,9 @@ update_bkwd_compact( step *stp ) bdescr *bd, *free_bd; StgInfoTable *info; 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; @@ -844,7 +881,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; @@ -852,8 +889,9 @@ update_bkwd_compact( step *stp ) free_blocks++; } - unthread(p,free); - ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info)); + iptr = get_threaded_info(p); + unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr)); + ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)((StgClosure *)p)->header.info)); info = get_itbl((StgClosure *)p); size = closure_sizeW_((StgClosure *)p,info); @@ -885,13 +923,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) { @@ -905,15 +943,26 @@ 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); @@ -921,48 +970,46 @@ compact(void) // the task list { Task *task; + InCall *incall; for (task = all_tasks; task != NULL; task = task->all_link) { - if (task->tso) { - thread_(&task->tso); - } + for (incall = task->incall; incall != NULL; + incall = incall->prev_stack) { + if (incall->tso) { + thread_(&incall->tso); + } + } } } // 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; } }