[project @ 2005-04-05 09:38:00 by simonmar]

[ghc-hetmet.git] / ghc / rts / GC.c

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index a57fa2c..ea88b21 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -434,7 +434,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
          bitmap_size = stp->n_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
 
          if (bitmap_size > 0) {
-             bitmap_bdescr = allocGroup((nat)BLOCK_ROUND_UP(bitmap_size) 
+             bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size) 
                                         / BLOCK_SIZE);
              stp->bitmap = bitmap_bdescr;
              bitmap = bitmap_bdescr->start;
@@ -1415,8 +1415,6 @@ mark_root(StgClosure **root)
 STATIC_INLINE void 
 upd_evacuee(StgClosure *p, StgClosure *dest)
 {
-    // Source object must be in from-space:
-    ASSERT((Bdescr((P_)p)->flags & BF_EVACUATED) == 0);
     // not true: (ToDo: perhaps it should be)
     // ASSERT(Bdescr((P_)dest)->flags & BF_EVACUATED);
     SET_INFO(p, &stg_EVACUATED_info);
@@ -1677,6 +1675,9 @@ loop:
        return q;
     }
 
+    /* Object is not already evacuated. */
+    ASSERT((bd->flags & BF_EVACUATED) == 0);
+
     stp = bd->step->to;
   }
 #ifdef DEBUG
@@ -2117,10 +2118,10 @@ selector_loop:
 
          // check that we don't recurse too much, re-using the
          // depth bound also used in evacuate().
-         thunk_selector_depth++;
-         if (thunk_selector_depth > MAX_THUNK_SELECTOR_DEPTH) {
+         if (thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) {
              break;
          }
+         thunk_selector_depth++;
 
          val = eval_thunk_selector(info->layout.selector_offset, 
                                    (StgSelector *)selectee);
@@ -2351,8 +2352,8 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
     p = (StgPtr)args;
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->f.bitmap);
-       size = BITMAP_SIZE(fun_info->f.bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
+       size = BITMAP_SIZE(fun_info->f.b.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
        size = GET_FUN_LARGE_BITMAP(fun_info)->size;
@@ -2392,7 +2393,7 @@ scavenge_PAP (StgPAP *pap)
 
     switch (fun_info->f.fun_type) {
     case ARG_GEN:
-       bitmap = BITMAP_BITS(fun_info->f.bitmap);
+       bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
        goto small_bitmap;
     case ARG_GEN_BIG:
        scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
@@ -3087,7 +3088,7 @@ linear_scan:
                           p, info_type((StgClosure *)p)));
            break;
        }
-#endif // PAR
+#endif /* PAR */
 
        case TVAR_WAIT_QUEUE:
          {
@@ -3452,11 +3453,21 @@ scavenge_one(StgPtr p)
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
     case IND_STATIC:
-      /* Try to pull the indirectee into this generation, so we can
-       * remove the indirection from the mutable list.  
-       */
-      ((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee);
-      
+    {
+       /* Careful here: a THUNK can be on the mutable list because
+        * it contains pointers to young gen objects.  If such a thunk
+        * is updated, the IND_OLDGEN will be added to the mutable
+        * list again, and we'll scavenge it twice.  evacuate()
+        * doesn't check whether the object has already been
+        * evacuated, so we perform that check here.
+        */
+       StgClosure *q = ((StgInd *)p)->indirectee;
+       if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
+           break;
+       }
+       ((StgInd *)p)->indirectee = evacuate(q);
+    }
+
 #if 0 && defined(DEBUG)
       if (RtsFlags.DebugFlags.gc) 
       /* Debugging code to print out the size of the thing we just
@@ -3838,14 +3849,14 @@ revertCAFs( void )
 {
     StgIndStatic *c;
 
-    for (c = (StgIndStatic *)caf_list; c != NULL; 
+    for (c = (StgIndStatic *)revertible_caf_list; c != NULL; 
         c = (StgIndStatic *)c->static_link) 
     {
        SET_INFO(c, c->saved_info);
        c->saved_info = NULL;
        // could, but not necessary: c->static_link = NULL; 
     }
-    caf_list = NULL;
+    revertible_caf_list = NULL;
 }
 
 void
@@ -3858,6 +3869,11 @@ markCAFs( evac_fn evac )
     {
        evac(&c->indirectee);
     }
+    for (c = (StgIndStatic *)revertible_caf_list; c != NULL; 
+        c = (StgIndStatic *)c->static_link) 
+    {
+       evac(&c->indirectee);
+    }
 }
 
 /* -----------------------------------------------------------------------------
@@ -4239,4 +4255,4 @@ maybeLarge(StgClosure *closure)
 }
 
   
-#endif // DEBUG
+#endif /* DEBUG */