X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=72338c0074aa252d6d5ec321046b145f87f9f3dc;hb=efa881239effd5ea4cb403c2c03ebb09fbdfd363;hp=f4308141ae83fdc38a2a317913afe7726faa4632;hpb=d50874325473c23699a7d77222b1902f28c942af;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index f430814..72338c0 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.78 2000/04/11 16:36:53 sewardj Exp $ + * $Id: GC.c,v 1.91 2000/12/11 12:36:59 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 ); @@ -212,7 +216,9 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc ) 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 @@ -230,6 +236,12 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc ) 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) // ToDo!: check sanity IF_DEBUG(sanity, checkTSOsSanity()); @@ -486,9 +498,6 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc ) */ 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); @@ -764,6 +773,12 @@ 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) { + updateFrontPanelAfterGC( N, live ); + } +#endif + /* ok, GC over: tell the stats department what happened. */ stat_endGC(allocated, collected, live, copied, N); } @@ -820,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; @@ -866,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 @@ -996,10 +1015,6 @@ isAlive(StgClosure *p) /* alive! */ return ((StgEvacuated *)p)->evacuee; - case BCO: - size = bco_sizeW((StgBCO*)p); - goto large; - case ARR_WORDS: size = arr_words_sizeW((StgArrWords *)p); goto large; @@ -1071,7 +1086,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; } @@ -1246,7 +1261,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); @@ -1323,31 +1338,31 @@ loop: switch (info -> type) { - case BCO: - { - nat size = bco_sizeW((StgBCO*)q); - - if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - evacuate_large((P_)q, rtsFalse); - to = q; - } else { - /* just copy the block */ - to = copy(q,size,step); - } - return to; - } - 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 */ @@ -1382,6 +1397,7 @@ loop: case WEAK: case FOREIGN: case STABLE_NAME: + case BCO: return copy(q,sizeW_fromITBL(info),step); case CAF_BLACKHOLE: @@ -1458,6 +1474,7 @@ loop: selectee = ((StgEvacuated *)selectee)->evacuee; goto selector_loop; + case AP_UPD: case THUNK: case THUNK_1_0: case THUNK_0_1: @@ -1638,7 +1655,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); @@ -1864,17 +1880,6 @@ scavenge(step *step) switch (info -> type) { - case BCO: - { - StgBCO* bco = (StgBCO *)p; - nat i; - for (i = 0; i < bco->n_ptrs; i++) { - bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i)); - } - p += bco_sizeW(bco); - break; - } - case MVAR: /* treat MVars specially, because we don't want to evacuate the * mut_link field in the middle of the closure. @@ -1947,6 +1952,7 @@ scavenge(step *step) case WEAK: case FOREIGN: case STABLE_NAME: + case BCO: { StgPtr end; @@ -1960,7 +1966,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: @@ -2006,7 +2012,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; @@ -2418,7 +2424,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. @@ -2534,7 +2540,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; @@ -2757,7 +2763,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 @@ -3005,18 +3011,6 @@ scavenge_large(step *step) continue; } - case BCO: - { - StgBCO* bco = (StgBCO *)p; - nat i; - evac_gen = saved_evac_gen; - for (i = 0; i < bco->n_ptrs; i++) { - bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i)); - } - evac_gen = 0; - continue; - } - case TSO: scavengeTSO((StgTSO *)p); continue; @@ -3086,39 +3080,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 @@ -3160,7 +3144,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; } @@ -3215,16 +3199,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; @@ -3305,7 +3289,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++; @@ -3321,7 +3305,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; } } @@ -3387,11 +3371,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; @@ -3431,13 +3415,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); } } @@ -3550,8 +3546,7 @@ maybeLarge(StgClosure *closure) return (info->type == MUT_ARR_PTRS || info->type == MUT_ARR_PTRS_FROZEN || info->type == TSO || - info->type == ARR_WORDS || - info->type == BCO); + info->type == ARR_WORDS); } @@ -3577,7 +3572,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