X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStorage.c;h=180e9c9d26c2ede0967cb35b32006e7ca606c76f;hb=5881f6a50c9c85985149047295106123a1b8e62a;hp=6595ad7d1940b515d4156710381f96e2145c7ab2;hpb=1dc12c3c4acba688327fb2429f0a822bd98a5753;p=ghc-hetmet.git

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 6595ad7..180e9c9 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.47 2001/08/09 12:12:23 sewardj Exp $
+ * $Id: Storage.c,v 1.58 2002/01/24 01:45:55 sof Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -7,6 +7,7 @@
  *
  * ---------------------------------------------------------------------------*/
 
+#include "PosixSource.h"
 #include "Rts.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
@@ -16,14 +17,13 @@
 #include "MBlock.h"
 #include "Weak.h"
 #include "Sanity.h"
+#include "Arena.h"
 
 #include "Storage.h"
 #include "Schedule.h"
 #include "StoragePriv.h"
 
-#ifndef SMP
-nat nursery_blocks;		/* number of blocks in the nursery */
-#endif
+#include "RetainerProfile.h"	// for counting memory blocks (memInventory)
 
 StgClosure    *caf_list         = NULL;
 
@@ -65,29 +65,19 @@ initStorage( void )
   step *stp;
   generation *gen;
 
-  /* If we're doing heap profiling, we want a two-space heap with a
-   * fixed-size allocation area so that we get roughly even-spaced
-   * samples.
-   */
-
-  /* As an experiment, try a 2 generation collector
-   */
-
-#if defined(PROFILING) || defined(DEBUG)
-  if (RtsFlags.ProfFlags.doHeapProfile) {
-    RtsFlags.GcFlags.generations = 1;
-    RtsFlags.GcFlags.steps = 1;
-    RtsFlags.GcFlags.oldGenFactor = 0;
-    RtsFlags.GcFlags.heapSizeSuggestion = 0;
-  }
-#endif
-
   if (RtsFlags.GcFlags.maxHeapSize != 0 &&
       RtsFlags.GcFlags.heapSizeSuggestion > 
       RtsFlags.GcFlags.maxHeapSize) {
     RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
   }
 
+  if (RtsFlags.GcFlags.maxHeapSize != 0 &&
+      RtsFlags.GcFlags.minAllocAreaSize > 
+      RtsFlags.GcFlags.maxHeapSize) {
+      prog_belch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
+      exit(1);
+  }
+
   initBlockAllocator();
   
   /* allocate generation info array */
@@ -153,6 +143,7 @@ initStorage( void )
       stp->scavenged_large_objects = NULL;
       stp->n_scavenged_large_blocks = 0;
       stp->is_compacted = 0;
+      stp->bitmap = NULL;
     }
   }
   
@@ -166,7 +157,11 @@ initStorage( void )
   
   /* The oldest generation has one step and it is compacted. */
   if (RtsFlags.GcFlags.compact) {
-      oldest_gen->steps[0].is_compacted = 1;
+      if (RtsFlags.GcFlags.generations == 1) {
+	  belch("WARNING: compaction is incompatible with -G1; disabled");
+      } else {
+	  oldest_gen->steps[0].is_compacted = 1;
+      }
   }
   oldest_gen->steps[0].to = &oldest_gen->steps[0];
 
@@ -298,9 +293,9 @@ allocNurseries( void )
     g0s0->blocks = NULL;
     g0s0->n_blocks = 0;
     for (cap = free_capabilities; cap != NULL; cap = cap->link) {
-      cap->rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
-      cap->rCurrentNursery = cap->rNursery;
-      for (bd = cap->rNursery; bd != NULL; bd = bd->link) {
+      cap->r.rNursery = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
+      cap->r.rCurrentNursery = cap->r.rNursery;
+      for (bd = cap->r.rNursery; bd != NULL; bd = bd->link) {
 	bd->u.back = (bdescr *)cap;
       }
     }
@@ -309,13 +304,12 @@ allocNurseries( void )
      */
   }
 #else /* SMP */
-  nursery_blocks    = RtsFlags.GcFlags.minAllocAreaSize;
-  g0s0->blocks      = allocNursery(NULL, nursery_blocks);
-  g0s0->n_blocks    = nursery_blocks;
+  g0s0->blocks      = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
+  g0s0->n_blocks    = RtsFlags.GcFlags.minAllocAreaSize;
   g0s0->to_blocks   = NULL;
   g0s0->n_to_blocks = 0;
-  MainRegTable.rNursery        = g0s0->blocks;
-  MainRegTable.rCurrentNursery = g0s0->blocks;
+  MainCapability.r.rNursery        = g0s0->blocks;
+  MainCapability.r.rCurrentNursery = g0s0->blocks;
   /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */
 #endif
 }
@@ -331,13 +325,13 @@ resetNurseries( void )
   ASSERT(n_free_capabilities == RtsFlags.ParFlags.nNodes);
 
   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
-    for (bd = cap->rNursery; bd; bd = bd->link) {
+    for (bd = cap->r.rNursery; bd; bd = bd->link) {
       bd->free = bd->start;
       ASSERT(bd->gen_no == 0);
       ASSERT(bd->step == g0s0);
       IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
     }
-    cap->rCurrentNursery = cap->rNursery;
+    cap->r.rCurrentNursery = cap->r.rNursery;
   }
 #else
   for (bd = g0s0->blocks; bd; bd = bd->link) {
@@ -346,41 +340,55 @@ resetNurseries( void )
     ASSERT(bd->step == g0s0);
     IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
   }
