[commit: ghc] master: Cache the size of part_list/scavd_list (#11783) (5c4cd0e)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/5c4cd0e44657d52f7ca5fee63f8765d17f1fbe85/ghc

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

commit 5c4cd0e44657d52f7ca5fee63f8765d17f1fbe85
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.


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

5c4cd0e44657d52f7ca5fee63f8765d17f1fbe85
 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 d861db9..02bb3bb 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 45bb54c..18ae796 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)