X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FEvac.c;h=3212ce5852737cbf8e5703630294786c8ac86a14;hb=3c341e968786893dd18368093068489583db1b54;hp=1c453fc52e7763b539a66d511208fa17d3b995c5;hpb=f20fe8deeee0353f8cdb27ca8031dd38b4b44ed1;p=ghc-hetmet.git diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c index 1c453fc..3212ce5 100644 --- a/rts/sm/Evac.c +++ b/rts/sm/Evac.c @@ -11,17 +11,19 @@ * * ---------------------------------------------------------------------------*/ +#include "PosixSource.h" #include "Rts.h" -#include "Storage.h" -#include "MBlock.h" + #include "Evac.h" +#include "Storage.h" #include "GC.h" #include "GCThread.h" #include "GCUtils.h" #include "Compact.h" +#include "MarkStack.h" #include "Prelude.h" -#include "LdvProfile.h" #include "Trace.h" +#include "LdvProfile.h" #if defined(PROF_SPIN) && defined(THREADED_RTS) && defined(PARALLEL_GC) StgWord64 whitehole_spin = 0; @@ -29,6 +31,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) @@ -73,10 +76,10 @@ alloc_for_copy (nat size, step *stp) * necessary. */ to = ws->todo_free; - if (to + size > ws->todo_lim) { + ws->todo_free += size; + if (ws->todo_free > ws->todo_lim) { to = todo_block_full(size, ws); } - ws->todo_free = to + size; ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim); return to; @@ -95,8 +98,6 @@ copy_tag(StgClosure **p, const StgInfoTable *info, 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 @@ -141,8 +142,6 @@ copy_tag_nolock(StgClosure **p, const StgInfoTable *info, *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 @@ -193,8 +192,6 @@ spin: 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 @@ -248,10 +245,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 @@ -287,11 +280,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); } @@ -356,7 +363,7 @@ loop: ASSERT(LOOKS_LIKE_CLOSURE_PTR(q)); - if (!HEAP_ALLOCED(q)) { + if (!HEAP_ALLOCED_GC(q)) { if (!major_gc) return; @@ -493,11 +500,6 @@ loop: */ if (!is_marked((P_)q,bd)) { mark((P_)q,bd); - if (mark_stack_full()) { - debugTrace(DEBUG_gc,"mark stack overflowed"); - mark_stack_overflowed = rtsTrue; - reset_mark_stack(); - } push_mark_stack((P_)q); } return; @@ -547,8 +549,17 @@ loop: copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp); return; + // For ints and chars of low value, save space by replacing references to + // these with closures with references to common, shared ones in the RTS. + // + // * Except when compiling into Windows DLLs which don't support cross-package + // data references very well. + // case CONSTR_0_1: - { + { +#if defined(__PIC__) && defined(mingw32_HOST_OS) + copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); +#else StgWord w = (StgWord)q->payload[0]; if (info == Czh_con_info && // unsigned, so always true: (StgChar)w >= MIN_CHARLIKE && @@ -566,6 +577,7 @@ loop: else { copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag); } +#endif return; } @@ -691,8 +703,7 @@ loop: goto loop; } - /* To evacuate a small TSO, we need to relocate the update frame - * list it contains. + /* To evacuate a small TSO, we need to adjust the stack pointer */ { StgTSO *new_tso; @@ -772,7 +783,7 @@ 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]; @@ -826,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