X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=db05ef5f072482ecbd0ec6a105c48a73cef6d794;hb=4ab216140652b1ebdc011bba06f77cd05c614b91;hp=7074a5301e91b7c753e31cb383de040fa40432b9;hpb=693550d93040439ac20d7ab3bfcaee8ca5b7e923;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 7074a53..db05ef5 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1029,7 +1029,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } else { // we might have added extra large blocks to the nursery, so // resize back to minAllocAreaSize again. - resizeNurseries(RtsFlags.GcFlags.minAllocAreaSize); + resizeNurseriesFixed(RtsFlags.GcFlags.minAllocAreaSize); } } @@ -1266,6 +1266,16 @@ traverse_weak_ptr_list(void) ; } + // Threads blocked on black holes: if the black hole + // is alive, then the thread is alive too. + if (tmp == NULL && t->why_blocked == BlockedOnBlackHole) { + if (isAlive(t->block_info.closure)) { + t = (StgTSO *)evacuate((StgClosure *)t); + tmp = t; + flag = rtsTrue; + } + } + if (tmp == NULL) { // not alive (yet): leave this thread on the // old_all_threads list. @@ -1282,6 +1292,10 @@ traverse_weak_ptr_list(void) } } + /* If we evacuated any threads, we need to go back to the scavenger. + */ + if (flag) return rtsTrue; + /* And resurrect any threads which were about to become garbage. */ { @@ -1294,6 +1308,21 @@ traverse_weak_ptr_list(void) } } + /* Finally, we can update the blackhole_queue. This queue + * simply strings together TSOs blocked on black holes, it is + * not intended to keep anything alive. Hence, we do not follow + * pointers on the blackhole_queue until now, when we have + * determined which TSOs are otherwise reachable. We know at + * this point that all TSOs have been evacuated, however. + */ + { + StgTSO **pt; + for (pt = &blackhole_queue; *pt != END_TSO_QUEUE; pt = &((*pt)->link)) { + *pt = (StgTSO *)isAlive((StgClosure *)*pt); + ASSERT(*pt != NULL); + } + } + weak_stage = WeakDone; // *now* we're done, return rtsTrue; // but one more round of scavenging, please @@ -1721,9 +1750,11 @@ loop: case FUN_1_0: case FUN_0_1: case CONSTR_1_0: + return copy(q,sizeofW(StgHeader)+1,stp); + case THUNK_1_0: case THUNK_0_1: - return copy(q,sizeofW(StgHeader)+1,stp); + return copy(q,sizeofW(StgThunk)+1,stp); case THUNK_1_1: case THUNK_0_2: @@ -1735,7 +1766,7 @@ loop: stp = bd->step; } #endif - return copy(q,sizeofW(StgHeader)+2,stp); + return copy(q,sizeofW(StgThunk)+2,stp); case FUN_1_1: case FUN_0_2: @@ -1745,8 +1776,10 @@ loop: case CONSTR_2_0: return copy(q,sizeofW(StgHeader)+2,stp); - case FUN: case THUNK: + return copy(q,thunk_sizeW_fromITBL(info),stp); + + case FUN: case CONSTR: case IND_PERM: case IND_OLDGEN_PERM: @@ -1801,16 +1834,16 @@ loop: case THUNK_STATIC: if (info->srt_bitmap != 0 && major_gc && - THUNK_STATIC_LINK((StgClosure *)q) == NULL) { - THUNK_STATIC_LINK((StgClosure *)q) = static_objects; + *THUNK_STATIC_LINK((StgClosure *)q) == NULL) { + *THUNK_STATIC_LINK((StgClosure *)q) = static_objects; static_objects = (StgClosure *)q; } return q; case FUN_STATIC: if (info->srt_bitmap != 0 && major_gc && - FUN_STATIC_LINK((StgClosure *)q) == NULL) { - FUN_STATIC_LINK((StgClosure *)q) = static_objects; + *FUN_STATIC_LINK((StgClosure *)q) == NULL) { + *FUN_STATIC_LINK((StgClosure *)q) = static_objects; static_objects = (StgClosure *)q; } return q; @@ -1822,15 +1855,15 @@ loop: */ if (major_gc && ((StgIndStatic *)q)->saved_info == NULL - && IND_STATIC_LINK((StgClosure *)q) == NULL) { - IND_STATIC_LINK((StgClosure *)q) = static_objects; + && *IND_STATIC_LINK((StgClosure *)q) == NULL) { + *IND_STATIC_LINK((StgClosure *)q) = static_objects; static_objects = (StgClosure *)q; } return q; case CONSTR_STATIC: - if (major_gc && STATIC_LINK(info,(StgClosure *)q) == NULL) { - STATIC_LINK(info,(StgClosure *)q) = static_objects; + if (major_gc && *STATIC_LINK(info,(StgClosure *)q) == NULL) { + *STATIC_LINK(info,(StgClosure *)q) = static_objects; static_objects = (StgClosure *)q; } return q; @@ -1859,9 +1892,11 @@ loop: barf("evacuate: stack frame at %p\n", q); case PAP: - case AP: return copy(q,pap_sizeW((StgPAP*)q),stp); + case AP: + return copy(q,ap_sizeW((StgAP*)q),stp); + case AP_STACK: return copy(q,ap_stack_sizeW((StgAP_STACK*)q),stp); @@ -1996,6 +2031,48 @@ loop: been BLACKHOLE'd, and should be updated with an indirection or a forwarding pointer. If the return value is NULL, then the selector thunk is unchanged. + + *** + ToDo: the treatment of THUNK_SELECTORS could be improved in the + following way (from a suggestion by Ian Lynagh): + + We can have a chain like this: + + sel_0 --> (a,b) + | + |-----> sel_0 --> (a,b) + | + |-----> sel_0 --> ... + + and the depth limit means we don't go all the way to the end of the + chain, which results in a space leak. This affects the recursive + call to evacuate() in the THUNK_SELECTOR case in evacuate(): *not* + the recursive call to eval_thunk_selector() in + eval_thunk_selector(). + + We could eliminate the depth bound in this case, in the following + way: + + - traverse the chain once to discover the *value* of the + THUNK_SELECTOR. Mark all THUNK_SELECTORS that we + visit on the way as having been visited already (somehow). + + - in a second pass, traverse the chain again updating all + THUNK_SEELCTORS that we find on the way with indirections to + the value. + + - if we encounter a "marked" THUNK_SELECTOR in a normal + evacuate(), we konw it can't be updated so just evac it. + + Program that illustrates the problem: + + foo [] = ([], []) + foo (x:xs) = let (ys, zs) = foo xs + in if x >= 0 then (x:ys, zs) else (ys, x:zs) + + main = bar [1..(100000000::Int)] + bar xs = (\(ys, zs) -> print ys >> print zs) (foo xs) + -------------------------------------------------------------------------- */ static inline rtsBool @@ -2301,15 +2378,6 @@ scavenge_fun_srt(const StgInfoTable *info) scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap); } -STATIC_INLINE void -scavenge_ret_srt(const StgInfoTable *info) -{ - StgRetInfoTable *ret_info; - - ret_info = itbl_to_ret_itbl(info); - scavenge_srt((StgClosure **)GET_SRT(ret_info), ret_info->i.srt_bitmap); -} - /* ----------------------------------------------------------------------------- Scavenge a TSO. -------------------------------------------------------------------------- */ @@ -2317,8 +2385,6 @@ scavenge_ret_srt(const StgInfoTable *info) static void scavengeTSO (StgTSO *tso) { - // chase the link field for any TSOs on the same queue - tso->link = (StgTSO *)evacuate((StgClosure *)tso->link); if ( tso->why_blocked == BlockedOnMVar || tso->why_blocked == BlockedOnBlackHole || tso->why_blocked == BlockedOnException @@ -2334,6 +2400,13 @@ scavengeTSO (StgTSO *tso) (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions); } + // We don't always chase the link field: TSOs on the blackhole + // queue are not automatically alive, so the link field is a + // "weak" pointer in that case. + if (tso->why_blocked != BlockedOnBlackHole) { + tso->link = (StgTSO *)evacuate((StgClosure *)tso->link); + } + // scavange current transaction record tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec); @@ -2382,18 +2455,15 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args) } STATIC_INLINE StgPtr -scavenge_PAP (StgPAP *pap) +scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size) { StgPtr p; - StgWord bitmap, size; + StgWord bitmap; StgFunInfoTable *fun_info; - - pap->fun = evacuate(pap->fun); - fun_info = get_fun_itbl(pap->fun); + + fun_info = get_fun_itbl(fun); ASSERT(fun_info->i.type != PAP); - - p = (StgPtr)pap->payload; - size = pap->n_args; + p = (StgPtr)payload; switch (fun_info->f.fun_type) { case ARG_GEN: @@ -2404,13 +2474,12 @@ scavenge_PAP (StgPAP *pap) p += size; break; case ARG_BCO: - scavenge_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size); + scavenge_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size); p += size; break; default: bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]); small_bitmap: - size = pap->n_args; while (size > 0) { if ((bitmap & 1) == 0) { *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); @@ -2424,6 +2493,20 @@ scavenge_PAP (StgPAP *pap) return p; } +STATIC_INLINE StgPtr +scavenge_PAP (StgPAP *pap) +{ + pap->fun = evacuate(pap->fun); + return scavenge_PAP_payload (pap->fun, pap->payload, pap->n_args); +} + +STATIC_INLINE StgPtr +scavenge_AP (StgAP *ap) +{ + ap->fun = evacuate(ap->fun); + return scavenge_PAP_payload (ap->fun, ap->payload, ap->n_args); +} + /* ----------------------------------------------------------------------------- Scavenge a given step until there are no more objects in this step to scavenge. @@ -2493,6 +2576,11 @@ scavenge(step *stp) case THUNK_2_0: scavenge_thunk_srt(info); + ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]); + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + p += sizeofW(StgThunk) + 2; + break; + case CONSTR_2_0: ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]); ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); @@ -2501,8 +2589,8 @@ scavenge(step *stp) case THUNK_1_0: scavenge_thunk_srt(info); - ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); - p += sizeofW(StgHeader) + 1; + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + p += sizeofW(StgThunk) + 1; break; case FUN_1_0: @@ -2514,7 +2602,7 @@ scavenge(step *stp) case THUNK_0_1: scavenge_thunk_srt(info); - p += sizeofW(StgHeader) + 1; + p += sizeofW(StgThunk) + 1; break; case FUN_0_1: @@ -2525,7 +2613,7 @@ scavenge(step *stp) case THUNK_0_2: scavenge_thunk_srt(info); - p += sizeofW(StgHeader) + 2; + p += sizeofW(StgThunk) + 2; break; case FUN_0_2: @@ -2536,8 +2624,8 @@ scavenge(step *stp) case THUNK_1_1: scavenge_thunk_srt(info); - ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); - p += sizeofW(StgHeader) + 2; + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + p += sizeofW(StgThunk) + 2; break; case FUN_1_1: @@ -2552,8 +2640,17 @@ scavenge(step *stp) goto gen_obj; case THUNK: + { + StgPtr end; + scavenge_thunk_srt(info); - // fall through + end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgThunk *)p)->payload; p < end; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + p += info->layout.payload.nptrs; + break; + } gen_obj: case CONSTR: @@ -2638,10 +2735,13 @@ scavenge(step *stp) } case PAP: - case AP: 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); @@ -2872,6 +2972,10 @@ linear_scan: case THUNK_2_0: scavenge_thunk_srt(info); + ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]); + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + break; + case CONSTR_2_0: ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]); ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); @@ -2886,6 +2990,9 @@ linear_scan: case THUNK_1_0: case THUNK_1_1: scavenge_thunk_srt(info); + ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]); + break; + case CONSTR_1_0: case CONSTR_1_1: ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]); @@ -2910,8 +3017,16 @@ linear_scan: goto gen_obj; case THUNK: + { + StgPtr end; + scavenge_thunk_srt(info); - // fall through + end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs; + for (p = (P_)((StgThunk *)p)->payload; p < end; p++) { + *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p); + } + break; + } gen_obj: case CONSTR: @@ -2981,9 +3096,12 @@ linear_scan: } case PAP: - case AP: scavenge_PAP((StgPAP *)p); break; + + case AP: + scavenge_AP((StgAP *)p); + break; case MUT_ARR_PTRS: // follow everything @@ -3212,18 +3330,28 @@ scavenge_one(StgPtr p) break; } - case FUN: - case FUN_1_0: // hardly worth specialising these guys - case FUN_0_1: - case FUN_1_1: - case FUN_0_2: - case FUN_2_0: case THUNK: case THUNK_1_0: case THUNK_0_1: case THUNK_1_1: case THUNK_0_2: case THUNK_2_0: + { + StgPtr q, end; + + end = (StgPtr)((StgThunk *)p)->payload + info->layout.payload.ptrs; + for (q = (StgPtr)((StgThunk *)p)->payload; q < end; q++) { + *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q); + } + break; + } + + case FUN: + case FUN_1_0: // hardly worth specialising these guys + case FUN_0_1: + case FUN_1_1: + case FUN_0_2: + case FUN_2_0: case CONSTR: case CONSTR_1_0: case CONSTR_0_1: @@ -3274,10 +3402,13 @@ scavenge_one(StgPtr p) } case PAP: - case AP: p = scavenge_PAP((StgPAP *)p); break; + case AP: + p = scavenge_AP((StgAP *)p); + break; + case ARR_WORDS: // nothing to follow break; @@ -3540,8 +3671,8 @@ scavenge_static(void) /* Take this object *off* the static_objects list, * and put it on the scavenged_static_objects list. */ - static_objects = STATIC_LINK(info,p); - STATIC_LINK(info,p) = scavenged_static_objects; + static_objects = *STATIC_LINK(info,p); + *STATIC_LINK(info,p) = scavenged_static_objects; scavenged_static_objects = p; switch (info -> type) { @@ -3810,8 +3941,8 @@ zero_static_object_list(StgClosure* first_static) for (p = first_static; p != END_OF_STATIC_LIST; p = link) { info = get_itbl(p); - link = STATIC_LINK(info, p); - STATIC_LINK(info,p) = NULL; + link = *STATIC_LINK(info, p); + *STATIC_LINK(info,p) = NULL; } } @@ -4211,20 +4342,4 @@ printMutableList(generation *gen) } debugBelch("\n"); } - -STATIC_INLINE rtsBool -maybeLarge(StgClosure *closure) -{ - StgInfoTable *info = get_itbl(closure); - - /* closure types that may be found on the new_large_objects list; - see scavenge_large */ - return (info->type == MUT_ARR_PTRS || - info->type == MUT_ARR_PTRS_FROZEN || - info->type == MUT_ARR_PTRS_FROZEN0 || - info->type == TSO || - info->type == ARR_WORDS); -} - - #endif /* DEBUG */