A small GC optimisation
[ghc-hetmet.git] / rts / sm / Storage.c
index c2a1911..1b8a720 100644 (file)
@@ -40,8 +40,8 @@ StgClosure    *caf_list         = NULL;
 StgClosure    *revertible_caf_list = NULL;
 rtsBool       keepCAFs;
 
-nat alloc_blocks_lim;    /* GC if n_large_blocks in any nursery
-                          * reaches this. */
+nat large_alloc_lim;    /* GC if n_large_blocks in any nursery
+                         * reaches this. */
 
 bdescr *exec_block;
 
@@ -77,8 +77,7 @@ initGeneration (generation *gen, int g)
     gen->n_old_blocks = 0;
     gen->large_objects = NULL;
     gen->n_large_blocks = 0;
-    gen->n_new_large_blocks = 0;
-    gen->mut_list = allocBlock();
+    gen->n_new_large_words = 0;
     gen->scavenged_large_objects = NULL;
     gen->n_scavenged_large_blocks = 0;
     gen->mark = 0;
@@ -181,7 +180,7 @@ initStorage( void )
   revertible_caf_list = END_OF_STATIC_LIST;
    
   /* initialise the allocate() interface */
-  alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
+  large_alloc_lim = RtsFlags.GcFlags.minAllocAreaSize * BLOCK_SIZE_W;
 
   exec_block = NULL;
 
@@ -209,14 +208,14 @@ initStorage( void )
 void
 exitStorage (void)
 {
-    stat_exit(calcAllocated());
+    stat_exit(calcAllocated(rtsTrue));
 }
 
 void
-freeStorage (void)
+freeStorage (rtsBool free_heap)
 {
     stgFree(generations);
-    freeAllMBlocks();
+    if (free_heap) freeAllMBlocks();
 #if defined(THREADED_RTS)
     closeMutex(&sm_mutex);
 #endif
@@ -290,7 +289,9 @@ newCAF(StgRegTable *reg, StgClosure* caf)
   {
     // Put this CAF on the mutable list for the old generation.
     ((StgIndStatic *)caf)->saved_info = NULL;
-    recordMutableCap(caf, regTableToCapability(reg), oldest_gen->no);
+    if (oldest_gen->no != 0) {
+        recordMutableCap(caf, regTableToCapability(reg), oldest_gen->no);
+    }
   }
 }
 
@@ -329,32 +330,48 @@ newDynCAF (StgRegTable *reg STG_UNUSED, StgClosure *caf)
 static bdescr *
 allocNursery (bdescr *tail, nat blocks)
 {
-    bdescr *bd;
-    nat i;
+    bdescr *bd = NULL;
+    nat i, n;
 
-    // Allocate a nursery: we allocate fresh blocks one at a time and
-    // cons them on to the front of the list, not forgetting to update
-    // the back pointer on the tail of the list to point to the new block.
-    for (i=0; i < blocks; i++) {
-       // @LDV profiling
-       /*
-         processNursery() in LdvProfile.c assumes that every block group in
-         the nursery contains only a single block. So, if a block group is
-         given multiple blocks, change processNursery() accordingly.
-       */
-       bd = allocBlock();
-       bd->link = tail;
-       // double-link the nursery: we might need to insert blocks
-       if (tail != NULL) {
-           tail->u.back = bd;
-       }
-        initBdescr(bd, g0, g0);
-       bd->flags = 0;
-       bd->free = bd->start;
-       tail = bd;
+    // We allocate the nursery as a single contiguous block and then
+    // divide it into single blocks manually.  This way we guarantee
+    // that the nursery blocks are adjacent, so that the processor's
+    // automatic prefetching works across nursery blocks.  This is a
+    // tiny optimisation (~0.5%), but it's free.
+
+    while (blocks > 0) {
+        n = stg_min(blocks, BLOCKS_PER_MBLOCK);
+        blocks -= n;
+
+        bd = allocGroup(n);
+        for (i = 0; i < n; i++) {
+            initBdescr(&bd[i], g0, g0);
+
+            bd[i].blocks = 1;
+            bd[i].flags = 0;
+
+            if (i > 0) {
+                bd[i].u.back = &bd[i-1];
+            } else {
+                bd[i].u.back = NULL;
+            }
+
+            if (i+1 < n) {
+                bd[i].link = &bd[i+1];
+            } else {
+                bd[i].link = tail;
+                if (tail != NULL) {
+                    tail->u.back = &bd[i];
+                }
+            }
+
+            bd[i].free = bd[i].start;
+        }
+
+        tail = &bd[0];
     }
-    tail->u.back = NULL;
-    return tail;
+
+    return &bd[0];
 }
 
 static void
@@ -383,21 +400,31 @@ allocNurseries( void )
     assignNurseriesToCapabilities();
 }
       
