[project @ 1999-03-09 14:24:43 by sewardj]

Include CAF_ENTEREDs on the mutables list so they get scavenged correctly.

diff --git a/ghc/includes/Closures.h b/ghc/includes/Closures.h
index 76aeecc..cb2270a 100644 (file)
--- a/ghc/includes/Closures.h
+++ b/ghc/includes/Closures.h
@@ -1,5 +1,5 @@
 /* ----------------------------------------------------------------------------
- * $Id: Closures.h,v 1.10 1999/02/26 17:46:04 simonm Exp $
+ * $Id: Closures.h,v 1.11 1999/03/09 14:24:46 sewardj Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -180,9 +180,10 @@ typedef struct {
 } StgIndStatic;
 
 typedef struct StgCAF_ {
-    StgHeader   header;
-    StgClosure *body;
-    StgClosure *value;
+    StgHeader     header;
+    StgClosure    *body;
+    StgMutClosure *mut_link;
+    StgClosure    *value;
     struct StgCAF_ *link;
 } StgCAF;
 

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index cc1c797..6a54291 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.47 1999/03/03 18:58:53 sof Exp $
+ * $Id: GC.c,v 1.48 1999/03/09 14:24:43 sewardj Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -177,6 +177,10 @@ void GarbageCollect(void (*get_roots)(void))
   for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
     allocated -= BLOCK_SIZE_W;
   }
+  if (current_nursery->free < current_nursery->start + BLOCK_SIZE_W) {
+    allocated -= (current_nursery->start + BLOCK_SIZE_W)
+      - current_nursery->free;
+  }
 
   /* Figure out which generation to collect
    */
@@ -354,22 +358,7 @@ void GarbageCollect(void (*get_roots)(void))
        * the CAF document.
        */
       extern void markHugsObjects(void);
-#if 0
-      /* ToDo: This (undefined) function should contain the scavenge
-       * loop immediately below this block of code - but I'm not sure
-       * enough of the details to do this myself.
-       */
-      scavengeEverything();
-      /* revert dead CAFs and update enteredCAFs list */
-      revert_dead_CAFs();
-#endif      
       markHugsObjects();
-#if 0
-      /* This will keep the CAFs and the attached BCOs alive 
-       * but the values will have been reverted
-       */
-      scavengeEverything();
-#endif
   }
 #endif
 
@@ -437,6 +426,9 @@ void GarbageCollect(void (*get_roots)(void))
    */
   gcStablePtrTable(major_gc);
 
+  /* revert dead CAFs and update enteredCAFs list */
+  revert_dead_CAFs();
+  
   /* Set the maximum blocks for the oldest generation, based on twice
    * the amount of live data now, adjusted to fit the maximum heap
    * size if necessary.  
@@ -665,10 +657,7 @@ void GarbageCollect(void (*get_roots)(void))
     }
   }
 
-  /* revert dead CAFs and update enteredCAFs list */
-  revert_dead_CAFs();
-  
-  /* mark the garbage collected CAFs as dead */
+ /* mark the garbage collected CAFs as dead */
 #ifdef DEBUG
   if (major_gc) { gcCAFs(); }
 #endif
@@ -1663,7 +1652,6 @@ scavenge(step *step)
     case IND_PERM:
     case IND_OLDGEN_PERM:
     case CAF_UNENTERED:
-    case CAF_ENTERED:
       {
        StgPtr end;
 
@@ -1675,6 +1663,20 @@ scavenge(step *step)
        break;
       }
 
