X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=7a447fdec3da1bf5761257a911a388a5e73f4cb5;hb=a395e1afebc881a6aafbc246c6de2bb21fd32048;hp=89a709d04f2da771d4b11ed348c1288a8085972c;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 89a709d..7a447fd 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.146 2002/12/11 15:36:42 simonmar Exp $ + * $Id: GC.c,v 1.157 2003/06/26 20:47:47 panne Exp $ * - * (c) The GHC Team 1998-2002 + * (c) The GHC Team 1998-2003 * * Generational garbage collector * @@ -20,7 +20,6 @@ #include "Sanity.h" #include "BlockAlloc.h" #include "MBlock.h" -#include "Main.h" #include "ProfHeap.h" #include "SchedAPI.h" #include "Weak.h" @@ -140,7 +139,14 @@ static lnat thunk_selector_depth = 0; static bdescr * gc_alloc_block ( step *stp ); static void mark_root ( StgClosure **root ); -static StgClosure * evacuate ( StgClosure *q ); + +// Use a register argument for evacuate, if available. +#if __GNUC__ >= 2 +static StgClosure * evacuate (StgClosure *q) __attribute__((regparm(1))); +#else +static StgClosure * evacuate (StgClosure *q); +#endif + static void zero_static_object_list ( StgClosure* first_static ); static void zero_mutable_list ( StgMutClosure *first ); @@ -304,7 +310,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) Now, Now)); #endif -#ifndef mingw32_TARGET_OS +#if defined(RTS_USER_SIGNALS) // block signals blockUserSignals(); #endif @@ -1081,7 +1087,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) // ok, GC over: tell the stats department what happened. stat_endGC(allocated, collected, live, copied, N); -#ifndef mingw32_TARGET_OS +#if defined(RTS_USER_SIGNALS) // unblock signals again unblockUserSignals(); #endif @@ -1631,6 +1637,23 @@ mkMutCons(StgClosure *ptr, generation *gen) if M < evac_gen set failed_to_evac flag to indicate that we didn't manage to evacuate this object into evac_gen. + + OPTIMISATION NOTES: + + evacuate() is the single most important function performance-wise + in the GC. Various things have been tried to speed it up, but as + far as I can tell the code generated by gcc 3.2 with -O2 is about + as good as it's going to get. We pass the argument to evacuate() + in a register using the 'regparm' attribute (see the prototype for + evacuate() near the top of this file). + + Changing evacuate() to take an (StgClosure **) rather than + returning the new pointer seems attractive, because we can avoid + writing back the pointer when it hasn't changed (eg. for a static + object, or an object in a generation > N). However, I tried it and + it doesn't help. One reason is that the (StgClosure **) pointer + gets spilled to the stack inside evacuate(), resulting in far more + extra reads/writes than we save. -------------------------------------------------------------------------- */ static StgClosure * @@ -1753,9 +1776,11 @@ loop: case WEAK: case FOREIGN: case STABLE_NAME: - case BCO: return copy(q,sizeW_fromITBL(info),stp); + case BCO: + return copy(q,bco_sizeW((StgBCO *)q),stp); + case CAF_BLACKHOLE: case SE_CAF_BLACKHOLE: case SE_BLACKHOLE: @@ -1802,7 +1827,7 @@ loop: goto loop; case THUNK_STATIC: - if (info->srt_len > 0 && major_gc && + if (info->srt_bitmap != 0 && major_gc && THUNK_STATIC_LINK((StgClosure *)q) == NULL) { THUNK_STATIC_LINK((StgClosure *)q) = static_objects; static_objects = (StgClosure *)q; @@ -1810,7 +1835,7 @@ loop: return q; case FUN_STATIC: - if (info->srt_len > 0 && major_gc && + if (info->srt_bitmap != 0 && major_gc && FUN_STATIC_LINK((StgClosure *)q) == NULL) { FUN_STATIC_LINK((StgClosure *)q) = static_objects; static_objects = (StgClosure *)q; @@ -1905,8 +1930,18 @@ loop: * list it contains. */ { - StgTSO *new_tso = (StgTSO *)copy((StgClosure *)tso,tso_sizeW(tso),stp); + StgTSO *new_tso; + StgPtr p, q; + + new_tso = (StgTSO *)copyPart((StgClosure *)tso, + tso_sizeW(tso), + sizeofW(StgTSO), stp); move_TSO(tso, new_tso); + for (p = tso->sp, q = new_tso->sp; + p < tso->stack+tso->stack_size;) { + *q++ = *p++; + } + return (StgClosure *)new_tso; } } @@ -2001,6 +2036,25 @@ eval_thunk_selector( nat field, StgSelector * p ) selector_loop: + // We don't want to end up in to-space, because this causes + // problems when the GC later tries to evacuate the result of + // eval_thunk_selector(). There are various ways this could + // happen: + // + // - following an IND_STATIC + // + // - when the old generation is compacted, the mark phase updates + // from-space pointers to be to-space pointers, and we can't + // reliably tell which we're following (eg. from an IND_STATIC). + // + // So we use the block-descriptor test to find out if we're in + // to-space. + // + if (HEAP_ALLOCED(selectee) && + Bdescr((StgPtr)selectee)->flags & BF_EVACUATED) { + goto bale_out; + } + info = get_itbl(selectee); switch (info->type) { case CONSTR: @@ -2015,12 +2069,15 @@ selector_loop: ASSERT(field < (StgWord32)(info->layout.payload.ptrs + info->layout.payload.nptrs)); + // ToDo: shouldn't we test whether this pointer is in + // to-space? return selectee->payload[field]; case IND: case IND_PERM: case IND_OLDGEN: case IND_OLDGEN_PERM: + case IND_STATIC: selectee = ((StgInd *)selectee)->indirectee; goto selector_loop; @@ -2030,11 +2087,6 @@ selector_loop: // leaks by evaluating this selector thunk anyhow. break; - case IND_STATIC: - // We can't easily tell whether the indirectee is into - // from or to-space, so just bail out here. - break; - case THUNK_SELECTOR: { StgClosure *val; @@ -2059,8 +2111,19 @@ selector_loop: // because we are guaranteed that p is in a generation // that we are collecting, and we never want to put the // indirection on a mutable list. +#ifdef PROFILING + // For the purposes of LDV profiling, we have destroyed + // the original selector thunk. + SET_INFO(p, info_ptr); + LDV_recordDead_FILL_SLOP_DYNAMIC(selectee); +#endif ((StgInd *)selectee)->indirectee = val; SET_INFO(selectee,&stg_IND_info); +#ifdef PROFILING + // For the purposes of LDV profiling, we have created an + // indirection. + LDV_recordCreate(selectee); +#endif selectee = val; goto selector_loop; } @@ -2096,6 +2159,7 @@ selector_loop: (int)(info->type)); } +bale_out: // We didn't manage to evaluate this thunk; restore the old info pointer SET_INFO(p, info_ptr); return NULL; @@ -2111,41 +2175,80 @@ move_TSO (StgTSO *src, StgTSO *dest) { ptrdiff_t diff; - // relocate the stack pointers... + // relocate the stack pointer... diff = (StgPtr)dest - (StgPtr)src; // In *words* dest->sp = (StgPtr)dest->sp + diff; } -/* evacuate the SRT. If srt_len is zero, then there isn't an +/* Similar to scavenge_large_bitmap(), but we don't write back the + * pointers we get back from evacuate(). + */ +static void +scavenge_large_srt_bitmap( StgLargeSRT *large_srt ) +{ + nat i, b, size; + StgWord bitmap; + StgClosure **p; + + b = 0; + bitmap = large_srt->l.bitmap[b]; + size = (nat)large_srt->l.size; + p = (StgClosure **)large_srt->srt; + for (i = 0; i < size; ) { + if ((bitmap & 1) != 0) { + evacuate(*p); + } + i++; + p++; + if (i % BITS_IN(W_) == 0) { + b++; + bitmap = large_srt->l.bitmap[b]; + } else { + bitmap = bitmap >> 1; + } + } +} + +/* evacuate the SRT. If srt_bitmap is zero, then there isn't an * srt field in the info table. That's ok, because we'll * never dereference it. */ static inline void -scavenge_srt (StgClosure **srt, nat srt_len) +scavenge_srt (StgClosure **srt, nat srt_bitmap) { - StgClosure **srt_end; + nat bitmap; + StgClosure **p; - srt_end = srt + srt_len; + bitmap = srt_bitmap; + p = srt; - for (; srt < srt_end; srt++) { - /* Special-case to handle references to closures hiding out in DLLs, since - double indirections required to get at those. The code generator knows - which is which when generating the SRT, so it stores the (indirect) - reference to the DLL closure in the table by first adding one to it. - We check for this here, and undo the addition before evacuating it. + if (bitmap == (StgHalfWord)(-1)) { + scavenge_large_srt_bitmap( (StgLargeSRT *)srt ); + return; + } - If the SRT entry hasn't got bit 0 set, the SRT entry points to a - closure that's fixed at link-time, and no extra magic is required. - */ + while (bitmap != 0) { + if ((bitmap & 1) != 0) { #ifdef ENABLE_WIN32_DLL_SUPPORT - if ( (unsigned long)(*srt) & 0x1 ) { - evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1))); - } else { - evacuate(*srt); - } + // Special-case to handle references to closures hiding out in DLLs, since + // double indirections required to get at those. The code generator knows + // which is which when generating the SRT, so it stores the (indirect) + // reference to the DLL closure in the table by first adding one to it. + // We check for this here, and undo the addition before evacuating it. + // + // If the SRT entry hasn't got bit 0 set, the SRT entry points to a + // closure that's fixed at link-time, and no extra magic is required. + if ( (unsigned long)(*srt) & 0x1 ) { + evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1))); + } else { + evacuate(*p); + } #else - evacuate(*srt); + evacuate(*p); #endif + } + p++; + bitmap = bitmap >> 1; } } @@ -2156,7 +2259,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_len); + scavenge_srt((StgClosure **)thunk_info->srt, thunk_info->i.srt_bitmap); } static inline void @@ -2165,7 +2268,7 @@ scavenge_fun_srt(const StgInfoTable *info) StgFunInfoTable *fun_info; fun_info = itbl_to_fun_itbl(info); - scavenge_srt((StgClosure **)fun_info->srt, fun_info->i.srt_len); + scavenge_srt((StgClosure **)fun_info->srt, fun_info->i.srt_bitmap); } static inline void @@ -2174,7 +2277,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_len); + scavenge_srt((StgClosure **)ret_info->srt, ret_info->i.srt_bitmap); } /* ----------------------------------------------------------------------------- @@ -2334,7 +2437,7 @@ scavenge(step *stp) q = p; 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. @@ -2428,7 +2531,6 @@ scavenge(step *stp) case WEAK: case FOREIGN: case STABLE_NAME: - case BCO: { StgPtr end; @@ -2440,6 +2542,16 @@ scavenge(step *stp) 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); + p += bco_sizeW(bco); + break; + } + case IND_PERM: if (stp->gen->no != 0) { #ifdef PROFILING @@ -2757,7 +2869,6 @@ linear_scan: case WEAK: case FOREIGN: case STABLE_NAME: - case BCO: { StgPtr end; @@ -2768,6 +2879,15 @@ linear_scan: 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); + break; + } + case IND_PERM: // don't need to do anything here: the only possible case // is that we're in a 1-space compacting collector, with @@ -3592,7 +3712,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_len); + scavenge_srt((StgClosure **)info->srt, info->i.srt_bitmap); continue; case RET_BCO: { @@ -3635,11 +3755,11 @@ scavenge_stack(StgPtr p, StgPtr stack_end) // traverse the bitmap first bitmap = GET_LIVENESS(dyn); p = (P_)&((StgRetDyn *)p)->payload[0]; - size = RET_DYN_SIZE; + size = RET_DYN_BITMAP_SIZE; p = scavenge_small_bitmap(p, size, bitmap); // skip over the non-ptr words - p += GET_NONPTRS(dyn); + p += GET_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE; // follow the ptr words for (size = GET_PTRS(dyn); size > 0; size--) {