[project @ 2002-03-07 17:53:05 by keithw]
[ghc-hetmet.git] / ghc / rts / GC.c
index 42668e7..11f7911 100644 (file)
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.129 2001/11/28 15:42:05 simonmar Exp $
+ * $Id: GC.c,v 1.131 2002/03/07 17:53:05 keithw Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -218,6 +218,8 @@ pop_mark_stack(void)
       
      - free from-space in each step, and set from-space = to-space.
 
+   Locks held: sched_mutex
+
    -------------------------------------------------------------------------- */
 
 void
@@ -958,12 +960,17 @@ 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 
   scheduleFinalizers(old_weak_ptr_list);
   
   // 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);
 
@@ -1663,6 +1670,7 @@ loop:
 
          // perform the selection! 
          q = selectee->payload[offset];
+          if (major_gc==rtsTrue) {TICK_GC_SEL_MAJOR();} else {TICK_GC_SEL_MINOR();}
 
          /* if we're already in to-space, there's no need to continue
           * with the evacuation, just update the source address with
@@ -1716,8 +1724,10 @@ loop:
                  thunk_selector_depth--;
                  goto selector_loop;
              }
-         }
-         // otherwise, fall through... 
+         } else {
+              TICK_GC_SEL_ABANDONED();
+              // and fall through...
+          }
 #         endif
 
       case AP_UPD: