FIX #2014: Template Haskell w/ mutually recursive modules

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

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 47c30ae..4aa210c 100644 (file)
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -109,11 +109,6 @@ rtsBool eager_promotion;
  */
 rtsBool failed_to_evac;
 
-/* Saved nursery (used for 2-space collector only)
- */
-static bdescr *saved_nursery;
-static nat saved_n_blocks;
-  
 /* Data used for allocation area sizing.
  */
 lnat new_blocks;                // blocks allocated during this GC 
@@ -274,17 +269,6 @@ GarbageCollect ( rtsBool force_major_gc )
   static_objects = END_OF_STATIC_LIST;
   scavenged_static_objects = END_OF_STATIC_LIST;
 
-  /* Save the nursery if we're doing a two-space collection.
-   * g0s0->blocks will be used for to-space, so we need to get the
-   * nursery out of the way.
-   */
-  if (RtsFlags.GcFlags.generations == 1) {
-      saved_nursery = g0s0->blocks;
-      saved_n_blocks = g0s0->n_blocks;
-      g0s0->blocks = NULL;
-      g0s0->n_blocks = 0;
-  }
-
   /* Keep a count of how many new blocks we allocated during this GC
    * (used for resizing the allocation area, later).
    */
@@ -663,7 +647,7 @@ GarbageCollect ( rtsBool force_major_gc )
         * the collected steps (except the allocation area).  These
         * freed blocks will probaby be quickly recycled.
         */
-       if (!(g == 0 && s == 0)) {
+       if (!(g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1)) {
            if (stp->is_compacted) {
                // for a compacted step, just shift the new to-space
                // onto the front of the now-compacted existing blocks.
@@ -817,13 +801,14 @@ GarbageCollect ( rtsBool force_major_gc )
   /* Free the small objects allocated via allocate(), since this will
    * all have been copied into G0S1 now.  
    */
-  if (small_alloc_list != NULL) {
-    freeChain(small_alloc_list);
+  if (RtsFlags.GcFlags.generations > 1) {
+      if (g0s0->blocks != NULL) {
+          freeChain(g0s0->blocks);
+          g0s0->blocks = NULL;
+      }
+      g0s0->n_blocks = 0;
   }
-  small_alloc_list = NULL;
   alloc_blocks = 0;
-  alloc_Hp = NULL;
-  alloc_HpLim = NULL;
   alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
 
   // Start a new pinned_object_block
@@ -853,17 +838,6 @@ GarbageCollect ( rtsBool force_major_gc )
   if (RtsFlags.GcFlags.generations == 1) {
     nat blocks;
     
-    if (g0s0->old_blocks != NULL) {
-      freeChain(g0s0->old_blocks);
-    }
-    for (bd = g0s0->blocks; bd != NULL; bd = bd->link) {
-      bd->flags = 0;   // now from-space 
-    }
-    g0s0->old_blocks = g0s0->blocks;
-    g0s0->n_old_blocks = g0s0->n_blocks;
-    g0s0->blocks = saved_nursery;
-    g0s0->n_blocks = saved_n_blocks;
-
     /* For a two-space collector, we need to resize the nursery. */
     
     /* set up a new nursery.  Allocate a nursery size based on a
@@ -880,7 +854,7 @@ GarbageCollect ( rtsBool force_major_gc )
      * performance we get from 3L bytes, reducing to the same
      * performance at 2L bytes.
      */
-    blocks = g0s0->n_old_blocks;
+    blocks = g0s0->n_blocks;
 
     if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
         blocks * RtsFlags.GcFlags.oldGenFactor * 2 > 
@@ -1042,14 +1016,15 @@ isAlive(StgClosure *p)
   const StgInfoTable *info;
   bdescr *bd;
   StgWord tag;
+  StgClosure *q;
 
   while (1) {
     /* The tag and the pointer are split, to be merged later when needed. */
     tag = GET_CLOSURE_TAG(p);
-    p = UNTAG_CLOSURE(p);
+    q = UNTAG_CLOSURE(p);
 
-    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-    info = get_itbl(p);
+    ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
+    info = get_itbl(q);
 
     // ignore static closures 
     //
@@ -1057,19 +1032,19 @@ isAlive(StgClosure *p)
     // Problem here is that we sometimes don't set the link field, eg.
     // for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
     //
-    if (!HEAP_ALLOCED(p)) {
-       return TAG_CLOSURE(tag,p);
+    if (!HEAP_ALLOCED(q)) {
+       return p;
     }
 
     // ignore closures in generations that we're not collecting. 
-    bd = Bdescr((P_)p);
+    bd = Bdescr((P_)q);
     if (bd->gen_no > N) {
-       return TAG_CLOSURE(tag,p);
+       return p;
     }
 
     // if it's a pointer into to-space, then we're done
     if (bd->flags & BF_EVACUATED) {
-       return TAG_CLOSURE(tag,p);
+       return p;
     }
 
     // large objects use the evacuated flag
@@ -1078,8 +1053,8 @@ isAlive(StgClosure *p)
     }
 
     // check the mark bit for compacted steps
-    if ((bd->flags & BF_COMPACTED) && is_marked((P_)p,bd)) {
-       return TAG_CLOSURE(tag,p);
+    if ((bd->flags & BF_COMPACTED) && is_marked((P_)q,bd)) {
+       return p;
     }
 
     switch (info->type) {
@@ -1090,16 +1065,16 @@ isAlive(StgClosure *p)
     case IND_OLDGEN:           // rely on compatible layout with StgInd 
     case IND_OLDGEN_PERM:
       // follow indirections 
-      p = ((StgInd *)p)->indirectee;
+      p = ((StgInd *)q)->indirectee;
       continue;
 
     case EVACUATED:
       // alive! 
-      return ((StgEvacuated *)p)->evacuee;
+      return ((StgEvacuated *)q)->evacuee;
 
     case TSO:
-      if (((StgTSO *)p)->what_next == ThreadRelocated) {
-       p = (StgClosure *)((StgTSO *)p)->link;
+      if (((StgTSO *)q)->what_next == ThreadRelocated) {
+       p = (StgClosure *)((StgTSO *)q)->link;
        continue;
       } 
       return NULL;