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

On branch  : local-gc

http://hackage.haskell.org/trac/ghc/changeset/b044b6f4d33a465a90320bb7d36e85a6885110d1

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

commit b044b6f4d33a465a90320bb7d36e85a6885110d1
Merge: 9c9d1fd... cc2ea98...
Author: Simon Marlow <[email protected]>
Date:   Sun Jun 5 16:04:22 2011 +0100

    merge commit cc2ea98ac4a15e40a15e89de9e47f33e191ba393

 HACKING                          |    7 ++++++-
 aclocal.m4                       |   10 +++-------
 compiler/cmm/CmmExpr.hs          |    6 ++++--
 compiler/cmm/OptimizationFuel.hs |   14 --------------
 compiler/codeGen/CodeGen.lhs     |    2 +-
 compiler/codeGen/StgCmm.hs       |    3 ++-
 compiler/utils/GraphOps.hs       |   15 ++++++++-------
 compiler/utils/UniqFM.lhs        |   23 ++++++++++++++++++++++-
 rts/Stats.c                      |    7 +++++++
 rts/sm/GC.c                      |    7 -------
 rts/sm/Sanity.c                  |    4 ++++
 rts/sm/Storage.c                 |   27 +++++++++++++++++++++------
 12 files changed, 78 insertions(+), 47 deletions(-)

diff --cc rts/Stats.c
index 1162d2b,3e7b5d8..bfb82c4
--- a/rts/Stats.c
+++ b/rts/Stats.c
@@@ -887,42 -795,34 +887,49 @@@ statDescribeGens(void
        gen_live   = genLiveWords(gen);
        gen_blocks = genLiveBlocks(gen);
  
 -      mut = 0;
 +      slop = gen_blocks * BLOCK_SIZE_W - gen_live;
 +
 +      debugBelch("%5d %7d %8d %8d %4s %8s %8d %8ld %8ld\n", 
 +                 g, gen->max_blocks, lge, gen->n_prim_blocks, "", "", 
gen_blocks, 
 +                 gen_live*sizeof(W_), slop*sizeof(W_));
 +
        for (i = 0; i < n_capabilities; i++) {
 -          mut += countOccupied(capabilities[i].mut_lists[g]);
 +          cap_mut    = countOccupied(capabilities[i].mut_lists[g]);
 +
 +          cap_live   = gcThreadLiveWords(i,n);
 +          cap_blocks = gcThreadLiveBlocks(i,n);
 +
 +          slop = cap_blocks * BLOCK_SIZE_W - cap_live;
 +
 +          debugBelch("%5s %7s %8s %8s %4d %8ld %8d %8ld %8ld\n", 
 +                     "", "", "", "", i, cap_mut*sizeof(W_), cap_blocks,
 +                     cap_live*sizeof(W_), slop*sizeof(W_));
  
+           // Add the pinned object block.
+           bd = capabilities[i].pinned_object_block;
+           if (bd != NULL) {
+               gen_live   += bd->free - bd->start;
+               gen_blocks += bd->blocks;
+           }
+ 
 -          gen_live   += gcThreadLiveWords(i,g);
 -          gen_live   += gcThreadLiveWords(i,g);
 -          gen_blocks += gcThreadLiveBlocks(i,g);
 -      }
 +          gen_mut    += cap_mut;
 +          gen_live   += cap_live;
 +          gen_blocks += cap_blocks;
 +      }         
  
 -      debugBelch("%5d %7d %9d", g, gen->max_blocks, mut);
 +      debugBelch("%55s-----------------\n","");
 +      debugBelch("%5s %7s %8s %4s %8s %8s %8s %8ld %8ld\n\n",
 +                 "", "", "", "", "", "", "", 
 +                 gen_live*sizeof(W_), slop*sizeof(W_));
  
 -      gen_slop = gen_blocks * BLOCK_SIZE_W - gen_live;
 +      slop = gen_blocks * BLOCK_SIZE_W - gen_live;
  
 -      debugBelch("%8ld %8d %8ld %8ld\n", gen_blocks, lge,
 -                 gen_live*sizeof(W_), gen_slop*sizeof(W_));
        tot_live += gen_live;
 -      tot_slop += gen_slop;
 +      tot_slop += slop;
    }
 -  debugBelch("----------------------------------------------------------\n");
 -  debugBelch("%41s%8ld %8ld\n","",tot_live*sizeof(W_),tot_slop*sizeof(W_));
 -  debugBelch("----------------------------------------------------------\n");
 +  
debugBelch("------------------------------------------------------------------------\n");
 +  debugBelch("%55s%8ld %8ld\n","",tot_live*sizeof(W_),tot_slop*sizeof(W_));
 +  
debugBelch("------------------------------------------------------------------------\n");
    debugBelch("\n");
  }
  
