[project @ 2000-08-21 15:27:18 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 3ed912e..0600f97 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.77 2000/03/31 03:09:36 hwloidl Exp $
+ * $Id: GC.c,v 1.84 2000/08/15 14:18:43 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -53,8 +53,6 @@
 # endif
 #endif
 
-StgCAF* enteredCAFs;
-
 //@node STATIC OBJECT LIST, Static function declarations, Includes
 //@subsection STATIC OBJECT LIST
 
@@ -144,7 +142,6 @@ lnat g0s0_pcnt_kept = 30;   /* percentage of g0s0 live at last minor GC */
 static StgClosure * evacuate                ( StgClosure *q );
 static void         zero_static_object_list ( StgClosure* first_static );
 static void         zero_mutable_list       ( StgMutClosure *first );
-static void         revert_dead_CAFs        ( void );
 
 static rtsBool      traverse_weak_ptr_list  ( void );
 static void         cleanup_weak_ptr_list   ( StgWeak **list );
@@ -187,7 +184,7 @@ static void         gcCAFs                  ( void );
    -------------------------------------------------------------------------- */
 //@cindex GarbageCollect
 
-void GarbageCollect(void (*get_roots)(void))
+void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
 {
   bdescr *bd;
   step *step;
@@ -217,13 +214,18 @@ void GarbageCollect(void (*get_roots)(void))
 
   /* Figure out which generation to collect
    */
-  N = 0;
-  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-    if (generations[g].steps[0].n_blocks >= generations[g].max_blocks) {
-      N = g;
+  if (force_major_gc) {
+    N = RtsFlags.GcFlags.generations - 1;
+    major_gc = rtsTrue;
+  } else {
+    N = 0;
+    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
+      if (generations[g].steps[0].n_blocks >= generations[g].max_blocks) {
+        N = g;
+      }
     }
+    major_gc = (N == RtsFlags.GcFlags.generations-1);
   }
-  major_gc = (N == RtsFlags.GcFlags.generations-1);
 
   /* check stack sanity *before* GC (ToDo: check all threads) */
 #if defined(GRAN)
@@ -481,9 +483,6 @@ void GarbageCollect(void (*get_roots)(void))
    */
   gcStablePtrTable(major_gc);
 
-  /* revert dead CAFs and update enteredCAFs list */
-  revert_dead_CAFs();
-  
 #if defined(PAR)
   /* Reconstruct the Global Address tables used in GUM */
   rebuildGAtables(major_gc);
@@ -861,11 +860,15 @@ traverse_weak_ptr_list(void)
        * the list.
        */
       switch (t->what_next) {
+      case ThreadRelocated:
+         next = t->link;
+         *prev = next;
+         continue;
       case ThreadKilled:
       case ThreadComplete:
-       next = t->global_link;
-       *prev = next;
-       continue;
+         next = t->global_link;
+         *prev = next;
+         continue;
       default:
       }
 
@@ -1453,6 +1456,7 @@ loop:
        selectee = ((StgEvacuated *)selectee)->evacuee;
        goto selector_loop;
 
+      case AP_UPD:
       case THUNK:
       case THUNK_1_0:
       case THUNK_0_1:
@@ -1633,7 +1637,6 @@ loop:
        /* relocate the stack pointers... */
        new_tso->su = (StgUpdateFrame *) ((StgPtr)new_tso->su + diff);
        new_tso->sp = (StgPtr)new_tso->sp + diff;
-       new_tso->splim = (StgPtr)new_tso->splim + diff;
        
        relocate_TSO(tso, new_tso);
 
@@ -2752,7 +2755,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
   const StgInfoTable* info;
   StgWord32 bitmap;
 
-  IF_DEBUG(sanity, belch("  scavenging stack between %p and %p", p, stack_end));
+  //IF_DEBUG(sanity, belch("  scavenging stack between %p and %p", p, stack_end));
 
   /* 
    * Each time around this loop, we are looking at a chunk of stack
@@ -3081,39 +3084,29 @@ zero_mutable_list( StgMutClosure *first )
 
 void RevertCAFs(void)
 {
-  while (enteredCAFs != END_CAF_LIST) {
-    StgCAF* caf = enteredCAFs;
-    
-    enteredCAFs = caf->link;
-    ASSERT(get_itbl(caf)->type == CAF_ENTERED);
-    SET_INFO(caf,&CAF_UNENTERED_info);
-    caf->value = (StgClosure *)0xdeadbeef;
-    caf->link  = (StgCAF *)0xdeadbeef;
-  }
-  enteredCAFs = END_CAF_LIST;
-}
-
-//@cindex revert_dead_CAFs
-
-void revert_dead_CAFs(void)
-{
-    StgCAF* caf = enteredCAFs;
-    enteredCAFs = END_CAF_LIST;
-    while (caf != END_CAF_LIST) {
-        StgCAF *next, *new;
-        next = caf->link;
-        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;
-    }
+#ifdef INTERPRETER
+   StgInt i;
+
+   /* Deal with CAFs created by compiled code. */
+   for (i = 0; i < usedECafTable; i++) {
+      SET_INFO( (StgInd*)(ecafTable[i].closure), ecafTable[i].origItbl );
+      ((StgInd*)(ecafTable[i].closure))->indirectee = 0;
+   }
+
+   /* Deal with CAFs created by the interpreter. */
+   while (ecafList != END_ECAF_LIST) {
+      StgCAF* caf  = ecafList;
+      ecafList     = caf->link;
+      ASSERT(get_itbl(caf)->type == CAF_ENTERED);
+      SET_INFO(caf,&CAF_UNENTERED_info);
+      caf->value   = (StgClosure *)0xdeadbeef;
+      caf->link    = (StgCAF *)0xdeadbeef;
+   }
+
+   /* Empty out both the table and the list. */
+   clearECafTable();
+   ecafList = END_ECAF_LIST;
+#endif
 }
 
 //@node Sanity code for CAF garbage collection, Lazy black holing, Reverting CAFs
@@ -3572,7 +3565,6 @@ maybeLarge(StgClosure *closure)
 //* printMutOnceList::  @cindex\s-+printMutOnceList
 //* printMutableList::  @cindex\s-+printMutableList
 //* relocate_TSO::  @cindex\s-+relocate_TSO
-//* revert_dead_CAFs::  @cindex\s-+revert_dead_CAFs
 //* scavenge::  @cindex\s-+scavenge
 //* scavenge_large::  @cindex\s-+scavenge_large
 //* scavenge_mut_once_list::  @cindex\s-+scavenge_mut_once_list