[commit: ghc] master: Cache the result of countOccupied(gen->large_objects) as gen->n_large_words (#7257) (016fd74)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/016fd74d6517512b62b36ff12cdccf2e723a0fb3

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

commit 016fd74d6517512b62b36ff12cdccf2e723a0fb3
Author: Simon Marlow <[email protected]>
Date:   Fri Sep 21 13:18:49 2012 +0100

    Cache the result of countOccupied(gen->large_objects) as gen->n_large_words (#7257)
    
    The program in #7257 was spending 90% of its time counting the live
    data in gen->large_objects.  We already avoid doing this for small
    objects, but in this example the old generation was full of large
    objects (actually pinned ByteStrings).

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

 includes/rts/storage/GC.h |    1 +
 rts/sm/GC.c               |    5 ++++-
 rts/sm/Storage.c          |    3 ++-
 3 files changed, 7 insertions(+), 2 deletions(-)

diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h
index fadaa8c..a5f4ed6 100644
--- a/includes/rts/storage/GC.h
+++ b/includes/rts/storage/GC.h
@@ -75,6 +75,7 @@ typedef struct generation_ {
 
     bdescr *       large_objects;	// large objects (doubly linked)
     memcount       n_large_blocks;      // no. of blocks used by large objs
+    memcount       n_large_words;       // no. of words used by large objs
     memcount       n_new_large_words;   // words of new large objects
                                         // (for allocation stats)
 
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 9360645..03c3068 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -578,6 +578,7 @@ GarbageCollect (nat collect_gen,
         freeChain(gen->large_objects);
         gen->large_objects  = gen->scavenged_large_objects;
         gen->n_large_blocks = gen->n_scavenged_large_blocks;
+        gen->n_large_words  = countOccupied(gen->large_objects);
         gen->n_new_large_words = 0;
     }
     else // for generations > N
@@ -589,13 +590,15 @@ GarbageCollect (nat collect_gen,
 	for (bd = gen->scavenged_large_objects; bd; bd = next) {
             next = bd->link;
             dbl_link_onto(bd, &gen->large_objects);
-	}
+            gen->n_large_words += bd->free - bd->start;
+        }
         
 	// add the new blocks we promoted during this GC 
 	gen->n_large_blocks += gen->n_scavenged_large_blocks;
     }
 
     ASSERT(countBlocks(gen->large_objects) == gen->n_large_blocks);
+    ASSERT(countOccupied(gen->large_objects) == gen->n_large_words);
 
     gen->scavenged_large_objects = NULL;
     gen->n_scavenged_large_blocks = 0;
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 755c654..dd2ee31 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -78,6 +78,7 @@ initGeneration (generation *gen, int g)
     gen->n_old_blocks = 0;
     gen->large_objects = NULL;
     gen->n_large_blocks = 0;
+    gen->n_large_words = 0;
     gen->n_new_large_words = 0;
     gen->scavenged_large_objects = NULL;
     gen->n_scavenged_large_blocks = 0;
@@ -951,7 +952,7 @@ W_ countOccupied (bdescr *bd)
 
 W_ genLiveWords (generation *gen)
 {
-    return gen->n_words + countOccupied(gen->large_objects);
+    return gen->n_words + gen->n_large_words;
 }
 
 W_ genLiveBlocks (generation *gen)