do a better job of re-using partial blocks in subsequent GCs
[ghc-hetmet.git] / rts / sm / GC.c
index b381e56..f869ec4 100644 (file)
@@ -144,7 +144,7 @@ static void update_task_list        (void);
 static void resize_generations      (void);
 static void resize_nursery          (void);
 static void start_gc_threads        (void);
-static void gc_thread_work          (void);
+static void scavenge_until_all_done (void);
 static nat  inc_running             (void);
 static nat  dec_running             (void);
 static void wakeup_gc_threads       (nat n_threads);
@@ -350,7 +350,7 @@ GarbageCollect ( rtsBool force_major_gc )
    */
   for (;;)
   {
-      gc_thread_work();
+      scavenge_until_all_done();
       // The other threads are now stopped.  We might recurse back to
       // here, but from now on this is the only thread.
       
@@ -408,9 +408,7 @@ GarbageCollect ( rtsBool force_major_gc )
       }
   }
 
-  // For each workspace, in each thread:
-  //    * clear the BF_EVACUATED flag from each copied block
-  //    * move the copied blocks to the step
+  // For each workspace, in each thread, move the copied blocks to the step
   {
       gc_thread *thr;
       step_workspace *ws;
@@ -438,7 +436,6 @@ GarbageCollect ( rtsBool force_major_gc )
               
               prev = NULL;
               for (bd = ws->scavd_list; bd != NULL; bd = bd->link) {
-                  bd->flags &= ~BF_EVACUATED;   // now from-space 
                   ws->step->n_words += bd->free - bd->start;
                   prev = bd;
               }
@@ -447,6 +444,23 @@ GarbageCollect ( rtsBool force_major_gc )
                   ws->step->blocks = ws->scavd_list;
               } 
               ws->step->n_blocks += ws->n_scavd_blocks;
+          }
+      }
+
+      // Add all the partial blocks *after* we've added all the full
+      // blocks.  This is so that we can grab the partial blocks back
+      // again and try to fill them up in the next GC.
+      for (t = 0; t < n_gc_threads; t++) {
+         thr = gc_threads[t];
+
+          // not step 0
+          if (RtsFlags.GcFlags.generations == 1) {
+              s = 0;
+          } else {
+              s = 1;
+          }
+          for (; s < total_steps; s++) {
+              ws = &thr->steps[s];
 
               prev = NULL;
               for (bd = ws->part_list; bd != NULL; bd = next) {
@@ -460,7 +474,6 @@ GarbageCollect ( rtsBool force_major_gc )
                       freeGroup(bd);
                       ws->n_part_blocks--;
                   } else {
-                      bd->flags &= ~BF_EVACUATED;       // now from-space 
                       ws->step->n_words += bd->free - bd->start;
                       prev = bd;
                   }
@@ -543,7 +556,6 @@ GarbageCollect ( rtsBool force_major_gc )
                // for a compacted step, just shift the new to-space
                // onto the front of the now-compacted existing blocks.
                for (bd = stp->blocks; bd != NULL; bd = bd->link) {
-                   bd->flags &= ~BF_EVACUATED;  // now from-space 
                     stp->n_words += bd->free - bd->start;
                }
                // tack the new blocks on the end of the existing blocks
@@ -585,10 +597,6 @@ GarbageCollect ( rtsBool force_major_gc )
          bd = next;
        }
 
-       // update the count of blocks used by large objects
-       for (bd = stp->scavenged_large_objects; bd != NULL; bd = bd->link) {
-         bd->flags &= ~BF_EVACUATED;
-       }
        stp->large_objects  = stp->scavenged_large_objects;
        stp->n_large_blocks = stp->n_scavenged_large_blocks;
 
@@ -601,7 +609,6 @@ GarbageCollect ( rtsBool force_major_gc )
         */
        for (bd = stp->scavenged_large_objects; bd; bd = next) {
          next = bd->link;
-         bd->flags &= ~BF_EVACUATED;
          dbl_link_onto(bd, &stp->large_objects);
        }
 
@@ -883,26 +890,13 @@ dec_running (void)
     return n_running;
 }
 