-void
-resetNurseries( void )
+lnat // words allocated
+clearNurseries (void)
 {
+    lnat allocated = 0;
     nat i;
     bdescr *bd;
 
     for (i = 0; i < n_capabilities; i++) {
        for (bd = nurseries[i].blocks; bd; bd = bd->link) {
-           bd->free = bd->start;
+            allocated += (lnat)(bd->free - bd->start);
+            bd->free = bd->start;
            ASSERT(bd->gen_no == 0);
            ASSERT(bd->gen == g0);
            IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
        }
     }
+
+    return allocated;
+}
+
+void
+resetNurseries (void)
+{
     assignNurseriesToCapabilities();
+
 }
 
 lnat
@@ -477,12 +504,12 @@ resizeNurseries (nat blocks)
 
 
 /* -----------------------------------------------------------------------------
-   move_TSO is called to update the TSO structure after it has been
+   move_STACK is called to update the TSO structure after it has been
    moved from one place to another.
    -------------------------------------------------------------------------- */
 
 void
-move_TSO (StgTSO *src, StgTSO *dest)
+move_STACK (StgStack *src, StgStack *dest)
 {
     ptrdiff_t diff;
 
@@ -492,45 +519,6 @@ move_TSO (StgTSO *src, StgTSO *dest)
 }
 
 /* -----------------------------------------------------------------------------
-   split N blocks off the front of the given bdescr, returning the
-   new block group.  We add the remainder to the large_blocks list
-   in the same step as the original block.
-   -------------------------------------------------------------------------- */
-
-bdescr *
-splitLargeBlock (bdescr *bd, nat blocks)
-{
-    bdescr *new_bd;
-
-    ACQUIRE_SM_LOCK;
-
-    ASSERT(countBlocks(bd->gen->large_objects) == bd->gen->n_large_blocks);
-
-    // subtract the original number of blocks from the counter first
-    bd->gen->n_large_blocks -= bd->blocks;
-
-    new_bd = splitBlockGroup (bd, blocks);
-    initBdescr(new_bd, bd->gen, bd->gen->to);
-    new_bd->flags   = BF_LARGE | (bd->flags & BF_EVACUATED); 
-    // if new_bd is in an old generation, we have to set BF_EVACUATED
-    new_bd->free    = bd->free;
-    dbl_link_onto(new_bd, &bd->gen->large_objects);
-
-    ASSERT(new_bd->free <= new_bd->start + new_bd->blocks * BLOCK_SIZE_W);
-
-    // add the new number of blocks to the counter.  Due to the gaps
-    // for block descriptors, new_bd->blocks + bd->blocks might not be
-    // equal to the original bd->blocks, which is why we do it this way.
-    bd->gen->n_large_blocks += bd->blocks + new_bd->blocks;
-
-    ASSERT(countBlocks(bd->gen->large_objects) == bd->gen->n_large_blocks);
-
-    RELEASE_SM_LOCK;
-
-    return new_bd;
-}
-
-/* -----------------------------------------------------------------------------
    allocate()
 
    This allocates memory in the current thread - it is intended for
@@ -570,7 +558,7 @@ allocate (Capability *cap, lnat n)
        bd = allocGroup(req_blocks);
        dbl_link_onto(bd, &g0->large_objects);
        g0->n_large_blocks += bd->blocks; // might be larger than req_blocks
-       g0->n_new_large_blocks += bd->blocks;
+        g0->n_new_large_words += n;
         RELEASE_SM_LOCK;
         initBdescr(bd, g0, g0);
        bd->flags = BF_LARGE;
@@ -672,13 +660,13 @@ allocatePinned (Capability *cap, lnat n)
        cap->pinned_object_block = bd = allocBlock();
        dbl_link_onto(bd, &g0->large_objects);
        g0->n_large_blocks++;
-       g0->n_new_large_blocks++;
         RELEASE_SM_LOCK;
         initBdescr(bd, g0, g0);
        bd->flags  = BF_PINNED | BF_LARGE;
        bd->free   = bd->start;
     }
 
+    g0->n_new_large_words += n;
     p = bd->free;
     bd->free += n;
     return p;
@@ -713,8 +701,8 @@ dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
 void
 setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target)
 {
-    if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
-        tso->flags |= TSO_LINK_DIRTY;
+    if (tso->dirty == 0) {
+        tso->dirty = 1;
         recordClosureMutated(cap,(StgClosure*)tso);
     }
     tso->_link = target;
@@ -723,8 +711,8 @@ setTSOLink (Capability *cap, StgTSO *tso, StgTSO *target)
 void
 setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target)
 {
-    if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
-        tso->flags |= TSO_LINK_DIRTY;
+    if (tso->dirty == 0) {
+        tso->dirty = 1;
         recordClosureMutated(cap,(StgClosure*)tso);
     }
     tso->block_info.prev = target;
@@ -733,10 +721,19 @@ setTSOPrev (Capability *cap, StgTSO *tso, StgTSO *target)
 void
 dirty_TSO (Capability *cap, StgTSO *tso)
 {
-    if (tso->dirty == 0 && (tso->flags & TSO_LINK_DIRTY) == 0) {
+    if (tso->dirty == 0) {
+        tso->dirty = 1;
         recordClosureMutated(cap,(StgClosure*)tso);
     }
-    tso->dirty = 1;
+}
+
+void
+dirty_STACK (Capability *cap, StgStack *stack)
+{
+    if (stack->dirty == 0) {
+        stack->dirty = 1;
+        recordClosureMutated(cap,(StgClosure*)stack);
+    }
 }
 
 /*
@@ -766,33 +763,26 @@ dirty_MVAR(StgRegTable *reg, StgClosure *p)
  * -------------------------------------------------------------------------- */
 
 lnat
