Allow "INLINEABLE" as a synonym

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

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 3bd5017..ec5f700 100644 (file)
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -395,13 +395,6 @@ SET_GCT(gc_threads[0]);
       // The other threads are now stopped.  We might recurse back to
       // here, but from now on this is the only thread.
       
-      // if any blackholes are alive, make the threads that wait on
-      // them alive too.
-      if (traverseBlackholeQueue()) {
-         inc_running(); 
-         continue;
-      }
-  
       // must be last...  invariant is that everything is fully
       // scavenged at this point.
       if (traverseWeakPtrList()) { // returns rtsTrue if evaced something 
@@ -418,6 +411,16 @@ SET_GCT(gc_threads[0]);
   // Now see which stable names are still alive.
   gcStablePtrTable();
 
+#ifdef THREADED_RTS
+  if (n_gc_threads == 1) {
+      for (n = 0; n < n_capabilities; n++) {
+          pruneSparkQueue(&capabilities[n]);
+      }
+  } else {
+      pruneSparkQueue(&capabilities[gct->thread_index]);
+  }
+#endif
+
 #ifdef PROFILING
   // We call processHeapClosureForDead() on every closure destroyed during
   // the current garbage collection, so we invoke LdvCensusForDead().
@@ -724,20 +727,38 @@ SET_GCT(gc_threads[0]);
   // Reset the nursery
   resetNurseries();
 
-  // start any pending finalizers 
-  RELEASE_SM_LOCK;
-  scheduleFinalizers(cap, old_weak_ptr_list);
-  ACQUIRE_SM_LOCK;
-  
   // send exceptions to any threads which were about to die 
   RELEASE_SM_LOCK;
   resurrectThreads(resurrected_threads);
-  performPendingThrowTos(exception_threads);
   ACQUIRE_SM_LOCK;
 
   // Update the stable pointer hash table.
   updateStablePtrTable(major_gc);
 
+  // unlock the StablePtr table.  Must be before scheduleFinalizers(),
+  // because a finalizer may call hs_free_fun_ptr() or
+  // hs_free_stable_ptr(), both of which access the StablePtr table.
+  stablePtrPostGC();
+
+  // Start any pending finalizers.  Must be after
+  // updateStablePtrTable() and stablePtrPostGC() (see #4221).
+  RELEASE_SM_LOCK;
+  scheduleFinalizers(cap, old_weak_ptr_list);
+  ACQUIRE_SM_LOCK;
+
+  if (major_gc) {
+      nat need, got;
+      need = BLOCKS_TO_MBLOCKS(n_alloc_blocks);
+      got = mblocks_allocated;
+      /* If the amount of data remains constant, next major GC we'll
+         require (F+1)*need. We leave (F+2)*need in order to reduce
+         repeated deallocation and reallocation. */
+      need = (RtsFlags.GcFlags.oldGenFactor + 2) * need;
+      if (got > need) {
+          returnMemoryToOS(got - need);
+      }
+  }
+
   // check sanity after GC
   IF_DEBUG(sanity, checkSanity(rtsTrue));
 
@@ -769,9 +790,6 @@ SET_GCT(gc_threads[0]);
   slop = calcLiveBlocks() * BLOCK_SIZE_W - live;
   stat_endGC(allocated, live, copied, N, max_copied, avg_copied, slop);
 
-  // unlock the StablePtr table
-  stablePtrPostGC();
-
   // Guess which generation we'll collect *next* time
   initialise_N(force_major_gc);
 
@@ -997,6 +1015,9 @@ any_work (void)
 #endif
 
     gct->no_work++;
+#if defined(THREADED_RTS)
+    yieldThread();
+#endif
 
     return rtsFalse;
 }    
@@ -1077,6 +1098,16 @@ gcWorkerThread (Capability *cap)
 
     scavenge_until_all_done();
     
