[project @ 2005-05-18 14:21:49 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 0cef213..791cc4c 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -739,7 +739,12 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
          if (stp->is_compacted) {
              collected += (oldgen_saved_blocks - stp->n_blocks) * BLOCK_SIZE_W;
          } else {
-             collected += stp->n_blocks * BLOCK_SIZE_W;
+             if (g == 0 && s == 0) {
+                 collected += countNurseryBlocks() * BLOCK_SIZE_W;
+                 collected += alloc_blocks;
+             } else {
+                 collected += stp->n_blocks * BLOCK_SIZE_W;
+             }
          }
 
        /* free old memory and shift to-space into from-space for all
@@ -1266,6 +1271,16 @@ traverse_weak_ptr_list(void)
                  ;
              }
              
+             // Threads blocked on black holes: if the black hole
+             // is alive, then the thread is alive too.
+             if (tmp == NULL && t->why_blocked == BlockedOnBlackHole) {
+                 if (isAlive(t->block_info.closure)) {
+                     t = (StgTSO *)evacuate((StgClosure *)t);
+                     tmp = t;
+                     flag = rtsTrue;
+                 }
+             }
+
              if (tmp == NULL) {
                  // not alive (yet): leave this thread on the
                  // old_all_threads list.
@@ -1282,6 +1297,10 @@ traverse_weak_ptr_list(void)
          }
       }
       
+      /* If we evacuated any threads, we need to go back to the scavenger.
+       */
+      if (flag) return rtsTrue;
+
       /* And resurrect any threads which were about to become garbage.
        */
       {
@@ -2371,10 +2390,6 @@ scavenge_fun_srt(const StgInfoTable *info)
 static void
 scavengeTSO (StgTSO *tso)
 {
-    // We don't chase the link field: TSOs on the blackhole queue are
-    // not automatically alive, so the link field is a "weak" pointer.
-    // Queues of TSOs are traversed explicitly.
-
     if (   tso->why_blocked == BlockedOnMVar
        || tso->why_blocked == BlockedOnBlackHole
        || tso->why_blocked == BlockedOnException
@@ -2390,6 +2405,13 @@ scavengeTSO (StgTSO *tso)
            (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
     }
     
+    // We don't always chase the link field: TSOs on the blackhole
+    // queue are not automatically alive, so the link field is a
+    // "weak" pointer in that case.
+    if (tso->why_blocked != BlockedOnBlackHole) {
+       tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
+    }
+
     // scavange current transaction record
     tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec);
     
@@ -4186,27 +4208,13 @@ threadSqueezeStack(StgTSO *tso)
                    debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);
 #endif
 #ifdef DEBUG
-                   /* zero out the slop so that the sanity checker can tell
-                    * where the next closure is.
-                    */
-                   { 
-                       StgInfoTable *bh_info = get_itbl(bh);
-                       nat np = bh_info->layout.payload.ptrs, 
-                           nw = bh_info->layout.payload.nptrs, i;
-                       /* don't zero out slop for a THUNK_SELECTOR,
-                        * because its layout info is used for a
-                        * different purpose, and it's exactly the
-                        * same size as a BLACKHOLE in any case.
-                        */
-                       if (bh_info->type != THUNK_SELECTOR) {
-                           for (i = 0; i < np + nw; i++) {
-                               ((StgClosure *)bh)->payload[i] = INVALID_OBJECT;
-                           }
-                       }
-                   }
+                   // zero out the slop so that the sanity checker can tell
+                   // where the next closure is.
+                   DEBUG_FILL_SLOP(bh);
 #endif
 #ifdef PROFILING
                    // We pretend that bh is now dead.
+                   // ToDo: is the slop filling the same as DEBUG_FILL_SLOP?
                    LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
 #endif
                    // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?