X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGC.c;h=0d2872ba04d132279e4637daf09c8e9e017014ad;hb=5bae664ba47e28edadd0539078754469e5bd04ac;hp=fa22b4e4f5cd1600694d4a38fc9ecd68acf05084;hpb=3ddfdc19e74af725239b7dfdec776d1d07847fc2;p=ghc-hetmet.git diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index fa22b4e..0d2872b 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.73 2000/03/16 17:27:12 simonmar Exp $ + * $Id: GC.c,v 1.83 2000/05/26 08:42:59 simonmar Exp $ * * (c) The GHC Team 1998-1999 * @@ -53,8 +53,6 @@ # endif #endif -StgCAF* enteredCAFs; - //@node STATIC OBJECT LIST, Static function declarations, Includes //@subsection STATIC OBJECT LIST @@ -144,7 +142,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 +184,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; @@ -200,7 +197,7 @@ void GarbageCollect(void (*get_roots)(void)) #if defined(DEBUG) && defined(GRAN) IF_DEBUG(gc, belch("@@ Starting garbage collection at %ld (%lx)\n", - Now, Now)) + Now, Now)); #endif /* tell the stats department that we've started a GC */ @@ -217,19 +214,24 @@ void GarbageCollect(void (*get_roots)(void)) /* 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); /* check stack sanity *before* GC (ToDo: check all threads) */ #if defined(GRAN) // ToDo!: check sanity IF_DEBUG(sanity, checkTSOsSanity()); #endif - IF_DEBUG(sanity, checkFreeListSanity()); + IF_DEBUG(sanity, checkFreeListSanity()); /* Initialise the static object lists */ @@ -426,6 +428,8 @@ void GarbageCollect(void (*get_roots)(void)) /* scavenge static objects */ if (major_gc && static_objects != END_OF_STATIC_LIST) { + IF_DEBUG(sanity, + checkStaticObjects()); scavenge_static(); } @@ -479,9 +483,13 @@ 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); + IF_DEBUG(sanity, checkGlobalTSOList(rtsTrue/*check TSOs, too*/)); + IF_DEBUG(sanity, checkLAGAtable(rtsTrue/*check closures, too*/)); +#endif + /* Set the maximum blocks for the oldest generation, based on twice * the amount of live data now, adjusted to fit the maximum heap * size if necessary. @@ -724,11 +732,6 @@ void GarbageCollect(void (*get_roots)(void)) */ resetNurseries(); -#if defined(PAR) - /* Reconstruct the Global Address tables used in GUM */ - RebuildGAtables(major_gc); -#endif - /* start any pending finalizers */ scheduleFinalizers(old_weak_ptr_list); @@ -856,12 +859,16 @@ traverse_weak_ptr_list(void) /* Threads which have finished or died get dropped from * the list. */ - switch (t->whatNext) { + switch (t->what_next) { + case ThreadRelocated: + next = t->link; + *prev = next; + continue; case ThreadKilled: case ThreadComplete: - next = t->global_link; - *prev = next; - continue; + next = t->global_link; + *prev = next; + continue; default: } @@ -967,14 +974,10 @@ isAlive(StgClosure *p) * for static closures with an empty SRT or CONSTR_STATIC_NOCAFs. */ -#if 1 || !defined(PAR) /* ignore closures in generations that we're not collecting. */ - /* In GUM we use this routine when rebuilding GA tables; for some - reason it has problems with the LOOKS_LIKE_STATIC macro -- HWL */ if (LOOKS_LIKE_STATIC(p) || Bdescr((P_)p)->gen->no > N) { return p; } -#endif switch (info->type) { @@ -1005,7 +1008,7 @@ isAlive(StgClosure *p) goto large; case TSO: - if (((StgTSO *)p)->whatNext == ThreadRelocated) { + if (((StgTSO *)p)->what_next == ThreadRelocated) { p = (StgClosure *)((StgTSO *)p)->link; continue; } @@ -1029,7 +1032,14 @@ isAlive(StgClosure *p) StgClosure * MarkRoot(StgClosure *root) { +# if 0 && defined(PAR) && defined(DEBUG) + StgClosure *foo = evacuate(root); + // ASSERT(closure_STATIC(foo) || maybeLarge(foo) || Bdescr(foo)->evacuated); + ASSERT(isAlive(foo)); // must be in to-space + return foo; +# else return evacuate(root); +# endif } //@cindex addBlock @@ -1446,6 +1456,7 @@ loop: selectee = ((StgEvacuated *)selectee)->evacuee; goto selector_loop; + case AP_UPD: case THUNK: case THUNK_1_0: case THUNK_0_1: @@ -1530,9 +1541,22 @@ loop: case AP_UPD: case PAP: - /* these are special - the payload is a copy of a chunk of stack, - tagging and all. */ - return copy(q,pap_sizeW((StgPAP *)q),step); + /* PAPs and AP_UPDs are special - the payload is a copy of a chunk + * of stack, tagging and all. + * + * They can be larger than a block in size. Both are only + * allocated via allocate(), so they should be chained on to the + * large_object list. + */ + { + nat size = pap_sizeW((StgPAP*)q); + if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { + evacuate_large((P_)q, rtsFalse); + return q; + } else { + return copy(q,size,step); + } + } case EVACUATED: /* Already evacuated, just return the forwarding address. @@ -1591,7 +1615,7 @@ loop: /* Deal with redirected TSOs (a TSO that's had its stack enlarged). */ - if (tso->whatNext == ThreadRelocated) { + if (tso->what_next == ThreadRelocated) { q = (StgClosure *)tso->link; goto loop; } @@ -1770,7 +1794,12 @@ scavengeTSO (StgTSO *tso) (StgClosure *)tso->link = evacuate((StgClosure *)tso->link); if ( tso->why_blocked == BlockedOnMVar || tso->why_blocked == BlockedOnBlackHole - || tso->why_blocked == BlockedOnException) { + || tso->why_blocked == BlockedOnException +#if defined(PAR) + || tso->why_blocked == BlockedOnGA + || tso->why_blocked == BlockedOnGA_NoSend +#endif + ) { tso->block_info.closure = evacuate(tso->block_info.closure); } if ( tso->blocked_exceptions != NULL ) { @@ -2166,10 +2195,12 @@ scavenge(step *step) #endif case EVACUATED: - barf("scavenge: unimplemented/strange closure type\n"); + barf("scavenge: unimplemented/strange closure type %d @ %p", + info->type, p); default: - barf("scavenge"); + barf("scavenge: unimplemented/strange closure type %d @ %p", + info->type, p); } /* If we didn't manage to promote all the objects pointed to by @@ -2281,7 +2312,7 @@ scavenge_one(StgClosure *p) break; default: - barf("scavenge_one: strange object"); + barf("scavenge_one: strange object %d", (int)(info->type)); } no_luck = failed_to_evac; @@ -2468,10 +2499,6 @@ scavenge_mutable_list(generation *gen) { StgPtr end, q; - IF_DEBUG(gc, - belch("@@ scavenge_mut_list: scavenging MUT_ARR_PTRS_FROZEN %p; size: %#x ; next: %p", - p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p), p->mut_link)); - end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); evac_gen = gen->no; for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) { @@ -2494,10 +2521,6 @@ scavenge_mutable_list(generation *gen) { StgPtr end, q; - IF_DEBUG(gc, - belch("@@ scavenge_mut_list: scavenging MUT_ARR_PTRS %p; size: %#x ; next: %p", - p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p), p->mut_link)); - end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) { (StgClosure *)*q = evacuate((StgClosure *)*q); @@ -2510,10 +2533,6 @@ scavenge_mutable_list(generation *gen) * it from the mutable list if possible by promoting whatever it * points to. */ - IF_DEBUG(gc, - belch("@@ scavenge_mut_list: scavenging MUT_VAR %p; var: %p ; next: %p", - p, ((StgMutVar *)p)->var, p->mut_link)); - ASSERT(p->header.info != &MUT_CONS_info); ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); p->mut_link = gen->mut_list; @@ -2523,11 +2542,6 @@ scavenge_mutable_list(generation *gen) case MVAR: { StgMVar *mvar = (StgMVar *)p; - - IF_DEBUG(gc, - belch("@@ scavenge_mut_list: scavenging MAVR %p; head: %p; tail: %p; value: %p ; next: %p", - mvar, mvar->head, mvar->tail, mvar->value, p->mut_link)); - (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head); (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail); (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value); @@ -2554,11 +2568,6 @@ scavenge_mutable_list(generation *gen) case BLACKHOLE_BQ: { StgBlockingQueue *bh = (StgBlockingQueue *)p; - - IF_DEBUG(gc, - belch("@@ scavenge_mut_list: scavenging BLACKHOLE_BQ (%p); next: %p", - p, p->mut_link)); - (StgClosure *)bh->blocking_queue = evacuate((StgClosure *)bh->blocking_queue); p->mut_link = gen->mut_list; @@ -2587,7 +2596,60 @@ scavenge_mutable_list(generation *gen) } continue; - // HWL: old PAR code deleted here +#if defined(PAR) + // HWL: check whether all of these are necessary + + case RBH: // cf. BLACKHOLE_BQ + { + // nat size, ptrs, nonptrs, vhs; + // char str[80]; + // StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str); + StgRBH *rbh = (StgRBH *)p; + (StgClosure *)rbh->blocking_queue = + evacuate((StgClosure *)rbh->blocking_queue); + if (failed_to_evac) { + failed_to_evac = rtsFalse; + recordMutable((StgMutClosure *)rbh); + } + // ToDo: use size of reverted closure here! + p += BLACKHOLE_sizeW(); + break; + } + + case BLOCKED_FETCH: + { + StgBlockedFetch *bf = (StgBlockedFetch *)p; + /* follow the pointer to the node which is being demanded */ + (StgClosure *)bf->node = + evacuate((StgClosure *)bf->node); + /* follow the link to the rest of the blocking queue */ + (StgClosure *)bf->link = + evacuate((StgClosure *)bf->link); + if (failed_to_evac) { + failed_to_evac = rtsFalse; + recordMutable((StgMutClosure *)bf); + } + p += sizeofW(StgBlockedFetch); + break; + } + + case FETCH_ME: + p += sizeofW(StgFetchMe); + break; // nothing to do in this case + + case FETCH_ME_BQ: // cf. BLACKHOLE_BQ + { + StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p; + (StgClosure *)fmbq->blocking_queue = + evacuate((StgClosure *)fmbq->blocking_queue); + if (failed_to_evac) { + failed_to_evac = rtsFalse; + recordMutable((StgMutClosure *)fmbq); + } + p += sizeofW(StgFetchMeBlockingQueue); + break; + } +#endif default: /* shouldn't have anything else on the mutables list */ @@ -2667,12 +2729,12 @@ scavenge_static(void) } default: - barf("scavenge_static"); + barf("scavenge_static: strange closure %d", (int)(info->type)); } ASSERT(failed_to_evac == rtsFalse); - /* get the next static object from the list. Remeber, there might + /* get the next static object from the list. Remember, there might * be more stuff on this list now that we've done some evacuating! * (static_objects is a global) */ @@ -2694,7 +2756,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 @@ -2813,18 +2875,6 @@ scavenge_stack(StgPtr p, StgPtr stack_end) case STOP_FRAME: case CATCH_FRAME: case SEQ_FRAME: - { - // StgPtr old_p = p; // debugging only -- HWL - /* stack frames like these are ordinary closures and therefore may - contain setup-specific fixed-header words (as in GranSim!); - therefore, these cases should not use p++ but &(p->payload) -- HWL */ - // IF_DEBUG(gran, IF_DEBUG(sanity, printObj(p))); - bitmap = info->layout.bitmap; - - p = (StgPtr)&(((StgClosure *)p)->payload); - // IF_DEBUG(sanity, belch("HWL: scavenge_stack: (STOP|CATCH|SEQ)_FRAME adjusting p from %p to %p (instead of %p)", old_p, p, old_p+1)); - goto small_bitmap; - } case RET_BCO: case RET_SMALL: case RET_VEC_SMALL: @@ -2878,7 +2928,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) } default: - barf("scavenge_stack: weird activation record found on stack.\n"); + barf("scavenge_stack: weird activation record found on stack: %d", (int)(info->type)); } } } @@ -2968,11 +3018,22 @@ scavenge_large(step *step) case TSO: scavengeTSO((StgTSO *)p); - // HWL: old PAR code deleted here continue; + case AP_UPD: + case PAP: + { + StgPAP* pap = (StgPAP *)p; + + evac_gen = saved_evac_gen; /* not really mutable */ + pap->fun = evacuate(pap->fun); + scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args); + evac_gen = 0; + continue; + } + default: - barf("scavenge_large: unknown/strange object"); + barf("scavenge_large: unknown/strange object %d", (int)(info->type)); } } } @@ -3024,39 +3085,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 @@ -3429,7 +3480,6 @@ threadSqueezeStack(StgTSO *tso) * turned on. * -------------------------------------------------------------------------- */ //@cindex threadPaused - void threadPaused(StgTSO *tso) { @@ -3467,16 +3517,33 @@ printMutableList(generation *gen) { StgMutClosure *p, *next; - p = gen->saved_mut_list; + p = gen->mut_list; next = p->mut_link; - fprintf(stderr, "@@ Mutable list %p: ", gen->saved_mut_list); + fprintf(stderr, "@@ Mutable list %p: ", gen->mut_list); for (; p != END_MUT_LIST; p = next, next = p->mut_link) { fprintf(stderr, "%p (%s), ", p, info_type((StgClosure *)p)); } fputc('\n', stderr); } + +//@cindex maybeLarge +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 == TSO || + info->type == ARR_WORDS || + info->type == BCO); +} + + #endif /* DEBUG */ //@node Index, , Pausing a thread @@ -3494,9 +3561,11 @@ printMutableList(generation *gen) //* evacuate_large:: @cindex\s-+evacuate_large //* gcCAFs:: @cindex\s-+gcCAFs //* isAlive:: @cindex\s-+isAlive +//* maybeLarge:: @cindex\s-+maybeLarge //* mkMutCons:: @cindex\s-+mkMutCons +//* 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