-  MainRegTable.rNursery = g0s0->blocks;
-  MainRegTable.rCurrentNursery = g0s0->blocks;
+  MainCapability.r.rNursery = g0s0->blocks;
+  MainCapability.r.rCurrentNursery = g0s0->blocks;
 #endif
 }
 
 bdescr *
-allocNursery (bdescr *last_bd, nat blocks)
+allocNursery (bdescr *tail, nat blocks)
 {
   bdescr *bd;
   nat i;
 
-  /* Allocate a nursery */
+  // 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 = last_bd;
+    bd->link = tail;
+    // double-link the nursery: we might need to insert blocks
+    if (tail != NULL) {
+	tail->u.back = bd;
+    }
     bd->step = g0s0;
     bd->gen_no = 0;
     bd->flags = 0;
     bd->free = bd->start;
-    last_bd = bd;
+    tail = bd;
   }
-  return last_bd;
+  tail->u.back = NULL;
+  return tail;
 }
 
 void
 resizeNursery ( nat blocks )
 {
   bdescr *bd;
+  nat nursery_blocks;
 
 #ifdef SMP
   barf("resizeNursery: can't resize in SMP mode");
 #endif
 
+  nursery_blocks = g0s0->n_blocks;
   if (nursery_blocks == blocks) {
-    ASSERT(g0s0->n_blocks == blocks);
     return;
   }
 
@@ -395,15 +403,25 @@ resizeNursery ( nat blocks )
     
     IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n", 
 			 blocks));
-    for (bd = g0s0->blocks; nursery_blocks > blocks; nursery_blocks--) {
-      next_bd = bd->link;
-      freeGroup(bd);
-      bd = next_bd;
+
+    bd = g0s0->blocks;
+    while (nursery_blocks > blocks) {
+	next_bd = bd->link;
+	next_bd->u.back = NULL;
+	nursery_blocks -= bd->blocks; // might be a large block
+	freeGroup(bd);
+	bd = next_bd;
     }
     g0s0->blocks = bd;
+    // might have gone just under, by freeing a large block, so make
+    // up the difference.
+    if (nursery_blocks < blocks) {
+	g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks);
+    }
   }
   
-  g0s0->n_blocks = nursery_blocks = blocks;
+  g0s0->n_blocks = blocks;
+  ASSERT(countBlocks(g0s0->blocks) == g0s0->n_blocks);
 }
 
 /* -----------------------------------------------------------------------------
@@ -617,20 +635,20 @@ calcAllocated( void )
     + allocated_bytes();
 
   for (cap = free_capabilities; cap != NULL; cap = cap->link) {
-    for ( bd = cap->rCurrentNursery->link; bd != NULL; bd = bd->link ) {
+    for ( bd = cap->r.rCurrentNursery->link; bd != NULL; bd = bd->link ) {
       allocated -= BLOCK_SIZE_W;
     }
-    if (cap->rCurrentNursery->free < cap->rCurrentNursery->start 
+    if (cap->r.rCurrentNursery->free < cap->r.rCurrentNursery->start 
 	+ BLOCK_SIZE_W) {
-      allocated -= (cap->rCurrentNursery->start + BLOCK_SIZE_W)
-	- cap->rCurrentNursery->free;
+      allocated -= (cap->r.rCurrentNursery->start + BLOCK_SIZE_W)
+	- cap->r.rCurrentNursery->free;
     }
   }
 
 #else /* !SMP */
-  bdescr *current_nursery = MainRegTable.rCurrentNursery;
+  bdescr *current_nursery = MainCapability.r.rCurrentNursery;
 
-  allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
+  allocated = (g0s0->n_blocks * BLOCK_SIZE_W) + allocated_bytes();
   for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
     allocated -= BLOCK_SIZE_W;
   }
@@ -759,7 +777,17 @@ memInventory(void)
   for (bd = large_alloc_list; bd; bd = bd->link) {
     total_blocks += bd->blocks;
   }
-  
+
+#ifdef PROFILING
+  if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) {
+    for (bd = firstStack; bd != NULL; bd = bd->link) 
+      total_blocks += bd->blocks;
+  }
+#endif
+
+  // count the blocks allocated by the arena allocator
+  total_blocks += arenaBlocks();
+
   /* count the blocks on the free list */
   free_blocks = countFreeList();
 
@@ -773,7 +801,8 @@ memInventory(void)
   ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);
 }
 
-static nat
+
+nat
 countBlocks(bdescr *bd)
 {
     nat n;
@@ -796,13 +825,13 @@ checkSanity( void )
 	
 	for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
 	    for (s = 0; s < generations[g].n_steps; s++) {
-		if (g == 0 && s == 0) { continue; }
-		checkHeap(generations[g].steps[s].blocks);
-		checkChain(generations[g].steps[s].large_objects);
 		ASSERT(countBlocks(generations[g].steps[s].blocks)
 		       == generations[g].steps[s].n_blocks);
 		ASSERT(countBlocks(generations[g].steps[s].large_objects)
 		       == generations[g].steps[s].n_large_blocks);
+		if (g == 0 && s == 0) { continue; }
+		checkHeap(generations[g].steps[s].blocks);
+		checkChain(generations[g].steps[s].large_objects);
 		if (g > 0) {
 		    checkMutableList(generations[g].mut_list, g);
 		    checkMutOnceList(generations[g].mut_once_list, g);
@@ -813,4 +842,13 @@ checkSanity( void )
     }
 }
 
+// handy function for use in gdb, because Bdescr() is inlined.
+extern bdescr *_bdescr( StgPtr p );
+
+bdescr *
+_bdescr( StgPtr p )
+{
+    return Bdescr(p);
+}
+
 #endif