X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=120f02a76e25eb5fd5fd5f48303a18da1ad17c2b;hb=e0c787c10fc73125878312a5d88e90f9fcab2637;hp=f4493ca7bc619f0e38b926ed81a5de452a70694e;hpb=83856260f0caa9bb646813a304accb8c11194123;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index f4493ca..120f02a 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.92 2001/01/16 11:50:30 simonmar Exp $ + * $Id: GC.c,v 1.102 2001/04/03 16:35:12 sewardj Exp $ * * (c) The GHC Team 1998-1999 * @@ -44,6 +44,7 @@ #include "Weak.h" #include "StablePriv.h" #include "Prelude.h" +#include "ParTicky.h" // ToDo: move into Rts.h #if defined(GRAN) || defined(PAR) # include "GranSimRts.h" # include "ParallelRts.h" @@ -53,10 +54,8 @@ # include "ParallelDebug.h" # endif #endif -#if defined(GHCI) -# include "HsFFI.h" -# include "Linker.h" -#endif +#include "HsFFI.h" +#include "Linker.h" #if defined(RTS_GTK_FRONTPANEL) #include "FrontPanel.h" #endif @@ -139,6 +138,11 @@ bdescr *old_to_space; lnat new_blocks; /* blocks allocated during this GC */ lnat g0s0_pcnt_kept = 30; /* percentage of g0s0 live at last minor GC */ +/* Used to avoid long recursion due to selector thunks + */ +lnat thunk_selector_depth = 0; +#define MAX_THUNK_SELECTOR_DEPTH 256 + //@node Static function declarations, Garbage Collect, STATIC OBJECT LIST //@subsection Static function declarations @@ -164,6 +168,9 @@ static void scavenge_mut_once_list ( generation *g ); static void gcCAFs ( void ); #endif +void revertCAFs ( void ); +void scavengeCAFs ( void ); + //@node Garbage Collect, Weak Pointers, Static function declarations //@subsection Garbage Collect @@ -210,6 +217,9 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc ) /* tell the stats department that we've started a GC */ stat_startGC(); + /* Init stats and print par specific (timing) info */ + PAR_TICKY_PAR_START(); + /* attribute any costs to CCS_GC */ #ifdef PROFILING prev_CCS = CCCS; @@ -385,6 +395,8 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc ) } } + scavengeCAFs(); + /* follow all the roots that the application knows about. */ evac_gen = 0; @@ -401,6 +413,8 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc ) /* Mark the entries in the GALA table of the parallel system */ markLocalGAs(major_gc); + /* Mark all entries on the list of pending fetches */ + markPendingFetches(major_gc); #endif /* Mark the weak pointer list, and prepare to detect dead weak @@ -734,9 +748,11 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc ) } /* mark the garbage collected CAFs as dead */ -#ifdef DEBUG +#if 0 /* doesn't work at the moment */ +#if defined(DEBUG) if (major_gc) { gcCAFs(); } #endif +#endif /* zero the scavenged static object list */ if (major_gc) { @@ -773,14 +789,16 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc ) /* check for memory leaks if sanity checking is on */ IF_DEBUG(sanity, memInventory()); -#ifdef RTS_GTK_VISUALS - if (RtsFlags.GcFlags.visuals) { +#ifdef RTS_GTK_FRONTPANEL + if (RtsFlags.GcFlags.frontpanel) { updateFrontPanelAfterGC( N, live ); } #endif /* ok, GC over: tell the stats department what happened. */ stat_endGC(allocated, collected, live, copied, N); + + //PAR_TICKY_TP(); } //@node Weak Pointers, Evacuation, Garbage Collect @@ -1392,8 +1410,6 @@ loop: case CONSTR: case IND_PERM: case IND_OLDGEN_PERM: - case CAF_UNENTERED: - case CAF_ENTERED: case WEAK: case FOREIGN: case STABLE_NAME: @@ -1466,14 +1482,33 @@ loop: selectee = ((StgInd *)selectee)->indirectee; goto selector_loop; - case CAF_ENTERED: - selectee = ((StgCAF *)selectee)->value; - goto selector_loop; - case EVACUATED: selectee = ((StgEvacuated *)selectee)->evacuee; goto selector_loop; + case THUNK_SELECTOR: +# if 0 + /* Disabled 03 April 2001 by JRS; it seems to cause the GC (or + something) to go into an infinite loop when the nightly + stage2 compiles PrelTup.lhs. */ + + /* we can't recurse indefinitely in evacuate(), so set a + * limit on the number of times we can go around this + * loop. + */ + if (thunk_selector_depth < MAX_THUNK_SELECTOR_DEPTH) { + bdescr *bd; + bd = Bdescr((P_)selectee); + if (!bd->evacuated) { + thunk_selector_depth++; + selectee = evacuate(selectee); + thunk_selector_depth--; + goto selector_loop; + } + } + /* otherwise, fall through... */ +# endif + case AP_UPD: case THUNK: case THUNK_1_0: @@ -1482,9 +1517,6 @@ loop: case THUNK_1_1: case THUNK_0_2: case THUNK_STATIC: - case THUNK_SELECTOR: - /* aargh - do recursively???? */ - case CAF_UNENTERED: case CAF_BLACKHOLE: case SE_CAF_BLACKHOLE: case SE_BLACKHOLE: @@ -1493,6 +1525,37 @@ loop: /* not evaluated yet */ break; +#if defined(PAR) + /* a copy of the top-level cases below */ + case RBH: // cf. BLACKHOLE_BQ + { + //StgInfoTable *rip = get_closure_info(q, &size, &ptrs, &nonptrs, &vhs, str); + to = copy(q,BLACKHOLE_sizeW(),stp); + //ToDo: derive size etc from reverted IP + //to = copy(q,size,stp); + // recordMutable((StgMutClosure *)to); + return to; + } + + case BLOCKED_FETCH: + ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE); + to = copy(q,sizeofW(StgBlockedFetch),stp); + return to; + +# ifdef DIST + case REMOTE_REF: +# endif + case FETCH_ME: + ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); + to = copy(q,sizeofW(StgFetchMe),stp); + return to; + + case FETCH_ME_BQ: + ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); + to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp); + return to; +#endif + default: barf("evacuate: THUNK_SELECTOR: strange selectee %d", (int)(selectee_info->type)); @@ -1523,9 +1586,15 @@ loop: return q; case IND_STATIC: - if (major_gc && IND_STATIC_LINK((StgClosure *)q) == NULL) { - IND_STATIC_LINK((StgClosure *)q) = static_objects; - static_objects = (StgClosure *)q; + /* If q->saved_info != NULL, then it's a revertible CAF - it'll be + * on the CAF list, so don't do anything with it here (we'll + * scavenge it later). + */ + if (major_gc + && ((StgIndStatic *)q)->saved_info == NULL + && IND_STATIC_LINK((StgClosure *)q) == NULL) { + IND_STATIC_LINK((StgClosure *)q) = static_objects; + static_objects = (StgClosure *)q; } return q; @@ -1685,6 +1754,9 @@ loop: q, info_type(q), to, info_type(to))); return to; +# ifdef DIST + case REMOTE_REF: +# endif case FETCH_ME: ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); to = copy(q,sizeofW(StgFetchMe),stp); @@ -1979,37 +2051,6 @@ scavenge(step *stp) p += sizeofW(StgIndOldGen); break; - case CAF_UNENTERED: - { - StgCAF *caf = (StgCAF *)p; - - caf->body = evacuate(caf->body); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordOldToNewPtrs((StgMutClosure *)p); - } else { - caf->mut_link = NULL; - } - p += sizeofW(StgCAF); - break; - } - - case CAF_ENTERED: - { - StgCAF *caf = (StgCAF *)p; - - caf->body = evacuate(caf->body); - caf->value = evacuate(caf->value); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - recordOldToNewPtrs((StgMutClosure *)p); - } else { - caf->mut_link = NULL; - } - p += sizeofW(StgCAF); - break; - } - case MUT_VAR: /* ignore MUT_CONSs */ if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) { @@ -2177,10 +2218,10 @@ scavenge(step *stp) break; } +#ifdef DIST + case REMOTE_REF: +#endif case FETCH_ME: - IF_DEBUG(gc, - belch("@@ scavenge: HWL claims nothing to do for %p (%s)", - p, info_type((StgClosure *)p))); p += sizeofW(StgFetchMe); break; // nothing to do in this case @@ -2273,7 +2314,6 @@ scavenge_one(StgClosure *p) case FOREIGN: case IND_PERM: case IND_OLDGEN_PERM: - case CAF_UNENTERED: { StgPtr q, end; @@ -2434,35 +2474,6 @@ scavenge_mut_once_list(generation *gen) } continue; - case CAF_ENTERED: - { - StgCAF *caf = (StgCAF *)p; - caf->body = evacuate(caf->body); - caf->value = evacuate(caf->value); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - p->mut_link = new_list; - new_list = p; - } else { - p->mut_link = NULL; - } - } - continue; - - case CAF_UNENTERED: - { - StgCAF *caf = (StgCAF *)p; - caf->body = evacuate(caf->body); - if (failed_to_evac) { - failed_to_evac = rtsFalse; - p->mut_link = new_list; - new_list = p; - } else { - p->mut_link = NULL; - } - } - continue; - default: /* shouldn't have anything else on the mutables list */ barf("scavenge_mut_once_list: strange object? %d", (int)(info->type)); @@ -2640,6 +2651,10 @@ scavenge_mutable_list(generation *gen) break; } +#ifdef DIST + case REMOTE_REF: + barf("scavenge_mutable_list: REMOTE_REF %d", (int)(info->type)); +#endif case FETCH_ME: p += sizeofW(StgFetchMe); break; // nothing to do in this case @@ -2721,7 +2736,7 @@ scavenge_static(void) case THUNK_STATIC: case FUN_STATIC: scavenge_srt(info); - /* fall through */ + break; case CONSTR_STATIC: { @@ -3057,7 +3072,6 @@ zero_static_object_list(StgClosure* first_static) * It doesn't do any harm to zero all the mutable link fields on the * mutable list. */ -//@cindex zero_mutable_list static void zero_mutable_list( StgMutClosure *first ) @@ -3070,43 +3084,37 @@ zero_mutable_list( StgMutClosure *first ) } } -//@node Reverting CAFs, Sanity code for CAF garbage collection, Scavenging -//@subsection Reverting CAFs - /* ----------------------------------------------------------------------------- Reverting CAFs -------------------------------------------------------------------------- */ -//@cindex RevertCAFs -void RevertCAFs(void) +void +revertCAFs( void ) { -#ifdef INTERPRETER - StgInt i; - - /* Deal with CAFs created by compiled code. */ - for (i = 0; i < usedECafTable; i++) { - SET_INFO( (StgInd*)(ecafTable[i].closure), ecafTable[i].origItbl ); - ((StgInd*)(ecafTable[i].closure))->indirectee = 0; - } - - /* Deal with CAFs created by the interpreter. */ - while (ecafList != END_ECAF_LIST) { - StgCAF* caf = ecafList; - ecafList = caf->link; - ASSERT(get_itbl(caf)->type == CAF_ENTERED); - SET_INFO(caf,&CAF_UNENTERED_info); - caf->value = (StgClosure *)0xdeadbeef; - caf->link = (StgCAF *)0xdeadbeef; - } - - /* Empty out both the table and the list. */ - clearECafTable(); - ecafList = END_ECAF_LIST; -#endif + StgIndStatic *c; + + for (c = (StgIndStatic *)caf_list; c != NULL; + c = (StgIndStatic *)c->static_link) + { + c->header.info = c->saved_info; + c->saved_info = NULL; + /* could, but not necessary: c->static_link = NULL; */ + } + caf_list = NULL; } -//@node Sanity code for CAF garbage collection, Lazy black holing, Reverting CAFs -//@subsection Sanity code for CAF garbage collection +void +scavengeCAFs( void ) +{ + StgIndStatic *c; + + evac_gen = 0; + for (c = (StgIndStatic *)caf_list; c != NULL; + c = (StgIndStatic *)c->static_link) + { + c->indirectee = evacuate(c->indirectee); + } +} /* ----------------------------------------------------------------------------- Sanity code for CAF garbage collection. @@ -3288,16 +3296,20 @@ threadSqueezeStack(StgTSO *tso) frame, prev_frame); }) switch (get_itbl(frame)->type) { - case UPDATE_FRAME: upd_frames++; - if (frame->updatee->header.info == &stg_BLACKHOLE_info) - bhs++; - break; - case STOP_FRAME: stop_frames++; - break; - case CATCH_FRAME: catch_frames++; - break; - case SEQ_FRAME: seq_frames++; - break; + case UPDATE_FRAME: + upd_frames++; + if (frame->updatee->header.info == &stg_BLACKHOLE_info) + bhs++; + break; + case STOP_FRAME: + stop_frames++; + break; + case CATCH_FRAME: + catch_frames++; + break; + case SEQ_FRAME: + seq_frames++; + break; default: barf("Found non-frame during stack squeezing at %p (prev frame was %p)\n", frame, prev_frame); @@ -3401,8 +3413,18 @@ threadSqueezeStack(StgTSO *tso) /* wasn't there something about update squeezing and ticky to be * sorted out? oh yes: we aren't counting each enter properly * in this case. See the log somewhere. KSW 1999-04-21 + * + * Check two things: that the two update frames don't point to + * the same object, and that the updatee_bypass isn't already an + * indirection. Both of these cases only happen when we're in a + * block hole-style loop (and there are multiple update frames + * on the stack pointing to the same closure), but they can both + * screw us up if we don't check. */ - UPD_IND_NOLOCK(updatee_bypass, updatee_keep); /* this wakes the threads up */ + if (updatee_bypass != updatee_keep && !closure_IND(updatee_bypass)) { + /* this wakes the threads up */ + UPD_IND_NOLOCK(updatee_bypass, updatee_keep); + } sp = (P_)frame - 1; /* sp = stuff to slide */ displacement += sizeofW(StgUpdateFrame); @@ -3428,8 +3450,14 @@ threadSqueezeStack(StgTSO *tso) { StgInfoTable *info = get_itbl(bh); nat np = info->layout.payload.ptrs, nw = info->layout.payload.nptrs, i; - for (i = np; i < np + nw; i++) { + /* don't zero out slop for a THUNK_SELECTOR, because it's layout + * info is used for a different purpose, and it's exactly the + * same size as a BLACKHOLE in any case. + */ + if (info->type != THUNK_SELECTOR) { + for (i = np; i < np + nw; i++) { ((StgClosure *)bh)->payload[i] = 0; + } } } #endif