X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FCompact.c;h=d70f05955036ac70579093258ddafab0d645fcd7;hb=a370654a872838c43e63bdd6cc279c0ee9913cdf;hp=ef0aefc28ed5114b28bbdcb7145e20e2a048bf60;hpb=cb3cb473854e815784375ad23cc5081621a95ce8;p=ghc-hetmet.git diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c index ef0aefc..d70f059 100644 --- a/rts/sm/Compact.c +++ b/rts/sm/Compact.c @@ -1,9 +1,14 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team 2001 + * (c) The GHC Team 2001-2008 * * Compacting garbage collector * + * Documentation on the architecture of the Garbage Collector can be + * found in the online commentary: + * + * http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC + * * ---------------------------------------------------------------------------*/ #include "PosixSource.h" @@ -11,8 +16,6 @@ #include "RtsUtils.h" #include "RtsFlags.h" #include "OSThreads.h" -#include "Storage.h" -#include "Stable.h" #include "BlockAlloc.h" #include "MBlock.h" #include "GC.h" @@ -27,7 +30,7 @@ # define STATIC_INLINE static #endif -/* ----------------------------------------------------------------------------- +/* ---------------------------------------------------------------------------- Threading / unthreading pointers. The basic idea here is to chain together all the fields pointing at @@ -43,65 +46,138 @@ 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_EVACUATED) == 0) + { + 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(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. @@ -263,7 +339,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++; @@ -295,7 +370,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); @@ -307,8 +381,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); @@ -329,7 +403,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; @@ -527,7 +602,6 @@ thread_obj (StgInfoTable *info, StgPtr p) thread_(&bco->instrs); thread_(&bco->literals); thread_(&bco->ptrs); - thread_(&bco->itbls); return p + bco_sizeW(bco); } @@ -576,7 +650,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); @@ -722,6 +797,7 @@ update_fwd_compact( bdescr *blocks ) bdescr *bd, *free_bd; StgInfoTable *info; nat size; + StgWord iptr; bd = blocks; free_bd = blocks; @@ -763,7 +839,12 @@ update_fwd_compact( bdescr *blocks ) // know the destination without the size, because we may // spill into the next block. So we have to run down the // threaded list and get the info ptr first. - info = get_threaded_info(p); + // + // 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. + iptr = get_threaded_info(p); + info = INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)iptr)); q = p; @@ -782,7 +863,7 @@ update_fwd_compact( bdescr *blocks ) ASSERT(is_marked(q+1,bd)); } - unthread(q,free); + unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr)); free += size; #if 0 goto next; @@ -801,6 +882,7 @@ update_bkwd_compact( step *stp ) bdescr *bd, *free_bd; StgInfoTable *info; nat size, free_blocks; + StgWord iptr; bd = free_bd = stp->old_blocks; free = free_bd->start; @@ -845,7 +927,8 @@ update_bkwd_compact( step *stp ) free_blocks++; } - unthread(p,free); + iptr = get_threaded_info(p); + unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr)); ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info)); info = get_itbl((StgClosure *)p); size = closure_sizeW_((StgClosure *)p,info); @@ -878,13 +961,13 @@ update_bkwd_compact( step *stp ) } void -compact(void) +compact(StgClosure *static_objects) { nat g, s, blocks; step *stp; // 1. thread the roots - GetRoots((evac_fn)thread); + markCapabilities((evac_fn)thread_root, NULL); // the weak pointer lists... if (weak_ptr_list != NULL) { @@ -922,13 +1005,13 @@ 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++) {