[project @ 2001-11-08 12:46:31 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index d978fce..3ecde2b 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.122 2001/08/30 10:22:52 simonmar Exp $
+ * $Id: GC.c,v 1.126 2001/11/08 12:46:31 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -142,7 +142,6 @@ static void         scavenge_large          ( step * );
 static void         scavenge_static         ( void );
 static void         scavenge_mutable_list   ( generation *g );
 static void         scavenge_mut_once_list  ( generation *g );
-static void         scavengeCAFs            ( void );
 
 #if 0 && defined(DEBUG)
 static void         gcCAFs                  ( void );
@@ -462,7 +461,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
     }
   }
 
-  scavengeCAFs();
+  /* follow roots from the CAF list (used by GHCi)
+   */
+  evac_gen = 0;
+  markCAFs(mark_root);
 
   /* follow all the roots that the application knows about.
    */
@@ -758,6 +760,14 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       // different if compaction is turned on, because we don't need
       // to double the space required to collect the old generation.
       if (max != 0) {
+
+         // this test is necessary to ensure that the calculations
+         // below don't have any negative results - we're working
+         // with unsigned values here.
+         if (max < min_alloc) {
+             heapOverflow();
+         }
+
          if (oldest_gen->steps[0].is_compacted) {
              if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
                  size = (max - min_alloc) / ((gens - 1) * 2 - 1);
@@ -910,6 +920,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       }
       
       resizeNursery((nat)blocks);
+
+    } else {
+      // we might have added extra large blocks to the nursery, so
+      // resize back to minAllocAreaSize again.
+      resizeNursery(RtsFlags.GcFlags.minAllocAreaSize);
     }
   }
 
@@ -1457,6 +1472,9 @@ loop:
   if (HEAP_ALLOCED(q)) {
     bd = Bdescr((P_)q);
 
+    // not a group head: find the group head
+    if (bd->blocks == 0) { bd = bd->link; }
+
     if (bd->gen_no > N) {
        /* Can't evacuate this object, because it's in a generation
         * older than the ones we're collecting.  Let's hope that it's
@@ -1595,6 +1613,7 @@ loop:
       case CONSTR_1_1:
       case CONSTR_0_2:
       case CONSTR_STATIC:
+      case CONSTR_NOCAF_STATIC:
        { 
          StgWord offset = info->layout.selector_offset;
 
@@ -3464,15 +3483,14 @@ revertCAFs( void )
 }
 
 void
-scavengeCAFs( void )
+markCAFs( evac_fn evac )
 {
     StgIndStatic *c;
 
-    evac_gen = 0;
     for (c = (StgIndStatic *)caf_list; c != NULL; 
         c = (StgIndStatic *)c->static_link) 
     {
-       c->indirectee = evacuate(c->indirectee);
+       evac(&c->indirectee);
     }
 }