[project @ 2005-11-02 13:05:30 by simonmar]
[ghc-hetmet.git] / ghc / rts / GC.c
index c6325f7..9a21af8 100644 (file)
@@ -26,7 +26,7 @@
 #include "Prelude.h"
 #include "ParTicky.h"          // ToDo: move into Rts.h
 #include "GCCompact.h"
-#include "Signals.h"
+#include "RtsSignals.h"
 #include "STM.h"
 #if defined(GRAN) || defined(PAR)
 # include "GranSimRts.h"
@@ -323,7 +323,7 @@ gc_alloc_scavd_block(step *stp)
       
      - free from-space in each step, and set from-space = to-space.
 
-   Locks held: sched_mutex
+   Locks held: all capabilities are held throughout GarbageCollect().
 
    -------------------------------------------------------------------------- */
 
@@ -334,7 +334,9 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   step *stp;
   lnat live, allocated, collected = 0, copied = 0, scavd_copied = 0;
   lnat oldgen_saved_blocks = 0;
-  nat g, s;
+  nat g, s, i;
+
+  ACQUIRE_SM_LOCK;
 
 #ifdef PROFILING
   CostCentreStack *prev_CCS;
@@ -356,6 +358,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   // tell the stats department that we've started a GC 
   stat_startGC();
 
+#ifdef DEBUG
+  // check for memory leaks if DEBUG is on 
+  memInventory();
+#endif
+
   // Init stats and print par specific (timing) info 
   PAR_TICKY_PAR_START();
 
@@ -432,6 +439,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
     if (g != 0) {
        freeChain(generations[g].mut_list);
        generations[g].mut_list = allocBlock();
+       for (i = 0; i < n_capabilities; i++) {
+           freeChain(capabilities[i].mut_lists[g]);
+           capabilities[i].mut_lists[g] = allocBlock();
+       }
     }
 
     for (s = 0; s < generations[g].n_steps; s++) {
@@ -534,6 +545,19 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       stp->scavenged_large_objects = NULL;
       stp->n_scavenged_large_blocks = 0;
     }
