X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FEvac.c-inc;h=7a657ca226c1299dd356c938a2a80f1c98c24448;hb=2ac31c7f6e9306024da822674f478db039edb39b;hp=e6514180d5d9ea9cc8b696b3721bc04b19a9c680;hpb=4c394999264d602f10e7623cefa7588423c4f68b;p=ghc-hetmet.git diff --git a/rts/sm/Evac.c-inc b/rts/sm/Evac.c-inc index e651418..7a657ca 100644 --- a/rts/sm/Evac.c-inc +++ b/rts/sm/Evac.c-inc @@ -1,6 +1,6 @@ /* -----------------------------------------------------------------------*-c-*- * - * (c) The GHC Team 1998-2006 + * (c) The GHC Team 1998-2008 * * Generational garbage collector: evacuation functions * @@ -10,55 +10,77 @@ // non-minor, parallel, GC. This file contains the code for both, // controllled by the CPP symbol MINOR_GC. -#ifdef MINOR_GC -#define copy(a,b,c,d) copy0(a,b,c,d) -#define copy_tag(a,b,c,d,e) copy_tag0(a,b,c,d,e) -#define copyPart(a,b,c,d,e) copyPart0(a,b,c,d,e) -#define evacuate(a) evacuate0(a) +#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 -#undef copy -#undef copy_tag -#undef copyPart -#undef evacuate +# 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, StgClosure *src, nat size, step *stp, StgWord tag) +copy_tag(StgClosure **p, const StgInfoTable *info, + StgClosure *src, nat size, step *stp, StgWord tag) { - StgPtr to, tagged_to, from; + StgPtr to, from; nat i; - StgWord info; -#if !defined(MINOR_GC) && defined(THREADED_RTS) -spin: - info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info); - // so.. what is it? - if (info == (W_)&stg_WHITEHOLE_info) { -#ifdef PROF_SPIN - whitehole_spin++; -#endif - goto spin; + 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 (info == (W_)&stg_EVACUATED_info || info == (W_)&stg_IND_info) { - // NB. a closure might be updated with an IND by - // unchain_selector_thunks(), hence the test above. - src->header.info = (const StgInfoTable *)info; - return evacuate(p); // does the failed_to_evac stuff + +// 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 - ASSERT(n_gc_threads == 1); - info = (W_)src->header.info; - src->header.info = &stg_EVACUATED_info; + 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); - tagged_to = (StgPtr)TAG_CLOSURE(tag,(StgClosure*)to); - *p = (StgClosure *)tagged_to; + *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] = info; + to[0] = (W_)info; for (i = 1; i < size; i++) { // unroll for small i to[i] = from[i]; } @@ -67,19 +89,13 @@ spin: // __builtin_prefetch(to + size + 2, 1); // } - ((StgEvacuated*)from)->evacuee = (StgClosure *)tagged_to; -#if !defined(MINOR_GC) && defined(THREADED_RTS) - write_barrier(); - ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info; -#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 } - +#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 @@ -92,7 +108,7 @@ copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy, nat i; StgWord info; -#if !defined(MINOR_GC) && defined(THREADED_RTS) +#if defined(PARALLEL_GC) spin: info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info); if (info == (W_)&stg_WHITEHOLE_info) { @@ -101,14 +117,13 @@ spin: #endif goto spin; } - if (info == (W_)&stg_EVACUATED_info) { + 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; - src->header.info = &stg_EVACUATED_info; #endif to = alloc_for_copy(size_to_reserve, stp); @@ -122,11 +137,10 @@ spin: to[i] = from[i]; } - ((StgEvacuated*)from)->evacuee = (StgClosure *)to; -#if !defined(MINOR_GC) && defined(THREADED_RTS) +#if defined(PARALLEL_GC) write_barrier(); - ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info; #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 @@ -141,9 +155,10 @@ spin: /* Copy wrappers that don't tag the closure after copying */ STATIC_INLINE void -copy(StgClosure **p, StgClosure *src, nat size, step *stp) +copy(StgClosure **p, const StgInfoTable *info, + StgClosure *src, nat size, step *stp) { - copy_tag(p,src,size,stp,0); + copy_tag(p,info,src,size,stp,0); } /* ---------------------------------------------------------------------------- @@ -208,9 +223,6 @@ loop: if (!HEAP_ALLOCED(q)) { -#ifdef MINOR_GC - return; -#endif if (!major_gc) return; info = get_itbl(q); @@ -308,28 +320,18 @@ loop: bd = Bdescr((P_)q); - if (bd->gen_no > N) { - /* Can't evacuate this object, because it's in a generation - * older than the ones we're collecting. Let's hope that it's - * in gct->evac_step or older, or we will have to arrange to track - * this pointer using the mutable list. - */ - if (bd->step < gct->evac_step) { - // nope - gct->failed_to_evac = rtsTrue; - TICK_GC_FAILED_PROMOTION(); - } - return; - } - if ((bd->flags & (BF_LARGE | BF_COMPACTED | BF_EVACUATED)) != 0) { - /* pointer into to-space: just return it. This normally - * shouldn't happen, but alllowing it makes certain things - * slightly easier (eg. the mutable list can contain the same - * object twice, for example). - */ + // 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(); @@ -343,7 +345,7 @@ loop: info = get_itbl(q); if (info->type == TSO && ((StgTSO *)q)->what_next == ThreadRelocated) { - q = (StgClosure *)((StgTSO *)q)->link; + q = (StgClosure *)((StgTSO *)q)->_link; *p = q; goto loop; } @@ -369,9 +371,37 @@ loop: stp = bd->step->to; - info = get_itbl(q); - - switch (info->type) { + 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; @@ -380,27 +410,27 @@ loop: case MUT_VAR_DIRTY: case MVAR_CLEAN: case MVAR_DIRTY: - copy(p,q,sizeW_fromITBL(info),stp); + copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp); return; case CONSTR_0_1: { StgWord w = (StgWord)q->payload[0]; - if (q->header.info == Czh_con_info && + 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 (q->header.info == Izh_con_info && + 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(p,q,sizeofW(StgHeader)+1,stp,tag); + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); } return; } @@ -408,12 +438,12 @@ loop: case FUN_0_1: case FUN_1_0: case CONSTR_1_0: - copy_tag(p,q,sizeofW(StgHeader)+1,stp,tag); + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); return; case THUNK_1_0: case THUNK_0_1: - copy(p,q,sizeofW(StgThunk)+1,stp); + copy(p,info,q,sizeofW(StgThunk)+1,stp); return; case THUNK_1_1: @@ -426,7 +456,7 @@ loop: stp = bd->step; } #endif - copy(p,q,sizeofW(StgThunk)+2,stp); + copy(p,info,q,sizeofW(StgThunk)+2,stp); return; case FUN_1_1: @@ -434,28 +464,31 @@ loop: case FUN_0_2: case CONSTR_1_1: case CONSTR_2_0: - copy_tag(p,q,sizeofW(StgHeader)+2,stp,tag); + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag); return; case CONSTR_0_2: - copy_tag(p,q,sizeofW(StgHeader)+2,stp,tag); + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag); return; case THUNK: - copy(p,q,thunk_sizeW_fromITBL(info),stp); + 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: - case CONSTR: - copy_tag(p,q,sizeW_fromITBL(info),stp,tag); + copy_tag(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp,tag); return; case BCO: - copy(p,q,bco_sizeW((StgBCO *)q),stp); + copy(p,info,q,bco_sizeW((StgBCO *)q),stp); return; case CAF_BLACKHOLE: @@ -490,49 +523,20 @@ loop: barf("evacuate: stack frame at %p\n", q); case PAP: - copy(p,q,pap_sizeW((StgPAP*)q),stp); + copy(p,info,q,pap_sizeW((StgPAP*)q),stp); return; case AP: - copy(p,q,ap_sizeW((StgAP*)q),stp); + copy(p,info,q,ap_sizeW((StgAP*)q),stp); return; case AP_STACK: - copy(p,q,ap_stack_sizeW((StgAP_STACK*)q),stp); + copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),stp); return; - case EVACUATED: - /* 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 = ((StgEvacuated*)q)->evacuee; - *p = 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; - } - case ARR_WORDS: // just copy the block - copy(p,q,arr_words_sizeW((StgArrWords *)q),stp); + copy(p,info,q,arr_words_sizeW((StgArrWords *)q),stp); return; case MUT_ARR_PTRS_CLEAN: @@ -540,7 +544,7 @@ loop: case MUT_ARR_PTRS_FROZEN: case MUT_ARR_PTRS_FROZEN0: // just copy the block - copy(p,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp); + copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp); return; case TSO: @@ -550,7 +554,7 @@ loop: /* Deal with redirected TSOs (a TSO that's had its stack enlarged). */ if (tso->what_next == ThreadRelocated) { - q = (StgClosure *)tso->link; + q = (StgClosure *)tso->_link; *p = q; goto loop; } @@ -574,31 +578,31 @@ loop: } case TREC_HEADER: - copy(p,q,sizeofW(StgTRecHeader),stp); + copy(p,info,q,sizeofW(StgTRecHeader),stp); return; case TVAR_WATCH_QUEUE: - copy(p,q,sizeofW(StgTVarWatchQueue),stp); + copy(p,info,q,sizeofW(StgTVarWatchQueue),stp); return; case TVAR: - copy(p,q,sizeofW(StgTVar),stp); + copy(p,info,q,sizeofW(StgTVar),stp); return; case TREC_CHUNK: - copy(p,q,sizeofW(StgTRecChunk),stp); + copy(p,info,q,sizeofW(StgTRecChunk),stp); return; case ATOMIC_INVARIANT: - copy(p,q,sizeofW(StgAtomicInvariant),stp); + copy(p,info,q,sizeofW(StgAtomicInvariant),stp); return; case INVARIANT_CHECK_QUEUE: - copy(p,q,sizeofW(StgInvariantCheckQueue),stp); + copy(p,info,q,sizeofW(StgInvariantCheckQueue),stp); return; default: - barf("evacuate: strange closure type %d", (int)(info->type)); + barf("evacuate: strange closure type %d", (int)(INFO_PTR_TO_STRUCT(info)->type)); } barf("evacuate"); @@ -606,5 +610,6 @@ loop: #undef copy #undef copy_tag +#undef copy_tag_nolock #undef copyPart #undef evacuate