Massive patch for the first months work adding System FC to GHC #15

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

diff --git a/rts/GC.c b/rts/GC.c
index a13cd33..66bb5dc 100644 (file)
--- a/rts/GC.c
+++ b/rts/GC.c
@@ -42,8 +42,9 @@
 #if defined(RTS_GTK_FRONTPANEL)
 #include "FrontPanel.h"
 #endif
 #if defined(RTS_GTK_FRONTPANEL)
 #include "FrontPanel.h"
 #endif

-
+#include "Trace.h"

 #include "RetainerProfile.h"
 #include "RetainerProfile.h"

+#include "RaiseAsync.h"

 
 #include <string.h>
 
 
 #include <string.h>
 

@@ -172,6 +173,7 @@ static void         zero_static_object_list ( StgClosure* first_static );
 
 static rtsBool      traverse_weak_ptr_list  ( void );
 static void         mark_weak_ptr_list      ( StgWeak **list );
 
 static rtsBool      traverse_weak_ptr_list  ( void );
 static void         mark_weak_ptr_list      ( StgWeak **list );

+static rtsBool      traverse_blackhole_queue ( void );

 
 static StgClosure * eval_thunk_selector     ( nat field, StgSelector * p );
 
 
 static StgClosure * eval_thunk_selector     ( nat field, StgSelector * p );
 

@@ -354,10 +356,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   CostCentreStack *prev_CCS;
 #endif
 
   CostCentreStack *prev_CCS;
 #endif
 

-#if defined(DEBUG) && defined(GRAN)
-  IF_DEBUG(gc, debugBelch("@@ Starting garbage collection at %ld (%lx)\n", 
-                    Now, Now));
-#endif
+  debugTrace(DEBUG_gc, "starting GC");

 
 #if defined(RTS_USER_SIGNALS)
   // block signals
 
 #if defined(RTS_USER_SIGNALS)
   // block signals

@@ -515,8 +514,8 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
              stp->bitmap = bitmap_bdescr;
              bitmap = bitmap_bdescr->start;
              
              stp->bitmap = bitmap_bdescr;
              bitmap = bitmap_bdescr->start;
              

-             IF_DEBUG(gc, debugBelch("bitmap_size: %d, bitmap: %p",
-                                  bitmap_size, bitmap););
+             debugTrace(DEBUG_gc, "bitmap_size: %d, bitmap: %p",
+                        bitmap_size, bitmap);

              
              // don't forget to fill it with zeros!
              memset(bitmap, 0, bitmap_size);
              
              // don't forget to fill it with zeros!
              memset(bitmap, 0, bitmap_size);

@@ -665,6 +664,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
    */
   markStablePtrTable(mark_root);
 
    */
   markStablePtrTable(mark_root);
 

+  /* Mark the root pointer table.
+   */
+  markRootPtrTable(mark_root);
+

   /* -------------------------------------------------------------------------
    * Repeatedly scavenge all the areas we know about until there's no
    * more scavenging to be done.
   /* -------------------------------------------------------------------------
    * Repeatedly scavenge all the areas we know about until there's no
    * more scavenging to be done.

@@ -723,6 +726,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       }
     }
 
       }
     }
 

+    // if any blackholes are alive, make the threads that wait on
+    // them alive too.
+    if (traverse_blackhole_queue())
+       flag = rtsTrue;
+

     if (flag) { goto loop; }
 
     // must be last...  invariant is that everything is fully
     if (flag) { goto loop; }
 
     // must be last...  invariant is that everything is fully

@@ -818,7 +826,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
        }
        copied +=  mut_list_size;
 
        }
        copied +=  mut_list_size;
 

-       IF_DEBUG(gc, debugBelch("mut_list_size: %ld (%d vars, %d arrays, %d others)\n", mut_list_size * sizeof(W_), mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS));
+       debugTrace(DEBUG_gc,
+                  "mut_list_size: %lu (%d vars, %d arrays, %d others)",
+                  (unsigned long)(mut_list_size * sizeof(W_)),
+                  mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS);

     }
 
     for (s = 0; s < generations[g].n_steps; s++) {
     }
 
     for (s = 0; s < generations[g].n_steps; s++) {

@@ -1067,7 +1078,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
       int pc_free; 
       
       adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
       int pc_free; 
       
       adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);

-      IF_DEBUG(gc, debugBelch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks));
+
+      debugTrace(DEBUG_gc, "near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", 
+                RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks);
+

       pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
       if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ {
        heapOverflow();
       pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
       if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ {
        heapOverflow();

@@ -1299,8 +1313,10 @@ traverse_weak_ptr_list(void)
                  w->link = weak_ptr_list;
                  weak_ptr_list = w;
                  flag = rtsTrue;
                  w->link = weak_ptr_list;
                  weak_ptr_list = w;
                  flag = rtsTrue;

-                 IF_DEBUG(weak, debugBelch("Weak pointer still alive at %p -> %p", 
-                                      w, w->key));
+
+                 debugTrace(DEBUG_weak, 
+                            "weak pointer still alive at %p -> %p",
+                            w, w->key);

                  continue;
              }
              else {
                  continue;
              }
              else {

@@ -1366,16 +1382,6 @@ traverse_weak_ptr_list(void)
                  ;
              }
              
                  ;
              }
              

-             // Threads blocked on black holes: if the black hole
-             // is alive, then the thread is alive too.
-             if (tmp == NULL && t->why_blocked == BlockedOnBlackHole) {
-                 if (isAlive(t->block_info.closure)) {
-                     t = (StgTSO *)evacuate((StgClosure *)t);
-                     tmp = t;
-                     flag = rtsTrue;
-                 }
-             }
-

              if (tmp == NULL) {
                  // not alive (yet): leave this thread on the
                  // old_all_threads list.
              if (tmp == NULL) {
                  // not alive (yet): leave this thread on the
                  // old_all_threads list.

@@ -1434,6 +1440,34 @@ traverse_weak_ptr_list(void)
 }
 
 /* -----------------------------------------------------------------------------
 }
 
 /* -----------------------------------------------------------------------------

+   The blackhole queue
+   
+   Threads on this list behave like weak pointers during the normal
+   phase of garbage collection: if the blackhole is reachable, then
+   the thread is reachable too.
+   -------------------------------------------------------------------------- */
+static rtsBool
+traverse_blackhole_queue (void)
+{
+    StgTSO *prev, *t, *tmp;
+    rtsBool flag;
+
+    flag = rtsFalse;
+    prev = NULL;
+
+    for (t = blackhole_queue; t != END_TSO_QUEUE; prev=t, t = t->link) {
+       if (! (tmp = (StgTSO *)isAlive((StgClosure*)t))) {
+           if (isAlive(t->block_info.closure)) {
+               t = (StgTSO *)evacuate((StgClosure *)t);
+               if (prev) prev->link = t;
+               flag = rtsTrue;
+           }
+       }
+    }
+    return flag;
+}
+
+/* -----------------------------------------------------------------------------

    After GC, the live weak pointer list may have forwarding pointers
    on it, because a weak pointer object was evacuated after being
    moved to the live weak pointer list.  We remove those forwarding
    After GC, the live weak pointer list may have forwarding pointers
    on it, because a weak pointer object was evacuated after being
    moved to the live weak pointer list.  We remove those forwarding

@@ -1864,8 +1898,6 @@ loop:
          }
          return q;
          
          }
          return q;
          

-      case CONSTR_INTLIKE:
-      case CONSTR_CHARLIKE:

       case CONSTR_NOCAF_STATIC:
          /* no need to put these on the static linked list, they don't need
           * to be scavenged.
       case CONSTR_NOCAF_STATIC:
          /* no need to put these on the static linked list, they don't need
           * to be scavenged.

@@ -2168,18 +2200,16 @@ loop:
       to = copy(q,BLACKHOLE_sizeW(),stp); 
       //ToDo: derive size etc from reverted IP
       //to = copy(q,size,stp);
       to = copy(q,BLACKHOLE_sizeW(),stp); 
       //ToDo: derive size etc from reverted IP
       //to = copy(q,size,stp);

-      IF_DEBUG(gc,
-              debugBelch("@@ evacuate: RBH %p (%s) to %p (%s)",
-                    q, info_type(q), to, info_type(to)));
+      debugTrace(DEBUG_gc, "evacuate: RBH %p (%s) to %p (%s)",
+                q, info_type(q), to, info_type(to));

       return to;
     }
       return to;
     }

-
+  

   case BLOCKED_FETCH:
     ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOD_SIZE);
     to = copy(q,sizeofW(StgBlockedFetch),stp);
   case BLOCKED_FETCH:
     ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOD_SIZE);
     to = copy(q,sizeofW(StgBlockedFetch),stp);

-    IF_DEBUG(gc,
-            debugBelch("@@ evacuate: %p (%s) to %p (%s)",
-                  q, info_type(q), to, info_type(to)));
+    debugTrace(DEBUG_gc, "evacuate: %p (%s) to %p (%s)",
+              q, info_type(q), to, info_type(to));

     return to;
 
 # ifdef DIST    
     return to;
 
 # ifdef DIST    

@@ -2188,17 +2218,15 @@ loop:
   case FETCH_ME:
     ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE);
     to = copy(q,sizeofW(StgFetchMe),stp);
   case FETCH_ME:
     ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE);
     to = copy(q,sizeofW(StgFetchMe),stp);

-    IF_DEBUG(gc,
-            debugBelch("@@ evacuate: %p (%s) to %p (%s)",
-                  q, info_type(q), to, info_type(to)));
+    debugTrace(DEBUG_gc, "evacuate: %p (%s) to %p (%s)",
+              q, info_type(q), to, info_type(to)));

     return to;
 
   case FETCH_ME_BQ:
     ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE);
     to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp);
     return to;
 
   case FETCH_ME_BQ:
     ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE);
     to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp);

-    IF_DEBUG(gc,
-            debugBelch("@@ evacuate: %p (%s) to %p (%s)",
-                  q, info_type(q), to, info_type(to)));
+    debugTrace(DEBUG_gc, "evacuate: %p (%s) to %p (%s)",
+              q, info_type(q), to, info_type(to)));

     return to;
 #endif
 
     return to;
 #endif
 

@@ -2602,10 +2630,8 @@ scavengeTSO (StgTSO *tso)
        ) {
        tso->block_info.closure = evacuate(tso->block_info.closure);
     }
        ) {
        tso->block_info.closure = evacuate(tso->block_info.closure);
     }

-    if ( tso->blocked_exceptions != NULL ) {
-       tso->blocked_exceptions = 
-           (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
-    }
+    tso->blocked_exceptions = 
+       (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);

     
     // We don't always chase the link field: TSOs on the blackhole
     // queue are not automatically alive, so the link field is a
     
     // We don't always chase the link field: TSOs on the blackhole
     // queue are not automatically alive, so the link field is a

@@ -3044,9 +3070,8 @@ scavenge(step *stp)
        (StgClosure *)rbh->blocking_queue = 
            evacuate((StgClosure *)rbh->blocking_queue);
        failed_to_evac = rtsTrue;  // mutable anyhow.
        (StgClosure *)rbh->blocking_queue = 
            evacuate((StgClosure *)rbh->blocking_queue);
        failed_to_evac = rtsTrue;  // mutable anyhow.

-       IF_DEBUG(gc,
-                debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
-                      p, info_type(p), (StgClosure *)rbh->blocking_queue));
+       debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)",
+                  p, info_type(p), (StgClosure *)rbh->blocking_queue);

        // ToDo: use size of reverted closure here!
        p += BLACKHOLE_sizeW(); 
        break;
        // ToDo: use size of reverted closure here!
        p += BLACKHOLE_sizeW(); 
        break;

@@ -3061,10 +3086,9 @@ scavenge(step *stp)
        // follow the link to the rest of the blocking queue 
        (StgClosure *)bf->link = 
            evacuate((StgClosure *)bf->link);
        // follow the link to the rest of the blocking queue 
        (StgClosure *)bf->link = 
            evacuate((StgClosure *)bf->link);

-       IF_DEBUG(gc,
-                debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
-                      bf, info_type((StgClosure *)bf), 
-                      bf->node, info_type(bf->node)));
+       debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it",
+                  bf, info_type((StgClosure *)bf), 
+                  bf->node, info_type(bf->node)));

        p += sizeofW(StgBlockedFetch);
        break;
     }
        p += sizeofW(StgBlockedFetch);
        break;
     }

@@ -3081,9 +3105,8 @@ scavenge(step *stp)
        StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
        (StgClosure *)fmbq->blocking_queue = 
            evacuate((StgClosure *)fmbq->blocking_queue);
        StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
        (StgClosure *)fmbq->blocking_queue = 
            evacuate((StgClosure *)fmbq->blocking_queue);

-       IF_DEBUG(gc,
-                debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
-                      p, info_type((StgClosure *)p)));
+       debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it",
+                  p, info_type((StgClosure *)p)));

        p += sizeofW(StgFetchMeBlockingQueue);
        break;
     }
        p += sizeofW(StgFetchMeBlockingQueue);
        break;
     }

@@ -3436,9 +3459,8 @@ linear_scan:
            bh->blocking_queue = 
                (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
            failed_to_evac = rtsTrue;  // mutable anyhow.
            bh->blocking_queue = 
                (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
            failed_to_evac = rtsTrue;  // mutable anyhow.

-           IF_DEBUG(gc,
-                    debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
-                          p, info_type(p), (StgClosure *)rbh->blocking_queue));
+           debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)",
+                      p, info_type(p), (StgClosure *)rbh->blocking_queue));

            break;
        }
        
            break;
        }
        

@@ -3451,10 +3473,9 @@ linear_scan:
            // follow the link to the rest of the blocking queue 
            (StgClosure *)bf->link = 
                evacuate((StgClosure *)bf->link);
            // follow the link to the rest of the blocking queue 
            (StgClosure *)bf->link = 
                evacuate((StgClosure *)bf->link);

-           IF_DEBUG(gc,
-                    debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
-                          bf, info_type((StgClosure *)bf), 
-                          bf->node, info_type(bf->node)));
+           debugTrace(DEBUG_gc, "scavenge: %p (%s); node is now %p; exciting, isn't it",
+                      bf, info_type((StgClosure *)bf), 
+                      bf->node, info_type(bf->node)));

            break;
        }
 
            break;
        }
 

@@ -3469,9 +3490,8 @@ linear_scan:
            StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
            (StgClosure *)fmbq->blocking_queue = 
                evacuate((StgClosure *)fmbq->blocking_queue);
            StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
            (StgClosure *)fmbq->blocking_queue = 
                evacuate((StgClosure *)fmbq->blocking_queue);

-           IF_DEBUG(gc,
-                    debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
-                          p, info_type((StgClosure *)p)));
+           debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it",
+                      p, info_type((StgClosure *)p)));

            break;
        }
 #endif /* PAR */
            break;
        }
 #endif /* PAR */

@@ -3546,7 +3566,7 @@ linear_scan:
 
     // start a new linear scan if the mark stack overflowed at some point
     if (mark_stack_overflowed && oldgen_scan_bd == NULL) {
 
     // start a new linear scan if the mark stack overflowed at some point
     if (mark_stack_overflowed && oldgen_scan_bd == NULL) {

-       IF_DEBUG(gc, debugBelch("scavenge_mark_stack: starting linear scan"));
+       debugTrace(DEBUG_gc, "scavenge_mark_stack: starting linear scan");

        mark_stack_overflowed = rtsFalse;
        oldgen_scan_bd = oldest_gen->steps[0].old_blocks;
        oldgen_scan = oldgen_scan_bd->start;
        mark_stack_overflowed = rtsFalse;
        oldgen_scan_bd = oldest_gen->steps[0].old_blocks;
        oldgen_scan = oldgen_scan_bd->start;

@@ -3788,9 +3808,8 @@ scavenge_one(StgPtr p)
        (StgClosure *)rbh->blocking_queue = 
            evacuate((StgClosure *)rbh->blocking_queue);
        failed_to_evac = rtsTrue;  // mutable anyhow.
        (StgClosure *)rbh->blocking_queue = 
            evacuate((StgClosure *)rbh->blocking_queue);
        failed_to_evac = rtsTrue;  // mutable anyhow.

-       IF_DEBUG(gc,
-                debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
-                      p, info_type(p), (StgClosure *)rbh->blocking_queue));
+       debugTrace(DEBUG_gc, "scavenge: RBH %p (%s) (new blocking_queue link=%p)",
+                  p, info_type(p), (StgClosure *)rbh->blocking_queue));

        // ToDo: use size of reverted closure here!
        break;
     }
        // ToDo: use size of reverted closure here!
        break;
     }

@@ -3804,10 +3823,10 @@ scavenge_one(StgPtr p)
        // follow the link to the rest of the blocking queue 
        (StgClosure *)bf->link = 
            evacuate((StgClosure *)bf->link);
        // follow the link to the rest of the blocking queue 
        (StgClosure *)bf->link = 
            evacuate((StgClosure *)bf->link);

-       IF_DEBUG(gc,
-                debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
-                      bf, info_type((StgClosure *)bf), 
-                      bf->node, info_type(bf->node)));
+       debugTrace(DEBUG_gc,
+                  "scavenge: %p (%s); node is now %p; exciting, isn't it",
+                  bf, info_type((StgClosure *)bf), 
+                  bf->node, info_type(bf->node)));

        break;
     }
 
        break;
     }
 

@@ -3822,9 +3841,8 @@ scavenge_one(StgPtr p)
        StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
        (StgClosure *)fmbq->blocking_queue = 
            evacuate((StgClosure *)fmbq->blocking_queue);
        StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
        (StgClosure *)fmbq->blocking_queue = 
            evacuate((StgClosure *)fmbq->blocking_queue);

-       IF_DEBUG(gc,
-                debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
-                      p, info_type((StgClosure *)p)));
+       debugTrace(DEBUG_gc, "scavenge: %p (%s) exciting, isn't it",
+                  p, info_type((StgClosure *)p)));

        break;
     }
 #endif
        break;
     }
 #endif

@@ -4152,8 +4170,6 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
   StgWord bitmap;
   nat size;
 
   StgWord bitmap;
   nat size;
 

-  //IF_DEBUG(sanity, debugBelch("  scavenging stack between %p and %p", p, stack_end));
-

   /* 
    * Each time around this loop, we are looking at a chunk of stack
    * that starts with an activation record. 
   /* 
    * Each time around this loop, we are looking at a chunk of stack
    * that starts with an activation record. 

@@ -4413,11 +4429,11 @@ gcCAFs(void)
     ASSERT(info->type == IND_STATIC);
 
     if (STATIC_LINK(info,p) == NULL) {
     ASSERT(info->type == IND_STATIC);
 
     if (STATIC_LINK(info,p) == NULL) {

-      IF_DEBUG(gccafs, debugBelch("CAF gc'd at 0x%04lx", (long)p));
-      // black hole it 
-      SET_INFO(p,&stg_BLACKHOLE_info);
-      p = STATIC_LINK2(info,p);
-      *pp = p;
+       debugTrace(DEBUG_gccafs, "CAF gc'd at 0x%04lx", (long)p);
+       // black hole it 
+       SET_INFO(p,&stg_BLACKHOLE_info);
+       p = STATIC_LINK2(info,p);
+       *pp = p;

     }
     else {
       pp = &STATIC_LINK2(info,p);
     }
     else {
       pp = &STATIC_LINK2(info,p);

@@ -4427,7 +4443,7 @@ gcCAFs(void)
 
   }
 
 
   }
 

-  //  debugBelch("%d CAFs live", i); 
+  debugTrace(DEBUG_gccafs, "%d CAFs live", i); 

 }
 #endif
 
 }
 #endif
 

@@ -4601,6 +4617,14 @@ threadPaused(Capability *cap, StgTSO *tso)
     nat weight_pending   = 0;
     rtsBool prev_was_update_frame;
     
     nat weight_pending   = 0;
     rtsBool prev_was_update_frame;
     

+    // Check to see whether we have threads waiting to raise
+    // exceptions, and we're not blocking exceptions, or are blocked
+    // interruptibly.  This is important; if a thread is running with
+    // TSO_BLOCKEX and becomes blocked interruptibly, this is the only
+    // place we ensure that the blocked_exceptions get a chance.
+    maybePerformBlockedException (cap, tso);
+    if (tso->what_next == ThreadKilled) { return; }
+

     stack_end = &tso->stack[tso->stack_size];
     
     frame = (StgClosure *)tso->sp;
     stack_end = &tso->stack[tso->stack_size];
     
     frame = (StgClosure *)tso->sp;

@@ -4622,7 +4646,9 @@ threadPaused(Capability *cap, StgTSO *tso)
            bh = ((StgUpdateFrame *)frame)->updatee;
 
            if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) {
            bh = ((StgUpdateFrame *)frame)->updatee;
 
            if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) {

-               IF_DEBUG(squeeze, debugBelch("suspending duplicate work: %ld words of stack\n", (StgPtr)frame - tso->sp));
+               debugTrace(DEBUG_squeeze,
+                          "suspending duplicate work: %ld words of stack",
+                          (long)((StgPtr)frame - tso->sp));

 
                // If this closure is already an indirection, then
                // suspend the computation up to this point:
 
                // If this closure is already an indirection, then
                // suspend the computation up to this point:

@@ -4682,10 +4708,10 @@ threadPaused(Capability *cap, StgTSO *tso)
     }
 
 end:
     }
 
 end:

-    IF_DEBUG(squeeze, 
-            debugBelch("words_to_squeeze: %d, weight: %d, squeeze: %s\n", 
-                       words_to_squeeze, weight, 
-                       weight < words_to_squeeze ? "YES" : "NO"));
+    debugTrace(DEBUG_squeeze, 
+              "words_to_squeeze: %d, weight: %d, squeeze: %s", 
+              words_to_squeeze, weight, 
+              weight < words_to_squeeze ? "YES" : "NO");

 
     // Should we squeeze or not?  Arbitrary heuristic: we squeeze if
     // the number of words we have to shift down is less than the
 
     // Should we squeeze or not?  Arbitrary heuristic: we squeeze if
     // the number of words we have to shift down is less than the

@@ -4707,7 +4733,7 @@ printMutableList(generation *gen)
     bdescr *bd;
     StgPtr p;
 
     bdescr *bd;
     StgPtr p;
 

-    debugBelch("@@ Mutable list %p: ", gen->mut_list);
+    debugBelch("mutable list %p: ", gen->mut_list);

 
     for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
        for (p = bd->start; p < bd->free; p++) {
 
     for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
        for (p = bd->start; p < bd->free; p++) {