[project @ 2003-09-23 15:38:35 by simonmar]

Add a BF_PINNED block flag, and attach it to blocks containing pinned
objects (in addition to the usual BF_LARGE).

In heapCensus, we now ignore blocks containing pinned objects, because
they might contain gaps, and in any case it isn't clear that we want
to include the whole block in a heap census, because much of it might
well be dead.  Ignoring it isn't right either, though, so this patch
just fixes the crash and leaves a ToDo.

3 files changed, 14 insertions, 4 deletions

diff --git a/ghc/includes/Block.h b/ghc/includes/Block.h
index 867a73c448..f07d4e7bac 100644
--- a/ghc/includes/Block.h
+++ b/ghc/includes/Block.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Block.h,v 1.13 2003/03/28 15:13:52 sof Exp $
+ * $Id: Block.h,v 1.14 2003/09/23 15:38:35 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -78,6 +78,7 @@ typedef struct _bdescr {
 
 #define BF_EVACUATED 1
 #define BF_LARGE     2
+#define BF_PINNED    4
 
 /* Finding the block descriptor for a given block -------------------------- */
 
diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
index 19beb9cba6..27a1a41312 100644
--- a/ghc/rts/ProfHeap.c
+++ b/ghc/rts/ProfHeap.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: ProfHeap.c,v 1.47 2003/08/22 22:24:12 sof Exp $
+ * $Id: ProfHeap.c,v 1.48 2003/09/23 15:38:36 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2003
  *
@@ -825,6 +825,15 @@ heapCensusChain( Census *census, bdescr *bd )
     rtsBool prim;
 
     for (; bd != NULL; bd = bd->link) {
+
+	// HACK: ignore pinned blocks, because they contain gaps.
+	// It's not clear exactly what we'd like to do here, since we
+	// can't tell which objects in the block are actually alive.
+	// Perhaps the whole block should be counted as SYSTEM memory.
+	if (bd->flags & BF_PINNED) {
+	    continue;
+	}
+
 	p = bd->start;
 	while (p < bd->free) {
 	    info = get_itbl((StgClosure *)p);
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
index 62a383fd64..f511b76688 100644
--- a/ghc/rts/Storage.c
+++ b/ghc/rts/Storage.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.79 2003/03/26 18:59:34 sof Exp $
+ * $Id: Storage.c,v 1.80 2003/09/23 15:38:36 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -588,7 +588,7 @@ allocatePinned( nat n )
 	dbl_link_onto(bd, &g0s0->large_objects);
 	bd->gen_no = 0;
 	bd->step   = g0s0;
-	bd->flags  = BF_LARGE;
+	bd->flags  = BF_PINNED | BF_LARGE;
 	bd->free   = bd->start;
 	alloc_blocks++;
     }