[project @ 2002-07-10 09:28:54 by simonmar]
[ghc-hetmet.git] / ghc / rts / GC.c
index 8dbe589..80f7291 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.133 2002/04/13 05:16:25 sof Exp $
+ * $Id: GC.c,v 1.136 2002/07/10 09:28:54 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -990,11 +990,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   // start any pending finalizers 
   scheduleFinalizers(old_weak_ptr_list);
   
-  ACQUIRE_LOCK(&sched_mutex);
-
   // send exceptions to any threads which were about to die 
   resurrectThreads(resurrected_threads);
   
+  ACQUIRE_LOCK(&sched_mutex);
+
   // Update the stable pointer hash table.
   updateStablePtrTable(major_gc);
 
@@ -1104,31 +1104,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");
          }
       }
       
@@ -1241,6 +1251,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);
@@ -1273,6 +1286,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;
@@ -1583,9 +1597,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