X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FGCCompact.c;h=3254ba624a2670515b24e815a80d7ec3ed0a3ba7;hb=b8b6d871386ce70c5bf54f3bd91efa2dc7364eb7;hp=e954bc9f5e82a37c0e6f5f62940f29712a9dcdca;hpb=5d38ec160389ca25b405da32a8d94e2ed97d9bf4;p=ghc-hetmet.git diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c index e954bc9..3254ba6 100644 --- a/ghc/rts/GCCompact.c +++ b/ghc/rts/GCCompact.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GCCompact.c,v 1.2 2001/07/24 14:29:13 simonmar Exp $ + * $Id: GCCompact.c,v 1.9 2001/08/14 13:40:09 sewardj Exp $ * * (c) The GHC Team 2001 * @@ -7,6 +7,7 @@ * * ---------------------------------------------------------------------------*/ +#include "PosixSource.h" #include "Rts.h" #include "RtsUtils.h" #include "RtsFlags.h" @@ -45,9 +46,16 @@ static inline void thread( StgPtr p ) { StgPtr q = (StgPtr)*p; + bdescr *bd; + ASSERT(!LOOKS_LIKE_GHC_INFO(q)); if (HEAP_ALLOCED(q)) { - if (Bdescr(q)->gen_no > 0) { + bd = Bdescr(q); + // a handy way to discover whether the ptr is into the + // compacted area of the old gen, is that the EVACUATED flag + // is zero (it's non-zero for all the other areas of live + // memory). + if ((bd->flags & BF_EVACUATED) == 0) { *p = (StgWord)*q; *q = (StgWord)p + 1; // set the low bit } @@ -141,18 +149,23 @@ thread_static( StgClosure* p ) case IND_STATIC: thread((StgPtr)&((StgInd *)p)->indirectee); - break; + p = IND_STATIC_LINK(p); + continue; case THUNK_STATIC: + p = THUNK_STATIC_LINK(p); + continue; case FUN_STATIC: + p = FUN_STATIC_LINK(p); + continue; case CONSTR_STATIC: - break; + p = STATIC_LINK(info,p); + continue; default: barf("thread_static: strange closure %d", (int)(info->type)); } - p = STATIC_LINK(info,p); } } @@ -161,7 +174,7 @@ thread_stack(StgPtr p, StgPtr stack_end) { StgPtr q; const StgInfoTable* info; - StgWord32 bitmap; + StgWord bitmap; // highly similar to scavenge_stack, but we do pointer threading here. @@ -201,7 +214,7 @@ thread_stack(StgPtr p, StgPtr stack_end) p++; continue; - // small bitmap (< 32 entries, or 64 on a 64-bit machine) + // small bitmap (<= 32 entries, or 64 on a 64-bit machine) case UPDATE_FRAME: case STOP_FRAME: case CATCH_FRAME: @@ -222,7 +235,7 @@ thread_stack(StgPtr p, StgPtr stack_end) } continue; - // large bitmap (> 32 entries) + // large bitmap (> 32 entries, or 64 on a 64-bit machine) case RET_BIG: case RET_VEC_BIG: { @@ -235,7 +248,7 @@ thread_stack(StgPtr p, StgPtr stack_end) for (i=0; isize; i++) { bitmap = large_bitmap->bitmap[i]; - q = p + sizeof(W_) * 8; + q = p + BITS_IN(W_); while (bitmap != 0) { if ((bitmap & 1) == 0) { thread(p); @@ -269,7 +282,6 @@ update_fwd_large( bdescr *bd ) for (; bd != NULL; bd = bd->link) { p = bd->start; - unthread(p,p); info = get_itbl((StgClosure *)p); switch (info->type) { @@ -295,6 +307,8 @@ update_fwd_large( bdescr *bd ) { StgTSO *tso = (StgTSO *)p; thread_stack(tso->sp, &(tso->stack[tso->stack_size])); + thread((StgPtr)&tso->link); + thread((StgPtr)&tso->global_link); continue; } @@ -333,8 +347,6 @@ update_fwd( bdescr *blocks ) // linearly scan the objects in this block while (p < bd->free) { - /* unthread the info ptr */ - unthread(p,p); info = get_itbl((StgClosure *)p); ASSERT(p && (LOOKS_LIKE_GHC_INFO(info) @@ -435,18 +447,11 @@ update_fwd( bdescr *blocks ) break; } - // specialise this case, because we want to update the - // mut_link field too. case IND_OLDGEN: case IND_OLDGEN_PERM: - { - StgIndOldGen *ind = (StgIndOldGen *)p; - thread((StgPtr)&ind->indirectee); - if (ind->mut_link != NULL) { - thread((StgPtr)&ind->mut_link); - } + thread((StgPtr)&((StgIndOldGen *)p)->indirectee); + p += sizeofW(StgIndOldGen); break; - } case THUNK_SELECTOR: { @@ -650,17 +655,9 @@ update_fwd_compact( bdescr *blocks ) case IND_OLDGEN: case IND_OLDGEN_PERM: - // specialise this case, because we want to update the - // mut_link field too. - { - StgIndOldGen *ind = (StgIndOldGen *)p; - thread((StgPtr)&ind->indirectee); - if (ind->mut_link != NULL) { - thread((StgPtr)&ind->mut_link); - } + thread((StgPtr)&((StgIndOldGen *)p)->indirectee); p += sizeofW(StgIndOldGen); break; - } case THUNK_SELECTOR: { @@ -714,8 +711,15 @@ update_fwd_compact( bdescr *blocks ) size = p - q; if (free + size > free_bd->start + BLOCK_SIZE_W) { + // unset the next bit in the bitmap to indicate that + // this object needs to be pushed into the next + // block. This saves us having to run down the + // threaded info pointer list twice during the next pass. + unmark(q+1,bd); free_bd = free_bd->link; free = free_bd->start; + } else { + ASSERT(is_marked(q+1,bd)); } unthread(q,free); @@ -727,38 +731,6 @@ update_fwd_compact( bdescr *blocks ) } } -static void -update_bkwd( bdescr *blocks ) -{ - StgPtr p; - bdescr *bd; - StgInfoTable *info; - - bd = blocks; - -#if defined(PAR) - barf("update_bkwd: ToDo"); -#endif - - // cycle through all the blocks in the step - for (; bd != NULL; bd = bd->link) { - p = bd->start; - - // linearly scan the objects in this block - while (p < bd->free) { - - // must unthread before we look at the info ptr... - unthread(p,p); - - info = get_itbl((StgClosure *)p); - ASSERT(p && (LOOKS_LIKE_GHC_INFO(info) - || IS_HUGS_CONSTR_INFO(info))); - - p += obj_sizeW((StgClosure *)p,info); - } - } -} - static nat update_bkwd_compact( step *stp ) { @@ -807,15 +779,7 @@ update_bkwd_compact( step *stp ) } #endif - // must unthread before we look at the info ptr... - info = get_threaded_info(p); - - ASSERT(p && (LOOKS_LIKE_GHC_INFO(info) - || IS_HUGS_CONSTR_INFO(info))); - - size = obj_sizeW((StgClosure *)p,info); - - if (free + size > free_bd->start + BLOCK_SIZE_W) { + if (!is_marked(p+1,bd)) { // don't forget to update the free ptr in the block desc. free_bd->free = free; free_bd = free_bd->link; @@ -824,11 +788,17 @@ update_bkwd_compact( step *stp ) } unthread(p,free); - move(free,p,size); + info = get_itbl((StgClosure *)p); + size = obj_sizeW((StgClosure *)p,info); + + ASSERT(p && (LOOKS_LIKE_GHC_INFO(info) + || IS_HUGS_CONSTR_INFO(info))); + + if (free != p) { + move(free,p,size); + } // Rebuild the mutable list for the old generation. - // (the mut_once list is updated using threading, with - // special cases for IND_OLDGEN and MUT_CONS above). if (ip_MUTABLE(info)) { recordMutable((StgMutClosure *)free); } @@ -855,19 +825,21 @@ update_bkwd_compact( step *stp ) stp->n_blocks = free_blocks; return free_blocks; -} +} static void -update_bkwd_large( bdescr *blocks ) +thread_mut_once_list( generation *g ) { - bdescr *bd; + StgMutClosure *p, *next; - for (bd = blocks; bd != NULL; bd = bd->link ) { - unthread(bd->start, bd->start); + for (p = g->mut_once_list; p != END_MUT_LIST; p = next) { + next = p->mut_link; + thread((StgPtr)&p->mut_link); } + + thread((StgPtr)&g->mut_once_list); } - void compact( void (*get_roots)(evac_fn) ) { @@ -886,9 +858,11 @@ compact( void (*get_roots)(evac_fn) ) thread((StgPtr)&old_weak_ptr_list); // tmp } - // mutable lists (ToDo: all gens) - thread((StgPtr)&oldest_gen->mut_list); - thread((StgPtr)&oldest_gen->mut_once_list); + // mutable lists + for (g = 1; g < RtsFlags.GcFlags.generations; g++) { + thread((StgPtr)&generations[g].mut_list); + thread_mut_once_list(&generations[g]); + } // the global thread list thread((StgPtr)&all_threads); @@ -915,20 +889,12 @@ compact( void (*get_roots)(evac_fn) ) } // 3. update backward ptrs - for (g = 0; g < RtsFlags.GcFlags.generations; g++) { - for (s = 0; s < generations[g].n_steps; s++) { - stp = &generations[g].steps[s]; - IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d\n", stp->gen->no, stp->no);); - update_bkwd(stp->to_blocks); - update_bkwd_large(stp->scavenged_large_objects); - if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) { - IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact)\n", stp->gen->no, stp->no);); - blocks = update_bkwd_compact(stp); - IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", - stp->gen->no, stp->no, - stp->n_blocks, blocks);); - stp->n_blocks = blocks; - } - } + stp = &oldest_gen->steps[0]; + if (stp->blocks != NULL) { + blocks = update_bkwd_compact(stp); + IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", + stp->gen->no, stp->no, + stp->n_blocks, blocks);); + stp->n_blocks = blocks; } }