X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FStorage.c;h=974c075b955938690bdfffe8956de0dfe00bb26e;hb=e7c3f957fd36fd9f6369183b7a31e2a4a4c21b43;hp=f13f186ec41151c9b5c171361bffb64f280c0c55;hpb=e1c4a20eb3545e0ac5c67099e487d1f26d4a655c;p=ghc-hetmet.git

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index f13f186..974c075 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,7 +1,6 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.83 2004/07/21 10:47:28 simonmar Exp $
  *
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2004
  *
  * Storage manager front end
  *
@@ -22,7 +21,6 @@
 #include "Storage.h"
 #include "Schedule.h"
 #include "OSThreads.h"
-#include "StoragePriv.h"
 
 #include "RetainerProfile.h"	// for counting memory blocks (memInventory)
 
@@ -89,7 +87,7 @@ initStorage( void )
   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)");
+      errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
       exit(1);
   }
 
@@ -108,8 +106,7 @@ initStorage( void )
   for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
     gen = &generations[g];
     gen->no = g;
-    gen->mut_list = END_MUT_LIST;
-    gen->mut_once_list = END_MUT_LIST;
+    gen->mut_list = allocBlock();
     gen->collections = 0;
     gen->failed_promotions = 0;
     gen->max_blocks = 0;
@@ -178,7 +175,7 @@ initStorage( void )
   /* The oldest generation has one step and it is compacted. */
   if (RtsFlags.GcFlags.compact) {
       if (RtsFlags.GcFlags.generations == 1) {
-	  belch("WARNING: compaction is incompatible with -G1; disabled");
+	  errorBelch("WARNING: compaction is incompatible with -G1; disabled");
       } else {
 	  oldest_gen->steps[0].is_compacted = 1;
       }
@@ -272,15 +269,15 @@ newCAF(StgClosure* caf)
   ACQUIRE_SM_LOCK;
 
   ((StgIndStatic *)caf)->saved_info = NULL;
-  ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_once_list;
-  oldest_gen->mut_once_list = (StgMutClosure *)caf;
+
+  recordMutableGen(caf, oldest_gen);
 
   RELEASE_SM_LOCK;
 
 #ifdef PAR
   /* If we are PAR or DIST then  we never forget a CAF */
   { globalAddr *newGA;
-    //belch("<##> Globalising CAF %08x %s",caf,info_type(caf));
+    //debugBelch("<##> Globalising CAF %08x %s",caf,info_type(caf));
     newGA=makeGlobal(caf,rtsTrue); /*given full weight*/
     ASSERT(newGA);
   } 
@@ -419,7 +416,7 @@ resizeNursery ( nat blocks )
   }
 
   else if (nursery_blocks < blocks) {
-    IF_DEBUG(gc, fprintf(stderr, "Increasing size of nursery to %d blocks\n", 
+    IF_DEBUG(gc, debugBelch("Increasing size of nursery to %d blocks\n", 
 			 blocks));
     g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks);
   } 
@@ -427,7 +424,7 @@ resizeNursery ( nat blocks )
   else {
     bdescr *next_bd;
     
-    IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n", 
+    IF_DEBUG(gc, debugBelch("Decreasing size of nursery to %d blocks\n", 
 			 blocks));
 
     bd = g0s0->blocks;
@@ -621,7 +618,7 @@ stgAllocForGMP (size_t size_in_bytes)
   SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
   
   /* and return a ptr to the goods inside the array */
-  return(BYTE_ARR_CTS(arr));
+  return arr->payload;
 }
 
 static void *
@@ -793,25 +790,28 @@ memInventory(void)
   /* count the blocks we current have */
 
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-    for (s = 0; s < generations[g].n_steps; s++) {
-      stp = &generations[g].steps[s];
-      total_blocks += stp->n_blocks;
-      if (RtsFlags.GcFlags.generations == 1) {
-	/* two-space collector has a to-space too :-) */
-	total_blocks += g0s0->n_to_blocks;
+      for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
+	  total_blocks += bd->blocks;
       }
-      for (bd = stp->large_objects; bd; bd = bd->link) {
-	total_blocks += bd->blocks;
-	/* hack for megablock groups: they have an extra block or two in
-	   the second and subsequent megablocks where the block
-	   descriptors would normally go.
-	*/
-	if (bd->blocks > BLOCKS_PER_MBLOCK) {
-	  total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
-	                  * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
-	}
+      for (s = 0; s < generations[g].n_steps; s++) {
+	  stp = &generations[g].steps[s];
+	  total_blocks += stp->n_blocks;
+	  if (RtsFlags.GcFlags.generations == 1) {
+	      /* two-space collector has a to-space too :-) */
+	      total_blocks += g0s0->n_to_blocks;
+	  }
+	  for (bd = stp->large_objects; bd; bd = bd->link) {
+	      total_blocks += bd->blocks;
+	      /* hack for megablock groups: they have an extra block or two in
+		 the second and subsequent megablocks where the block
+		 descriptors would normally go.
+	      */
+	      if (bd->blocks > BLOCKS_PER_MBLOCK) {
+		  total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
+		      * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
+	      }
+	  }
       }
-    }
   }
 
   /* any blocks held by allocate() */
@@ -833,7 +833,7 @@ memInventory(void)
 
   if (total_blocks + free_blocks != mblocks_allocated *
       BLOCKS_PER_MBLOCK) {
-    fprintf(stderr, "Blocks: %ld live + %ld free  = %ld total (%ld around)\n",
+    debugBelch("Blocks: %ld live + %ld free  = %ld total (%ld around)\n",
 	    total_blocks, free_blocks, total_blocks + free_blocks,
 	    mblocks_allocated * BLOCKS_PER_MBLOCK);
   }
@@ -874,7 +874,6 @@ checkSanity( void )
 		checkChain(generations[g].steps[s].large_objects);
 		if (g > 0) {
 		    checkMutableList(generations[g].mut_list, g);
-		    checkMutOnceList(generations[g].mut_once_list, g);
 		}
 	    }
 	}