[commit: ghc] ghc-8.0: Cache the size of part_list/scavd_list (#11783) (9649973)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/9649973c8038591a2c9f77e1183dd920b724daa5/ghc

>---------------------------------------------------------------

commit 9649973c8038591a2c9f77e1183dd920b724daa5
Author: Simon Marlow <marlowsd at gmail.com>
Date:   Mon Apr 11 19:29:14 2016 -0700

    Cache the size of part_list/scavd_list (#11783)
    
    After a parallel GC, it is possible to have a long list of blocks in
    ws->part_list, if we did a lot of work stealing but didn't fill up the
    blocks we stole.  These blocks persist until the next load-balanced GC,
    which might be a long time, and during every GC we were traversing this
    list to find its size.  The fix is to maintain the size all the time, so
    we don't have to compute it.
    
    (cherry picked from commit 5c4cd0e44657d52f7ca5fee63f8765d17f1fbe85)


>---------------------------------------------------------------

9649973c8038591a2c9f77e1183dd920b724daa5
 rts/sm/GC.c       |  7 ++++++-
 rts/sm/GCThread.h |  8 +++++---
 rts/sm/GCUtils.c  |  3 +++
 rts/sm/Storage.c  | 11 ++++++-----
 4 files changed, 20 insertions(+), 9 deletions(-)

diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 95d9951..470db0a 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -820,9 +820,11 @@ new_gc_thread (nat n, gc_thread *t)
 
         ws->part_list = NULL;
         ws->n_part_blocks = 0;
+        ws->n_part_words = 0;
 
         ws->scavd_list = NULL;
         ws->n_scavd_blocks = 0;
+        ws->n_scavd_words = 0;
     }
 }
 
@@ -1219,9 +1221,11 @@ prepare_collected_gen (generation *gen)
         }
         ws->part_list = NULL;
         ws->n_part_blocks = 0;
+        ws->n_part_words = 0;
 
         ASSERT(ws->scavd_list == NULL);
         ASSERT(ws->n_scavd_blocks == 0);
+        ASSERT(ws->n_scavd_words == 0);
 
         if (ws->todo_free != ws->todo_bd->start) {
             ws->todo_bd->free = ws->todo_free;
@@ -1346,7 +1350,6 @@ collect_gct_blocks (void)
 
             prev = NULL;
             for (bd = ws->scavd_list; bd != NULL; bd = bd->link) {
-                ws->gen->n_words += bd->free - bd->start;
                 prev = bd;
             }
             if (prev != NULL) {
@@ -1354,9 +1357,11 @@ collect_gct_blocks (void)
                 ws->gen->blocks = ws->scavd_list;
             }
             ws->gen->n_blocks += ws->n_scavd_blocks;
+            ws->gen->n_words += ws->n_scavd_words;
 
             ws->scavd_list = NULL;
             ws->n_scavd_blocks = 0;
+            ws->n_scavd_words = 0;
 
             RELEASE_SPIN_LOCK(&ws->gen->sync);
         }
diff --git a/rts/sm/GCThread.h b/rts/sm/GCThread.h
index ca90717..1fee7a6 100644
--- a/rts/sm/GCThread.h
+++ b/rts/sm/GCThread.h
@@ -94,13 +94,15 @@ typedef struct gen_workspace_ {
 
     // Objects that have already been scavenged.
     bdescr *     scavd_list;
-    nat          n_scavd_blocks;     // count of blocks in this list
+    StgWord      n_scavd_blocks;     // count of blocks in this list
+    StgWord      n_scavd_words;
 
     // Partially-full, scavenged, blocks
     bdescr *     part_list;
-    unsigned int n_part_blocks;      // count of above
+    StgWord      n_part_blocks;      // count of above
+    StgWord      n_part_words;
 
-    StgWord pad[3];
+    StgWord pad[1];
 
 } gen_workspace ATTRIBUTE_ALIGNED(64);
 // align so that computing gct->gens[n] is a shift, not a multiply
diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c
index 1c6a93c..364a10a 100644
--- a/rts/sm/GCUtils.c
+++ b/rts/sm/GCUtils.c
@@ -146,6 +146,7 @@ push_scanned_block (bdescr *bd, gen_workspace *ws)
         bd->link = ws->part_list;
         ws->part_list = bd;
         ws->n_part_blocks += bd->blocks;
+        ws->n_part_words += bd->free - bd->start;
         IF_DEBUG(sanity,
                  ASSERT(countBlocks(ws->part_list) == ws->n_part_blocks));
     }
@@ -155,6 +156,7 @@ push_scanned_block (bdescr *bd, gen_workspace *ws)
         bd->link = ws->scavd_list;
         ws->scavd_list = bd;
         ws->n_scavd_blocks += bd->blocks;
+        ws->n_scavd_words += bd->free - bd->start;
         IF_DEBUG(sanity,
                  ASSERT(countBlocks(ws->scavd_list) == ws->n_scavd_blocks));
     }
@@ -306,6 +308,7 @@ alloc_todo_block (gen_workspace *ws, nat size)
     {
         ws->part_list = bd->link;
         ws->n_part_blocks -= bd->blocks;
+        ws->n_part_words -= bd->free - bd->start;
     }
     else
     {
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index bfc6eb1..cd66e06 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -1183,13 +1183,14 @@ W_ genLiveBlocks (generation *gen)
 
 W_ gcThreadLiveWords (nat i, nat g)
 {
-    W_ words;
+    W_ a, b, c;
 
-    words   = countOccupied(gc_threads[i]->gens[g].todo_bd);
-    words  += countOccupied(gc_threads[i]->gens[g].part_list);
-    words  += countOccupied(gc_threads[i]->gens[g].scavd_list);
+    a = countOccupied(gc_threads[i]->gens[g].todo_bd);
+    b = gc_threads[i]->gens[g].n_part_words;
+    c = gc_threads[i]->gens[g].n_scavd_words;
 
-    return words;
+//    debugBelch("cap %d, g%d, %ld %ld %ld\n", i, g, a, b, c);
+    return a + b + c;
 }
 
 W_ gcThreadLiveBlocks (nat i, nat g)