[project @ 2000-11-01 11:41:47 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index f430814..7578d1c 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.78 2000/04/11 16:36:53 sewardj Exp $
+ * $Id: GC.c,v 1.86 2000/11/01 11:41:47 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -52,8 +52,13 @@
 #  include "ParallelDebug.h"
 # endif
 #endif
-
-StgCAF* enteredCAFs;
+#if defined(GHCI)
+# include "HsFFI.h"
+# include "Linker.h"
+#endif
+#if defined(RTS_GTK_FRONTPANEL)
+#include "FrontPanel.h"
+#endif
 
 //@node STATIC OBJECT LIST, Static function declarations, Includes
 //@subsection STATIC OBJECT LIST
@@ -128,7 +133,6 @@ static rtsBool failed_to_evac;
  */
 bdescr *old_to_space;
 
-
 /* Data used for allocation area sizing.
  */
 lnat new_blocks;               /* blocks allocated during this GC */
@@ -144,7 +148,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 );
@@ -212,7 +215,9 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
   CCCS = CCS_GC;
 #endif
 
-  /* Approximate how much we allocated */
+  /* Approximate how much we allocated.  
+   * Todo: only when generating stats? 
+   */
   allocated = calcAllocated();
 
   /* Figure out which generation to collect
@@ -230,6 +235,12 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
     major_gc = (N == RtsFlags.GcFlags.generations-1);
   }
 
+#ifdef RTS_GTK_FRONTPANEL
+  if (RtsFlags.GcFlags.frontpanel) {
+      updateFrontPanelBeforeGC(N);
+  }
+#endif
+
   /* check stack sanity *before* GC (ToDo: check all threads) */
 #if defined(GRAN)
   // ToDo!: check sanity  IF_DEBUG(sanity, checkTSOsSanity());
@@ -486,9 +497,6 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
    */
   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);
@@ -764,6 +772,12 @@ void GarbageCollect ( void (*get_roots)(void), rtsBool force_major_gc )
   /* check for memory leaks if sanity checking is on */
   IF_DEBUG(sanity, memInventory());
 
+#ifdef RTS_GTK_VISUALS
+  if (RtsFlags.GcFlags.visuals) {
+      updateFrontPanelAfterGC( N, live );
+  }
+#endif
+
   /* ok, GC over: tell the stats department what happened. */
   stat_endGC(allocated, collected, live, copied, N);
 }
@@ -866,11 +880,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:
       }
 
@@ -1458,6 +1476,7 @@ loop:
        selectee = ((StgEvacuated *)selectee)->evacuee;
        goto selector_loop;
 
+      case AP_UPD:
       case THUNK:
       case THUNK_1_0:
       case THUNK_0_1:
@@ -1638,7 +1657,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);
 
@@ -2757,7 +2775,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
@@ -3086,39 +3104,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
@@ -3577,7 +3585,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