[project @ 2005-11-02 13:05:30 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 3f91210..9a21af8 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -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;
@@ -437,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++) {
@@ -539,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.
@@ -693,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
@@ -701,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;
       }
   }
 
@@ -1108,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);
@@ -1156,6 +1182,8 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   unblockUserSignals();
 #endif
 
+  RELEASE_SM_LOCK;
+
   //PAR_TICKY_TP();
 }
 
@@ -4242,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
@@ -4367,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