From: simonm Date: Fri, 5 Feb 1999 14:45:43 +0000 (+0000) Subject: [project @ 1999-02-05 14:45:42 by simonm] X-Git-Tag: Approximately_9120_patches~6595 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4c47c22c37844784894dfadbf91d749fcafeef9d;p=ghc-hetmet.git [project @ 1999-02-05 14:45:42 by simonm] --- diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index a5abcd9..ffb58e9 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.23 1999/02/02 14:21:29 simonm Exp $ + * $Id: GC.c,v 1.24 1999/02/05 14:45:42 simonm Exp $ * * Two-space garbage collector * @@ -103,8 +103,8 @@ static void scavenge_stack(StgPtr p, StgPtr stack_end); static void scavenge_large(step *step); static void scavenge(step *step); static void scavenge_static(void); -static StgMutClosure *scavenge_mutable_list(StgMutClosure *p, nat gen); -static StgMutClosure *scavenge_mut_once_list(StgMutClosure *p, nat gen); +static void scavenge_mutable_list(generation *g); +static void scavenge_mut_once_list(generation *g); #ifdef DEBUG static void gcCAFs(void); @@ -285,25 +285,27 @@ void GarbageCollect(void (*get_roots)(void)) * it has already been evaced to gen 2. */ { - StgMutClosure *tmp, **pp; - for (g = N+1; g < RtsFlags.GcFlags.generations; g++) { + int st; + for (g = RtsFlags.GcFlags.generations-1; g > N; g--) { generations[g].saved_mut_list = generations[g].mut_list; generations[g].mut_list = END_MUT_LIST; } /* Do the mut-once lists first */ for (g = RtsFlags.GcFlags.generations-1; g > N; g--) { - generations[g].mut_once_list = - scavenge_mut_once_list(generations[g].mut_once_list, g); + scavenge_mut_once_list(&generations[g]); + evac_gen = g; + for (st = generations[g].n_steps-1; st >= 0; st--) { + scavenge(&generations[g].steps[st]); + } } for (g = RtsFlags.GcFlags.generations-1; g > N; g--) { - tmp = scavenge_mutable_list(generations[g].saved_mut_list, g); - pp = &generations[g].mut_list; - while (*pp != END_MUT_LIST) { - pp = &(*pp)->mut_link; + scavenge_mutable_list(&generations[g]); + evac_gen = g; + for (st = generations[g].n_steps-1; st >= 0; st--) { + scavenge(&generations[g].steps[st]); } - *pp = tmp; } } @@ -381,18 +383,21 @@ void GarbageCollect(void (*get_roots)(void)) /* scavenge each step in generations 0..maxgen */ { - int gen; + int gen, st; + loop2: for (gen = RtsFlags.GcFlags.generations-1; gen >= 0; gen--) { - for (s = 0; s < generations[gen].n_steps; s++) { - step = &generations[gen].steps[s]; + for (st = generations[gen].n_steps-1; st >= 0 ; st--) { + step = &generations[gen].steps[st]; evac_gen = gen; if (step->hp_bd != step->scan_bd || step->scan < step->hp) { scavenge(step); flag = rtsTrue; + goto loop2; } if (step->new_large_objects != NULL) { scavenge_large(step); flag = rtsTrue; + goto loop2; } } } @@ -1821,20 +1826,20 @@ scavenge_one(StgClosure *p) remove non-mutable objects from the mutable list at this point. -------------------------------------------------------------------------- */ -static StgMutClosure * -scavenge_mut_once_list(StgMutClosure *p, nat gen) +static void +scavenge_mut_once_list(generation *gen) { StgInfoTable *info; - StgMutClosure *start; - StgMutClosure **prev; + StgMutClosure *p, *next, *new_list; - prev = &start; - start = p; + p = gen->mut_once_list; + new_list = END_MUT_LIST; + next = p->mut_link; - evac_gen = gen; + evac_gen = gen->no; failed_to_evac = rtsFalse; - for (; p != END_MUT_LIST; p = *prev) { + for (; p != END_MUT_LIST; p = next, next = p->mut_link) { /* make sure the info pointer is into text space */ ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p)) @@ -1852,6 +1857,31 @@ scavenge_mut_once_list(StgMutClosure *p, nat gen) ((StgIndOldGen *)p)->indirectee = evacuate(((StgIndOldGen *)p)->indirectee); +#if 0 + /* Debugging code to print out the size of the thing we just + * promoted + */ + { + StgPtr start = gen->steps[0].scan; + bdescr *start_bd = gen->steps[0].scan_bd; + nat size = 0; + scavenge(&gen->steps[0]); + if (start_bd != gen->steps[0].scan_bd) { + size += (P_)BLOCK_ROUND_UP(start) - start; + start_bd = start_bd->link; + while (start_bd != gen->steps[0].scan_bd) { + size += BLOCK_SIZE_W; + start_bd = start_bd->link; + } + size += gen->steps[0].scan - + (P_)BLOCK_ROUND_DOWN(gen->steps[0].scan); + } else { + size = gen->steps[0].scan - start; + } + fprintf(stderr,"evac IND_OLDGEN: %d bytes\n", size * sizeof(W_)); + } +#endif + /* failed_to_evac might happen if we've got more than two * generations, we're collecting only generation 0, the * indirection resides in generation 2 and the indirectee is @@ -1859,9 +1889,9 @@ scavenge_mut_once_list(StgMutClosure *p, nat gen) */ if (failed_to_evac) { failed_to_evac = rtsFalse; - prev = &p->mut_link; + p->mut_link = new_list; + new_list = p; } else { - *prev = p->mut_link; /* the mut_link field of an IND_STATIC is overloaded as the * static link field too (it just so happens that we don't need * both at the same time), so we need to NULL it out when @@ -1880,13 +1910,12 @@ scavenge_mut_once_list(StgMutClosure *p, nat gen) */ ASSERT(p->header.info == &MUT_CONS_info); if (scavenge_one(((StgMutVar *)p)->var) == rtsTrue) { - /* didn't manage to promote everything, so leave the - * MUT_CONS on the list. + /* didn't manage to promote everything, so put the + * MUT_CONS back on the list. */ - prev = &p->mut_link; - } else { - *prev = p->mut_link; - } + p->mut_link = new_list; + new_list = p; + } continue; default: @@ -1894,25 +1923,25 @@ scavenge_mut_once_list(StgMutClosure *p, nat gen) barf("scavenge_mut_once_list: strange object?"); } } - return start; + + gen->mut_once_list = new_list; } -static StgMutClosure * -scavenge_mutable_list(StgMutClosure *p, nat gen) +static void +scavenge_mutable_list(generation *gen) { StgInfoTable *info; - StgMutClosure *start; - StgMutClosure **prev; + StgMutClosure *p, *next, *new_list; - evac_gen = 0; - - prev = &start; - start = p; + p = gen->saved_mut_list; + new_list = END_MUT_LIST; + next = p->mut_link; + evac_gen = 0; failed_to_evac = rtsFalse; - for (; p != END_MUT_LIST; p = *prev) { + for (; p != END_MUT_LIST; p = next, next = p->mut_link) { /* make sure the info pointer is into text space */ ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p)) @@ -1929,7 +1958,7 @@ scavenge_mutable_list(StgMutClosure *p, nat gen) StgPtr end, q; end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p); - evac_gen = gen; + evac_gen = gen->no; for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) { (StgClosure *)*q = evacuate((StgClosure *)*q); } @@ -1937,16 +1966,16 @@ scavenge_mutable_list(StgMutClosure *p, nat gen) if (failed_to_evac) { failed_to_evac = rtsFalse; - prev = &p->mut_link; - } else { - *prev = p->mut_link; - } + p->mut_link = new_list; + new_list = p; + } continue; } case MUT_ARR_PTRS: /* follow everything */ - prev = &p->mut_link; + p->mut_link = new_list; + new_list = p; { StgPtr end, q; @@ -1964,7 +1993,8 @@ scavenge_mutable_list(StgMutClosure *p, nat gen) */ ASSERT(p->header.info != &MUT_CONS_info); ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var); - prev = &p->mut_link; + p->mut_link = new_list; + new_list = p; continue; case MVAR: @@ -1973,7 +2003,8 @@ scavenge_mutable_list(StgMutClosure *p, nat gen) (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head); (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail); (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value); - prev = &p->mut_link; + p->mut_link = new_list; + new_list = p; continue; } @@ -1996,7 +2027,8 @@ scavenge_mutable_list(StgMutClosure *p, nat gen) * point to some younger objects (because we set evac_gen to 0 * above). */ - prev = &tso->mut_link; + tso->mut_link = new_list; + new_list = (StgMutClosure *)tso; continue; } @@ -2005,8 +2037,9 @@ scavenge_mutable_list(StgMutClosure *p, nat gen) StgBlockingQueue *bh = (StgBlockingQueue *)p; (StgClosure *)bh->blocking_queue = evacuate((StgClosure *)bh->blocking_queue); - prev = &p->mut_link; - break; + p->mut_link = new_list; + new_list = p; + continue; } default: @@ -2014,7 +2047,8 @@ scavenge_mutable_list(StgMutClosure *p, nat gen) barf("scavenge_mut_list: strange object?"); } } - return start; + + gen->mut_list = new_list; } static void diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index 2c8dc38..88f8904 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Storage.c,v 1.9 1999/02/02 14:21:33 simonm Exp $ + * $Id: Storage.c,v 1.10 1999/02/05 14:45:43 simonm Exp $ * * Storage manager front end * @@ -133,12 +133,17 @@ initStorage (void) /* generation 0 is special: that's the nursery */ generations[0].max_blocks = 0; - /* G0S0: the allocation area */ + /* G0S0: the allocation area. Policy: keep the allocation area + * small to begin with, even if we have a large suggested heap + * size. Reason: we're going to do a major collection first, and we + * don't want it to be a big one. This vague idea is borne out by + * rigorous experimental evidence. + */ step = &generations[0].steps[0]; g0s0 = step; - step->blocks = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize); - step->n_blocks = RtsFlags.GcFlags.minAllocAreaSize; nursery_blocks = RtsFlags.GcFlags.minAllocAreaSize; + step->blocks = allocNursery(NULL, nursery_blocks); + step->n_blocks = nursery_blocks; current_nursery = step->blocks; /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */