X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRetainerProfile.c;h=2f93cbf29abe98e7032e92c5d502dc92883ef157;hb=91b07216be1cb09230b7d1b417899ddea8620ff3;hp=de3ae0938707f2404a0d266024c788e85fe718c6;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git

diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c
index de3ae09..2f93cbf 100644
--- a/ghc/rts/RetainerProfile.c
+++ b/ghc/rts/RetainerProfile.c
@@ -1,5 +1,4 @@
 /* -----------------------------------------------------------------------------
- * $Id: RetainerProfile.c,v 1.6 2002/12/11 15:36:47 simonmar Exp $
  *
  * (c) The GHC Team, 2001
  * Author: Sungwoo Park
@@ -10,7 +9,12 @@
 
 #ifdef PROFILING
 
-#include <stdio.h>
+// Turn off inlining when debugging - it obfuscates things
+#ifdef DEBUG
+#define INLINE
+#else
+#define INLINE inline
+#endif
 
 #include "Rts.h"
 #include "RtsUtils.h"
@@ -19,16 +23,12 @@
 #include "Schedule.h"
 #include "Printer.h"
 #include "Storage.h"
-#include "StoragePriv.h"
 #include "RtsFlags.h"
 #include "Weak.h"
 #include "Sanity.h"
-#include "StablePriv.h"
 #include "Profiling.h"
 #include "Stats.h"
 #include "BlockAlloc.h"
-#include "Itimer.h"
-#include "Proftimer.h"
 #include "ProfHeap.h"
 #include "Apply.h"
 
@@ -106,6 +106,7 @@ typedef enum {
     posTypeStep,
     posTypePtrs,
     posTypeSRT,
+    posTypeLargeSRT,
 } nextPosType;
 
 typedef union {
@@ -128,8 +129,15 @@ typedef union {
     // SRT
     struct {
 	StgClosure **srt;
-	StgClosure **srt_end;
+	StgWord    srt_bitmap;
     } srt;
+
+    // Large SRT
+    struct {
+	StgLargeSRT *srt;
+	StgWord offset;
+    } large_srt;
+	
 } nextPos;
 
 typedef struct {
@@ -160,7 +168,7 @@ typedef struct {
     the topmost element on the previous block group so as to satisfy
     the invariants described above.
  */
-bdescr *firstStack = NULL;
+static bdescr *firstStack = NULL;
 static bdescr *currentStack;
 static stackElement *stackBottom, *stackTop, *stackLimit;
 
@@ -196,7 +204,7 @@ static int stackSize, maxStackSize;
  * Invariants:
  *  currentStack->link == s.
  * -------------------------------------------------------------------------- */
-static inline void
+static INLINE void
 newStackBlock( bdescr *bd )
 {
     currentStack = bd;
@@ -211,7 +219,7 @@ newStackBlock( bdescr *bd )
  * Invariants:
  *   s->link == currentStack.
  * -------------------------------------------------------------------------- */
-static inline void
+static INLINE void
 returnToOldStack( bdescr *bd )
 {
     currentStack = bd;
@@ -253,17 +261,34 @@ closeTraverseStack( void )
 /* -----------------------------------------------------------------------------
  * Returns rtsTrue if the whole stack is empty.
  * -------------------------------------------------------------------------- */
-static inline rtsBool
+static INLINE rtsBool
 isEmptyRetainerStack( void )
 {
     return (firstStack == currentStack) && stackTop == stackLimit;
 }
 
 /* -----------------------------------------------------------------------------
+ * Returns size of stack
+ * -------------------------------------------------------------------------- */
+#ifdef DEBUG
+lnat
+retainerStackBlocks( void )
+{
+    bdescr* bd;
+    lnat res = 0;
+
+    for (bd = firstStack; bd != NULL; bd = bd->link) 
+      res += bd->blocks;
+
+    return res;
+}
+#endif
+
+/* -----------------------------------------------------------------------------
  * Returns rtsTrue if stackTop is at the stack boundary of the current stack,
  * i.e., if the current stack chunk is empty.
  * -------------------------------------------------------------------------- */
-static inline rtsBool
+static INLINE rtsBool
 isOnBoundary( void )
 {
     return stackTop == currentStackBoundary;
@@ -274,7 +299,7 @@ isOnBoundary( void )
  * Invariants:
  *   payload[] begins with ptrs pointers followed by non-pointers.
  * -------------------------------------------------------------------------- */
-static inline void
+static INLINE void
 init_ptrs( stackPos *info, nat ptrs, StgPtr payload )
 {
     info->type              = posTypePtrs;
@@ -286,7 +311,7 @@ init_ptrs( stackPos *info, nat ptrs, StgPtr payload )
 /* -----------------------------------------------------------------------------
  * Find the next object from *info.
  * -------------------------------------------------------------------------- */
-static inline StgClosure *
+static INLINE StgClosure *
 find_ptrs( stackPos *info )
 {
     if (info->next.ptrs.pos < info->next.ptrs.ptrs) {
@@ -299,43 +324,92 @@ find_ptrs( stackPos *info )
 /* -----------------------------------------------------------------------------
  *  Initializes *info from SRT information stored in *infoTable.
  * -------------------------------------------------------------------------- */
-static inline void
+static INLINE void
 init_srt_fun( stackPos *info, StgFunInfoTable *infoTable )
 {
-    info->type = posTypeSRT;
-    info->next.srt.srt = (StgClosure **)(infoTable->srt);
-    info->next.srt.srt_end = info->next.srt.srt + infoTable->i.srt_len;
+    if (infoTable->i.srt_bitmap == (StgHalfWord)(-1)) {
+	info->type = posTypeLargeSRT;
+	info->next.large_srt.srt = (StgLargeSRT *)GET_FUN_SRT(infoTable);
+	info->next.large_srt.offset = 0;
+    } else {
+	info->type = posTypeSRT;
+	info->next.srt.srt = (StgClosure **)GET_FUN_SRT(infoTable);
+	info->next.srt.srt_bitmap = infoTable->i.srt_bitmap;
+    }
 }
 
-static inline void
+static INLINE void
 init_srt_thunk( stackPos *info, StgThunkInfoTable *infoTable )
 {
-    info->type = posTypeSRT;
-    info->next.srt.srt = (StgClosure **)(infoTable->srt);
-    info->next.srt.srt_end = info->next.srt.srt + infoTable->i.srt_len;
+    if (infoTable->i.srt_bitmap == (StgHalfWord)(-1)) {
+	info->type = posTypeLargeSRT;
+	info->next.large_srt.srt = (StgLargeSRT *)GET_SRT(infoTable);
+	info->next.large_srt.offset = 0;
+    } else {
+	info->type = posTypeSRT;
+	info->next.srt.srt = (StgClosure **)GET_SRT(infoTable);
+	info->next.srt.srt_bitmap = infoTable->i.srt_bitmap;
+    }
 }
 
 /* -----------------------------------------------------------------------------
  * Find the next object from *info.
  * -------------------------------------------------------------------------- */
-static inline StgClosure *
+static INLINE StgClosure *
 find_srt( stackPos *info )
 {
     StgClosure *c;
+    StgWord bitmap;
 
-    if (info->next.srt.srt < info->next.srt.srt_end) {
-	// See scavenge_srt() in GC.c for details.
+    if (info->type == posTypeSRT) {
+	// Small SRT bitmap
+	bitmap = info->next.srt.srt_bitmap;
+	while (bitmap != 0) {
+	    if ((bitmap & 1) != 0) {
 #ifdef ENABLE_WIN32_DLL_SUPPORT
-	if ((unsigned long)(*(info->next.srt.srt)) & 0x1)
-	    c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1);
-	else
-	    c = *(info->next.srt.srt);
+		
+		if ((unsigned long)(*(info->next.srt.srt)) & 0x1)
+		    c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1);
+		else
+		    c = *(info->next.srt.srt);
 #else
-	c = *(info->next.srt.srt);
+		c = *(info->next.srt.srt);
 #endif
-	info->next.srt.srt++;
-	return c;
-    } else {
+		bitmap = bitmap >> 1;
+		info->next.srt.srt++;
+		info->next.srt.srt_bitmap = bitmap;
+		return c;
+	    }
+	    bitmap = bitmap >> 1;
+	    info->next.srt.srt++;
+	}
+	// bitmap is now zero...
+	return NULL;
+    }
+    else {
+	// Large SRT bitmap
+	nat i = info->next.large_srt.offset;
+	StgWord bitmap;
+
+	// Follow the pattern from GC.c:scavenge_large_srt_bitmap().
+	bitmap = info->next.large_srt.srt->l.bitmap[i / BITS_IN(W_)];
+	bitmap = bitmap >> (i % BITS_IN(StgWord));
+	while (i < info->next.large_srt.srt->l.size) {
+	    if ((bitmap & 1) != 0) {
+		c = ((StgClosure **)info->next.large_srt.srt->srt)[i];
+		i++;
+		info->next.large_srt.offset = i;
+		return c;
+	    }
+	    i++;
+	    if (i % BITS_IN(W_) == 0) {
+		bitmap = info->next.large_srt.srt->l.bitmap[i / BITS_IN(W_)];
+	    } else {
+		bitmap = bitmap >> 1;
+	    }
+	}
+	// reached the end of this bitmap.
+	info->next.large_srt.offset = i;
 	return NULL;
     }
 }
@@ -355,14 +429,14 @@ find_srt( stackPos *info )
  *        there cannot be any stack objects.
  *  Note: SRTs are considered to  be children as well.
  * -------------------------------------------------------------------------- */
-static inline void
+static INLINE void
 push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 {
     stackElement se;
     bdescr *nbd;      // Next Block Descriptor
 
 #ifdef DEBUG_RETAINER
-    // fprintf(stderr, "push(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
+    // debugBelch("push(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
 #endif
 
     ASSERT(get_itbl(c)->type != TSO);
@@ -389,22 +463,17 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 	return;
 
 	// one child (fixed), no SRT
-    case MUT_VAR:
-    case MUT_CONS:
+    case MUT_VAR_CLEAN:
+    case MUT_VAR_DIRTY:
 	*first_child = ((StgMutVar *)c)->var;
 	return;
-    case BLACKHOLE_BQ:
-	// blocking_queue must be TSO and the head of a linked list of TSOs.
-	// Shoule it be a child? Seems to be yes.
-	*first_child = (StgClosure *)((StgBlockingQueue *)c)->blocking_queue;
-	return;
     case THUNK_SELECTOR:
 	*first_child = ((StgSelector *)c)->selectee;
 	return;
     case IND_PERM:
     case IND_OLDGEN_PERM:
     case IND_OLDGEN:
-	*first_child = ((StgIndOldGen *)c)->indirectee;
+	*first_child = ((StgInd *)c)->indirectee;
 	return;
     case CONSTR_1_0:
     case CONSTR_1_1:
@@ -442,7 +511,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
 	// layout.payload.ptrs, no SRT
     case CONSTR:
-    case FOREIGN:
     case STABLE_NAME:
     case BCO:
     case CONSTR_STATIC:
@@ -454,8 +522,10 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 	break;
 
 	// StgMutArrPtr.ptrs, no SRT
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
+    case MUT_ARR_PTRS_FROZEN0:
 	init_ptrs(&se.info, ((StgMutArrPtrs *)c)->ptrs,
 		  (StgPtr)(((StgMutArrPtrs *)c)->payload));
 	*first_child = find_ptrs(&se.info);
@@ -475,7 +545,8 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
     case THUNK:
     case THUNK_2_0:
-	init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, (StgPtr)c->payload);
+	init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, 
+		  (StgPtr)((StgThunk *)c)->payload);
 	*first_child = find_ptrs(&se.info);
 	if (*first_child == NULL)
 	    // no child from ptrs, so check SRT
@@ -492,13 +563,13 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
     case THUNK_1_0:
     case THUNK_1_1:
-	*first_child = c->payload[0];
+	*first_child = ((StgThunk *)c)->payload[0];
 	ASSERT(*first_child != NULL);
 	init_srt_thunk(&se.info, get_thunk_itbl(c));
 	break;
 
     case FUN_STATIC:      // *c is a heap object.
-	ASSERT(get_itbl(c)->srt_len != 0);
+	ASSERT(get_itbl(c)->srt_bitmap != 0);
     case FUN_0_1:
     case FUN_0_2:
     fun_srt_only:
@@ -510,7 +581,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
     // SRT only
     case THUNK_STATIC:
-	ASSERT(get_itbl(c)->srt_len != 0);
+	ASSERT(get_itbl(c)->srt_bitmap != 0);
     case THUNK_0_1:
     case THUNK_0_2:
     thunk_srt_only:
@@ -555,7 +626,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
 
     if (stackTop - 1 < stackBottom) {
 #ifdef DEBUG_RETAINER
-	// fprintf(stderr, "push() to the next stack.\n");
+	// debugBelch("push() to the next stack.\n");
 #endif
 	// currentStack->free is updated when the active stack is switched
 	// to the next stack.
@@ -584,7 +655,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
     stackSize++;
     if (stackSize > maxStackSize) maxStackSize = stackSize;
     // ASSERT(stackSize >= 0);
-    // fprintf(stderr, "stackSize = %d\n", stackSize);
+    // debugBelch("stackSize = %d\n", stackSize);
 #endif
 }
 
@@ -598,7 +669,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
  *    executed at the end of popOff() in necessary. Since popOff() is
  *    likely to be executed quite often while popOffReal() is not, we
  *    separate popOffReal() from popOff(), which is declared as an
- *    inline function (for the sake of execution speed).  popOffReal()
+ *    INLINE function (for the sake of execution speed).  popOffReal()
  *    is called only within popOff() and nowhere else.
  * -------------------------------------------------------------------------- */
 static void
@@ -607,7 +678,7 @@ popOffReal(void)
     bdescr *pbd;    // Previous Block Descriptor
 
 #ifdef DEBUG_RETAINER
-    // fprintf(stderr, "pop() to the previous stack.\n");
+    // debugBelch("pop() to the previous stack.\n");
 #endif
 
     ASSERT(stackTop + 1 == stackLimit);
@@ -622,7 +693,7 @@ popOffReal(void)
 	if (stackSize > maxStackSize) maxStackSize = stackSize;
 	/*
 	  ASSERT(stackSize >= 0);
-	  fprintf(stderr, "stackSize = %d\n", stackSize);
+	  debugBelch("stackSize = %d\n", stackSize);
 	*/
 #endif
 	return;
@@ -643,15 +714,15 @@ popOffReal(void)
     if (stackSize > maxStackSize) maxStackSize = stackSize;
     /*
       ASSERT(stackSize >= 0);
-      fprintf(stderr, "stackSize = %d\n", stackSize);
+      debugBelch("stackSize = %d\n", stackSize);
     */
 #endif
 }
 
-static inline void
+static INLINE void
 popOff(void) {
 #ifdef DEBUG_RETAINER
-    // fprintf(stderr, "\tpopOff(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
+    // debugBelch("\tpopOff(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
 #endif
 
     ASSERT(stackTop != stackLimit);
@@ -665,7 +736,7 @@ popOff(void) {
 	if (stackSize > maxStackSize) maxStackSize = stackSize;
 	/*
 	  ASSERT(stackSize >= 0);
-	  fprintf(stderr, "stackSize = %d\n", stackSize);
+	  debugBelch("stackSize = %d\n", stackSize);
 	*/
 #endif
 	return;
@@ -690,13 +761,13 @@ popOff(void) {
  *    It is okay to call this function even when the current stack chunk
  *    is empty.
  * -------------------------------------------------------------------------- */
-static inline void
+static INLINE void
 pop( StgClosure **c, StgClosure **cp, retainer *r )
 {
     stackElement *se;
 
 #ifdef DEBUG_RETAINER
-    // fprintf(stderr, "pop(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
+    // debugBelch("pop(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
 #endif
 
     do {
@@ -747,13 +818,14 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
 	    return;
 
 	case CONSTR:
-	case FOREIGN:
 	case STABLE_NAME:
 	case BCO:
 	case CONSTR_STATIC:
 	    // StgMutArrPtr.ptrs, no SRT
-	case MUT_ARR_PTRS:
+	case MUT_ARR_PTRS_CLEAN:
+	case MUT_ARR_PTRS_DIRTY:
 	case MUT_ARR_PTRS_FROZEN:
+	case MUT_ARR_PTRS_FROZEN0:
 	    *c = find_ptrs(&se->info);
 	    if (*c == NULL) {
 		popOff();
@@ -820,9 +892,8 @@ pop( StgClosure **c, StgClosure **cp, retainer *r )
 	case SE_CAF_BLACKHOLE:
 	case ARR_WORDS:
 	    // one child (fixed), no SRT
-	case MUT_VAR:
-	case MUT_CONS:
-	case BLACKHOLE_BQ:
+	case MUT_VAR_CLEAN:
+	case MUT_VAR_DIRTY:
 	case THUNK_SELECTOR:
 	case IND_PERM:
 	case IND_OLDGEN_PERM:
@@ -899,7 +970,7 @@ endRetainerProfiling( void )
  *    We have to perform an XOR (^) operation each time a closure is examined.
  *    The reason is that we do not know when a closure is visited last.
  * -------------------------------------------------------------------------- */
-static inline void
+static INLINE void
 maybeInitRetainerSet( StgClosure *c )
 {
     if (!isRetainerSetFieldValid(c)) {
@@ -910,7 +981,7 @@ maybeInitRetainerSet( StgClosure *c )
 /* -----------------------------------------------------------------------------
  * Returns rtsTrue if *c is a retainer.
  * -------------------------------------------------------------------------- */
-static inline rtsBool
+static INLINE rtsBool
 isRetainer( StgClosure *c )
 {
     switch (get_itbl(c)->type) {
@@ -922,10 +993,12 @@ isRetainer( StgClosure *c )
 
 	// mutable objects
     case MVAR:
-    case MUT_VAR:
-    case MUT_CONS:
-    case MUT_ARR_PTRS:
+    case MUT_VAR_CLEAN:
+    case MUT_VAR_DIRTY:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
+    case MUT_ARR_PTRS_FROZEN0:
 
 	// thunks are retainers.
     case THUNK:
@@ -971,7 +1044,6 @@ isRetainer( StgClosure *c )
     case BLACKHOLE:
     case SE_BLACKHOLE:
     case SE_CAF_BLACKHOLE:
-    case BLACKHOLE_BQ:
 	// indirection
     case IND_PERM:
     case IND_OLDGEN_PERM:
@@ -980,7 +1052,6 @@ isRetainer( StgClosure *c )
     case CONSTR_STATIC:
     case FUN_STATIC:
 	// misc
-    case FOREIGN:
     case STABLE_NAME:
     case BCO:
     case ARR_WORDS:
@@ -1036,7 +1107,7 @@ isRetainer( StgClosure *c )
  *    re-initialize the hash table.
  *    See refreshAllRetainerSet() in RetainerSet.c.
  * -------------------------------------------------------------------------- */
-static inline retainer
+static INLINE retainer
 getRetainerFrom( StgClosure *c )
 {
     ASSERT(isRetainer(c));
@@ -1060,7 +1131,7 @@ getRetainerFrom( StgClosure *c )
  *    c != NULL
  *    s != NULL
  * -------------------------------------------------------------------------- */
-static inline void
+static INLINE void
 associate( StgClosure *c, RetainerSet *s )
 {
     // StgWord has the same size as pointers, so the following type
@@ -1069,40 +1140,6 @@ associate( StgClosure *c, RetainerSet *s )
 }
 
 /* -----------------------------------------------------------------------------
- * Call retainClosure for each of the closures in an SRT.
- * ------------------------------------------------------------------------- */
-
-static inline void
-retainSRT (StgClosure **srt, nat srt_len, StgClosure *c, retainer c_child_r)
-{
-  StgClosure **srt_end;
-
-  srt_end = srt + srt_len;
-
-  for (; srt < srt_end; srt++) {
-    /* Special-case to handle references to closures hiding out in DLLs, since
-       double indirections required to get at those. The code generator knows
-       which is which when generating the SRT, so it stores the (indirect)
-       reference to the DLL closure in the table by first adding one to it.
-       We check for this here, and undo the addition before evacuating it.
-
-       If the SRT entry hasn't got bit 0 set, the SRT entry points to a
-       closure that's fixed at link-time, and no extra magic is required.
-    */
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-    if ( (unsigned long)(*srt) & 0x1 ) {
-       retainClosure(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)), 
-		     c, c_child_r);
-    } else {
-       retainClosure(*srt,c,c_child_r);
-    }
-#else
-    retainClosure(*srt,c,c_child_r);
-#endif
-  }
-}
-
-/* -----------------------------------------------------------------------------
    Call retainClosure for each of the closures covered by a large bitmap.
    -------------------------------------------------------------------------- */
 
@@ -1130,7 +1167,7 @@ retain_large_bitmap (StgPtr p, StgLargeBitmap *large_bitmap, nat size,
     }
 }
 
-static inline StgPtr
+static INLINE StgPtr
 retain_small_bitmap (StgPtr p, nat size, StgWord bitmap,
 		     StgClosure *c, retainer c_child_r)
 {
@@ -1146,6 +1183,68 @@ retain_small_bitmap (StgPtr p, nat size, StgWord bitmap,
 }
 
 /* -----------------------------------------------------------------------------
+ * Call retainClosure for each of the closures in an SRT.
+ * ------------------------------------------------------------------------- */
+
+static void
+retain_large_srt_bitmap (StgLargeSRT *srt, StgClosure *c, retainer c_child_r)
+{
+    nat i, b, size;
+    StgWord bitmap;
+    StgClosure **p;
+    
+    b = 0;
+    p = (StgClosure **)srt->srt;
+    size   = srt->l.size;
+    bitmap = srt->l.bitmap[b];
+    for (i = 0; i < size; ) {
+	if ((bitmap & 1) != 0) {
+	    retainClosure((StgClosure *)*p, c, c_child_r);
+	}
+	i++;
+	p++;
+	if (i % BITS_IN(W_) == 0) {
+	    b++;
+	    bitmap = srt->l.bitmap[b];
+	} else {
+	    bitmap = bitmap >> 1;
+	}
+    }
+}
+
+static INLINE void
+retainSRT (StgClosure **srt, nat srt_bitmap, StgClosure *c, retainer c_child_r)
+{
+  nat bitmap;
+  StgClosure **p;
+
+  bitmap = srt_bitmap;
+  p = srt;
+
+  if (bitmap == (StgHalfWord)(-1)) {  
+      retain_large_srt_bitmap( (StgLargeSRT *)srt, c, c_child_r );
+      return;
+  }
+
+  while (bitmap != 0) {
+      if ((bitmap & 1) != 0) {
+#ifdef ENABLE_WIN32_DLL_SUPPORT
+	  if ( (unsigned long)(*srt) & 0x1 ) {
+	      retainClosure(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)), 
+			    c, c_child_r);
+	  } else {
+	      retainClosure(*srt,c,c_child_r);
+	  }
+#else
+	  retainClosure(*srt,c,c_child_r);
+#endif
+      }
+      p++;
+      bitmap = bitmap >> 1;
+  }
+}
+
+/* -----------------------------------------------------------------------------
  *  Process all the objects in the stack chunk from stackStart to stackEnd
  *  with *c and *c_child_r being their parent and their most recent retainer,
  *  respectively. Treat stackOptionalFun as another child of *c if it is
@@ -1188,7 +1287,7 @@ retainStack( StgClosure *c, retainer c_child_r,
     currentStackBoundary = stackTop;
 
 #ifdef DEBUG_RETAINER
-    // fprintf(stderr, "retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary);
+    // debugBelch("retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary);
 #endif
 
     ASSERT(get_itbl(c)->type != TSO || 
@@ -1217,7 +1316,7 @@ retainStack( StgClosure *c, retainer c_child_r,
 	    p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
 
 	follow_srt:
-	    retainSRT((StgClosure **)info->srt, info->i.srt_len, c, c_child_r);
+	    retainSRT((StgClosure **)GET_SRT(info), info->i.srt_bitmap, c, c_child_r);
 	    continue;
 
 	case RET_BCO: {
@@ -1236,9 +1335,9 @@ retainStack( StgClosure *c, retainer c_child_r,
 	    // large bitmap (> 32 entries, or > 64 on a 64-bit machine) 
 	case RET_BIG:
 	case RET_VEC_BIG:
-	    size = info->i.layout.large_bitmap->size;
+	    size = GET_LARGE_BITMAP(&info->i)->size;
 	    p++;
-	    retain_large_bitmap(p, info->i.layout.large_bitmap,
+	    retain_large_bitmap(p, GET_LARGE_BITMAP(&info->i),
 				size, c, c_child_r);
 	    p += size;
 	    // and don't forget to follow the SRT 
@@ -1250,16 +1349,16 @@ retainStack( StgClosure *c, retainer c_child_r,
 	    dyn = ((StgRetDyn *)p)->liveness;
 
 	    // traverse the bitmap first
-	    bitmap = GET_LIVENESS(dyn);
+	    bitmap = RET_DYN_LIVENESS(dyn);
 	    p      = (P_)&((StgRetDyn *)p)->payload[0];
-	    size   = RET_DYN_SIZE;
+	    size   = RET_DYN_BITMAP_SIZE;
 	    p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
 	    
 	    // skip over the non-ptr words
-	    p += GET_NONPTRS(dyn);
+	    p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
 	    
 	    // follow the ptr words
-	    for (size = GET_PTRS(dyn); size > 0; size--) {
+	    for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
 		retainClosure((StgClosure *)*p, c, c_child_r);
 		p++;
 	    }
@@ -1274,21 +1373,21 @@ retainStack( StgClosure *c, retainer c_child_r,
 	    fun_info = get_fun_itbl(ret_fun->fun);
 	    
 	    p = (P_)&ret_fun->payload;
-	    switch (fun_info->fun_type) {
+	    switch (fun_info->f.fun_type) {
 	    case ARG_GEN:
-		bitmap = BITMAP_BITS(fun_info->bitmap);
-		size = BITMAP_SIZE(fun_info->bitmap);
+		bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
+		size = BITMAP_SIZE(fun_info->f.b.bitmap);
 		p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
 		break;
 	    case ARG_GEN_BIG:
-		size = ((StgLargeBitmap *)fun_info->bitmap)->size;
-		retain_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, 
+		size = GET_FUN_LARGE_BITMAP(fun_info)->size;
+		retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), 
 				    size, c, c_child_r);
 		p += size;
 		break;
 	    default:
-		bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
-		size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->fun_type]);
+		bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
+		size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
 		p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
 		break;
 	    }
@@ -1304,7 +1403,7 @@ retainStack( StgClosure *c, retainer c_child_r,
     // restore currentStackBoundary
     currentStackBoundary = oldStackBoundary;
 #ifdef DEBUG_RETAINER
-    // fprintf(stderr, "retainStack() finished: currentStackBoundary = 0x%x\n", currentStackBoundary);
+    // debugBelch("retainStack() finished: currentStackBoundary = 0x%x\n", currentStackBoundary);
 #endif
 
 #ifdef DEBUG_RETAINER
@@ -1316,40 +1415,39 @@ retainStack( StgClosure *c, retainer c_child_r,
  * Call retainClosure for each of the children of a PAP/AP
  * ------------------------------------------------------------------------- */
 
-static inline StgPtr
-retain_PAP (StgPAP *pap, retainer c_child_r)
+static INLINE StgPtr
+retain_PAP_payload (StgClosure *pap,  retainer c_child_r, StgClosure *fun, 
+		    StgClosure** payload, StgWord n_args)
 {
     StgPtr p;
-    StgWord bitmap, size;
+    StgWord bitmap;
     StgFunInfoTable *fun_info;
 
-    retainClosure(pap->fun, (StgClosure *)pap, c_child_r);
-    fun_info = get_fun_itbl(pap->fun);
+    retainClosure(fun, pap, c_child_r);
+    fun_info = get_fun_itbl(fun);
     ASSERT(fun_info->i.type != PAP);
 
-    p = (StgPtr)pap->payload;
-    size = pap->n_args;
+    p = (StgPtr)payload;
 
-    switch (fun_info->fun_type) {
+    switch (fun_info->f.fun_type) {
     case ARG_GEN:
-	bitmap = BITMAP_BITS(fun_info->bitmap);
-	p = retain_small_bitmap(p, pap->n_args, bitmap, 
-				(StgClosure *)pap, c_child_r);
+	bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
+	p = retain_small_bitmap(p, n_args, bitmap, 
+				pap, c_child_r);
 	break;
     case ARG_GEN_BIG:
-	retain_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap,
-			    size, (StgClosure *)pap, c_child_r);
-	p += size;
+	retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info),
+			    n_args, pap, c_child_r);
+	p += n_args;
 	break;
     case ARG_BCO:
-	retain_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun),
-			    size, (StgClosure *)pap, c_child_r);
-	p += size;
+	retain_large_bitmap((StgPtr)payload, BCO_BITMAP(fun),
+			    n_args, pap, c_child_r);
+	p += n_args;
 	break;
     default:
-	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
-	p = retain_small_bitmap(p, pap->n_args, bitmap, 
-				(StgClosure *)pap, c_child_r);
+	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
+	p = retain_small_bitmap(p, n_args, bitmap, pap, c_child_r);
 	break;
     }
     return p;
@@ -1390,7 +1488,7 @@ retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 )
 
 #ifdef DEBUG_RETAINER
     // oldStackTop = stackTop;
-    // fprintf(stderr, "retainClosure() called: c0 = 0x%x, cp0 = 0x%x, r0 = 0x%x\n", c0, cp0, r0);
+    // debugBelch("retainClosure() called: c0 = 0x%x, cp0 = 0x%x, r0 = 0x%x\n", c0, cp0, r0);
 #endif
 
     // (c, cp, r) = (c0, cp0, r0)
@@ -1400,18 +1498,18 @@ retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 )
     goto inner_loop;
 
 loop:
-    //fprintf(stderr, "loop");
+    //debugBelch("loop");
     // pop to (c, cp, r);
     pop(&c, &cp, &r);
 
     if (c == NULL) {
 #ifdef DEBUG_RETAINER
-	// fprintf(stderr, "retainClosure() ends: oldStackTop = 0x%x, stackTop = 0x%x\n", oldStackTop, stackTop);
+	// debugBelch("retainClosure() ends: oldStackTop = 0x%x, stackTop = 0x%x\n", oldStackTop, stackTop);
 #endif
 	return;
     }
 
-    //fprintf(stderr, "inner_loop");
+    //debugBelch("inner_loop");
 
 inner_loop:
     // c  = current closure under consideration,
@@ -1453,13 +1551,13 @@ inner_loop:
 	if (((StgTSO *)c)->what_next == ThreadComplete ||
 	    ((StgTSO *)c)->what_next == ThreadKilled) {
 #ifdef DEBUG_RETAINER
-	    fprintf(stderr, "ThreadComplete or ThreadKilled encountered in retainClosure()\n");
+	    debugBelch("ThreadComplete or ThreadKilled encountered in retainClosure()\n");
 #endif
 	    goto loop;
 	}
 	if (((StgTSO *)c)->what_next == ThreadRelocated) {
 #ifdef DEBUG_RETAINER
-	    fprintf(stderr, "ThreadRelocated encountered in retainClosure()\n");
+	    debugBelch("ThreadRelocated encountered in retainClosure()\n");
 #endif
 	    c = (StgClosure *)((StgTSO *)c)->link;
 	    goto inner_loop;
@@ -1481,7 +1579,7 @@ inner_loop:
 	goto loop;
     case THUNK_STATIC:
     case FUN_STATIC:
-	if (get_itbl(c)->srt_len == 0) {
+	if (get_itbl(c)->srt_bitmap == 0) {
 	    // No need to compute the retainer set; no dynamic objects
 	    // are reachable from *c.
 	    //
@@ -1587,9 +1685,18 @@ inner_loop:
 	goto loop;
 
     case PAP:
+    {
+	StgPAP *pap = (StgPAP *)c;
+	retain_PAP_payload(c, c_child_r, pap->fun, pap->payload, pap->n_args);
+	goto loop;
+    }
+
     case AP:
-	retain_PAP((StgPAP *)c, c_child_r);
+    {
+	StgAP *ap = (StgAP *)c;
+	retain_PAP_payload(c, c_child_r, ap->fun, ap->payload, ap->n_args);
 	goto loop;
+    }
 
     case AP_STACK:
 	retainClosure(((StgAP_STACK *)c)->fun, c, c_child_r);
@@ -1647,7 +1754,8 @@ computeRetainerSet( void )
     StgWeak *weak;
     RetainerSet *rtl;
     nat g;
-    StgMutClosure *ml;
+    StgPtr ml;
+    bdescr *bd;
 #ifdef DEBUG_RETAINER
     RetainerSet tmpRetainerSet;
 #endif
@@ -1670,81 +1778,44 @@ computeRetainerSet( void )
     // object (computing sumOfNewCostExtra and updating costArray[] when
     // debugging retainer profiler).
     for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	ASSERT(g != 0 ||
-	       (generations[g].mut_list == END_MUT_LIST &&
-		generations[g].mut_once_list == END_MUT_LIST));
+        ASSERT(g != 0 || (generations[g].mut_list == NULL));
 
-	// Todo:
-	// I think traversing through mut_list is unnecessary.
-	// Think about removing this part.
-	for (ml = generations[g].mut_list; ml != END_MUT_LIST;
-	     ml = ml->mut_link) {
-
-	    maybeInitRetainerSet((StgClosure *)ml);
-	    rtl = retainerSetOf((StgClosure *)ml);
-
-#ifdef DEBUG_RETAINER
-	    if (rtl == NULL) {
-		// first visit to *ml
-		// This is a violation of the interface rule!
-		RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
-
-		switch (get_itbl((StgClosure *)ml)->type) {
-		case IND_STATIC:
-		    // no cost involved
-		    break;
-		case CONSTR_INTLIKE:
-		case CONSTR_CHARLIKE:
-		case CONSTR_NOCAF_STATIC:
-		case CONSTR_STATIC:
-		case THUNK_STATIC:
-		case FUN_STATIC:
-		    barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
-		    break;
-		default:
-		    // dynamic objects
-		    costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
-		    sumOfNewCostExtra += cost((StgClosure *)ml);
-		    break;
-		}
-	    }
-#endif
-	}
-
-	// Traversing through mut_once_list is, in contrast, necessary
+	// Traversing through mut_list is necessary
 	// because we can find MUT_VAR objects which have not been
 	// visited during retainer profiling.
-	for (ml = generations[g].mut_once_list; ml != END_MUT_LIST;
-	     ml = ml->mut_link) {
+	for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
+	    for (ml = bd->start; ml < bd->free; ml++) {
+
+		maybeInitRetainerSet((StgClosure *)*ml);
+		rtl = retainerSetOf((StgClosure *)*ml);
 
-	    maybeInitRetainerSet((StgClosure *)ml);
-	    rtl = retainerSetOf((StgClosure *)ml);
 #ifdef DEBUG_RETAINER
-	    if (rtl == NULL) {
-		// first visit to *ml
-		// This is a violation of the interface rule!
-		RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
-
-		switch (get_itbl((StgClosure *)ml)->type) {
-		case IND_STATIC:
-		    // no cost involved
-		    break;
-		case CONSTR_INTLIKE:
-		case CONSTR_CHARLIKE:
-		case CONSTR_NOCAF_STATIC:
-		case CONSTR_STATIC:
-		case THUNK_STATIC:
-		case FUN_STATIC:
-		    barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
-		    break;
-		default:
-		    // dynamic objects
-		    costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
-		    sumOfNewCostExtra += cost((StgClosure *)ml);
-		    break;
+		if (rtl == NULL) {
+		    // first visit to *ml
+		    // This is a violation of the interface rule!
+		    RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
+		    
+		    switch (get_itbl((StgClosure *)ml)->type) {
+		    case IND_STATIC:
+			// no cost involved
+			break;
+		    case CONSTR_INTLIKE:
+		    case CONSTR_CHARLIKE:
+		    case CONSTR_NOCAF_STATIC:
+		    case CONSTR_STATIC:
+		    case THUNK_STATIC:
+		    case FUN_STATIC:
+			barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
+			break;
+		    default:
+			// dynamic objects
+			costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
+			sumOfNewCostExtra += cost((StgClosure *)ml);
+			break;
+		    }
 		}
-	    }
 #endif
+	    }
 	}
     }
 }
@@ -1786,19 +1857,19 @@ resetStaticObjectForRetainerProfiling( void )
 	    // Since we do not compute the retainer set of any
 	    // IND_STATIC object, we don't have to reset its retainer
 	    // field.
-	    p = IND_STATIC_LINK(p);
+	    p = (StgClosure*)*IND_STATIC_LINK(p);
 	    break;
 	case THUNK_STATIC:
 	    maybeInitRetainerSet(p);
-	    p = THUNK_STATIC_LINK(p);
+	    p = (StgClosure*)*THUNK_STATIC_LINK(p);
 	    break;
 	case FUN_STATIC:
 	    maybeInitRetainerSet(p);
-	    p = FUN_STATIC_LINK(p);
+	    p = (StgClosure*)*FUN_STATIC_LINK(p);
 	    break;
 	case CONSTR_STATIC:
 	    maybeInitRetainerSet(p);
-	    p = STATIC_LINK(get_itbl(p), p);
+	    p = (StgClosure*)*STATIC_LINK(get_itbl(p), p);
 	    break;
 	default:
 	    barf("resetStaticObjectForRetainerProfiling: %p (%s)",
@@ -1807,7 +1878,7 @@ resetStaticObjectForRetainerProfiling( void )
 	}
     }
 #ifdef DEBUG_RETAINER
-    // fprintf(stderr, "count in scavenged_static_objects = %d\n", count);
+    // debugBelch("count in scavenged_static_objects = %d\n", count);
 #endif
 }
 
@@ -1829,25 +1900,25 @@ retainerProfile(void)
 #endif
 
 #ifdef DEBUG_RETAINER
-  fprintf(stderr, " < retainerProfile() invoked : %d>\n", retainerGeneration);
+  debugBelch(" < retainerProfile() invoked : %d>\n", retainerGeneration);
 #endif
 
   stat_startRP();
 
   // We haven't flipped the bit yet.
 #ifdef DEBUG_RETAINER
-  fprintf(stderr, "Before traversing:\n");
+  debugBelch("Before traversing:\n");
   sumOfCostLinear = 0;
   for (i = 0;i < N_CLOSURE_TYPES; i++)
     costArrayLinear[i] = 0;
   totalHeapSize = checkHeapSanityForRetainerProfiling();
 
-  fprintf(stderr, "\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
+  debugBelch("\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
   /*
-  fprintf(stderr, "costArrayLinear[] = ");
+  debugBelch("costArrayLinear[] = ");
   for (i = 0;i < N_CLOSURE_TYPES; i++)
-    fprintf(stderr, "[%u:%u] ", i, costArrayLinear[i]);
-  fprintf(stderr, "\n");
+    debugBelch("[%u:%u] ", i, costArrayLinear[i]);
+  debugBelch("\n");
   */
 
   ASSERT(sumOfCostLinear == totalHeapSize);
@@ -1855,7 +1926,7 @@ retainerProfile(void)
 /*
 #define pcostArrayLinear(index) \
   if (costArrayLinear[index] > 0) \
-    fprintf(stderr, "costArrayLinear[" #index "] = %u\n", costArrayLinear[index])
+    debugBelch("costArrayLinear[" #index "] = %u\n", costArrayLinear[index])
   pcostArrayLinear(THUNK_STATIC);
   pcostArrayLinear(FUN_STATIC);
   pcostArrayLinear(CONSTR_STATIC);
@@ -1878,7 +1949,7 @@ retainerProfile(void)
   timesAnyObjectVisited = 0;
 
 #ifdef DEBUG_RETAINER
-  fprintf(stderr, "During traversing:\n");
+  debugBelch("During traversing:\n");
   sumOfNewCost = 0;
   sumOfNewCostExtra = 0;
   for (i = 0;i < N_CLOSURE_TYPES; i++)
@@ -1900,13 +1971,13 @@ retainerProfile(void)
   computeRetainerSet();
 
 #ifdef DEBUG_RETAINER
-  fprintf(stderr, "After traversing:\n");
+  debugBelch("After traversing:\n");
   sumOfCostLinear = 0;
   for (i = 0;i < N_CLOSURE_TYPES; i++)
     costArrayLinear[i] = 0;
   totalHeapSize = checkHeapSanityForRetainerProfiling();
 
-  fprintf(stderr, "\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
+  debugBelch("\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
   ASSERT(sumOfCostLinear == totalHeapSize);
 
   // now, compare the two results
@@ -1917,22 +1988,22 @@ retainerProfile(void)
         1) Dead weak pointers, whose type is CONSTR. These objects are not
            reachable from any roots.
   */
-  fprintf(stderr, "Comparison:\n");
-  fprintf(stderr, "\tcostArrayLinear[] (must be empty) = ");
+  debugBelch("Comparison:\n");
+  debugBelch("\tcostArrayLinear[] (must be empty) = ");
   for (i = 0;i < N_CLOSURE_TYPES; i++)
     if (costArray[i] != costArrayLinear[i])
       // nothing should be printed except MUT_VAR after major GCs
-      fprintf(stderr, "[%u:%u] ", i, costArrayLinear[i]);
-  fprintf(stderr, "\n");
+      debugBelch("[%u:%u] ", i, costArrayLinear[i]);
+  debugBelch("\n");
 
-  fprintf(stderr, "\tsumOfNewCost = %u\n", sumOfNewCost);
-  fprintf(stderr, "\tsumOfNewCostExtra = %u\n", sumOfNewCostExtra);
-  fprintf(stderr, "\tcostArray[] (must be empty) = ");
+  debugBelch("\tsumOfNewCost = %u\n", sumOfNewCost);
+  debugBelch("\tsumOfNewCostExtra = %u\n", sumOfNewCostExtra);
+  debugBelch("\tcostArray[] (must be empty) = ");
   for (i = 0;i < N_CLOSURE_TYPES; i++)
     if (costArray[i] != costArrayLinear[i])
       // nothing should be printed except MUT_VAR after major GCs
-      fprintf(stderr, "[%u:%u] ", i, costArray[i]);
-  fprintf(stderr, "\n");
+      debugBelch("[%u:%u] ", i, costArray[i]);
+  debugBelch("\n");
 
   // only for major garbage collection
   ASSERT(sumOfNewCost + sumOfNewCostExtra == sumOfCostLinear);
@@ -1962,7 +2033,7 @@ retainerProfile(void)
 #ifdef DEBUG_RETAINER
 
 #define LOOKS_LIKE_PTR(r) ((LOOKS_LIKE_STATIC_CLOSURE(r) || \
-        ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1))) && \
+        ((HEAP_ALLOCED(r) && ((Bdescr((P_)r)->flags & BF_FREE) == 0)))) && \
         ((StgWord)(*(StgPtr)r)!=0xaaaaaaaa))
 
 static nat
@@ -1978,17 +2049,17 @@ sanityCheckHeapClosure( StgClosure *c )
 	if (get_itbl(c)->type == CONSTR &&
 	    !strcmp(get_itbl(c)->prof.closure_type, "DEAD_WEAK") &&
 	    !strcmp(get_itbl(c)->prof.closure_desc, "DEAD_WEAK")) {
-	    fprintf(stderr, "\tUnvisited dead weak pointer object found: c = %p\n", c);
+	    debugBelch("\tUnvisited dead weak pointer object found: c = %p\n", c);
 	    costArray[get_itbl(c)->type] += cost(c);
 	    sumOfNewCost += cost(c);
 	} else
-	    fprintf(stderr,
+	    debugBelch(
 		    "Unvisited object: flip = %d, c = %p(%d, %s, %s), rs = %p\n",
 		    flip, c, get_itbl(c)->type,
 		    get_itbl(c)->prof.closure_type, get_itbl(c)->prof.closure_desc,
 		    RSET(c));
     } else {
-	// fprintf(stderr, "sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
+	// debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
     }
 
     info = get_itbl(c);
@@ -2007,8 +2078,10 @@ sanityCheckHeapClosure( StgClosure *c )
     case MVAR:
 	return sizeofW(StgMVar);
 
-    case MUT_ARR_PTRS:
+    case MUT_ARR_PTRS_CLEAN:
+    case MUT_ARR_PTRS_DIRTY:
     case MUT_ARR_PTRS_FROZEN:
+    case MUT_ARR_PTRS_FROZEN0:
 	return mut_arr_ptrs_sizeW((StgMutArrPtrs *)c);
 
     case AP:
@@ -2034,17 +2107,15 @@ sanityCheckHeapClosure( StgClosure *c )
     case FUN_1_1:
     case FUN_0_2:
     case WEAK:
-    case MUT_VAR:
-    case MUT_CONS:
+    case MUT_VAR_CLEAN:
+    case MUT_VAR_DIRTY:
     case CAF_BLACKHOLE:
     case BLACKHOLE:
     case SE_BLACKHOLE:
     case SE_CAF_BLACKHOLE:
-    case BLACKHOLE_BQ:
     case IND_PERM:
     case IND_OLDGEN:
     case IND_OLDGEN_PERM:
-    case FOREIGN:
     case BCO:
     case STABLE_NAME:
 	return sizeW_fromITBL(info);
@@ -2177,12 +2248,12 @@ checkHeapSanityForRetainerProfiling( void )
     nat costSum, g, s;
 
     costSum = 0;
-    fprintf(stderr, "START: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+    debugBelch("START: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
     if (RtsFlags.GcFlags.generations == 1) {
 	costSum += heapCheck(g0s0->to_blocks);
-	fprintf(stderr, "heapCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+	debugBelch("heapCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
 	costSum += chainCheck(g0s0->large_objects);
-	fprintf(stderr, "chainCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+	debugBelch("chainCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
     } else {
 	for (g = 0; g < RtsFlags.GcFlags.generations; g++)
 	for (s = 0; s < generations[g].n_steps; s++) {
@@ -2195,14 +2266,14 @@ checkHeapSanityForRetainerProfiling( void )
 	    */
 	    if (g == 0 && s == 0) {
 		costSum += smallObjectPoolCheck();
-		fprintf(stderr, "smallObjectPoolCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+		debugBelch("smallObjectPoolCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
 		costSum += chainCheck(generations[g].steps[s].large_objects);
-		fprintf(stderr, "chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+		debugBelch("chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
 	    } else {
 		costSum += heapCheck(generations[g].steps[s].blocks);
-		fprintf(stderr, "heapCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+		debugBelch("heapCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
 		costSum += chainCheck(generations[g].steps[s].large_objects);
-		fprintf(stderr, "chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+		debugBelch("chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
 	    }
 	}
     }
@@ -2226,7 +2297,7 @@ findPointer(StgPtr p)
 		    if (*q == (StgWord)p) {
 			r = q;
 			while (!LOOKS_LIKE_GHC_INFO(*r)) r--;
-			fprintf(stderr, "Found in gen[%d], step[%d]: q = %p, r = %p\n", g, s, q, r);
+			debugBelch("Found in gen[%d], step[%d]: q = %p, r = %p\n", g, s, q, r);
 			// return;
 		    }
 		}
@@ -2238,7 +2309,7 @@ findPointer(StgPtr p)
 		    if (*q == (StgWord)p) {
 			r = q;
 			while (*r == 0 || !LOOKS_LIKE_GHC_INFO(*r)) r--;
-			fprintf(stderr, "Found in gen[%d], large_objects: %p\n", g, r);
+			debugBelch("Found in gen[%d], large_objects: %p\n", g, r);
 			// return;
 		    }
 		}
@@ -2259,20 +2330,20 @@ belongToHeap(StgPtr p)
 	    bd = generations[g].steps[s].blocks;
 	    for (; bd; bd = bd->link) {
 		if (bd->start <= p && p < bd->free) {
-		    fprintf(stderr, "Belongs to gen[%d], step[%d]", g, s);
+		    debugBelch("Belongs to gen[%d], step[%d]", g, s);
 		    return;
 		}
 	    }
 	    bd = generations[g].steps[s].large_objects;
 	    for (; bd; bd = bd->link) {
 		if (bd->start <= p && p < bd->start + getHeapClosureSize((StgClosure *)bd->start)) {
-		    fprintf(stderr, "Found in gen[%d], large_objects: %p\n", g, bd->start);
+		    debugBelch("Found in gen[%d], large_objects: %p\n", g, bd->start);
 		    return;
 		}
 	    }
 	}
     }
 }
-#endif // DEBUG_RETAINER
+#endif /* DEBUG_RETAINER */
 
 #endif /* PROFILING */