From: simonmar <unknown>
Date: Thu, 12 May 2005 10:03:42 +0000 (+0000)
Subject: [project @ 2005-05-12 10:03:42 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~571
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=045b58bd2a5e3755f749d66643fc4d1c5b807f7e;p=ghc-hetmet.git

[project @ 2005-05-12 10:03:42 by simonmar]
Fix more bugginess in allocateLocal().
---

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 95a5bce..04f5149 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1515,7 +1515,7 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
 	    
 	    // This assert can be a killer if the app is doing lots
 	    // of large block allocations.
-	    ASSERT(countBlocks(cap->r.rNursery->blocks) == cap->r.rNursery->n_blocks);
+	    IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
 	    
 	    // now update the nursery to point to the new block
 	    cap->r.rCurrentNursery = bd;
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 99d36d2..8643972 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -672,9 +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;
+		}
 	    }
 	    dbl_link_onto(bd, &reg->rNursery->blocks);
 	    reg->rCurrentAlloc = bd;
+	    IF_DEBUG(sanity, checkNurserySanity(reg->rNursery));
 	}
     }
     p = bd->free;
@@ -1057,6 +1061,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 );