diff options
| -rw-r--r-- | rts/Makefile | 14 | ||||
| -rw-r--r-- | rts/sm/Evac.c | 615 | ||||
| -rw-r--r-- | rts/sm/Evac.c-inc | 615 | ||||
| -rw-r--r-- | rts/sm/GC.c | 42 | ||||
| -rw-r--r-- | rts/sm/Scav.c | 681 | ||||
| -rw-r--r-- | rts/sm/Scav.c-inc | 463 | ||||
| -rw-r--r-- | rts/sm/Scav.h | 6 | ||||
| -rw-r--r-- | rts/sm/Storage.c | 16 |
8 files changed, 1203 insertions, 1249 deletions
diff --git a/rts/Makefile b/rts/Makefile index 9f1782bb70..ab1eb3d7d8 100644 --- a/rts/Makefile +++ b/rts/Makefile @@ -397,6 +397,20 @@ endif # -O3 helps unroll some loops (especially in copy() with a constant argument). sm/Evac_HC_OPTS += -optc-funroll-loops +ifneq "$(findstring thr, $(way))" "" +EXTRA_SRCS += sm/Evac_thr.c sm/Scav_thr.c + +sm/Evac_thr.c : sm/Evac.c + cp $< $@ +sm/Scav_thr.c : sm/Scav.c + cp $< $@ + +sm/Evac_thr_HC_OPTS += -optc-DPARALLEL_GC +sm/Scav_thr_HC_OPTS += -optc-DPARALLEL_GC +else +EXCLUDED_SRCS += sm/Evac_thr.c sm/Scav_thr.c +endif + # Without this, thread_obj will not be inlined (at least on x86 with GCC 4.1.0) sm/Compact_HC_OPTS += -optc-finline-limit=2500 diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index fd36cb03c8..78f0f315d2 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -22,10 +22,19 @@ #include "Prelude.h" #include "LdvProfile.h" -#if defined(PROF_SPIN) && defined(THREADED_RTS) +#if defined(PROF_SPIN) && defined(THREADED_RTS) && defined(PARALLEL_GC) StgWord64 whitehole_spin = 0; #endif +#if defined(THREADED_RTS) && !defined(PARALLEL_GC) +#define evacuate(p) evacuate1(p) +#endif + +#if !defined(PARALLEL_GC) +#define copy_tag_nolock(p, info, src, size, stp, tag) \ + copy_tag(p, info, src, size, stp, tag) +#endif + /* Used to avoid long recursion due to selector thunks */ #define MAX_THUNK_SELECTOR_DEPTH 16 @@ -76,14 +85,592 @@ alloc_for_copy (nat size, step *stp) The evacuate() code -------------------------------------------------------------------------- */ -#undef PARALLEL_GC -#include "Evac.c-inc" +STATIC_INLINE void +copy_tag(StgClosure **p, const StgInfoTable *info, + StgClosure *src, nat size, step *stp, StgWord tag) +{ + StgPtr to, from; + nat i; + + to = alloc_for_copy(size,stp); + + TICK_GC_WORDS_COPIED(size); -#ifdef THREADED_RTS -#define PARALLEL_GC -#include "Evac.c-inc" + from = (StgPtr)src; + to[0] = (W_)info; + for (i = 1; i < size; i++) { // unroll for small i + to[i] = from[i]; + } + +// if (to+size+2 < bd->start + BLOCK_SIZE_W) { +// __builtin_prefetch(to + size + 2, 1); +// } + +#if defined(PARALLEL_GC) + { + const StgInfoTable *new_info; + new_info = (const StgInfoTable *)cas((StgPtr)&src->header.info, (W_)info, MK_FORWARDING_PTR(to)); + if (new_info != info) { + return evacuate(p); // does the failed_to_evac stuff + } else { + *p = TAG_CLOSURE(tag,(StgClosure*)to); + } + } +#else + src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to); + *p = TAG_CLOSURE(tag,(StgClosure*)to); +#endif + +#ifdef PROFILING + // We store the size of the just evacuated object in the LDV word so that + // the profiler can guess the position of the next object later. + SET_EVACUAEE_FOR_LDV(from, size); +#endif +} + +#if defined(PARALLEL_GC) +STATIC_INLINE void +copy_tag_nolock(StgClosure **p, const StgInfoTable *info, + StgClosure *src, nat size, step *stp, StgWord tag) +{ + StgPtr to, from; + nat i; + + to = alloc_for_copy(size,stp); + *p = TAG_CLOSURE(tag,(StgClosure*)to); + src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to); + + TICK_GC_WORDS_COPIED(size); + + from = (StgPtr)src; + to[0] = (W_)info; + for (i = 1; i < size; i++) { // unroll for small i + to[i] = from[i]; + } + +// if (to+size+2 < bd->start + BLOCK_SIZE_W) { +// __builtin_prefetch(to + size + 2, 1); +// } + +#ifdef PROFILING + // We store the size of the just evacuated object in the LDV word so that + // the profiler can guess the position of the next object later. + SET_EVACUAEE_FOR_LDV(from, size); +#endif +} #endif +/* Special version of copy() for when we only want to copy the info + * pointer of an object, but reserve some padding after it. This is + * used to optimise evacuation of BLACKHOLEs. + */ +static void +copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp) +{ + StgPtr to, from; + nat i; + StgWord info; + +#if defined(PARALLEL_GC) +spin: + info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info); + if (info == (W_)&stg_WHITEHOLE_info) { +#ifdef PROF_SPIN + whitehole_spin++; +#endif + goto spin; + } + if (IS_FORWARDING_PTR(info)) { + src->header.info = (const StgInfoTable *)info; + evacuate(p); // does the failed_to_evac stuff + return ; + } +#else + info = (W_)src->header.info; +#endif + + to = alloc_for_copy(size_to_reserve, stp); + *p = (StgClosure *)to; + + TICK_GC_WORDS_COPIED(size_to_copy); + + from = (StgPtr)src; + to[0] = info; + for (i = 1; i < size_to_copy; i++) { // unroll for small i + to[i] = from[i]; + } + +#if defined(PARALLEL_GC) + write_barrier(); +#endif + src->header.info = (const StgInfoTable*)MK_FORWARDING_PTR(to); + +#ifdef PROFILING + // We store the size of the just evacuated object in the LDV word so that + // the profiler can guess the position of the next object later. + SET_EVACUAEE_FOR_LDV(from, size_to_reserve); + // fill the slop + if (size_to_reserve - size_to_copy > 0) + LDV_FILL_SLOP(to + size_to_copy - 1, (int)(size_to_reserve - size_to_copy)); +#endif +} + + +/* Copy wrappers that don't tag the closure after copying */ +STATIC_INLINE void +copy(StgClosure **p, const StgInfoTable *info, + StgClosure *src, nat size, step *stp) +{ + copy_tag(p,info,src,size,stp,0); +} + +/* ---------------------------------------------------------------------------- + Evacuate + + This is called (eventually) for every live object in the system. + + The caller to evacuate specifies a desired generation in the + gct->evac_step thread-local variable. The following conditions apply to + evacuating an object which resides in generation M when we're + collecting up to generation N + + if M >= gct->evac_step + if M > N do nothing + else evac to step->to + + if M < gct->evac_step evac to gct->evac_step, step 0 + + if the object is already evacuated, then we check which generation + it now resides in. + + if M >= gct->evac_step do nothing + if M < gct->evac_step set gct->failed_to_evac flag to indicate that we + didn't manage to evacuate this object into gct->evac_step. + + + 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. + ------------------------------------------------------------------------- */ + +REGPARM1 void +evacuate(StgClosure **p) +{ + bdescr *bd = NULL; + step *stp; + StgClosure *q; + const StgInfoTable *info; + StgWord tag; + + q = *p; + +loop: + /* The tag and the pointer are split, to be merged after evacing */ + tag = GET_CLOSURE_TAG(q); + q = UNTAG_CLOSURE(q); + + ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); + + if (!HEAP_ALLOCED(q)) { + + if (!major_gc) return; + + info = get_itbl(q); + switch (info->type) { + + case THUNK_STATIC: + if (info->srt_bitmap != 0) { + if (*THUNK_STATIC_LINK((StgClosure *)q) == NULL) { +#ifndef THREADED_RTS + *THUNK_STATIC_LINK((StgClosure *)q) = gct->static_objects; + gct->static_objects = (StgClosure *)q; +#else + StgPtr link; + link = (StgPtr)cas((StgPtr)THUNK_STATIC_LINK((StgClosure *)q), + (StgWord)NULL, + (StgWord)gct->static_objects); + if (link == NULL) { + gct->static_objects = (StgClosure *)q; + } +#endif + } + } + return; + + case FUN_STATIC: + if (info->srt_bitmap != 0 && + *FUN_STATIC_LINK((StgClosure *)q) == NULL) { +#ifndef THREADED_RTS + *FUN_STATIC_LINK((StgClosure *)q) = gct->static_objects; + gct->static_objects = (StgClosure *)q; +#else + StgPtr link; + link = (StgPtr)cas((StgPtr)FUN_STATIC_LINK((StgClosure *)q), + (StgWord)NULL, + (StgWord)gct->static_objects); + if (link == NULL) { + gct->static_objects = (StgClosure *)q; + } +#endif + } + return; + + case IND_STATIC: + /* If q->saved_info != NULL, then it's a revertible CAF - it'll be + * on the CAF list, so don't do anything with it here (we'll + * scavenge it later). + */ + if (((StgIndStatic *)q)->saved_info == NULL) { + if (*IND_STATIC_LINK((StgClosure *)q) == NULL) { +#ifndef THREADED_RTS + *IND_STATIC_LINK((StgClosure *)q) = gct->static_objects; + gct->static_objects = (StgClosure *)q; +#else + StgPtr link; + link = (StgPtr)cas((StgPtr)IND_STATIC_LINK((StgClosure *)q), + (StgWord)NULL, + (StgWord)gct->static_objects); + if (link == NULL) { + gct->static_objects = (StgClosure *)q; + } +#endif + } + } + return; + + case CONSTR_STATIC: + if (*STATIC_LINK(info,(StgClosure *)q) == NULL) { +#ifndef THREADED_RTS + *STATIC_LINK(info,(StgClosure *)q) = gct->static_objects; + gct->static_objects = (StgClosure *)q; +#else + StgPtr link; + link = (StgPtr)cas((StgPtr)STATIC_LINK(info,(StgClosure *)q), + (StgWord)NULL, + (StgWord)gct->static_objects); + if (link == NULL) { + gct->static_objects = (StgClosure *)q; + } +#endif + } + /* I am assuming that static_objects pointers are not + * written to other objects, and thus, no need to retag. */ + return; + + case CONSTR_NOCAF_STATIC: + /* no need to put these on the static linked list, they don't need + * to be scavenged. + */ + return; + + default: + barf("evacuate(static): strange closure type %d", (int)(info->type)); + } + } + + bd = Bdescr((P_)q); + + if ((bd->flags & (BF_LARGE | BF_COMPACTED | BF_EVACUATED)) != 0) { + + // pointer into to-space: just return it. It might be a pointer + // into a generation that we aren't collecting (> N), or it + // might just be a pointer into to-space. The latter doesn't + // happen often, but allowing it makes certain things a bit + // easier; e.g. scavenging an object is idempotent, so it's OK to + // have an object on the mutable list multiple times. + if (bd->flags & BF_EVACUATED) { + // We aren't copying this object, so we have to check + // whether it is already in the target generation. (this is + // the write barrier). + if (bd->step < gct->evac_step) { + gct->failed_to_evac = rtsTrue; + TICK_GC_FAILED_PROMOTION(); + } + return; + } + + /* evacuate large objects by re-linking them onto a different list. + */ + if (bd->flags & BF_LARGE) { + info = get_itbl(q); + if (info->type == TSO && + ((StgTSO *)q)->what_next == ThreadRelocated) { + q = (StgClosure *)((StgTSO *)q)->_link; + *p = q; + goto loop; + } + evacuate_large((P_)q); + return; + } + + /* If the object is in a step that we're compacting, then we + * need to use an alternative evacuate procedure. + */ + if (bd->flags & BF_COMPACTED) { + if (!is_marked((P_)q,bd)) { + mark((P_)q,bd); + if (mark_stack_full()) { + mark_stack_overflowed = rtsTrue; + reset_mark_stack(); + } + push_mark_stack((P_)q); + } + return; + } + } + + stp = bd->step->to; + + info = q->header.info; + if (IS_FORWARDING_PTR(info)) + { + /* Already evacuated, just return the forwarding address. + * HOWEVER: if the requested destination generation (gct->evac_step) is + * older than the actual generation (because the object was + * already evacuated to a younger generation) then we have to + * set the gct->failed_to_evac flag to indicate that we couldn't + * manage to promote the object to the desired generation. + */ + /* + * Optimisation: the check is fairly expensive, but we can often + * shortcut it if either the required generation is 0, or the + * current object (the EVACUATED) is in a high enough generation. + * We know that an EVACUATED always points to an object in the + * same or an older generation. stp is the lowest step that the + * current object would be evacuated to, so we only do the full + * check if stp is too low. + */ + StgClosure *e = (StgClosure*)UN_FORWARDING_PTR(info); + *p = TAG_CLOSURE(tag,e); + if (stp < gct->evac_step) { // optimisation + if (Bdescr((P_)e)->step < gct->evac_step) { + gct->failed_to_evac = rtsTrue; + TICK_GC_FAILED_PROMOTION(); + } + } + return; + } + + switch (INFO_PTR_TO_STRUCT(info)->type) { + + case WHITEHOLE: + goto loop; + + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: + case MVAR_CLEAN: + case MVAR_DIRTY: + copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp); + return; + + case CONSTR_0_1: + { + StgWord w = (StgWord)q->payload[0]; + if (info == Czh_con_info && + // unsigned, so always true: (StgChar)w >= MIN_CHARLIKE && + (StgChar)w <= MAX_CHARLIKE) { + *p = TAG_CLOSURE(tag, + (StgClosure *)CHARLIKE_CLOSURE((StgChar)w) + ); + } + else if (info == Izh_con_info && + (StgInt)w >= MIN_INTLIKE && (StgInt)w <= MAX_INTLIKE) { + *p = TAG_CLOSURE(tag, + (StgClosure *)INTLIKE_CLOSURE((StgInt)w) + ); + } + else { + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); + } + return; + } + + case FUN_0_1: + case FUN_1_0: + case CONSTR_1_0: + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); + return; + + case THUNK_1_0: + case THUNK_0_1: + copy(p,info,q,sizeofW(StgThunk)+1,stp); + return; + + case THUNK_1_1: + case THUNK_2_0: + case THUNK_0_2: +#ifdef NO_PROMOTE_THUNKS + if (bd->gen_no == 0 && + bd->step->no != 0 && + bd->step->no == generations[bd->gen_no].n_steps-1) { + stp = bd->step; + } +#endif + copy(p,info,q,sizeofW(StgThunk)+2,stp); + return; + + case FUN_1_1: + case FUN_2_0: + case FUN_0_2: + case CONSTR_1_1: + case CONSTR_2_0: + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag); + return; + + case CONSTR_0_2: + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag); + return; + + case THUNK: + copy(p,info,q,thunk_sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp); + return; + + case FUN: + case IND_PERM: + case IND_OLDGEN_PERM: + case CONSTR: + copy_tag_nolock(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp,tag); + return; + + case WEAK: + case STABLE_NAME: + copy_tag(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp,tag); + return; + + case BCO: + copy(p,info,q,bco_sizeW((StgBCO *)q),stp); + return; + + case CAF_BLACKHOLE: + case SE_CAF_BLACKHOLE: + case SE_BLACKHOLE: + case BLACKHOLE: + copyPart(p,q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp); + return; + + case THUNK_SELECTOR: + eval_thunk_selector(p, (StgSelector *)q, rtsTrue); + return; + + case IND: + case IND_OLDGEN: + // follow chains of indirections, don't evacuate them + q = ((StgInd*)q)->indirectee; + *p = q; + goto loop; + + case RET_BCO: + case RET_SMALL: + case RET_BIG: + case RET_DYN: + 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); + + case PAP: + copy(p,info,q,pap_sizeW((StgPAP*)q),stp); + return; + + case AP: + copy(p,info,q,ap_sizeW((StgAP*)q),stp); + return; + + case AP_STACK: + copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),stp); + return; + + case ARR_WORDS: + // just copy the block + copy(p,info,q,arr_words_sizeW((StgArrWords *)q),stp); + return; + + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + case MUT_ARR_PTRS_FROZEN: + case MUT_ARR_PTRS_FROZEN0: + // just copy the block + copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp); + return; + + case TSO: + { + StgTSO *tso = (StgTSO *)q; + + /* Deal with redirected TSOs (a TSO that's had its stack enlarged). + */ + if (tso->what_next == ThreadRelocated) { + q = (StgClosure *)tso->_link; + *p = q; + goto loop; + } + + /* To evacuate a small TSO, we need to relocate the update frame + * list it contains. + */ + { + StgTSO *new_tso; + StgPtr r, s; + + copyPart(p,(StgClosure *)tso, tso_sizeW(tso), sizeofW(StgTSO), stp); + new_tso = (StgTSO *)*p; + move_TSO(tso, new_tso); + for (r = tso->sp, s = new_tso->sp; + r < tso->stack+tso->stack_size;) { + *s++ = *r++; + } + return; + } + } + + case TREC_HEADER: + copy(p,info,q,sizeofW(StgTRecHeader),stp); + return; + + case TVAR_WATCH_QUEUE: + copy(p,info,q,sizeofW(StgTVarWatchQueue),stp); + return; + + case TVAR: + copy(p,info,q,sizeofW(StgTVar),stp); + return; + + case TREC_CHUNK: + copy(p,info,q,sizeofW(StgTRecChunk),stp); + return; + + case ATOMIC_INVARIANT: + copy(p,info,q,sizeofW(StgAtomicInvariant),stp); + return; + + case INVARIANT_CHECK_QUEUE: + copy(p,info,q,sizeofW(StgInvariantCheckQueue),stp); + return; + + default: + barf("evacuate: strange closure type %d", (int)(INFO_PTR_TO_STRUCT(info)->type)); + } + + barf("evacuate"); +} + /* ----------------------------------------------------------------------------- Evacuate a large object @@ -448,19 +1035,3 @@ bale_out: unchain_thunk_selectors(prev_thunk_selector, *q); return; } - -/* ----------------------------------------------------------------------------- - move_TSO is called to update the TSO structure after it has been - moved from one place to another. - -------------------------------------------------------------------------- */ - -void -move_TSO (StgTSO *src, StgTSO *dest) -{ - ptrdiff_t diff; - - // relocate the stack pointer... - diff = (StgPtr)dest - (StgPtr)src; // In *words* - dest->sp = (StgPtr)dest->sp + diff; -} - diff --git a/rts/sm/Evac.c-inc b/rts/sm/Evac.c-inc deleted file mode 100644 index 7a657ca226..0000000000 --- a/rts/sm/Evac.c-inc +++ /dev/null @@ -1,615 +0,0 @@ -/* -----------------------------------------------------------------------*-c-*- - * - * (c) The GHC Team 1998-2008 - * - * Generational garbage collector: evacuation functions - * - * ---------------------------------------------------------------------------*/ - -// We have two versions of evacuate(): one for minor GC, and one for -// non-minor, parallel, GC. This file contains the code for both, -// controllled by the CPP symbol MINOR_GC. - -#if defined(THREADED_RTS) -# if !defined(PARALLEL_GC) -# define copy(a,b,c,d,e) copy1(a,b,c,d,e) -# define copy_tag(a,b,c,d,e,f) copy_tag1(a,b,c,d,e,f) -# define copy_tag_nolock(a,b,c,d,e,f) copy_tag1(a,b,c,d,e,f) -# define copyPart(a,b,c,d,e) copyPart1(a,b,c,d,e) -# define evacuate(a) evacuate1(a) -# endif -#else -# define copy_tag_nolock(a,b,c,d,e,f) copy_tag(a,b,c,d,e,f) -#endif - -STATIC_INLINE void -copy_tag(StgClosure **p, const StgInfoTable *info, - StgClosure *src, nat size, step *stp, StgWord tag) -{ - StgPtr to, from; - nat i; - - to = alloc_for_copy(size,stp); - - TICK_GC_WORDS_COPIED(size); - - from = (StgPtr)src; - to[0] = (W_)info; - for (i = 1; i < size; i++) { // unroll for small i - to[i] = from[i]; - } - -// if (to+size+2 < bd->start + BLOCK_SIZE_W) { -// __builtin_prefetch(to + size + 2, 1); -// } - -#if defined(PARALLEL_GC) - { - const StgInfoTable *new_info; - new_info = (const StgInfoTable *)cas((StgPtr)&src->header.info, (W_)info, MK_FORWARDING_PTR(to)); - if (new_info != info) { - return evacuate(p); // does the failed_to_evac stuff - } else { - *p = TAG_CLOSURE(tag,(StgClosure*)to); - } - } -#else - src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to); - *p = TAG_CLOSURE(tag,(StgClosure*)to); -#endif - -#ifdef PROFILING - // We store the size of the just evacuated object in the LDV word so that - // the profiler can guess the position of the next object later. - SET_EVACUAEE_FOR_LDV(from, size); -#endif -} - -#if defined(PARALLEL_GC) -STATIC_INLINE void -copy_tag_nolock(StgClosure **p, const StgInfoTable *info, - StgClosure *src, nat size, step *stp, StgWord tag) -{ - StgPtr to, from; - nat i; - - to = alloc_for_copy(size,stp); - *p = TAG_CLOSURE(tag,(StgClosure*)to); - src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to); - - TICK_GC_WORDS_COPIED(size); - - from = (StgPtr)src; - to[0] = (W_)info; - for (i = 1; i < size; i++) { // unroll for small i - to[i] = from[i]; - } - -// if (to+size+2 < bd->start + BLOCK_SIZE_W) { -// __builtin_prefetch(to + size + 2, 1); -// } - -#ifdef PROFILING - // We store the size of the just evacuated object in the LDV word so that - // the profiler can guess the position of the next object later. - SET_EVACUAEE_FOR_LDV(from, size); -#endif -} -#endif - -/* Special version of copy() for when we only want to copy the info - * pointer of an object, but reserve some padding after it. This is - * used to optimise evacuation of BLACKHOLEs. - */ -static void -copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp) -{ - StgPtr to, from; - nat i; - StgWord info; - -#if defined(PARALLEL_GC) -spin: - info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info); - if (info == (W_)&stg_WHITEHOLE_info) { -#ifdef PROF_SPIN - whitehole_spin++; -#endif - goto spin; - } - if (IS_FORWARDING_PTR(info)) { - src->header.info = (const StgInfoTable *)info; - evacuate(p); // does the failed_to_evac stuff - return ; - } -#else - info = (W_)src->header.info; -#endif - - to = alloc_for_copy(size_to_reserve, stp); - *p = (StgClosure *)to; - - TICK_GC_WORDS_COPIED(size_to_copy); - - from = (StgPtr)src; - to[0] = info; - for (i = 1; i < size_to_copy; i++) { // unroll for small i - to[i] = from[i]; - } - -#if defined(PARALLEL_GC) - write_barrier(); -#endif - src->header.info = (const StgInfoTable*)MK_FORWARDING_PTR(to); - -#ifdef PROFILING - // We store the size of the just evacuated object in the LDV word so that - // the profiler can guess the position of the next object later. - SET_EVACUAEE_FOR_LDV(from, size_to_reserve); - // fill the slop - if (size_to_reserve - size_to_copy > 0) - LDV_FILL_SLOP(to + size_to_copy - 1, (int)(size_to_reserve - size_to_copy)); -#endif -} - - -/* Copy wrappers that don't tag the closure after copying */ -STATIC_INLINE void -copy(StgClosure **p, const StgInfoTable *info, - StgClosure *src, nat size, step *stp) -{ - copy_tag(p,info,src,size,stp,0); -} - -/* ---------------------------------------------------------------------------- - Evacuate - - This is called (eventually) for every live object in the system. - - The caller to evacuate specifies a desired generation in the - gct->evac_step thread-local variable. The following conditions apply to - evacuating an object which resides in generation M when we're - collecting up to generation N - - if M >= gct->evac_step - if M > N do nothing - else evac to step->to - - if M < gct->evac_step evac to gct->evac_step, step 0 - - if the object is already evacuated, then we check which generation - it now resides in. - - if M >= gct->evac_step do nothing - if M < gct->evac_step set gct->failed_to_evac flag to indicate that we - didn't manage to evacuate this object into gct->evac_step. - - - 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. - ------------------------------------------------------------------------- */ - -REGPARM1 void -evacuate(StgClosure **p) -{ - bdescr *bd = NULL; - step *stp; - StgClosure *q; - const StgInfoTable *info; - StgWord tag; - - q = *p; - -loop: - /* The tag and the pointer are split, to be merged after evacing */ - tag = GET_CLOSURE_TAG(q); - q = UNTAG_CLOSURE(q); - - ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); - - if (!HEAP_ALLOCED(q)) { - - if (!major_gc) return; - - info = get_itbl(q); - switch (info->type) { - - case THUNK_STATIC: - if (info->srt_bitmap != 0) { - if (*THUNK_STATIC_LINK((StgClosure *)q) == NULL) { -#ifndef THREADED_RTS - *THUNK_STATIC_LINK((StgClosure *)q) = gct->static_objects; - gct->static_objects = (StgClosure *)q; -#else - StgPtr link; - link = (StgPtr)cas((StgPtr)THUNK_STATIC_LINK((StgClosure *)q), - (StgWord)NULL, - (StgWord)gct->static_objects); - if (link == NULL) { - gct->static_objects = (StgClosure *)q; - } -#endif - } - } - return; - - case FUN_STATIC: - if (info->srt_bitmap != 0 && - *FUN_STATIC_LINK((StgClosure *)q) == NULL) { -#ifndef THREADED_RTS - *FUN_STATIC_LINK((StgClosure *)q) = gct->static_objects; - gct->static_objects = (StgClosure *)q; -#else - StgPtr link; - link = (StgPtr)cas((StgPtr)FUN_STATIC_LINK((StgClosure *)q), - (StgWord)NULL, - (StgWord)gct->static_objects); - if (link == NULL) { - gct->static_objects = (StgClosure *)q; - } -#endif - } - return; - - case IND_STATIC: - /* If q->saved_info != NULL, then it's a revertible CAF - it'll be - * on the CAF list, so don't do anything with it here (we'll - * scavenge it later). - */ - if (((StgIndStatic *)q)->saved_info == NULL) { - if (*IND_STATIC_LINK((StgClosure *)q) == NULL) { -#ifndef THREADED_RTS - *IND_STATIC_LINK((StgClosure *)q) = gct->static_objects; - gct->static_objects = (StgClosure *)q; -#else - StgPtr link; - link = (StgPtr)cas((StgPtr)IND_STATIC_LINK((StgClosure *)q), - (StgWord)NULL, - (StgWord)gct->static_objects); - if (link == NULL) { - gct->static_objects = (StgClosure *)q; - } -#endif - } - } - return; - - case CONSTR_STATIC: - if (*STATIC_LINK(info,(StgClosure *)q) == NULL) { -#ifndef THREADED_RTS - *STATIC_LINK(info,(StgClosure *)q) = gct->static_objects; - gct->static_objects = (StgClosure *)q; -#else - StgPtr link; - link = (StgPtr)cas((StgPtr)STATIC_LINK(info,(StgClosure *)q), - (StgWord)NULL, - (StgWord)gct->static_objects); - if (link == NULL) { - gct->static_objects = (StgClosure *)q; - } -#endif - } - /* I am assuming that static_objects pointers are not - * written to other objects, and thus, no need to retag. */ - return; - - case CONSTR_NOCAF_STATIC: - /* no need to put these on the static linked list, they don't need - * to be scavenged. - */ - return; - - default: - barf("evacuate(static): strange closure type %d", (int)(info->type)); - } - } - - bd = Bdescr((P_)q); - - if ((bd->flags & (BF_LARGE | BF_COMPACTED | BF_EVACUATED)) != 0) { - - // pointer into to-space: just return it. It might be a pointer - // into a generation that we aren't collecting (> N), or it - // might just be a pointer into to-space. The latter doesn't - // happen often, but allowing it makes certain things a bit - // easier; e.g. scavenging an object is idempotent, so it's OK to - // have an object on the mutable list multiple times. - if (bd->flags & BF_EVACUATED) { - // We aren't copying this object, so we have to check - // whether it is already in the target generation. (this is - // the write barrier). - if (bd->step < gct->evac_step) { - gct->failed_to_evac = rtsTrue; - TICK_GC_FAILED_PROMOTION(); - } - return; - } - - /* evacuate large objects by re-linking them onto a different list. - */ - if (bd->flags & BF_LARGE) { - info = get_itbl(q); - if (info->type == TSO && - ((StgTSO *)q)->what_next == ThreadRelocated) { - q = (StgClosure *)((StgTSO *)q)->_link; - *p = q; - goto loop; - } - evacuate_large((P_)q); - return; - } - - /* If the object is in a step that we're compacting, then we - * need to use an alternative evacuate procedure. - */ - if (bd->flags & BF_COMPACTED) { - if (!is_marked((P_)q,bd)) { - mark((P_)q,bd); - if (mark_stack_full()) { - mark_stack_overflowed = rtsTrue; - reset_mark_stack(); - } - push_mark_stack((P_)q); - } - return; - } - } - - stp = bd->step->to; - - info = q->header.info; - if (IS_FORWARDING_PTR(info)) - { - /* Already evacuated, just return the forwarding address. - * HOWEVER: if the requested destination generation (gct->evac_step) is - * older than the actual generation (because the object was - * already evacuated to a younger generation) then we have to - * set the gct->failed_to_evac flag to indicate that we couldn't - * manage to promote the object to the desired generation. - */ - /* - * Optimisation: the check is fairly expensive, but we can often - * shortcut it if either the required generation is 0, or the - * current object (the EVACUATED) is in a high enough generation. - * We know that an EVACUATED always points to an object in the - * same or an older generation. stp is the lowest step that the - * current object would be evacuated to, so we only do the full - * check if stp is too low. - */ - StgClosure *e = (StgClosure*)UN_FORWARDING_PTR(info); - *p = TAG_CLOSURE(tag,e); - if (stp < gct->evac_step) { // optimisation - if (Bdescr((P_)e)->step < gct->evac_step) { - gct->failed_to_evac = rtsTrue; - TICK_GC_FAILED_PROMOTION(); - } - } - return; - } - - switch (INFO_PTR_TO_STRUCT(info)->type) { - - case WHITEHOLE: - goto loop; - - case MUT_VAR_CLEAN: - case MUT_VAR_DIRTY: - case MVAR_CLEAN: - case MVAR_DIRTY: - copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp); - return; - - case CONSTR_0_1: - { - StgWord w = (StgWord)q->payload[0]; - if (info == Czh_con_info && - // unsigned, so always true: (StgChar)w >= MIN_CHARLIKE && - (StgChar)w <= MAX_CHARLIKE) { - *p = TAG_CLOSURE(tag, - (StgClosure *)CHARLIKE_CLOSURE((StgChar)w) - ); - } - else if (info == Izh_con_info && - (StgInt)w >= MIN_INTLIKE && (StgInt)w <= MAX_INTLIKE) { - *p = TAG_CLOSURE(tag, - (StgClosure *)INTLIKE_CLOSURE((StgInt)w) - ); - } - else { - copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); - } - return; - } - - case FUN_0_1: - case FUN_1_0: - case CONSTR_1_0: - copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); - return; - - case THUNK_1_0: - case THUNK_0_1: - copy(p,info,q,sizeofW(StgThunk)+1,stp); - return; - - case THUNK_1_1: - case THUNK_2_0: - case THUNK_0_2: -#ifdef NO_PROMOTE_THUNKS - if (bd->gen_no == 0 && - bd->step->no != 0 && - bd->step->no == generations[bd->gen_no].n_steps-1) { - stp = bd->step; - } -#endif - copy(p,info,q,sizeofW(StgThunk)+2,stp); - return; - - case FUN_1_1: - case FUN_2_0: - case FUN_0_2: - case CONSTR_1_1: - case CONSTR_2_0: - copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag); - return; - - case CONSTR_0_2: - copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag); - return; - - case THUNK: - copy(p,info,q,thunk_sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp); - return; - - case FUN: - case IND_PERM: - case IND_OLDGEN_PERM: - case CONSTR: - copy_tag_nolock(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp,tag); - return; - - case WEAK: - case STABLE_NAME: - copy_tag(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp,tag); - return; - - case BCO: - copy(p,info,q,bco_sizeW((StgBCO *)q),stp); - return; - - case CAF_BLACKHOLE: - case SE_CAF_BLACKHOLE: - case SE_BLACKHOLE: - case BLACKHOLE: - copyPart(p,q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp); - return; - - case THUNK_SELECTOR: - eval_thunk_selector(p, (StgSelector *)q, rtsTrue); - return; - - case IND: - case IND_OLDGEN: - // follow chains of indirections, don't evacuate them - q = ((StgInd*)q)->indirectee; - *p = q; - goto loop; - - case RET_BCO: - case RET_SMALL: - case RET_BIG: - case RET_DYN: - 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); - - case PAP: - copy(p,info,q,pap_sizeW((StgPAP*)q),stp); - return; - - case AP: - copy(p,info,q,ap_sizeW((StgAP*)q),stp); - return; - - case AP_STACK: - copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),stp); - return; - - case ARR_WORDS: - // just copy the block - copy(p,info,q,arr_words_sizeW((StgArrWords *)q),stp); - return; - - case MUT_ARR_PTRS_CLEAN: - case MUT_ARR_PTRS_DIRTY: - case MUT_ARR_PTRS_FROZEN: - case MUT_ARR_PTRS_FROZEN0: - // just copy the block - copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp); - return; - - case TSO: - { - StgTSO *tso = (StgTSO *)q; - - /* Deal with redirected TSOs (a TSO that's had its stack enlarged). - */ - if (tso->what_next == ThreadRelocated) { - q = (StgClosure *)tso->_link; - *p = q; - goto loop; - } - - /* To evacuate a small TSO, we need to relocate the update frame - * list it contains. - */ - { - StgTSO *new_tso; - StgPtr r, s; - - copyPart(p,(StgClosure *)tso, tso_sizeW(tso), sizeofW(StgTSO), stp); - new_tso = (StgTSO *)*p; - move_TSO(tso, new_tso); - for (r = tso->sp, s = new_tso->sp; - r < tso->stack+tso->stack_size;) { - *s++ = *r++; - } - return; - } - } - - case TREC_HEADER: - copy(p,info,q,sizeofW(StgTRecHeader),stp); - return; - - case TVAR_WATCH_QUEUE: - copy(p,info,q,sizeofW(StgTVarWatchQueue),stp); - return; - - case TVAR: - copy(p,info,q,sizeofW(StgTVar),stp); - return; - - case TREC_CHUNK: - copy(p,info,q,sizeofW(StgTRecChunk),stp); - return; - - case ATOMIC_INVARIANT: - copy(p,info,q,sizeofW(StgAtomicInvariant),stp); - return; - - case INVARIANT_CHECK_QUEUE: - copy(p,info,q,sizeofW(StgInvariantCheckQueue),stp); - return; - - default: - barf("evacuate: strange closure type %d", (int)(INFO_PTR_TO_STRUCT(info)->type)); - } - - barf("evacuate"); -} - -#undef copy -#undef copy_tag -#undef copy_tag_nolock -#undef copyPart -#undef evacuate diff --git a/rts/sm/GC.c b/rts/sm/GC.c index 9867029b84..b71079b4ab 100644 --- a/rts/sm/GC.c +++ b/rts/sm/GC.c @@ -895,6 +895,39 @@ dec_running (void) return n_running; } +static rtsBool +any_work (void) +{ + int s; + step_workspace *ws; + + gct->any_work++; + + write_barrier(); + + // scavenge objects in compacted generation + if (mark_stack_overflowed || oldgen_scan_bd != NULL || + (mark_stack_bdescr != NULL && !mark_stack_empty())) { + return rtsTrue; + } + + // Check for global work in any step. We don't need to check for + // local work, because we have already exited scavenge_loop(), + // which means there is no local work for this thread. + for (s = total_steps-1; s >= 0; s--) { + if (s == 0 && RtsFlags.GcFlags.generations > 1) { + continue; + } + ws = &gct->steps[s]; + if (ws->todo_large_objects) return rtsTrue; + if (ws->step->todos) return rtsTrue; + } + + gct->no_work++; + + return rtsFalse; +} + static void scavenge_until_all_done (void) { @@ -903,7 +936,16 @@ scavenge_until_all_done (void) debugTrace(DEBUG_gc, "GC thread %d working", gct->thread_index); loop: +#if defined(THREADED_RTS) + if (n_gc_threads > 1) { + scavenge_loop(); + } else { + scavenge_loop1(); + } +#else scavenge_loop(); +#endif + // scavenge_loop() only exits when there's no work to do r = dec_running(); diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c index 5d156ed64c..f61d6b7a61 100644 --- a/rts/sm/Scav.c +++ b/rts/sm/Scav.c @@ -32,101 +32,12 @@ static void scavenge_large_bitmap (StgPtr p, StgLargeBitmap *large_bitmap, nat size ); - -/* 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_bitmap) -{ - nat bitmap; - StgClosure **p; - - bitmap = srt_bitmap; - p = srt; - - if (bitmap == (StgHalfWord)(-1)) { - scavenge_large_srt_bitmap( (StgLargeSRT *)srt ); - return; - } - - while (bitmap != 0) { - if ((bitmap & 1) != 0) { -#if defined(__PIC__) && defined(mingw32_TARGET_OS) - // 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(p); +#if defined(THREADED_RTS) && !defined(PARALLEL_GC) +# define evacuate(a) evacuate1(a) +# define recordMutableGen_GC(a,b) recordMutableGen(a,b) +# define scavenge_loop(a) scavenge_loop1(a) +# define scavenge_mutable_list(g) scavenge_mutable_list1(g) #endif - } - p++; - bitmap = bitmap >> 1; - } -} - - -STATIC_INLINE void -scavenge_thunk_srt(const StgInfoTable *info) -{ - StgThunkInfoTable *thunk_info; - - if (!major_gc) return; - - thunk_info = itbl_to_thunk_itbl(info); - scavenge_srt((StgClosure **)GET_SRT(thunk_info), thunk_info->i.srt_bitmap); -} - -STATIC_INLINE void -scavenge_fun_srt(const StgInfoTable *info) -{ - StgFunInfoTable *fun_info; - - if (!major_gc) return; - - fun_info = itbl_to_fun_itbl(info); - scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap); -} /* ----------------------------------------------------------------------------- Scavenge a TSO. @@ -283,6 +194,532 @@ scavenge_AP (StgAP *ap) } /* ----------------------------------------------------------------------------- + Scavenge SRTs + -------------------------------------------------------------------------- */ + +/* 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_bitmap) +{ + nat bitmap; + StgClosure **p; + + bitmap = srt_bitmap; + p = srt; + + if (bitmap == (StgHalfWord)(-1)) { + scavenge_large_srt_bitmap( (StgLargeSRT *)srt ); + return; + } + + while (bitmap != 0) { + if ((bitmap & 1) != 0) { +#if defined(__PIC__) && defined(mingw32_TARGET_OS) + // 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(p); +#endif + } + p++; + bitmap = bitmap >> 1; + } +} + + +STATIC_INLINE void +scavenge_thunk_srt(const StgInfoTable *info) +{ + StgThunkInfoTable *thunk_info; + + if (!major_gc) return; + + thunk_info = itbl_to_thunk_itbl(info); + scavenge_srt((StgClosure **)GET_SRT(thunk_info), thunk_info->i.srt_bitmap); +} + +STATIC_INLINE void +scavenge_fun_srt(const StgInfoTable *info) +{ + StgFunInfoTable *fun_info; + + if (!major_gc) return; + + fun_info = itbl_to_fun_itbl(info); + scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap); +} + +/* ----------------------------------------------------------------------------- + Scavenge a block from the given scan pointer up to bd->free. + + evac_step is set by the caller to be either zero (for a step in a + generation < N) or G where G is the generation of the step being + scavenged. + + We sometimes temporarily change evac_step back to zero if we're + scavenging a mutable object where eager promotion isn't such a good + idea. + -------------------------------------------------------------------------- */ + +static void +scavenge_block (bdescr *bd) +{ + StgPtr p, q; + StgInfoTable *info; + step *saved_evac_step; + rtsBool saved_eager_promotion; + step_workspace *ws; + + debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p", + bd->start, bd->gen_no, bd->step->no, bd->u.scan); + + gct->scan_bd = bd; + gct->evac_step = bd->step; + saved_evac_step = gct->evac_step; + saved_eager_promotion = gct->eager_promotion; + gct->failed_to_evac = rtsFalse; + + ws = &gct->steps[bd->step->abs_no]; + + p = bd->u.scan; + + // we might be evacuating into the very object that we're + // scavenging, so we have to check the real bd->free pointer each + // time around the loop. + while (p < bd->free || (bd == ws->todo_bd && p < ws->todo_free)) { + + ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); + info = get_itbl((StgClosure *)p); + + ASSERT(gct->thunk_selector_depth == 0); + + q = p; + switch (info->type) { + + case MVAR_CLEAN: + case MVAR_DIRTY: + { + StgMVar *mvar = ((StgMVar *)p); + gct->eager_promotion = rtsFalse; + evacuate((StgClosure **)&mvar->head); + evacuate((StgClosure **)&mvar->tail); + evacuate((StgClosure **)&mvar->value); + gct->eager_promotion = saved_eager_promotion; + + if (gct->failed_to_evac) { + mvar->header.info = &stg_MVAR_DIRTY_info; + } else { + mvar->header.info = &stg_MVAR_CLEAN_info; + } + p += sizeofW(StgMVar); + break; + } + + case FUN_2_0: + scavenge_fun_srt(info); + evacuate(&((StgClosure *)p)->payload[1]); + evacuate(&((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 2; + break; + + case THUNK_2_0: + scavenge_thunk_srt(info); + evacuate(&((StgThunk *)p)->payload[1]); + evacuate(&((StgThunk *)p)->payload[0]); + p += sizeofW(StgThunk) + 2; + break; + + case CONSTR_2_0: + evacuate(&((StgClosure *)p)->payload[1]); + evacuate(&((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 2; + break; + + case THUNK_1_0: + scavenge_thunk_srt(info); + evacuate(&((StgThunk *)p)->payload[0]); + p += sizeofW(StgThunk) + 1; + break; + + case FUN_1_0: + scavenge_fun_srt(info); + case CONSTR_1_0: + evacuate(&((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 1; + break; + + case THUNK_0_1: + scavenge_thunk_srt(info); + p += sizeofW(StgThunk) + 1; + break; + + case FUN_0_1: + scavenge_fun_srt(info); + case CONSTR_0_1: + p += sizeofW(StgHeader) + 1; + break; + + case THUNK_0_2: + scavenge_thunk_srt(info); + p += sizeofW(StgThunk) + 2; + break; + + case FUN_0_2: + scavenge_fun_srt(info); + case CONSTR_0_2: + p += sizeofW(StgHeader) + 2; + break; + + case THUNK_1_1: + scavenge_thunk_srt(info); + evacuate(&((StgThunk *)p)->payload[0]); + p += sizeofW(StgThunk) + 2; + break; + + case FUN_1_1: + scavenge_fun_srt(info); + case CONSTR_1_1: + evacuate(&((StgClosure *)p)->payload[0]); + p += sizeofW(StgHeader) + 2; + break; + + case FUN: + scavenge_fun_srt(info); + goto gen_obj; + + case THUNK: + { + StgPtr end; + + scavenge_thunk_srt(info); + end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgThunk *)p)->payload; p < end; p++) { + evacuate((StgClosure **)p); + } + p += info->layout.payload.nptrs; + break; + } + + gen_obj: + case CONSTR: + case WEAK: + case STABLE_NAME: + { + StgPtr end; + + end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { + evacuate((StgClosure **)p); + } + p += info->layout.payload.nptrs; + break; + } + + case BCO: { + StgBCO *bco = (StgBCO *)p; + evacuate((StgClosure **)&bco->instrs); + evacuate((StgClosure **)&bco->literals); + evacuate((StgClosure **)&bco->ptrs); + p += bco_sizeW(bco); + break; + } + + case IND_PERM: + if (bd->gen_no != 0) { +#ifdef PROFILING + // @LDV profiling + // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an + // IND_OLDGEN_PERM closure is larger than an IND_PERM closure. + LDV_recordDead((StgClosure *)p, sizeofW(StgInd)); +#endif + // + // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()? + // + SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info); + + // We pretend that p has just been created. + LDV_RECORD_CREATE((StgClosure *)p); + } + // fall through + case IND_OLDGEN_PERM: + evacuate(&((StgInd *)p)->indirectee); + p += sizeofW(StgInd); + break; + + case MUT_VAR_CLEAN: + case MUT_VAR_DIRTY: + gct->eager_promotion = rtsFalse; + evacuate(&((StgMutVar *)p)->var); + gct->eager_promotion = saved_eager_promotion; + + if (gct->failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info; + } + p += sizeofW(StgMutVar); + break; + + case CAF_BLACKHOLE: + case SE_CAF_BLACKHOLE: + case SE_BLACKHOLE: + case BLACKHOLE: + p += BLACKHOLE_sizeW(); + break; + + case THUNK_SELECTOR: + { + StgSelector *s = (StgSelector *)p; + evacuate(&s->selectee); + p += THUNK_SELECTOR_sizeW(); + break; + } + + // A chunk of stack saved in a heap object + case AP_STACK: + { + StgAP_STACK *ap = (StgAP_STACK *)p; + + evacuate(&ap->fun); + scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); + p = (StgPtr)ap->payload + ap->size; + break; + } + + case PAP: + p = scavenge_PAP((StgPAP *)p); + break; + + case AP: + p = scavenge_AP((StgAP *)p); + break; + + case ARR_WORDS: + // nothing to follow + p += arr_words_sizeW((StgArrWords *)p); + break; + + case MUT_ARR_PTRS_CLEAN: + case MUT_ARR_PTRS_DIRTY: + // follow everything + { + StgPtr next; + + // We don't eagerly promote objects pointed to by a mutable + // array, but if we find the array only points to objects in + // the same or an older generation, we mark it "clean" and + // avoid traversing it during minor GCs. + gct->eager_promotion = rtsFalse; + next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); + for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { + evacuate((StgClosure **)p); + } + gct->eager_promotion = saved_eager_promotion; + + if (gct->failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; + } + + gct->failed_to_evac = rtsTrue; // always put it on the mutable list. + break; + } + + case MUT_ARR_PTRS_FROZEN: + 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++) { + evacuate((StgClosure **)p); + } + + // If we're going to put this object on the mutable list, then + // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that. + if (gct->failed_to_evac) { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; + } else { + ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; + } + break; + } + + case TSO: + { + StgTSO *tso = (StgTSO *)p; + scavengeTSO(tso); + p += tso_sizeW(tso); + break; + } + + case TVAR_WATCH_QUEUE: + { + StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); + gct->evac_step = 0; + evacuate((StgClosure **)&wq->closure); + evacuate((StgClosure **)&wq->next_queue_entry); + evacuate((StgClosure **)&wq->prev_queue_entry); + gct->evac_step = saved_evac_step; + gct->failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgTVarWatchQueue); + break; + } + + case TVAR: + { + StgTVar *tvar = ((StgTVar *) p); + gct->evac_step = 0; + evacuate((StgClosure **)&tvar->current_value); + evacuate((StgClosure **)&tvar->first_watch_queue_entry); + gct->evac_step = saved_evac_step; + gct->failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgTVar); + break; + } + + case TREC_HEADER: + { + StgTRecHeader *trec = ((StgTRecHeader *) p); + gct->evac_step = 0; + evacuate((StgClosure **)&trec->enclosing_trec); + evacuate((StgClosure **)&trec->current_chunk); + evacuate((StgClosure **)&trec->invariants_to_check); + gct->evac_step = saved_evac_step; + gct->failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgTRecHeader); + break; + } + + case TREC_CHUNK: + { + StgWord i; + StgTRecChunk *tc = ((StgTRecChunk *) p); + TRecEntry *e = &(tc -> entries[0]); + gct->evac_step = 0; + evacuate((StgClosure **)&tc->prev_chunk); + for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { + evacuate((StgClosure **)&e->tvar); + evacuate((StgClosure **)&e->expected_value); + evacuate((StgClosure **)&e->new_value); + } + gct->evac_step = saved_evac_step; + gct->failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgTRecChunk); + break; + } + + case ATOMIC_INVARIANT: + { + StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); + gct->evac_step = 0; + evacuate(&invariant->code); + evacuate((StgClosure **)&invariant->last_execution); + gct->evac_step = saved_evac_step; + gct->failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgAtomicInvariant); + break; + } + + case INVARIANT_CHECK_QUEUE: + { + StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); + gct->evac_step = 0; + evacuate((StgClosure **)&queue->invariant); + evacuate((StgClosure **)&queue->my_execution); + evacuate((StgClosure **)&queue->next_queue_entry); + gct->evac_step = saved_evac_step; + gct->failed_to_evac = rtsTrue; // mutable + p += sizeofW(StgInvariantCheckQueue); + break; + } + + default: + barf("scavenge: unimplemented/strange closure type %d @ %p", + info->type, p); + } + + /* + * 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 (gct->failed_to_evac) { + gct->failed_to_evac = rtsFalse; + if (bd->gen_no > 0) { + recordMutableGen_GC((StgClosure *)q, &generations[bd->gen_no]); + } + } + } + + if (p > bd->free) { + gct->copied += ws->todo_free - bd->free; + bd->free = p; + } + + debugTrace(DEBUG_gc, " scavenged %ld bytes", + (unsigned long)((bd->free - bd->u.scan) * sizeof(W_))); + + // update stats: this is a block that has been scavenged + gct->scanned += bd->free - bd->u.scan; + bd->u.scan = bd->free; + + if (bd != ws->todo_bd) { + // we're not going to evac any more objects into + // this block, so push it now. + push_scanned_block(bd, ws); + } + + gct->scan_bd = NULL; +} +/* ----------------------------------------------------------------------------- Scavenge everything on the mark stack. This is slightly different from scavenge(): @@ -1403,18 +1840,6 @@ scavenge_large (step_workspace *ws) } /* ---------------------------------------------------------------------------- - Scavenge a block - ------------------------------------------------------------------------- */ - -#undef PARALLEL_GC -#include "Scav.c-inc" - -#ifdef THREADED_RTS -#define PARALLEL_GC -#include "Scav.c-inc" -#endif - -/* ---------------------------------------------------------------------------- Look for work to do. We look for the oldest step that has either a todo block that can @@ -1459,11 +1884,7 @@ loop: // scavenge everything up to the free pointer. if (ws->todo_bd->u.scan < ws->todo_free) { - if (n_gc_threads == 1) { - scavenge_block1(ws->todo_bd); - } else { - scavenge_block(ws->todo_bd); - } + scavenge_block(ws->todo_bd); did_something = rtsTrue; break; } @@ -1476,11 +1897,7 @@ loop: } if ((bd = grab_todo_block(ws)) != NULL) { - if (n_gc_threads == 1) { - scavenge_block1(bd); - } else { - scavenge_block(bd); - } + scavenge_block(bd); did_something = rtsTrue; break; } @@ -1530,35 +1947,3 @@ loop: if (work_to_do) goto loop; } -rtsBool -any_work (void) -{ - int s; - step_workspace *ws; - - gct->any_work++; - - write_barrier(); - - // scavenge objects in compacted generation - if (mark_stack_overflowed || oldgen_scan_bd != NULL || - (mark_stack_bdescr != NULL && !mark_stack_empty())) { - return rtsTrue; - } - - // Check for global work in any step. We don't need to check for - // local work, because we have already exited scavenge_loop(), - // which means there is no local work for this thread. - for (s = total_steps-1; s >= 0; s--) { - if (s == 0 && RtsFlags.GcFlags.generations > 1) { - continue; - } - ws = &gct->steps[s]; - if (ws->todo_large_objects) return rtsTrue; - if (ws->step->todos) return rtsTrue; - } - - gct->no_work++; - - return rtsFalse; -} diff --git a/rts/sm/Scav.c-inc b/rts/sm/Scav.c-inc deleted file mode 100644 index a75f6ee04e..0000000000 --- a/rts/sm/Scav.c-inc +++ /dev/null @@ -1,463 +0,0 @@ -/* -----------------------------------------------------------------------*-c-*- - * - * (c) The GHC Team 1998-2008 - * - * Generational garbage collector: scavenging functions - * - * 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 - * - * ---------------------------------------------------------------------------*/ - -// This file is #included into Scav.c, twice: firstly with PARALLEL_GC -// defined, the second time without. - -#if defined(THREADED_RTS) && !defined(PARALLEL_GC) -# define scavenge_block(a) scavenge_block1(a) -# define evacuate(a) evacuate1(a) -# define recordMutableGen_GC(a,b) recordMutableGen(a,b) -#else -# undef scavenge_block -# undef evacuate -# undef recordMutableGen_GC -# if !defined(THREADED_RTS) -# define scavenge_block1(a) scavenge_block(a) -# endif -#endif - - -static void scavenge_block (bdescr *bd); - -/* ----------------------------------------------------------------------------- - Scavenge a block from the given scan pointer up to bd->free. - - evac_step is set by the caller to be either zero (for a step in a - generation < N) or G where G is the generation of the step being - scavenged. - - We sometimes temporarily change evac_step back to zero if we're - scavenging a mutable object where eager promotion isn't such a good - idea. - -------------------------------------------------------------------------- */ - -static void -scavenge_block (bdescr *bd) -{ - StgPtr p, q; - StgInfoTable *info; - step *saved_evac_step; - rtsBool saved_eager_promotion; - step_workspace *ws; - - debugTrace(DEBUG_gc, "scavenging block %p (gen %d, step %d) @ %p", - bd->start, bd->gen_no, bd->step->no, bd->u.scan); - - gct->scan_bd = bd; - gct->evac_step = bd->step; - saved_evac_step = gct->evac_step; - saved_eager_promotion = gct->eager_promotion; - gct->failed_to_evac = rtsFalse; - - ws = &gct->steps[bd->step->abs_no]; - - p = bd->u.scan; - - // we might be evacuating into the very object that we're - // scavenging, so we have to check the real bd->free pointer each - // time around the loop. - while (p < bd->free || (bd == ws->todo_bd && p < ws->todo_free)) { - - ASSERT(LOOKS_LIKE_CLOSURE_PTR(p)); - info = get_itbl((StgClosure *)p); - - ASSERT(gct->thunk_selector_depth == 0); - - q = p; - switch (info->type) { - - case MVAR_CLEAN: - case MVAR_DIRTY: - { - StgMVar *mvar = ((StgMVar *)p); - gct->eager_promotion = rtsFalse; - evacuate((StgClosure **)&mvar->head); - evacuate((StgClosure **)&mvar->tail); - evacuate((StgClosure **)&mvar->value); - gct->eager_promotion = saved_eager_promotion; - - if (gct->failed_to_evac) { - mvar->header.info = &stg_MVAR_DIRTY_info; - } else { - mvar->header.info = &stg_MVAR_CLEAN_info; - } - p += sizeofW(StgMVar); - break; - } - - case FUN_2_0: - scavenge_fun_srt(info); - evacuate(&((StgClosure *)p)->payload[1]); - evacuate(&((StgClosure *)p)->payload[0]); - p += sizeofW(StgHeader) + 2; - break; - - case THUNK_2_0: - scavenge_thunk_srt(info); - evacuate(&((StgThunk *)p)->payload[1]); - evacuate(&((StgThunk *)p)->payload[0]); - p += sizeofW(StgThunk) + 2; - break; - - case CONSTR_2_0: - evacuate(&((StgClosure *)p)->payload[1]); - evacuate(&((StgClosure *)p)->payload[0]); - p += sizeofW(StgHeader) + 2; - break; - - case THUNK_1_0: - scavenge_thunk_srt(info); - evacuate(&((StgThunk *)p)->payload[0]); - p += sizeofW(StgThunk) + 1; - break; - - case FUN_1_0: - scavenge_fun_srt(info); - case CONSTR_1_0: - evacuate(&((StgClosure *)p)->payload[0]); - p += sizeofW(StgHeader) + 1; - break; - - case THUNK_0_1: - scavenge_thunk_srt(info); - p += sizeofW(StgThunk) + 1; - break; - - case FUN_0_1: - scavenge_fun_srt(info); - case CONSTR_0_1: - p += sizeofW(StgHeader) + 1; - break; - - case THUNK_0_2: - scavenge_thunk_srt(info); - p += sizeofW(StgThunk) + 2; - break; - - case FUN_0_2: - scavenge_fun_srt(info); - case CONSTR_0_2: - p += sizeofW(StgHeader) + 2; - break; - - case THUNK_1_1: - scavenge_thunk_srt(info); - evacuate(&((StgThunk *)p)->payload[0]); - p += sizeofW(StgThunk) + 2; - break; - - case FUN_1_1: - scavenge_fun_srt(info); - case CONSTR_1_1: - evacuate(&((StgClosure *)p)->payload[0]); - p += sizeofW(StgHeader) + 2; - break; - - case FUN: - scavenge_fun_srt(info); - goto gen_obj; - - case THUNK: - { - StgPtr end; - - scavenge_thunk_srt(info); - end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs; - for (p = (P_)((StgThunk *)p)->payload; p < end; p++) { - evacuate((StgClosure **)p); - } - p += info->layout.payload.nptrs; - break; - } - - gen_obj: - case CONSTR: - case WEAK: - case STABLE_NAME: - { - StgPtr end; - - end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs; - for (p = (P_)((StgClosure *)p)->payload; p < end; p++) { - evacuate((StgClosure **)p); - } - p += info->layout.payload.nptrs; - break; - } - - case BCO: { - StgBCO *bco = (StgBCO *)p; - evacuate((StgClosure **)&bco->instrs); - evacuate((StgClosure **)&bco->literals); - evacuate((StgClosure **)&bco->ptrs); - p += bco_sizeW(bco); - break; - } - - case IND_PERM: - if (bd->gen_no != 0) { -#ifdef PROFILING - // @LDV profiling - // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an - // IND_OLDGEN_PERM closure is larger than an IND_PERM closure. - LDV_recordDead((StgClosure *)p, sizeofW(StgInd)); -#endif - // - // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()? - // - SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info); - - // We pretend that p has just been created. - LDV_RECORD_CREATE((StgClosure *)p); - } - // fall through - case IND_OLDGEN_PERM: - evacuate(&((StgInd *)p)->indirectee); - p += sizeofW(StgInd); - break; - - case MUT_VAR_CLEAN: - case MUT_VAR_DIRTY: - gct->eager_promotion = rtsFalse; - evacuate(&((StgMutVar *)p)->var); - gct->eager_promotion = saved_eager_promotion; - - if (gct->failed_to_evac) { - ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info; - } else { - ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info; - } - p += sizeofW(StgMutVar); - break; - - case CAF_BLACKHOLE: - case SE_CAF_BLACKHOLE: - case SE_BLACKHOLE: - case BLACKHOLE: - p += BLACKHOLE_sizeW(); - break; - - case THUNK_SELECTOR: - { - StgSelector *s = (StgSelector *)p; - evacuate(&s->selectee); - p += THUNK_SELECTOR_sizeW(); - break; - } - - // A chunk of stack saved in a heap object - case AP_STACK: - { - StgAP_STACK *ap = (StgAP_STACK *)p; - - evacuate(&ap->fun); - scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size); - p = (StgPtr)ap->payload + ap->size; - break; - } - - case PAP: - p = scavenge_PAP((StgPAP *)p); - break; - - case AP: - p = scavenge_AP((StgAP *)p); - break; - - case ARR_WORDS: - // nothing to follow - p += arr_words_sizeW((StgArrWords *)p); - break; - - case MUT_ARR_PTRS_CLEAN: - case MUT_ARR_PTRS_DIRTY: - // follow everything - { - StgPtr next; - - // We don't eagerly promote objects pointed to by a mutable - // array, but if we find the array only points to objects in - // the same or an older generation, we mark it "clean" and - // avoid traversing it during minor GCs. - gct->eager_promotion = rtsFalse; - next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); - for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) { - evacuate((StgClosure **)p); - } - gct->eager_promotion = saved_eager_promotion; - - if (gct->failed_to_evac) { - ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info; - } else { - ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info; - } - - gct->failed_to_evac = rtsTrue; // always put it on the mutable list. - break; - } - - case MUT_ARR_PTRS_FROZEN: - 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++) { - evacuate((StgClosure **)p); - } - - // If we're going to put this object on the mutable list, then - // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that. - if (gct->failed_to_evac) { - ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info; - } else { - ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info; - } - break; - } - - case TSO: - { - StgTSO *tso = (StgTSO *)p; - scavengeTSO(tso); - p += tso_sizeW(tso); - break; - } - - case TVAR_WATCH_QUEUE: - { - StgTVarWatchQueue *wq = ((StgTVarWatchQueue *) p); - gct->evac_step = 0; - evacuate((StgClosure **)&wq->closure); - evacuate((StgClosure **)&wq->next_queue_entry); - evacuate((StgClosure **)&wq->prev_queue_entry); - gct->evac_step = saved_evac_step; - gct->failed_to_evac = rtsTrue; // mutable - p += sizeofW(StgTVarWatchQueue); - break; - } - - case TVAR: - { - StgTVar *tvar = ((StgTVar *) p); - gct->evac_step = 0; - evacuate((StgClosure **)&tvar->current_value); - evacuate((StgClosure **)&tvar->first_watch_queue_entry); - gct->evac_step = saved_evac_step; - gct->failed_to_evac = rtsTrue; // mutable - p += sizeofW(StgTVar); - break; - } - - case TREC_HEADER: - { - StgTRecHeader *trec = ((StgTRecHeader *) p); - gct->evac_step = 0; - evacuate((StgClosure **)&trec->enclosing_trec); - evacuate((StgClosure **)&trec->current_chunk); - evacuate((StgClosure **)&trec->invariants_to_check); - gct->evac_step = saved_evac_step; - gct->failed_to_evac = rtsTrue; // mutable - p += sizeofW(StgTRecHeader); - break; - } - - case TREC_CHUNK: - { - StgWord i; - StgTRecChunk *tc = ((StgTRecChunk *) p); - TRecEntry *e = &(tc -> entries[0]); - gct->evac_step = 0; - evacuate((StgClosure **)&tc->prev_chunk); - for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) { - evacuate((StgClosure **)&e->tvar); - evacuate((StgClosure **)&e->expected_value); - evacuate((StgClosure **)&e->new_value); - } - gct->evac_step = saved_evac_step; - gct->failed_to_evac = rtsTrue; // mutable - p += sizeofW(StgTRecChunk); - break; - } - - case ATOMIC_INVARIANT: - { - StgAtomicInvariant *invariant = ((StgAtomicInvariant *) p); - gct->evac_step = 0; - evacuate(&invariant->code); - evacuate((StgClosure **)&invariant->last_execution); - gct->evac_step = saved_evac_step; - gct->failed_to_evac = rtsTrue; // mutable - p += sizeofW(StgAtomicInvariant); - break; - } - - case INVARIANT_CHECK_QUEUE: - { - StgInvariantCheckQueue *queue = ((StgInvariantCheckQueue *) p); - gct->evac_step = 0; - evacuate((StgClosure **)&queue->invariant); - evacuate((StgClosure **)&queue->my_execution); - evacuate((StgClosure **)&queue->next_queue_entry); - gct->evac_step = saved_evac_step; - gct->failed_to_evac = rtsTrue; // mutable - p += sizeofW(StgInvariantCheckQueue); - break; - } - - default: - barf("scavenge: unimplemented/strange closure type %d @ %p", - info->type, p); - } - - /* - * 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 (gct->failed_to_evac) { - gct->failed_to_evac = rtsFalse; - if (bd->gen_no > 0) { - recordMutableGen_GC((StgClosure *)q, &generations[bd->gen_no]); - } - } - } - - if (p > bd->free) { - gct->copied += ws->todo_free - bd->free; - bd->free = p; - } - - debugTrace(DEBUG_gc, " scavenged %ld bytes", - (unsigned long)((bd->free - bd->u.scan) * sizeof(W_))); - - // update stats: this is a block that has been scavenged - gct->scanned += bd->free - bd->u.scan; - bd->u.scan = bd->free; - - if (bd != ws->todo_bd) { - // we're not going to evac any more objects into - // this block, so push it now. - push_scanned_block(bd, ws); - } - - gct->scan_bd = NULL; -} - -#undef scavenge_block -#undef evacuate -#undef recordMutableGen_GC diff --git a/rts/sm/Scav.h b/rts/sm/Scav.h index e8eab485d5..244073e90d 100644 --- a/rts/sm/Scav.h +++ b/rts/sm/Scav.h @@ -12,5 +12,9 @@ * ---------------------------------------------------------------------------*/ void scavenge_loop (void); -rtsBool any_work (void); void scavenge_mutable_list (generation *g); + +#ifdef THREADED_RTS +void scavenge_loop1 (void); +void scavenge_mutable_list1 (generation *g); +#endif diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index 702c246717..d37a076ab6 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -553,6 +553,22 @@ resizeNurseries (nat blocks) resizeNurseriesFixed(blocks / n_nurseries); } + +/* ----------------------------------------------------------------------------- + move_TSO is called to update the TSO structure after it has been + moved from one place to another. + -------------------------------------------------------------------------- */ + +void +move_TSO (StgTSO *src, StgTSO *dest) +{ + ptrdiff_t diff; + + // relocate the stack pointer... + diff = (StgPtr)dest - (StgPtr)src; // In *words* + dest->sp = (StgPtr)dest->sp + diff; +} + /* ----------------------------------------------------------------------------- The allocate() interface |