/* -----------------------------------------------------------------------------
- * $Id: GCCompact.c,v 1.4 2001/07/25 11:55:57 simonmar Exp $
+ * $Id: GCCompact.c,v 1.11 2001/12/11 12:03:23 simonmar Exp $
*
* (c) The GHC Team 2001
*
*
* ---------------------------------------------------------------------------*/
+#include "PosixSource.h"
#include "Rts.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
{
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);
{
StgTSO *tso = (StgTSO *)p;
thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
+ thread((StgPtr)&tso->link);
+ thread((StgPtr)&tso->global_link);
continue;
}
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:
{
update_fwd_compact( bdescr *blocks )
{
StgPtr p, q, free;
+#if 0
StgWord m;
+#endif
bdescr *bd, *free_bd;
StgInfoTable *info;
nat size;
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:
{
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);
update_bkwd_compact( step *stp )
{
StgPtr p, free;
+#if 0
StgWord m;
+#endif
bdescr *bd, *free_bd;
StgInfoTable *info;
nat size, free_blocks;
}
#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);
+ 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);
}
stp->n_blocks = free_blocks;
return free_blocks;
-}
+}
+
+static void
+thread_mut_once_list( generation *g )
+{
+ StgMutClosure *p, *next;
+
+ 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) )
// mutable lists
for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
thread((StgPtr)&generations[g].mut_list);
- thread((StgPtr)&generations[g].mut_once_list);
+ thread_mut_once_list(&generations[g]);
}
// the global thread list
// the stable pointer table
threadStablePtrTable((evac_fn)thread);
+ // the CAF list (used by GHCi)
+ markCAFs((evac_fn)thread);
+
// 2. update forward ptrs
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
for (s = 0; s < generations[g].n_steps; s++) {