[project @ 2005-05-12 11:36:50 by stolz]

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

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 7e07ff2..7bb6e39 100644 (file)
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -662,7 +662,7 @@ allocateLocal( StgRegTable *reg, nat n )
                // full: allocate a fresh block (we can't fail here).
                ACQUIRE_SM_LOCK;
                bd = allocBlock();
-               alloc_blocks++;
+               reg->rNursery->n_blocks++;
                RELEASE_SM_LOCK;
                bd->gen_no = 0;
                bd->step = g0s0;
@@ -672,11 +672,13 @@ allocateLocal( StgRegTable *reg, nat n )
                // it at the *front* of the nursery list, and use it
                // to allocate() from.
                reg->rCurrentNursery->link = bd->link;
+               if (bd->link != NULL) {
+                   bd->link->u.back = reg->rCurrentNursery;
+               }
            }
-           bd->link = reg->rNursery->blocks;
-           reg->rNursery->blocks = bd;
-           bd->u.back = NULL;
+           dbl_link_onto(bd, &reg->rNursery->blocks);
            reg->rCurrentAlloc = bd;
+           IF_DEBUG(sanity, checkNurserySanity(reg->rNursery));
        }
     }
     p = bd->free;
@@ -822,12 +824,13 @@ calcAllocated( void )
 {
   nat allocated;
   bdescr *bd;
-  nat i;
 
   allocated = allocated_bytes();
   allocated += countNurseryBlocks() * BLOCK_SIZE_W;
   
+  {
 #ifdef SMP
+  nat i;
   for (i = 0; i < n_nurseries; i++) {
       Capability *cap;
       for ( bd = capabilities[i].r.rCurrentNursery->link; 
@@ -852,6 +855,7 @@ calcAllocated( void )
          - current_nursery->free;
   }
 #endif
+  }
 
   total_allocated += allocated;
   return allocated;
@@ -1059,6 +1063,22 @@ checkSanity( void )
     }
 }
 
+/* Nursery sanity check */
+void
+checkNurserySanity( step *stp )
+{
+    bdescr *bd, *prev;
+    nat blocks = 0;
+
+    prev = NULL;
+    for (bd = stp->blocks; bd != NULL; bd = bd->link) {
+       ASSERT(bd->u.back == prev);
+       prev = bd;
+       blocks += bd->blocks;
+    }
+    ASSERT(blocks == stp->n_blocks);
+}
+
 // handy function for use in gdb, because Bdescr() is inlined.
 extern bdescr *_bdescr( StgPtr p );