+    case CAF_ENTERED:
+      {
+       StgCAF *caf = (StgCAF *)p;
+
+       caf->body = evacuate(caf->body);
+       caf->value = evacuate(caf->value);
+       if (failed_to_evac) {
+         failed_to_evac = rtsFalse;
+         recordOldToNewPtrs((StgMutClosure *)p);
+       }
+        p += sizeofW(StgCAF);
+       break;
+      }
+
     case MUT_VAR:
       /* ignore MUT_CONSs */
       if (((StgMutVar *)p)->header.info != &MUT_CONS_info) {
@@ -1869,7 +1871,6 @@ scavenge_one(StgClosure *p)
   case IND_PERM:
   case IND_OLDGEN_PERM:
   case CAF_UNENTERED:
-  case CAF_ENTERED:
     {
       StgPtr q, end;
       
@@ -2022,6 +2023,19 @@ scavenge_mut_once_list(generation *gen)
       } 
       continue;
       
+    case CAF_ENTERED:
+      { 
+       StgCAF *caf = (StgCAF *)p;
+       caf->body  = evacuate(caf->body);
+       caf->value = evacuate(caf->value);
+       if (failed_to_evac) {
+         failed_to_evac = rtsFalse;
+         p->mut_link = new_list;
+         new_list = p;
+       }
+      }
+      continue;
+
     default:
       /* shouldn't have anything else on the mutables list */
       barf("scavenge_mut_once_list: strange object?");
@@ -2562,28 +2576,18 @@ void revert_dead_CAFs(void)
     StgCAF* caf = enteredCAFs;
     enteredCAFs = END_CAF_LIST;
     while (caf != END_CAF_LIST) {
-       StgCAF* next = caf->link;
-
-       switch(GET_INFO(caf)->type) {
-       case EVACUATED:
-           {
-               /* This object has been evacuated, it must be live. */
-               StgCAF* new = stgCast(StgCAF*,stgCast(StgEvacuated*,caf)->evacuee);
-               new->link = enteredCAFs;
-               enteredCAFs = new;
-               break;
-           }
-       case CAF_ENTERED:
-           {
-               SET_INFO(caf,&CAF_UNENTERED_info);
-               caf->value = stgCast(StgClosure*,0xdeadbeef);
-               caf->link  = stgCast(StgCAF*,0xdeadbeef);
-               break;
-           }
-       default:
-               barf("revert_dead_CAFs: enteredCAFs list corrupted");
-       } 
-       caf = next;
+        StgCAF* next = caf->link;
+        StgCAF* new = (StgCAF*)isAlive((StgClosure*)caf);
+        if (new) {
+           new->link = enteredCAFs;
+           enteredCAFs = new;
+        } else {
+           ASSERT(0);
+           SET_INFO(caf,&CAF_UNENTERED_info);
+           caf->value = (StgClosure*)0xdeadbeef;
+           caf->link  = (StgCAF*)0xdeadbeef;
+        } 
+        caf = next;
     }
 }
 

diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc
index 669df32..1058a2d 100644 (file)
--- a/ghc/rts/StgMiscClosures.hc
+++ b/ghc/rts/StgMiscClosures.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.15 1999/03/02 19:59:40 sof Exp $
+ * $Id: StgMiscClosures.hc,v 1.16 1999/03/09 14:24:45 sewardj Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -98,7 +98,7 @@ STGFUN(IND_OLDGEN_PERM_entry)
    This code assumes R1 is in a register for now.
    -------------------------------------------------------------------------- */
 
-INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,2,CAF_UNENTERED,const,EF_,0,0);
+INFO_TABLE(CAF_UNENTERED_info,CAF_UNENTERED_entry,1,3,CAF_UNENTERED,const,EF_,0,0);
 STGFUN(CAF_UNENTERED_entry)
 {
     FB_
@@ -109,7 +109,8 @@ STGFUN(CAF_UNENTERED_entry)
     FE_
 }
 
-INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,2,1,CAF_ENTERED,const,EF_,0,0);
+/* 0,4 is entirely bogus; _do not_ rely on this info */
+INFO_TABLE(CAF_ENTERED_info,CAF_ENTERED_entry,0,4,CAF_ENTERED,const,EF_,0,0);
 STGFUN(CAF_ENTERED_entry)
 {
     FB_