X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FGCUtils.c;h=4432ad6ce5181f893b3ff0b2c27d422464b08201;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hp=0e20c46bee8ed53f4c22641d928427548b95fdbb;hpb=baf34c5931e931566d0a6d3f892db43db7ed8f46;p=ghc-hetmet.git diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c index 0e20c46..4432ad6 100644 --- a/rts/sm/GCUtils.c +++ b/rts/sm/GCUtils.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The GHC Team 1998-2006 + * (c) The GHC Team 1998-2008 * * Generational garbage collector: utilities * @@ -15,6 +15,7 @@ #include "RtsFlags.h" #include "Storage.h" #include "GC.h" +#include "GCThread.h" #include "GCUtils.h" #include "Printer.h" #include "Trace.h" @@ -33,6 +34,31 @@ allocBlock_sync(void) return bd; } + +#if 0 +static void +allocBlocks_sync(nat n, bdescr **hd, bdescr **tl, + nat gen_no, step *stp, + StgWord32 flags) +{ + bdescr *bd; + nat i; + ACQUIRE_SPIN_LOCK(&gc_alloc_block_sync); + bd = allocGroup(n); + for (i = 0; i < n; i++) { + bd[i].blocks = 1; + bd[i].gen_no = gen_no; + bd[i].step = stp; + bd[i].flags = flags; + bd[i].link = &bd[i+1]; + bd[i].u.scan = bd[i].free = bd[i].start; + } + *hd = bd; + *tl = &bd[n-1]; + RELEASE_SPIN_LOCK(&gc_alloc_block_sync); +} +#endif + void freeChain_sync(bdescr *bd) { @@ -115,15 +141,13 @@ todo_block_full (nat size, step_workspace *ws) ASSERT(bd->link == NULL); ASSERT(bd->step == ws->step); - bd->free = ws->todo_free; - // If the global list is not empty, or there's not much work in // this block to push, and there's enough room in // this block to evacuate the current object, then just increase // the limit. if (ws->step->todos != NULL || - (bd->free - bd->u.scan < WORK_UNIT_WORDS / 2)) { - if (bd->free + size < bd->start + BLOCK_SIZE_W) { + (ws->todo_free - bd->u.scan < WORK_UNIT_WORDS / 2)) { + if (ws->todo_free + size < bd->start + BLOCK_SIZE_W) { ws->todo_lim = stg_min(bd->start + BLOCK_SIZE_W, ws->todo_lim + stg_max(WORK_UNIT_WORDS,size)); debugTrace(DEBUG_gc, "increasing limit for %p to %p", bd->start, ws->todo_lim); @@ -131,11 +155,14 @@ todo_block_full (nat size, step_workspace *ws) } } + gct->copied += ws->todo_free - bd->free; + bd->free = ws->todo_free; + ASSERT(bd->u.scan >= bd->start && bd->u.scan <= bd->free); // If this block is not the scan block, we want to push it out and // make room for a new todo block. - if (bd != ws->scan_bd) + if (bd != gct->scan_bd) { // If this block does not have enough space to allocate the // current object, but it also doesn't have any work to push, then @@ -151,8 +178,9 @@ todo_block_full (nat size, step_workspace *ws) { step *stp; stp = ws->step; - trace(TRACE_gc|DEBUG_gc, "push todo block %p (%d words), step %d, n_todos: %d", - bd->start, bd->free - bd->u.scan, stp->abs_no, stp->n_todos); + trace(TRACE_gc|DEBUG_gc, "push todo block %p (%ld words), step %d, n_todos: %d", + bd->start, (unsigned long)(bd->free - bd->u.scan), + stp->abs_no, stp->n_todos); // ToDo: use buffer_todo ACQUIRE_SPIN_LOCK(&stp->sync_todo); if (stp->todos_last == NULL) { @@ -179,7 +207,7 @@ todo_block_full (nat size, step_workspace *ws) StgPtr alloc_todo_block (step_workspace *ws, nat size) { - bdescr *bd; + bdescr *bd/*, *hd, *tl*/; // Grab a part block if we have one, and it has enough room if (ws->part_list != NULL && @@ -191,18 +219,22 @@ alloc_todo_block (step_workspace *ws, nat size) } else { + // blocks in to-space get the BF_EVACUATED flag. + +// allocBlocks_sync(4, &hd, &tl, +// ws->step->gen_no, ws->step, BF_EVACUATED); +// +// tl->link = ws->part_list; +// ws->part_list = hd->link; +// ws->n_part_blocks += 3; +// +// bd = hd; + bd = allocBlock_sync(); - bd->gen_no = ws->step->gen_no; bd->step = ws->step; - bd->u.scan = bd->start; - - // blocks in to-space in generations up to and including N - // get the BF_EVACUATED flag. - if (ws->step->gen_no <= N) { - bd->flags = BF_EVACUATED; - } else { - bd->flags = 0; - } + bd->gen_no = ws->step->gen_no; + bd->flags = BF_EVACUATED; + bd->u.scan = bd->free = bd->start; } bd->link = NULL;