diff --cc rts/sm/GC.c
index ba4aab2,3036140..3375760
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@@ -658,25 -597,18 +658,18 @@@ GarbageCollect (nat N, // generation t
    // update the max size of older generations after a major GC
    resize_generations();
    
-   // Start a new pinned_object_block
-   if (gc_type == GC_LOCAL) {
-       cap->pinned_object_block = NULL;
-   } else {
-       for (n = 0; n < n_capabilities; n++) {
-           capabilities[n].pinned_object_block = NULL;
-       }
 -  // Free the mark stack.
 -  if (mark_stack_top_bd != NULL) {
 -      debugTrace(DEBUG_gc, "mark stack: %d blocks",
 -                 countBlocks(mark_stack_top_bd));
 -      freeChain(mark_stack_top_bd);
    }
  
 +  // Free the mark stack, leaving one block.
 +  freeMarkStack();
 +      
    // Free any bitmaps.
 -  for (g = 0; g <= N; g++) {
 -      gen = &generations[g];
 +  for (g = 0; g < total_generations; g++) {
 +      gen = &all_generations[g];
 +      if (gct->gc_type == GC_LOCAL && isNonLocalGen(gen))
 +          continue;
        if (gen->bitmap != NULL) {
 -          freeGroup(gen->bitmap);
 +          freeGroup_sync(gen->bitmap);
            gen->bitmap = NULL;
        }
    }
diff --cc rts/sm/Sanity.c
index 8c82d47,0ec552c..623831a
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@@ -1109,7 -789,7 +1109,8 @@@ findMemoryLeak (void
  
      for (i = 0; i < n_capabilities; i++) {
          markBlocks(nurseries[i].blocks);
 +        markBlocks(gc_threads[i]->mark_stack_top_bd);
+         markBlocks(capabilities[i].pinned_object_block);
      }
  
  #ifdef PROFILING
@@@ -1205,13 -881,11 +1206,16 @@@ memInventory (rtsBool show
    for (i = 0; i < n_capabilities; i++) {
        ASSERT(countBlocks(nurseries[i].blocks) == nurseries[i].n_blocks);
        nursery_blocks += nurseries[i].n_blocks;
+       if (capabilities[i].pinned_object_block != NULL) {
+           nursery_blocks += capabilities[i].pinned_object_block->blocks;
+       }
    }
  
 +  mark_stack_blocks = 0;
 +  for (i = 0; i < n_capabilities; i++) {
 +      mark_stack_blocks += countBlocks(gc_threads[i]->mark_stack_top_bd);
 +  }
 +
    retainer_blocks = 0;
  #ifdef PROFILING
    if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) {
diff --cc rts/sm/Storage.c
index 1920a3c,f8a9e55..4cb22f5
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@@ -765,18 -657,32 +765,33 @@@ allocatePinned (Capability *cap, lnat n
      // If we don't have a block of pinned objects yet, or the current
      // one isn't large enough to hold the new object, allocate a new one.
      if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) {
+         // The pinned_object_block remains attached to the capability
+         // until it is full, even if a GC occurs.  We want this
+         // behaviour because otherwise the unallocated portion of the
+         // block would be forever slop, and under certain workloads
+         // (allocating a few ByteStrings per GC) we accumulate a lot
+         // of slop.
+         //
+         // So, the pinned_object_block is initially marked
+         // BF_EVACUATED so the GC won't touch it.  When it is full,
+         // we place it on the large_objects list, and at the start of
+         // the next GC the BF_EVACUATED flag will be cleared, and the
+         // block will be promoted as usual (if anything in it is
+         // live).
          ACQUIRE_SM_LOCK;
-       cap->pinned_object_block = bd = allocBlock();
 +        gen = cap->r.rG0; // use our local G0
-       dbl_link_onto(bd, &gen->large_objects);
-       gen->n_large_blocks++;
+         if (bd != NULL) {
 -            dbl_link_onto(bd, &g0->large_objects);
 -            g0->n_large_blocks++;
++            dbl_link_onto(bd, &gen->large_objects);
++            gen->n_large_blocks++;
+             g0->n_new_large_words += bd->free - bd->start;
+         }
+         cap->pinned_object_block = bd = allocBlock();
          RELEASE_SM_LOCK;
 -        initBdescr(bd, g0, g0);
 +        initBdescr(bd, gen, gen);
-       bd->flags  = BF_PINNED | BF_LARGE;
-       bd->free   = bd->start;
+         bd->flags  = BF_PINNED | BF_LARGE | BF_EVACUATED;
 -      bd->free   = bd->start;
++        bd->free   = bd->start;
      }
  
-     cap->r.rG0->n_new_large_words += n;
      p = bd->free;
      bd->free += n;
      return p;



_______________________________________________
Cvs-ghc mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to