[project @ 2002-08-16 13:29:05 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 0b236bf..7821853 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.132 2002/03/12 11:50:02 simonmar Exp $
+ * $Id: GC.c,v 1.138 2002/08/16 13:29:06 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -45,6 +45,8 @@
 #include "RetainerProfile.h"
 #include "LdvProfile.h"
 
+#include <string.h>
+
 /* STATIC OBJECT LIST.
  *
  * During GC:
@@ -79,8 +81,8 @@
  * We build up a static object list while collecting generations 0..N,
  * which is then appended to the static object list of generation N+1.
  */
-StgClosure* static_objects;          // live static objects
-StgClosure* scavenged_static_objects; // static objects scavenged so far
+static StgClosure* static_objects;      // live static objects
+StgClosure* scavenged_static_objects;   // static objects scavenged so far
 
 /* N is the oldest generation being collected, where the generations
  * are numbered starting at 0.  A major GC (indicated by the major_gc
@@ -118,16 +120,16 @@ static rtsBool failed_to_evac;
 
 /* Old to-space (used for two-space collector only)
  */
-bdescr *old_to_blocks;
+static bdescr *old_to_blocks;
 
 /* Data used for allocation area sizing.
  */
-lnat new_blocks;               // blocks allocated during this GC 
-lnat g0s0_pcnt_kept = 30;      // percentage of g0s0 live at last minor GC 
+static lnat new_blocks;                 // blocks allocated during this GC 
+static lnat g0s0_pcnt_kept = 30; // percentage of g0s0 live at last minor GC 
 
 /* Used to avoid long recursion due to selector thunks
  */
-lnat thunk_selector_depth = 0;
+static lnat thunk_selector_depth = 0;
 #define MAX_THUNK_SELECTOR_DEPTH 256
 
 /* -----------------------------------------------------------------------------
@@ -985,7 +987,6 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   // Reset the nursery
   resetNurseries();
 
-  // let go of lock (so that it can be re-grabbed below).
   RELEASE_LOCK(&sched_mutex);
   
   // start any pending finalizers 
@@ -993,7 +994,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   
   // send exceptions to any threads which were about to die 
   resurrectThreads(resurrected_threads);
-
+  
   ACQUIRE_LOCK(&sched_mutex);
 
   // Update the stable pointer hash table.
@@ -1105,31 +1106,41 @@ traverse_weak_ptr_list(void)
              continue;
          }
          
-         ASSERT(get_itbl(w)->type == WEAK);
-         
-         /* Now, check whether the key is reachable.
-          */
-         new = isAlive(w->key);
-         if (new != NULL) {
-             w->key = new;
-             // evacuate the value and finalizer 
-             w->value = evacuate(w->value);
-             w->finalizer = evacuate(w->finalizer);
-             // remove this weak ptr from the old_weak_ptr list 
-             *last_w = w->link;
-             // and put it on the new weak ptr list 
-             next_w  = w->link;
-             w->link = weak_ptr_list;
-             weak_ptr_list = w;
-             flag = rtsTrue;
-             IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p", 
-                                  w, w->key));
-             continue;
-         }
-         else {
-             last_w = &(w->link);
-             next_w = w->link;
+         switch (get_itbl(w)->type) {
+
+         case EVACUATED:
+             next_w = (StgWeak *)((StgEvacuated *)w)->evacuee;
+             *last_w = next_w;
              continue;
+
+         case WEAK:
+             /* Now, check whether the key is reachable.
+              */
+             new = isAlive(w->key);
+             if (new != NULL) {
+                 w->key = new;
+                 // evacuate the value and finalizer 
+                 w->value = evacuate(w->value);
+                 w->finalizer = evacuate(w->finalizer);
+                 // remove this weak ptr from the old_weak_ptr list 
+                 *last_w = w->link;
+                 // and put it on the new weak ptr list 
+                 next_w  = w->link;
+                 w->link = weak_ptr_list;
+                 weak_ptr_list = w;
+                 flag = rtsTrue;
+                 IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p", 
+                                      w, w->key));
+                 continue;
+             }
+             else {
+                 last_w = &(w->link);
+                 next_w = w->link;
+                 continue;
+             }
+
+         default:
+             barf("traverse_weak_ptr_list: not WEAK");
          }
       }
       
@@ -1242,6 +1253,9 @@ mark_weak_ptr_list ( StgWeak **list )
 
   last_w = list;
   for (w = *list; w; w = w->link) {
+      // w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here
+      ASSERT(w->header.info == &stg_DEAD_WEAK_info 
+            || get_itbl(w)->type == WEAK || get_itbl(w)->type == EVACUATED);
       (StgClosure *)w = evacuate((StgClosure *)w);
       *last_w = w;
       last_w = &(w->link);
@@ -1274,6 +1288,7 @@ isAlive(StgClosure *p)
 
   loop:
     bd = Bdescr((P_)p);
+
     // ignore closures in generations that we're not collecting. 
     if (LOOKS_LIKE_STATIC(p) || bd->gen_no > N) {
        return p;
@@ -1454,8 +1469,8 @@ copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
    Evacuate a large object
 
    This just consists of removing the object from the (doubly-linked)
-   large_alloc_list, and linking it on to the (singly-linked)
-   new_large_objects list, from where it will be scavenged later.
+   step->large_objects list, and linking it on to the (singly-linked)
+   step->new_large_objects list, from where it will be scavenged later.
 
    Convention: bd->flags has BF_EVACUATED set for a large object
    that has been evacuated, or unset otherwise.
@@ -1584,9 +1599,6 @@ 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