-//
-// gc_thread_work(): Scavenge until there's no work left to do and all
-// the running threads are idle.
-//
 static void
-gc_thread_work (void)
+scavenge_until_all_done (void)
 {
     nat r;
        
     debugTrace(DEBUG_gc, "GC thread %d working", gct->thread_index);
 
-    // gc_running_threads has already been incremented for us; either
-    // this is the main thread and we incremented it inside
-    // GarbageCollect(), or this is a worker thread and the main
-    // thread bumped gc_running_threads before waking us up.
-
-    // Every thread evacuates some roots.
-    gct->evac_step = 0;
-    markSomeCapabilities(mark_root, gct, gct->thread_index, n_gc_threads);
-
 loop:
     scavenge_loop();
     // scavenge_loop() only exits when there's no work to do
@@ -927,8 +921,26 @@ loop:
     debugTrace(DEBUG_gc, "GC thread %d finished.", gct->thread_index);
 }
 
-
 #if defined(THREADED_RTS)
+//
+// gc_thread_work(): Scavenge until there's no work left to do and all
+// the running threads are idle.
+//
+static void
+gc_thread_work (void)
+{
+    // gc_running_threads has already been incremented for us; this is
+    // a worker thread and the main thread bumped gc_running_threads
+    // before waking us up.
+
+    // Every thread evacuates some roots.
+    gct->evac_step = 0;
+    markSomeCapabilities(mark_root, gct, gct->thread_index, n_gc_threads);
+
+    scavenge_until_all_done();
+}
+
+
 static void
 gc_thread_mainloop (void)
 {
@@ -1090,7 +1102,12 @@ init_collected_gen (nat g, nat n_threads)
        stp->scavenged_large_objects = NULL;
        stp->n_scavenged_large_blocks = 0;
 
-       // mark the large objects as not evacuated yet 
+       // mark the small objects as from-space
+       for (bd = stp->old_blocks; bd; bd = bd->link) {
+           bd->flags &= ~BF_EVACUATED;
+       }
+
+       // mark the large objects as from-space
        for (bd = stp->large_objects; bd; bd = bd->link) {
            bd->flags &= ~BF_EVACUATED;
        }
@@ -1179,11 +1196,12 @@ init_uncollected_gen (nat g, nat threads)
        stp->n_scavenged_large_blocks = 0;
     }
     
-    for (t = 0; t < threads; t++) {
-       for (s = 0; s < generations[g].n_steps; s++) {
+    for (s = 0; s < generations[g].n_steps; s++) {
            
+        stp = &generations[g].steps[s];
+
+        for (t = 0; t < threads; t++) {
            ws = &gc_threads[t]->steps[g * RtsFlags.GcFlags.steps + s];
-           stp = ws->step;
            
            ws->buffer_todo_bd = NULL;
            ws->todo_large_objects = NULL;
@@ -1214,8 +1232,26 @@ init_uncollected_gen (nat g, nat threads)
                alloc_todo_block(ws,0);
            }
        }
+
+        // deal out any more partial blocks to the threads' part_lists
+        t = 0;
+        while (stp->blocks && isPartiallyFull(stp->blocks))
+        {
+            bd = stp->blocks;
+            stp->blocks = bd->link;
+           ws = &gc_threads[t]->steps[g * RtsFlags.GcFlags.steps + s];
+            bd->link = ws->part_list;
+            ws->part_list = bd;
+            ws->n_part_blocks += 1;
+            bd->u.scan = bd->free;
+            stp->n_blocks -= 1;
+            stp->n_words -= bd->free - bd->start;
+            t++;
+            if (t == n_gc_threads) t = 0;
+        }
     }
 
+
     // Move the private mutable lists from each capability onto the
     // main mutable list for the generation.
     for (i = 0; i < n_capabilities; i++) {