+
+    /* Move the private mutable lists from each capability onto the
+     * main mutable list for the generation.
+     */
+    for (i = 0; i < n_capabilities; i++) {
+       for (bd = capabilities[i].mut_lists[g]; 
+            bd->link != NULL; bd = bd->link) {
+           /* nothing */
+       }
+       bd->link = generations[g].mut_list;
+       generations[g].mut_list = capabilities[i].mut_lists[g];
+       capabilities[i].mut_lists[g] = allocBlock();
+    }
   }
 
   /* Allocate a mark stack if we're doing a major collection.
@@ -688,7 +712,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
     }
   }
 
-  /* Update the pointers from the "main thread" list - these are
+  /* Update the pointers from the task list - these are
    * treated as weak pointers because we want to allow a main thread
    * to get a BlockedOnDeadMVar exception in the same way as any other
    * thread.  Note that the threads should all have been retained by
@@ -696,14 +720,23 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
    * updating pointers here.
    */
   {
-      StgMainThread *m;
+      Task *task;
       StgTSO *tso;
-      for (m = main_threads; m != NULL; m = m->link) {
-         tso = (StgTSO *) isAlive((StgClosure *)m->tso);
-         if (tso == NULL) {
-             barf("main thread has been GC'd");
+      for (task = all_tasks; task != NULL; task = task->all_link) {
+         if (!task->stopped && task->tso) {
+             ASSERT(task->tso->bound == task);
+             tso = (StgTSO *) isAlive((StgClosure *)task->tso);
+             if (tso == NULL) {
+                 barf("task %p: main thread %d has been GC'd", 
+#ifdef THREADED_RTS
+                      (void *)task->id, 
+#else
+                      (void *)task,
+#endif
+                      task->tso->id);
+             }
+             task->tso = tso;
          }
-         m->tso = tso;
       }
   }
 
@@ -806,20 +839,21 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
                // tack the new blocks on the end of the existing blocks
                if (stp->old_blocks != NULL) {
                    for (bd = stp->old_blocks; bd != NULL; bd = next) {
-                       next = bd->link;
-                       if (next == NULL) {
-                           bd->link = stp->blocks;
-                       }
                        // NB. this step might not be compacted next
                        // time, so reset the BF_COMPACTED flags.
                        // They are set before GC if we're going to
                        // compact.  (search for BF_COMPACTED above).
                        bd->flags &= ~BF_COMPACTED;
+                       next = bd->link;
+                       if (next == NULL) {
+                           bd->link = stp->blocks;
+                       }
                    }
                    stp->blocks = stp->old_blocks;
                }
                // add the new blocks to the block tally
                stp->n_blocks += stp->n_old_blocks;
+               ASSERT(countBlocks(stp->blocks) == stp->n_blocks);
            } else {
                freeChain(stp->old_blocks);
                for (bd = stp->blocks; bd != NULL; bd = bd->link) {
@@ -972,8 +1006,9 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   for (g = 0; g <= N; g++) {
       for (s = 0; s < generations[g].n_steps; s++) {
          stp = &generations[g].steps[s];
-         if (stp->is_compacted && stp->bitmap != NULL) {
+         if (stp->bitmap != NULL) {
              freeGroup(stp->bitmap);
+             stp->bitmap = NULL;
          }
       }
   }
@@ -1101,15 +1136,13 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   // Reset the nursery
   resetNurseries();
 
-  RELEASE_LOCK(&sched_mutex);
-  
   // start any pending finalizers 
-  scheduleFinalizers(old_weak_ptr_list);
+  RELEASE_SM_LOCK;
+  scheduleFinalizers(last_free_capability, old_weak_ptr_list);
+  ACQUIRE_SM_LOCK;
   
   // 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);
@@ -1130,8 +1163,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   CCCS = prev_CCS;
 #endif
 
-  // check for memory leaks if sanity checking is on 
-  IF_DEBUG(sanity, memInventory());
+#ifdef DEBUG
+  // check for memory leaks if DEBUG is on 
+  memInventory();
+#endif
 
 #ifdef RTS_GTK_FRONTPANEL
   if (RtsFlags.GcFlags.frontpanel) {
@@ -1147,6 +1182,8 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   unblockUserSignals();
 #endif
 
+  RELEASE_SM_LOCK;
+
   //PAR_TICKY_TP();
 }
 
@@ -1977,18 +2014,28 @@ loop:
        if (p == NULL) {
            return copy(q,THUNK_SELECTOR_sizeW(),stp);
        } else {
+           StgClosure *val;
            // q is still BLACKHOLE'd.
            thunk_selector_depth++;
-           p = evacuate(p);
+           val = evacuate(p);
            thunk_selector_depth--;
-           upd_evacuee(q,p);
+
+           // Update the THUNK_SELECTOR with an indirection to the
+           // EVACUATED closure now at p.  Why do this rather than
+           // upd_evacuee(q,p)?  Because we have an invariant that an
+           // EVACUATED closure always points to an object in the
+           // same or an older generation (required by the short-cut
+           // test in the EVACUATED case, below).
+           SET_INFO(q, &stg_IND_info);
+           ((StgInd *)q)->indirectee = p;
+
 #ifdef PROFILING
            // We store the size of the just evacuated object in the
            // LDV word so that the profiler can guess the position of
            // the next object later.
            SET_EVACUAEE_FOR_LDV(q, THUNK_SELECTOR_sizeW());
 #endif
-           return p;
+           return val;
        }
     }
 
@@ -2034,8 +2081,10 @@ loop:
      * Optimisation: the check is fairly expensive, but we can often
      * shortcut it if either the required generation is 0, or the
      * current object (the EVACUATED) is in a high enough generation.
-     * stp is the lowest step that the current object would be
-     * evacuated to, so we only do the full check if stp is too low.
+     * We know that an EVACUATED always points to an object in the
+     * same or an older generation.  stp is the lowest step that the
+     * current object would be evacuated to, so we only do the full
+     * check if stp is too low.
      */
     if (evac_gen > 0 && stp->gen_no < evac_gen) {  // optimisation 
       StgClosure *p = ((StgEvacuated*)q)->evacuee;
@@ -3051,7 +3100,9 @@ scavenge(step *stp)
      */
     if (failed_to_evac) {
        failed_to_evac = rtsFalse;
-       recordMutableGen((StgClosure *)q, stp->gen);
+       if (stp->gen_no > 0) {
+           recordMutableGen((StgClosure *)q, stp->gen);
+       }
     }
   }
 
@@ -3388,7 +3439,9 @@ linear_scan:
 
        if (failed_to_evac) {
            failed_to_evac = rtsFalse;
-           recordMutableGen((StgClosure *)q, &generations[evac_gen]);
+           if (evac_gen > 0) {
+               recordMutableGen((StgClosure *)q, &generations[evac_gen]);
+           }
        }
        
        // mark the next bit to indicate "scavenged"
@@ -3400,7 +3453,7 @@ linear_scan:
     if (mark_stack_overflowed && oldgen_scan_bd == NULL) {
        IF_DEBUG(gc, debugBelch("scavenge_mark_stack: starting linear scan"));
        mark_stack_overflowed = rtsFalse;
-       oldgen_scan_bd = oldest_gen->steps[0].blocks;
+       oldgen_scan_bd = oldest_gen->steps[0].old_blocks;
        oldgen_scan = oldgen_scan_bd->start;
     }
 
@@ -4063,7 +4116,9 @@ scavenge_large(step *stp)
 
     p = bd->start;
     if (scavenge_one(p)) {
-       recordMutableGen((StgClosure *)p, stp->gen);
+       if (stp->gen_no > 0) {
+           recordMutableGen((StgClosure *)p, stp->gen);
+       }
     }
   }
 }
@@ -4215,7 +4270,7 @@ threadLazyBlackHole(StgTSO *tso)
            
            if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
 #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
-               debugBelch("Unexpected lazy BHing required at 0x%04x\n",(int)bh);
+               debugBelch("Unexpected lazy BHing required at 0x%04lx\n",(long)bh);
 #endif
 #ifdef PROFILING
                // @LDV profiling
@@ -4340,7 +4395,7 @@ threadSqueezeStack(StgTSO *tso)
                if (bh->header.info != &stg_BLACKHOLE_info &&
                    bh->header.info != &stg_CAF_BLACKHOLE_info) {
 #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
-                   debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);
+                   debugBelch("Unexpected lazy BHing required at 0x%04lx",(long)bh);
 #endif
 #ifdef DEBUG
                    // zero out the slop so that the sanity checker can tell