[project @ 2005-02-10 13:01:52 by simonmar]

[ghc-hetmet.git] / ghc / rts / Storage.c

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index f13f186..974c075 100644 (file)
--- 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);
                }
            }
        }