X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=1e40065f3b7fa0162bcea80e7d6c197aae57f6f5;hb=ee63e6ddec3f1ceb6c1f3812320b961c1f84e928;hp=7ce6a8fe1de131b606ae9d678472aa0bfe34836b;hpb=9d909b3bb9a0740f272dadf4a35b642e1404fe3c;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 7ce6a8f..1e40065 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1154,7 +1154,9 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) ACQUIRE_SM_LOCK; // send exceptions to any threads which were about to die + RELEASE_SM_LOCK; resurrectThreads(resurrected_threads); + ACQUIRE_SM_LOCK; // Update the stable pointer hash table. updateStablePtrTable(major_gc); @@ -1696,7 +1698,7 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp) SET_EVACUAEE_FOR_LDV(src, size_to_reserve); // fill the slop if (size_to_reserve - size_to_copy_org > 0) - FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org)); + LDV_FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org)); #endif return (StgClosure *)dest; } @@ -2016,11 +2018,15 @@ loop: case THUNK_SELECTOR: { StgClosure *p; + const StgInfoTable *info_ptr; if (thunk_selector_depth > MAX_THUNK_SELECTOR_DEPTH) { return copy(q,THUNK_SELECTOR_sizeW(),stp); } + // stashed away for LDV profiling, see below + info_ptr = q->header.info; + p = eval_thunk_selector(info->layout.selector_offset, (StgSelector *)q); @@ -2033,6 +2039,13 @@ loop: val = evacuate(p); thunk_selector_depth--; +#ifdef PROFILING + // For the purposes of LDV profiling, we have destroyed + // the original selector thunk. + SET_INFO(q, info_ptr); + LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(q); +#endif + // 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 @@ -2042,12 +2055,10 @@ loop: SET_INFO(q, &stg_IND_info); ((StgInd *)q)->indirectee = p; -#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(q, THUNK_SELECTOR_sizeW()); -#endif + // For the purposes of LDV profiling, we have created an + // indirection. + LDV_RECORD_CREATE(q); + return val; } } @@ -2164,7 +2175,7 @@ loop: } case BLOCKED_FETCH: - ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE); + ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOD_SIZE); to = copy(q,sizeofW(StgBlockedFetch),stp); IF_DEBUG(gc, debugBelch("@@ evacuate: %p (%s) to %p (%s)", @@ -2175,7 +2186,7 @@ loop: case REMOTE_REF: # endif case FETCH_ME: - ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); + ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE); to = copy(q,sizeofW(StgFetchMe),stp); IF_DEBUG(gc, debugBelch("@@ evacuate: %p (%s) to %p (%s)", @@ -2183,7 +2194,7 @@ loop: return to; case FETCH_ME_BQ: - ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); + ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE); to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp); IF_DEBUG(gc, debugBelch("@@ evacuate: %p (%s) to %p (%s)", @@ -3555,12 +3566,12 @@ linear_scan: // already scavenged? if (is_marked(oldgen_scan+1,oldgen_scan_bd)) { - oldgen_scan += sizeofW(StgHeader) + MIN_NONUPD_SIZE; + oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE; goto loop; } push_mark_stack(oldgen_scan); // ToDo: bump the linear scan by the actual size of the object - oldgen_scan += sizeofW(StgHeader) + MIN_NONUPD_SIZE; + oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE; goto linear_scan; }