X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FEvac.c;h=6325a12f9ce8f9707b7246abe8012d25d4daf993;hb=a11662957fa688997e6c4befff44e7efe94c2db8;hp=ab2047036d48943c4ad19c3e84a2a970339e9d1d;hpb=fcc3794aeb78081c04103a0b7e7560cb8c7bea58;p=ghc-hetmet.git diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index ab20470..6325a12 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -29,6 +29,7 @@ StgWord64 whitehole_spin = 0; #if defined(THREADED_RTS) && !defined(PARALLEL_GC) #define evacuate(p) evacuate1(p) +#define HEAP_ALLOCED_GC(p) HEAP_ALLOCED(p) #endif #if !defined(PARALLEL_GC) @@ -165,7 +166,7 @@ copy_tag_nolock(StgClosure **p, const StgInfoTable *info, * pointer of an object, but reserve some padding after it. This is * used to optimise evacuation of BLACKHOLEs. */ -static void +static rtsBool copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp) { StgPtr to, from; @@ -184,7 +185,7 @@ spin: if (IS_FORWARDING_PTR(info)) { src->header.info = (const StgInfoTable *)info; evacuate(p); // does the failed_to_evac stuff - return ; + return rtsFalse; } #else info = (W_)src->header.info; @@ -212,8 +213,10 @@ spin: 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)); + LDV_FILL_SLOP(to + size_to_copy, (int)(size_to_reserve - size_to_copy)); #endif + + return rtsTrue; } @@ -246,10 +249,6 @@ evacuate_large(StgPtr p) stp = bd->step; ACQUIRE_SPIN_LOCK(&stp->sync_large_objects); - // object must be at the beginning of the block (or be a ByteArray) - ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS || - (((W_)p & BLOCK_MASK) == 0)); - // already evacuated? if (bd->flags & BF_EVACUATED) { /* Don't forget to set the gct->failed_to_evac flag if we didn't get @@ -285,11 +284,25 @@ evacuate_large(StgPtr p) } ws = &gct->steps[new_stp->abs_no]; + bd->flags |= BF_EVACUATED; bd->step = new_stp; bd->gen_no = new_stp->gen_no; - bd->link = ws->todo_large_objects; - ws->todo_large_objects = bd; + + // If this is a block of pinned objects, we don't have to scan + // these objects, because they aren't allowed to contain any + // pointers. For these blocks, we skip the scavenge stage and put + // them straight on the scavenged_large_objects list. + if (bd->flags & BF_PINNED) { + ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS); + if (new_stp != stp) { ACQUIRE_SPIN_LOCK(&new_stp->sync_large_objects); } + dbl_link_onto(bd, &new_stp->scavenged_large_objects); + new_stp->n_scavenged_large_blocks += bd->blocks; + if (new_stp != stp) { RELEASE_SPIN_LOCK(&new_stp->sync_large_objects); } + } else { + bd->link = ws->todo_large_objects; + ws->todo_large_objects = bd; + } RELEASE_SPIN_LOCK(&stp->sync_large_objects); } @@ -354,7 +367,7 @@ loop: ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); - if (!HEAP_ALLOCED(q)) { + if (!HEAP_ALLOCED_GC(q)) { if (!major_gc) return; @@ -624,8 +637,6 @@ loop: return; case CAF_BLACKHOLE: - case SE_CAF_BLACKHOLE: - case SE_BLACKHOLE: case BLACKHOLE: copyPart(p,q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp); return; @@ -697,14 +708,18 @@ loop: { 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++; - } + rtsBool mine; + + mine = copyPart(p,(StgClosure *)tso, tso_sizeW(tso), + sizeofW(StgTSO), stp); + if (mine) { + 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; } } @@ -768,19 +783,30 @@ unchain_thunk_selectors(StgSelector *p, StgClosure *val) // invoke eval_thunk_selector(), the recursive calls will not // evacuate the value (because we want to select on the value, // not evacuate it), so in this case val is in from-space. - // ASSERT(!HEAP_ALLOCED(val) || Bdescr((P_)val)->gen_no > N || (Bdescr((P_)val)->flags & BF_EVACUATED)); + // ASSERT(!HEAP_ALLOCED_GC(val) || Bdescr((P_)val)->gen_no > N || (Bdescr((P_)val)->flags & BF_EVACUATED)); prev = (StgSelector*)((StgClosure *)p)->payload[0]; // Update the THUNK_SELECTOR with an indirection to the - // EVACUATED closure now at p. Why do this rather than - // upd_evacuee(q,p)? Because we have an invariant that an - // EVACUATED closure always points to an object in the - // same or an older generation (required by the short-cut - // test in the EVACUATED case, below). - ((StgInd *)p)->indirectee = val; - write_barrier(); - SET_INFO(p, &stg_IND_info); + // value. The value is still in from-space at this stage. + // + // (old note: Why not do upd_evacuee(q,p)? Because we have an + // invariant that an EVACUATED closure always points to an + // object in the same or an older generation (required by + // the short-cut test in the EVACUATED case, below). + if ((StgClosure *)p == val) { + // must be a loop; just leave a BLACKHOLE in place. This + // can happen when we have a chain of selectors that + // eventually loops back on itself. We can't leave an + // indirection pointing to itself, and we want the program + // to deadlock if it ever enters this closure, so + // BLACKHOLE is correct. + SET_INFO(p, &stg_BLACKHOLE_info); + } else { + ((StgInd *)p)->indirectee = val; + write_barrier(); + SET_INFO(p, &stg_IND_info); + } // For the purposes of LDV profiling, we have created an // indirection. @@ -811,7 +837,7 @@ eval_thunk_selector (StgClosure **q, StgSelector * p, rtsBool evac) selector_chain: bd = Bdescr((StgPtr)p); - if (HEAP_ALLOCED(p)) { + if (HEAP_ALLOCED_GC(p)) { // If the THUNK_SELECTOR is in to-space or in a generation that we // are not collecting, then bale out early. We won't be able to // save any space in any case, and updating with an indirection is @@ -820,6 +846,11 @@ selector_chain: if (bd->flags & BF_EVACUATED) { unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p); *q = (StgClosure *)p; + // shortcut, behave as for: if (evac) evacuate(q); + if (evac && bd->step < gct->evac_step) { + gct->failed_to_evac = rtsTrue; + TICK_GC_FAILED_PROMOTION(); + } return; } // we don't update THUNK_SELECTORS in the compacted @@ -923,8 +954,12 @@ selector_loop: // the original selector thunk, p. SET_INFO(p, (StgInfoTable *)info_ptr); LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC((StgClosure *)p); +#if defined(THREADED_RTS) + SET_INFO(p, &stg_WHITEHOLE_info); +#else SET_INFO(p, &stg_BLACKHOLE_info); #endif +#endif // the closure in val is now the "value" of the // THUNK_SELECTOR in p. However, val may itself be a @@ -957,12 +992,18 @@ selector_loop: prev_thunk_selector = p; *q = val; - if (evac) evacuate(q); - val = *q; + + // update the other selectors in the chain *before* + // evacuating the value. This is necessary in the case + // where the value turns out to be one of the selectors + // in the chain (i.e. we have a loop), and evacuating it + // would corrupt the chain. + unchain_thunk_selectors(prev_thunk_selector, val); + // evacuate() cannot recurse through // eval_thunk_selector(), because we know val is not // a THUNK_SELECTOR. - unchain_thunk_selectors(prev_thunk_selector, val); + if (evac) evacuate(q); return; } @@ -1010,8 +1051,6 @@ selector_loop: case THUNK_0_2: case THUNK_STATIC: case CAF_BLACKHOLE: - case SE_CAF_BLACKHOLE: - case SE_BLACKHOLE: case BLACKHOLE: // not evaluated yet goto bale_out;