X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=a732d6d47fa0bf565b4f31e540908e0cc8fa5e32;hb=9ac55e08e159d7a4647ab01e7872e69dd762f275;hp=3ed912e7cfa7fcf0aa5bc2f38f9a59c3f14ce370;hpb=dd4c28a9c706cce09ecc2c6f532969efa925532f;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index 3ed912e..a732d6d 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.77 2000/03/31 03:09:36 hwloidl Exp $ + * $Id: GC.c,v 1.90 2000/12/04 12:31:20 simonmar Exp $ * * (c) The GHC Team 1998-1999 * @@ -37,6 +37,7 @@ #include "Sanity.h" #include "GC.h" #include "BlockAlloc.h" +#include "MBlock.h" #include "Main.h" #include "ProfHeap.h" #include "SchedAPI.h" @@ -52,8 +53,13 @@ # include "ParallelDebug.h" # endif #endif - -StgCAF* enteredCAFs; +#if defined(GHCI) +# include "HsFFI.h" +# include "Linker.h" +#endif +#if defined(RTS_GTK_FRONTPANEL) +#include "FrontPanel.h" +#endif //@node STATIC OBJECT LIST, Static function declarations, Includes //@subsection STATIC OBJECT LIST @@ -128,7 +134,6 @@ static rtsBool failed_to_evac; */ bdescr *old_to_space; - /* Data used for allocation area sizing. */ lnat new_blocks; /* blocks allocated during this GC */ @@ -144,7 +149,6 @@ lnat g0s0_pcnt_kept = 30; /* percentage of g0s0 live at last minor GC */ static StgClosure * evacuate ( StgClosure *q ); static void zero_static_object_list ( StgClosure* first_static ); static void zero_mutable_list ( StgMutClosure *first ); -static void revert_dead_CAFs ( void ); static rtsBool traverse_weak_ptr_list ( void ); static void cleanup_weak_ptr_list ( StgWeak **list ); @@ -187,7 +191,7 @@ static void gcCAFs ( void ); -------------------------------------------------------------------------- */ //@cindex GarbageCollect -void GarbageCollect(void (*get_roots)(void)) +void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc ) { bdescr *bd; step *step; @@ -212,18 +216,31 @@ void GarbageCollect(void (*get_roots)(void)) CCCS = CCS_GC; #endif - /* Approximate how much we allocated */ + /* Approximate how much we allocated. + * Todo: only when generating stats? + */ allocated = calcAllocated(); /* Figure out which generation to collect */ - N = 0; - for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - if (generations[g].steps[0].n_blocks >= generations[g].max_blocks) { - N = g; + if (force_major_gc) { + N = RtsFlags.GcFlags.generations - 1; + major_gc = rtsTrue; + } else { + N = 0; + for (g = 0; g < RtsFlags.GcFlags.generations; g++) { + if (generations[g].steps[0].n_blocks >= generations[g].max_blocks) { + N = g; + } } + major_gc = (N == RtsFlags.GcFlags.generations-1); } - major_gc = (N == RtsFlags.GcFlags.generations-1); + +#ifdef RTS_GTK_FRONTPANEL + if (RtsFlags.GcFlags.frontpanel) { + updateFrontPanelBeforeGC(N); + } +#endif /* check stack sanity *before* GC (ToDo: check all threads) */ #if defined(GRAN) @@ -481,9 +498,6 @@ void GarbageCollect(void (*get_roots)(void)) */ gcStablePtrTable(major_gc); - /* revert dead CAFs and update enteredCAFs list */ - revert_dead_CAFs(); - #if defined(PAR) /* Reconstruct the Global Address tables used in GUM */ rebuildGAtables(major_gc); @@ -759,6 +773,12 @@ void GarbageCollect(void (*get_roots)(void)) /* check for memory leaks if sanity checking is on */ IF_DEBUG(sanity, memInventory()); +#ifdef RTS_GTK_VISUALS + if (RtsFlags.GcFlags.visuals) { + updateFrontPanelAfterGC( N, live ); + } +#endif + /* ok, GC over: tell the stats department what happened. */ stat_endGC(allocated, collected, live, copied, N); } @@ -815,7 +835,7 @@ traverse_weak_ptr_list(void) /* There might be a DEAD_WEAK on the list if finalizeWeak# was * called on a live weak pointer object. Just remove it. */ - if (w->header.info == &DEAD_WEAK_info) { + if (w->header.info == &stg_DEAD_WEAK_info) { next_w = ((StgDeadWeak *)w)->link; *last_w = next_w; continue; @@ -861,12 +881,16 @@ traverse_weak_ptr_list(void) * the list. */ switch (t->what_next) { + case ThreadRelocated: + next = t->link; + *prev = next; + continue; case ThreadKilled: case ThreadComplete: - next = t->global_link; - *prev = next; - continue; - default: + next = t->global_link; + *prev = next; + continue; + default: ; } /* Threads which have already been determined to be alive are @@ -1066,7 +1090,7 @@ static void addBlock(step *step) static __inline__ void upd_evacuee(StgClosure *p, StgClosure *dest) { - p->header.info = &EVACUATED_info; + p->header.info = &stg_EVACUATED_info; ((StgEvacuated *)p)->evacuee = dest; } @@ -1241,7 +1265,7 @@ mkMutCons(StgClosure *ptr, generation *gen) q = (StgMutVar *)step->hp; step->hp += sizeofW(StgMutVar); - SET_HDR(q,&MUT_CONS_info,CCS_GC); + SET_HDR(q,&stg_MUT_CONS_info,CCS_GC); q->var = ptr; recordOldToNewPtrs((StgMutClosure *)q); @@ -1333,16 +1357,30 @@ loop: } case MUT_VAR: - ASSERT(q->header.info != &MUT_CONS_info); + ASSERT(q->header.info != &stg_MUT_CONS_info); case MVAR: to = copy(q,sizeW_fromITBL(info),step); recordMutable((StgMutClosure *)to); return to; + case CONSTR_0_1: + { + StgWord w = (StgWord)q->payload[0]; + if (q->header.info == Czh_con_info && + /* unsigned, so always true: (StgChar)w >= MIN_CHARLIKE && */ + (StgChar)w <= MAX_CHARLIKE) { + return (StgClosure *)CHARLIKE_CLOSURE((StgChar)w); + } + if (q->header.info == Izh_con_info && + (StgInt)w >= MIN_INTLIKE && (StgInt)w <= MAX_INTLIKE) { + return (StgClosure *)INTLIKE_CLOSURE((StgInt)w); + } + /* else, fall through ... */ + } + case FUN_1_0: case FUN_0_1: case CONSTR_1_0: - case CONSTR_0_1: return copy(q,sizeofW(StgHeader)+1,step); case THUNK_1_0: /* here because of MIN_UPD_SIZE */ @@ -1453,6 +1491,7 @@ loop: selectee = ((StgEvacuated *)selectee)->evacuee; goto selector_loop; + case AP_UPD: case THUNK: case THUNK_1_0: case THUNK_0_1: @@ -1633,7 +1672,6 @@ loop: /* relocate the stack pointers... */ new_tso->su = (StgUpdateFrame *) ((StgPtr)new_tso->su + diff); new_tso->sp = (StgPtr)new_tso->sp + diff; - new_tso->splim = (StgPtr)new_tso->splim + diff; relocate_TSO(tso, new_tso); @@ -1955,7 +1993,7 @@ scavenge(step *step) case IND_PERM: if (step->gen->no != 0) { - SET_INFO(((StgClosure *)p), &IND_OLDGEN_PERM_info); + SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info); } /* fall through */ case IND_OLDGEN_PERM: @@ -2001,7 +2039,7 @@ scavenge(step *step) case MUT_VAR: /* ignore MUT_CONSs */ - if (((StgMutVar *)p)->header.info != &MUT_CONS_info) { + if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) { evac_gen = 0; ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); evac_gen = saved_evac_gen; @@ -2413,7 +2451,7 @@ scavenge_mut_once_list(generation *gen) * it from the mutable list if possible by promoting whatever it * points to. */ - ASSERT(p->header.info == &MUT_CONS_info); + ASSERT(p->header.info == &stg_MUT_CONS_info); if (scavenge_one(((StgMutVar *)p)->var) == rtsTrue) { /* didn't manage to promote everything, so put the * MUT_CONS back on the list. @@ -2529,7 +2567,7 @@ scavenge_mutable_list(generation *gen) * it from the mutable list if possible by promoting whatever it * points to. */ - ASSERT(p->header.info != &MUT_CONS_info); + ASSERT(p->header.info != &stg_MUT_CONS_info); ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); p->mut_link = gen->mut_list; gen->mut_list = p; @@ -2752,7 +2790,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) const StgInfoTable* info; StgWord32 bitmap; - IF_DEBUG(sanity, belch(" scavenging stack between %p and %p", p, stack_end)); + //IF_DEBUG(sanity, belch(" scavenging stack between %p and %p", p, stack_end)); /* * Each time around this loop, we are looking at a chunk of stack @@ -3081,39 +3119,29 @@ zero_mutable_list( StgMutClosure *first ) void RevertCAFs(void) { - while (enteredCAFs != END_CAF_LIST) { - StgCAF* caf = enteredCAFs; - - enteredCAFs = caf->link; - ASSERT(get_itbl(caf)->type == CAF_ENTERED); - SET_INFO(caf,&CAF_UNENTERED_info); - caf->value = (StgClosure *)0xdeadbeef; - caf->link = (StgCAF *)0xdeadbeef; - } - enteredCAFs = END_CAF_LIST; -} - -//@cindex revert_dead_CAFs - -void revert_dead_CAFs(void) -{ - StgCAF* caf = enteredCAFs; - enteredCAFs = END_CAF_LIST; - while (caf != END_CAF_LIST) { - StgCAF *next, *new; - next = caf->link; - new = (StgCAF*)isAlive((StgClosure*)caf); - if (new) { - new->link = enteredCAFs; - enteredCAFs = new; - } else { - /* ASSERT(0); */ - SET_INFO(caf,&CAF_UNENTERED_info); - caf->value = (StgClosure*)0xdeadbeef; - caf->link = (StgCAF*)0xdeadbeef; - } - caf = next; - } +#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 } //@node Sanity code for CAF garbage collection, Lazy black holing, Reverting CAFs @@ -3155,7 +3183,7 @@ gcCAFs(void) if (STATIC_LINK(info,p) == NULL) { IF_DEBUG(gccafs, fprintf(stderr, "CAF gc'd at 0x%04x\n", (int)p)); /* black hole it */ - SET_INFO(p,&BLACKHOLE_info); + SET_INFO(p,&stg_BLACKHOLE_info); p = STATIC_LINK2(info,p); *pp = p; } @@ -3210,16 +3238,16 @@ threadLazyBlackHole(StgTSO *tso) * The blackhole made for a CAF is a CAF_BLACKHOLE, so they * don't interfere with this optimisation. */ - if (bh->header.info == &BLACKHOLE_info) { + if (bh->header.info == &stg_BLACKHOLE_info) { return; } - if (bh->header.info != &BLACKHOLE_BQ_info && - bh->header.info != &CAF_BLACKHOLE_info) { + if (bh->header.info != &stg_BLACKHOLE_BQ_info && + bh->header.info != &stg_CAF_BLACKHOLE_info) { #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) fprintf(stderr,"Unexpected lazy BHing required at 0x%04x\n",(int)bh); #endif - SET_INFO(bh,&BLACKHOLE_info); + SET_INFO(bh,&stg_BLACKHOLE_info); } update_frame = update_frame->link; @@ -3300,7 +3328,7 @@ threadSqueezeStack(StgTSO *tso) }) switch (get_itbl(frame)->type) { case UPDATE_FRAME: upd_frames++; - if (frame->updatee->header.info == &BLACKHOLE_info) + if (frame->updatee->header.info == &stg_BLACKHOLE_info) bhs++; break; case STOP_FRAME: stop_frames++; @@ -3316,7 +3344,7 @@ threadSqueezeStack(StgTSO *tso) } #endif if (get_itbl(frame)->type == UPDATE_FRAME - && frame->updatee->header.info == &BLACKHOLE_info) { + && frame->updatee->header.info == &stg_BLACKHOLE_info) { break; } } @@ -3382,11 +3410,11 @@ threadSqueezeStack(StgTSO *tso) # if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) # error Unimplemented lazy BH warning. (KSW 1999-01) # endif - if (GET_INFO(updatee_bypass) == BLACKHOLE_BQ_info - || GET_INFO(updatee_bypass) == CAF_BLACKHOLE_info + if (GET_INFO(updatee_bypass) == stg_BLACKHOLE_BQ_info + || GET_INFO(updatee_bypass) == stg_CAF_BLACKHOLE_info ) { /* Sigh. It has one. Don't lose those threads! */ - if (GET_INFO(updatee_keep) == BLACKHOLE_BQ_info) { + if (GET_INFO(updatee_keep) == stg_BLACKHOLE_BQ_info) { /* Urgh. Two queues. Merge them. */ P_ keep_tso = ((StgBlockingQueue *)updatee_keep)->blocking_queue; @@ -3426,13 +3454,25 @@ threadSqueezeStack(StgTSO *tso) */ if (is_update_frame) { StgBlockingQueue *bh = (StgBlockingQueue *)frame->updatee; - if (bh->header.info != &BLACKHOLE_info && - bh->header.info != &BLACKHOLE_BQ_info && - bh->header.info != &CAF_BLACKHOLE_info) { + if (bh->header.info != &stg_BLACKHOLE_info && + bh->header.info != &stg_BLACKHOLE_BQ_info && + bh->header.info != &stg_CAF_BLACKHOLE_info) { #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) fprintf(stderr,"Unexpected lazy BHing required at 0x%04x\n",(int)bh); #endif - SET_INFO(bh,&BLACKHOLE_info); +#ifdef DEBUG + /* zero out the slop so that the sanity checker can tell + * where the next closure is. + */ + { + StgInfoTable *info = get_itbl(bh); + nat np = info->layout.payload.ptrs, nw = info->layout.payload.nptrs, i; + for (i = np; i < np + nw; i++) { + ((StgClosure *)bh)->payload[i] = 0; + } + } +#endif + SET_INFO(bh,&stg_BLACKHOLE_info); } } @@ -3572,7 +3612,6 @@ maybeLarge(StgClosure *closure) //* printMutOnceList:: @cindex\s-+printMutOnceList //* printMutableList:: @cindex\s-+printMutableList //* relocate_TSO:: @cindex\s-+relocate_TSO -//* revert_dead_CAFs:: @cindex\s-+revert_dead_CAFs //* scavenge:: @cindex\s-+scavenge //* scavenge_large:: @cindex\s-+scavenge_large //* scavenge_mut_once_list:: @cindex\s-+scavenge_mut_once_list