[project @ 2002-11-01 11:05:46 by simonmar]

Fix the heapCensus crash.

It turned out that after a GC, the small_alloc_list might be non-empty
if a new finalizer thread had been started.  The last block on
small_alloc_list doesn't have the free pointer set correctly (as a
small optimisation, we don't normally set the free pointer after each
allocation, only when the block is full).  The result was that the
free pointer contains the wrong value, and the heap census traverses
garbage.  The fix is to set the free pointer correctly before
traversing small_alloc_list.

The bug doesn't show up when DEBUG is on, because extra DEBUG checks
cause the free pointer to be initialised to a sensible(-ish) value.
Hence my difficulty in reproducing the bug.

To reproduce: compile ghc-regress/lib/should_run/memo002 with
profiling and run it with a sufficiently small sample interval (-i0.02
did it for me).

Thanks to the kind folks at ARM for helping out with the debugging of
this one.

MERGE TO STABLE

diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index 0173754..7df27e1 100644 (file)
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.38 2002/08/16 13:29:06 simonmar Exp $
+ * $Id: ProfHeap.c,v 1.39 2002/11/01 11:05:46 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -985,8 +985,14 @@ heapCensus( void )
   stat_startHeapCensus();
 #endif
 
-  // traverse the heap, collecting the census info
+  // Traverse the heap, collecting the census info
+
+  // First the small_alloc_list: we have to fix the free pointer at
+  // the end by calling tidyAllocatedLists() first.
+  tidyAllocateLists();
   heapCensusChain( census, small_alloc_list );
+
+  // Now traverse the heap in each generation/step.
   if (RtsFlags.GcFlags.generations == 1) {
       heapCensusChain( census, g0s0->to_blocks );
   } else {

diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 911e432..5af42f4 100644 (file)
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.69 2002/10/15 11:02:32 simonmar Exp $
+ * $Id: Storage.c,v 1.70 2002/11/01 11:05:47 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -544,6 +544,16 @@ allocated_bytes( void )
     return allocated;
 }
 
+void
+tidyAllocateLists (void)
+{
+    if (small_alloc_list != NULL) {
+       ASSERT(alloc_Hp >= small_alloc_list->start && 
+              alloc_Hp <= small_alloc_list->start + BLOCK_SIZE);
+       small_alloc_list->free = alloc_Hp;
+    }
+}
+
 /* ---------------------------------------------------------------------------
    Allocate a fixed/pinned object.
 

diff --git a/ghc/rts/StoragePriv.h b/ghc/rts/StoragePriv.h
index 0c61bb6..a45e42d 100644 (file)
--- a/ghc/rts/StoragePriv.h
+++ b/ghc/rts/StoragePriv.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StoragePriv.h,v 1.21 2002/03/20 23:07:02 sebc Exp $
+ * $Id: StoragePriv.h,v 1.22 2002/11/01 11:05:47 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -54,6 +54,7 @@ extern void     allocNurseries ( void );
 extern void     resetNurseries ( void );
 extern bdescr * allocNursery   ( bdescr *last_bd, nat blocks );
 extern void     resizeNursery  ( nat blocks );
+extern void     tidyAllocateLists ( void );
 
 /* Stats 'n' stuff */
 extern lnat calcAllocated  ( void );