-calcAllocated( void )
+calcAllocated (rtsBool include_nurseries)
 {
-  nat allocated;
+  nat allocated = 0;
   bdescr *bd;
   nat i;
 
-  allocated = countNurseryBlocks() * BLOCK_SIZE_W;
-  
-  for (i = 0; i < n_capabilities; i++) {
-      Capability *cap;
-      for ( bd = capabilities[i].r.rCurrentNursery->link; 
-           bd != NULL; bd = bd->link ) {
-         allocated -= BLOCK_SIZE_W;
-      }
-      cap = &capabilities[i];
-      if (cap->r.rCurrentNursery->free < 
-         cap->r.rCurrentNursery->start + BLOCK_SIZE_W) {
-         allocated -= (cap->r.rCurrentNursery->start + BLOCK_SIZE_W)
-             - cap->r.rCurrentNursery->free;
-      }
-      if (cap->pinned_object_block != NULL) {
-          allocated -= (cap->pinned_object_block->start + BLOCK_SIZE_W) - 
-              cap->pinned_object_block->free;
+  // When called from GC.c, we already have the allocation count for
+  // the nursery from resetNurseries(), so we don't need to walk
+  // through these block lists again.
+  if (include_nurseries)
+  {
+      for (i = 0; i < n_capabilities; i++) {
+          for (bd = nurseries[i].blocks; bd; bd = bd->link) {
+              allocated += (lnat)(bd->free - bd->start);
+          }
       }
   }
 
-  allocated += g0->n_new_large_blocks * BLOCK_SIZE_W;
+  // add in sizes of new large and pinned objects
+  allocated += g0->n_new_large_words;
 
   return allocated;
 }