/* -----------------------------------------------------------------------------
- * $Id: GCCompact.c,v 1.2 2001/07/24 14:29:13 simonmar Exp $
+ * $Id: GCCompact.c,v 1.7 2001/08/08 13:44:13 simonmar Exp $
*
* (c) The GHC Team 2001
*
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
}
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);
}
}
{
StgPtr q;
const StgInfoTable* info;
- StgWord32 bitmap;
+ StgWord bitmap;
// highly similar to scavenge_stack, but we do pointer threading here.
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:
}
continue;
- // large bitmap (> 32 entries)
+ // large bitmap (> 32 entries, or 64 on a 64-bit machine)
case RET_BIG:
case RET_VEC_BIG:
{
for (i=0; i<large_bitmap->size; 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);
for (; bd != NULL; bd = bd->link) {
p = bd->start;
- unthread(p,p);
info = get_itbl((StgClosure *)p);
switch (info->type) {
{
StgTSO *tso = (StgTSO *)p;
thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
+ thread((StgPtr)&tso->link);
+ thread((StgPtr)&tso->global_link);
continue;
}
// 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)
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);
}
}
-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 )
{
}
#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;
}
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
return free_blocks;
}
-static void
-update_bkwd_large( bdescr *blocks )
-{
- bdescr *bd;
-
- for (bd = blocks; bd != NULL; bd = bd->link ) {
- unthread(bd->start, bd->start);
- }
-}
-
-
void
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((StgPtr)&generations[g].mut_once_list);
+ }
// the global thread list
thread((StgPtr)&all_threads);
}
// 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;
}
}