X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2Fsm%2FGC.c;h=0d2ba85860fd36a996af6e69dceff1a820c8e84f;hb=06f9b7c365fb9e9b53723f892b4d63b4f7a56e9a;hp=af35150072da9db7781299f8996a0a0a935abc46;hpb=313734473b419f55ee39d2df442f93a49b709aa4;p=ghc-hetmet.git

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index af35150..0d2ba85 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -207,16 +207,11 @@ GarbageCollect ( rtsBool force_major_gc )
   }
 #endif
 
-  // tell the STM to discard any cached closures it's hoping to re-use
-  stmPreGCHook();
-
   // tell the stats department that we've started a GC 
   stat_startGC();
 
-#ifdef DEBUG
-  // check for memory leaks if DEBUG is on 
-  memInventory();
-#endif
+  // tell the STM to discard any cached closures it's hoping to re-use
+  stmPreGCHook();
 
 #ifdef DEBUG
   mutlist_MUTVARS = 0;
@@ -266,6 +261,11 @@ GarbageCollect ( rtsBool force_major_gc )
   }
 #endif
 
+#ifdef DEBUG
+  // check for memory leaks if DEBUG is on 
+  memInventory(traceClass(DEBUG_gc));
+#endif
+
   // check stack sanity *before* GC (ToDo: check all threads) 
   IF_DEBUG(sanity, checkFreeListSanity());
 
@@ -580,7 +580,9 @@ GarbageCollect ( rtsBool force_major_gc )
   resize_generations();
   
   // Guess the amount of live data for stats.
-  live = calcLive();
+  live = calcLiveBlocks() * BLOCK_SIZE_W;
+  debugTrace(DEBUG_gc, "Slop: %ldKB", 
+             (live - calcLiveWords()) / (1024/sizeof(W_)));
 
   // Free the small objects allocated via allocate(), since this will
   // all have been copied into G0S1 now.  
@@ -665,7 +667,7 @@ GarbageCollect ( rtsBool force_major_gc )
 
 #ifdef DEBUG
   // check for memory leaks if DEBUG is on 
-  memInventory();
+  memInventory(traceClass(DEBUG_gc));
 #endif
 
 #ifdef RTS_GTK_FRONTPANEL
@@ -689,6 +691,76 @@ GarbageCollect ( rtsBool force_major_gc )
   gct = saved_gct;
 }
 
+/* -----------------------------------------------------------------------------
+ * Mark all nodes pointed to by sparks in the spark queues (for GC) Does an
+ * implicit slide i.e. after marking all sparks are at the beginning of the
+ * spark pool and the spark pool only contains sparkable closures 
+ * -------------------------------------------------------------------------- */
+
+#ifdef THREADED_RTS
+static void
+markSparkQueue (evac_fn evac, Capability *cap)
+{ 
+    StgClosure **sparkp, **to_sparkp;
+    nat n, pruned_sparks; // stats only
+    StgSparkPool *pool;
+    
+    PAR_TICKY_MARK_SPARK_QUEUE_START();
+    
+    n = 0;
+    pruned_sparks = 0;
+    
+    pool = &(cap->r.rSparks);
+    
+    ASSERT_SPARK_POOL_INVARIANTS(pool);
+    
+#if defined(PARALLEL_HASKELL)
+    // stats only
+    n = 0;
+    pruned_sparks = 0;
+#endif
+	
+    sparkp = pool->hd;
+    to_sparkp = pool->hd;
+    while (sparkp != pool->tl) {
+        ASSERT(*sparkp!=NULL);
+        ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgClosure *)*sparkp)));
+        // ToDo?: statistics gathering here (also for GUM!)
+        if (closure_SHOULD_SPARK(*sparkp)) {
+            evac(sparkp);
+            *to_sparkp++ = *sparkp;
+            if (to_sparkp == pool->lim) {
+                to_sparkp = pool->base;
+            }
+            n++;
+        } else {
+            pruned_sparks++;
+        }
+        sparkp++;
+        if (sparkp == pool->lim) {
+            sparkp = pool->base;
+        }
+    }
+    pool->tl = to_sparkp;
+	
+    PAR_TICKY_MARK_SPARK_QUEUE_END(n);
+	
+#if defined(PARALLEL_HASKELL)
+    debugTrace(DEBUG_sched, 
+               "marked %d sparks and pruned %d sparks on [%x]",
+               n, pruned_sparks, mytid);
+#else
+    debugTrace(DEBUG_sched, 
+               "marked %d sparks and pruned %d sparks",
+               n, pruned_sparks);
+#endif
+    
+    debugTrace(DEBUG_sched,
+               "new spark queue len=%d; (hd=%p; tl=%p)\n",
+               sparkPoolSize(pool), pool->hd, pool->tl);
+}
+#endif
+
 /* ---------------------------------------------------------------------------
    Where are the roots that we know about?
 
@@ -1237,7 +1309,7 @@ init_uncollected_gen (nat g, nat threads)
 
 	    // If the block at the head of the list in this generation
 	    // is less than 3/4 full, then use it as a todo block.
-	    if (isPartiallyFull(stp->blocks))
+	    if (stp->blocks && isPartiallyFull(stp->blocks))
 	    {
 		ws->todo_bd = stp->blocks;
                 ws->todo_free = ws->todo_bd->free;