+#ifdef THREADED_RTS
+    // Now that the whole heap is marked, we discard any sparks that
+    // were found to be unreachable.  The main GC thread is currently
+    // marking heap reachable via weak pointers, so it is
+    // non-deterministic whether a spark will be retained if it is
+    // only reachable via weak pointers.  To fix this problem would
+    // require another GC barrier, which is too high a price.
+    pruneSparkQueue(cap);
+#endif
+
 #ifdef USE_PAPI
     // count events in this thread towards the GC totals
     papi_thread_stop_gc1_count(gct->papi_events);
@@ -1100,8 +1131,8 @@ gcWorkerThread (Capability *cap)
 void
 waitForGcThreads (Capability *cap USED_IF_THREADS)
 {
-    nat n_threads = RtsFlags.ParFlags.nNodes;
-    nat me = cap->no;
+    const nat n_threads = RtsFlags.ParFlags.nNodes;
+    const nat me = cap->no;
     nat i, j;
     rtsBool retry = rtsTrue;
 
@@ -1175,8 +1206,8 @@ shutdown_gc_threads (nat n_threads USED_IF_THREADS, nat me USED_IF_THREADS)
 void
 releaseGCThreads (Capability *cap USED_IF_THREADS)
 {
-    nat n_threads = RtsFlags.ParFlags.nNodes;
-    nat me = cap->no;
+    const nat n_threads = RtsFlags.ParFlags.nNodes;
+    const nat me = cap->no;
     nat i;
     for (i=0; i < n_threads; i++) {
         if (i == me) continue;
@@ -1278,6 +1309,10 @@ init_collected_gen (nat g, nat n_threads)
                 if (!(bd->flags & BF_FRAGMENTED)) {
                     bd->flags |= BF_MARKED;
                 }
+
+                // BF_SWEPT should be marked only for blocks that are being
+                // collected in sweep()
+                bd->flags &= ~BF_SWEPT;
             }
         }
     }
@@ -1463,8 +1498,8 @@ resize_generations (void)
 
     if (major_gc && RtsFlags.GcFlags.generations > 1) {
        nat live, size, min_alloc, words;
-       nat max  = RtsFlags.GcFlags.maxHeapSize;
-       nat gens = RtsFlags.GcFlags.generations;
+       const nat max  = RtsFlags.GcFlags.maxHeapSize;
+       const nat gens = RtsFlags.GcFlags.generations;
        
        // live in the oldest generations
         if (oldest_gen->live_estimate != 0) {
@@ -1489,11 +1524,10 @@ resize_generations (void)
 
        // Auto-enable compaction when the residency reaches a
        // certain percentage of the maximum heap size (default: 30%).
-       if (RtsFlags.GcFlags.generations > 1 &&
-           (RtsFlags.GcFlags.compact ||
-            (max > 0 &&
-             oldest_gen->n_blocks > 
-             (RtsFlags.GcFlags.compactThreshold * max) / 100))) {
+       if (RtsFlags.GcFlags.compact ||
+            (max > 0 &&
+             oldest_gen->n_blocks > 
+             (RtsFlags.GcFlags.compactThreshold * max) / 100)) {
            oldest_gen->mark = 1;
            oldest_gen->compact = 1;
 //       debugBelch("compaction: on\n", live);
@@ -1553,7 +1587,7 @@ resize_generations (void)
 static void
 resize_nursery (void)
 {
-    lnat min_nursery = RtsFlags.GcFlags.minAllocAreaSize * n_capabilities;
+    const lnat min_nursery = RtsFlags.GcFlags.minAllocAreaSize * n_capabilities;
 
     if (RtsFlags.GcFlags.generations == 1)
     {   // Two-space collector:
@@ -1613,7 +1647,7 @@ resize_nursery (void)
        if (RtsFlags.GcFlags.heapSizeSuggestion)
        {
            long blocks;
-           nat needed = calcNeeded();  // approx blocks needed at next GC 
+           const nat needed = calcNeeded();    // approx blocks needed at next GC 
            
            /* Guess how much will be live in generation 0 step 0 next time.
             * A good approximation is obtained by finding the