Enable two-step allocator on FreeBSD
[ghc.git] / rts / Printer.c
index 737fba4..291f529 100644 (file)
@@ -3,19 +3,28 @@
  * (c) The GHC Team, 1994-2000.
  *
  * Heap printer
- * 
+ *
  * ---------------------------------------------------------------------------*/
 
 #include "PosixSource.h"
+#include "ghcconfig.h"
+
 #include "Rts.h"
 #include "rts/Bytecodes.h"  /* for InstrPtr */
 
+#include "sm/Storage.h"
+#include "sm/GCThread.h"
+#include "Hash.h"
 #include "Printer.h"
 #include "RtsUtils.h"
 
+#if defined(PROFILING)
+#include "Profiling.h"
+#endif
+
 #include <string.h>
 
-#ifdef DEBUG
+#if defined(DEBUG)
 
 #include "Disassembler.h"
 #include "Apply.h"
  * local function decls
  * ------------------------------------------------------------------------*/
 
-static void    printStdObjPayload( StgClosure *obj );
-#ifdef USING_LIBBFD
-static void    reset_table   ( int size );
-static void    prepare_table ( void );
-static void    insert        ( StgWord value, const char *name );
-#endif
-#if 0 /* unused but might be useful sometime */
-static rtsBool lookup_name   ( char *name, StgWord *result );
-static void    enZcode       ( char *in, char *out );
-#endif
-static char    unZcode       ( char ch );
-static void    printZcoded   ( const char *raw );
+static void    printStdObjPayload( const StgClosure *obj );
 
 /* --------------------------------------------------------------------------
  * Printer
@@ -46,12 +44,13 @@ void printPtr( StgPtr p )
     const char *raw;
     raw = lookupGHCName(p);
     if (raw != NULL) {
-        printZcoded(raw);
+        debugBelch("<%s>", raw);
+        debugBelch("[%p]", p);
     } else {
         debugBelch("%p", p);
     }
 }
-  
+
 void printObj( StgClosure *obj )
 {
     debugBelch("Object "); printPtr((StgPtr)obj); debugBelch(" = ");
@@ -59,17 +58,17 @@ void printObj( StgClosure *obj )
 }
 
 STATIC_INLINE void
-printStdObjHdr( StgClosure *obj, char* tag )
+printStdObjHdr( const StgClosure *obj, char* tag )
 {
     debugBelch("%s(",tag);
     printPtr((StgPtr)obj->header.info);
-#ifdef PROFILING
+#if defined(PROFILING)
     debugBelch(", %s", obj->header.prof.ccs->cc->label);
 #endif
 }
 
 static void
-printStdObjPayload( StgClosure *obj )
+printStdObjPayload( const StgClosure *obj )
 {
     StgWord i, j;
     const StgInfoTable* info;
@@ -110,11 +109,11 @@ printThunkObject( StgThunk *obj, char* tag )
 }
 
 void
-printClosure( StgClosure *obj )
+printClosure( const StgClosure *obj )
 {
-    obj = UNTAG_CLOSURE(obj);
+    const StgInfoTable *info;
 
-    StgInfoTable *info;
+    obj = UNTAG_CONST_CLOSURE(obj);
     info = get_itbl(obj);
 
     switch ( info->type ) {
@@ -124,19 +123,18 @@ printClosure( StgClosure *obj )
     case CONSTR:
     case CONSTR_1_0: case CONSTR_0_1:
     case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
-    case CONSTR_STATIC:
-    case CONSTR_NOCAF_STATIC:
+    case CONSTR_NOCAF:
         {
             StgWord i, j;
-            StgConInfoTable *con_info = get_con_itbl (obj);
+            const StgConInfoTable *con_info = get_con_itbl (obj);
 
             debugBelch("%s(", GET_CON_DESC(con_info));
             for (i = 0; i < info->layout.payload.ptrs; ++i) {
-               if (i != 0) debugBelch(", ");
+                if (i != 0) debugBelch(", ");
                 printPtr((StgPtr)obj->payload[i]);
             }
             for (j = 0; j < info->layout.payload.nptrs; ++j) {
-               if (i != 0 || j != 0) debugBelch(", ");
+                if (i != 0 || j != 0) debugBelch(", ");
                 debugBelch("%p#", obj->payload[i+j]);
             }
             debugBelch(")\n");
@@ -144,29 +142,35 @@ printClosure( StgClosure *obj )
         }
 
     case FUN:
-    case FUN_1_0: case FUN_0_1: 
+    case FUN_1_0: case FUN_0_1:
     case FUN_1_1: case FUN_0_2: case FUN_2_0:
     case FUN_STATIC:
-       debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity);
-       printPtr((StgPtr)obj->header.info);
-#ifdef PROFILING
-       debugBelch(", %s", obj->header.prof.ccs->cc->label);
+        debugBelch("FUN/%d(",(int)itbl_to_fun_itbl(info)->f.arity);
+        printPtr((StgPtr)obj->header.info);
+#if defined(PROFILING)
+        debugBelch(", %s", obj->header.prof.ccs->cc->label);
 #endif
-       printStdObjPayload(obj);
-       break;
+        printStdObjPayload(obj);
+        break;
 
     case PRIM:
-       debugBelch("PRIM(");
-       printPtr((StgPtr)obj->header.info);
-       printStdObjPayload(obj);
-       break;
+        debugBelch("PRIM(");
+        printPtr((StgPtr)obj->header.info);
+        printStdObjPayload(obj);
+        break;
+
+    case MUT_PRIM:
+        debugBelch("MUT_PRIM(");
+        printPtr((StgPtr)obj->header.info);
+        printStdObjPayload(obj);
+        break;
 
     case THUNK:
     case THUNK_1_0: case THUNK_0_1:
     case THUNK_1_1: case THUNK_0_2: case THUNK_2_0:
     case THUNK_STATIC:
             /* ToDo: will this work for THUNK_STATIC too? */
-#ifdef PROFILING
+#if defined(PROFILING)
             printThunkObject((StgThunk *)obj,GET_PROF_DESC(info));
 #else
             printThunkObject((StgThunk *)obj,"THUNK");
@@ -174,9 +178,9 @@ printClosure( StgClosure *obj )
             break;
 
     case THUNK_SELECTOR:
-       printStdObjHdr(obj, "THUNK_SELECTOR");
-       debugBelch(", %p)\n", ((StgSelector *)obj)->selectee);
-       break;
+        printStdObjHdr(obj, "THUNK_SELECTOR");
+        debugBelch(", %p)\n", ((StgSelector *)obj)->selectee);
+        break;
 
     case BCO:
             disassemble( (StgBCO*)obj );
@@ -184,7 +188,7 @@ printClosure( StgClosure *obj )
 
     case AP:
         {
-           StgAP* ap = (StgAP*)obj;
+            StgAP* ap = (StgAP*)obj;
             StgWord i;
             debugBelch("AP("); printPtr((StgPtr)ap->fun);
             for (i = 0; i < ap->n_args; ++i) {
@@ -197,10 +201,10 @@ printClosure( StgClosure *obj )
 
     case PAP:
         {
-           StgPAP* pap = (StgPAP*)obj;
+            StgPAP* pap = (StgPAP*)obj;
             StgWord i;
-            debugBelch("PAP/%d(",(int)pap->arity); 
-           printPtr((StgPtr)pap->fun);
+            debugBelch("PAP/%d(",(int)pap->arity);
+            printPtr((StgPtr)pap->fun);
             for (i = 0; i < pap->n_args; ++i) {
                 debugBelch(", ");
                 printPtr((StgPtr)pap->payload[i]);
@@ -211,7 +215,7 @@ printClosure( StgClosure *obj )
 
     case AP_STACK:
         {
-           StgAP_STACK* ap = (StgAP_STACK*)obj;
+            StgAP_STACK* ap = (StgAP_STACK*)obj;
             StgWord i;
             debugBelch("AP_STACK("); printPtr((StgPtr)ap->fun);
             for (i = 0; i < ap->size; ++i) {
@@ -223,45 +227,38 @@ printClosure( StgClosure *obj )
         }
 
     case IND:
-            debugBelch("IND("); 
-            printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
-            break;
-
-    case IND_PERM:
-            debugBelch("IND("); 
+            debugBelch("IND(");
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
 
     case IND_STATIC:
-            debugBelch("IND_STATIC("); 
+            debugBelch("IND_STATIC(");
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
 
     case BLACKHOLE:
-            debugBelch("BLACKHOLE("); 
+            debugBelch("BLACKHOLE(");
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
 
     /* Cannot happen -- use default case.
     case RET_BCO:
     case RET_SMALL:
     case RET_BIG:
-    case RET_DYN:
     case RET_FUN:
     */
 
     case UPDATE_FRAME:
         {
             StgUpdateFrame* u = (StgUpdateFrame*)obj;
-            debugBelch("UPDATE_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
+            debugBelch("%s(", info_update_frame(obj));
+            printPtr((StgPtr)GET_INFO((StgClosure *)u));
             debugBelch(",");
             printPtr((StgPtr)u->updatee);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
         }
 
@@ -269,10 +266,10 @@ printClosure( StgClosure *obj )
         {
             StgCatchFrame* u = (StgCatchFrame*)obj;
             debugBelch("CATCH_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
+            printPtr((StgPtr)GET_INFO((StgClosure *)u));
             debugBelch(",");
             printPtr((StgPtr)u->handler);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
         }
 
@@ -281,7 +278,7 @@ printClosure( StgClosure *obj )
             StgUnderflowFrame* u = (StgUnderflowFrame*)obj;
             debugBelch("UNDERFLOW_FRAME(");
             printPtr((StgPtr)u->next_chunk);
-            debugBelch(")\n"); 
+            debugBelch(")\n");
             break;
         }
 
@@ -289,8 +286,8 @@ printClosure( StgClosure *obj )
         {
             StgStopFrame* u = (StgStopFrame*)obj;
             debugBelch("STOP_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
-            debugBelch(")\n"); 
+            printPtr((StgPtr)GET_INFO((StgClosure *)u));
+            debugBelch(")\n");
             break;
         }
 
@@ -298,71 +295,128 @@ printClosure( StgClosure *obj )
         {
             StgWord i;
             debugBelch("ARR_WORDS(\"");
-           for (i=0; i<arr_words_words((StgArrWords *)obj); i++)
-             debugBelch("%" FMT_SizeT, (lnat)((StgArrWords *)obj)->payload[i]);
+            for (i=0; i<arr_words_words((StgArrBytes *)obj); i++)
+              debugBelch("%" FMT_Word, (W_)((StgArrBytes *)obj)->payload[i]);
             debugBelch("\")\n");
             break;
         }
 
     case MUT_ARR_PTRS_CLEAN:
-       debugBelch("MUT_ARR_PTRS_CLEAN(size=%" FMT_SizeT ")\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
-       break;
+        debugBelch("MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
+        break;
 
     case MUT_ARR_PTRS_DIRTY:
-       debugBelch("MUT_ARR_PTRS_DIRTY(size=%" FMT_SizeT ")\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
-       break;
+        debugBelch("MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
+        break;
+
+    case MUT_ARR_PTRS_FROZEN_CLEAN:
+        debugBelch("MUT_ARR_PTRS_FROZEN_CLEAN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
+        break;
+
+    case SMALL_MUT_ARR_PTRS_CLEAN:
+        debugBelch("SMALL_MUT_ARR_PTRS_CLEAN(size=%" FMT_Word ")\n",
+                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
+        break;
 
-    case MUT_ARR_PTRS_FROZEN:
-       debugBelch("MUT_ARR_PTRS_FROZEN(size=%" FMT_SizeT ")\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
-       break;
+    case SMALL_MUT_ARR_PTRS_DIRTY:
+        debugBelch("SMALL_MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n",
+                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
+        break;
+
+    case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
+        debugBelch("SMALL_MUT_ARR_PTRS_FROZEN_CLEAN(size=%" FMT_Word ")\n",
+                   (W_)((StgSmallMutArrPtrs *)obj)->ptrs);
+        break;
 
     case MVAR_CLEAN:
     case MVAR_DIRTY:
         {
-         StgMVar* mv = (StgMVar*)obj;
-         debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value);
+          StgMVar* mv = (StgMVar*)obj;
+
+          debugBelch("MVAR(head=");
+          if ((StgClosure*)mv->head == &stg_END_TSO_QUEUE_closure) {
+              debugBelch("END_TSO_QUEUE");
+          } else {
+              debugBelch("%p", mv->head);
+          }
+
+          debugBelch(", tail=");
+          if ((StgClosure*)mv->tail == &stg_END_TSO_QUEUE_closure) {
+              debugBelch("END_TSO_QUEUE");
+          } else {
+              debugBelch("%p", mv->tail);
+          }
+
+          debugBelch(", value=");
+          if ((StgClosure*)mv->value == &stg_END_TSO_QUEUE_closure) {
+              debugBelch("END_TSO_QUEUE");
+          } else {
+              debugBelch("%p", mv->value);
+          }
+          debugBelch(")\n");
+
+          break;
+        }
+
+    case TVAR:
+        {
+          StgTVar* tv = (StgTVar*)obj;
+          debugBelch("TVAR(value=%p, wq=%p, num_updates=%" FMT_Word ")\n", tv->current_value, tv->first_watch_queue_entry, tv->num_updates);
           break;
         }
 
     case MUT_VAR_CLEAN:
         {
-         StgMutVar* mv = (StgMutVar*)obj;
-         debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var);
+          StgMutVar* mv = (StgMutVar*)obj;
+          debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var);
           break;
         }
 
     case MUT_VAR_DIRTY:
         {
-         StgMutVar* mv = (StgMutVar*)obj;
-         debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var);
+          StgMutVar* mv = (StgMutVar*)obj;
+          debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var);
           break;
         }
 
     case WEAK:
-            debugBelch("WEAK("); 
-           debugBelch(" key=%p value=%p finalizer=%p", 
-                   (StgPtr)(((StgWeak*)obj)->key),
-                   (StgPtr)(((StgWeak*)obj)->value),
-                   (StgPtr)(((StgWeak*)obj)->finalizer));
-            debugBelch(")\n"); 
-           /* ToDo: chase 'link' ? */
+            debugBelch("WEAK(");
+            debugBelch("key=%p value=%p finalizer=%p",
+                    (StgPtr)(((StgWeak*)obj)->key),
+                    (StgPtr)(((StgWeak*)obj)->value),
+                    (StgPtr)(((StgWeak*)obj)->finalizer));
+            debugBelch(")\n");
+            /* ToDo: chase 'link' ? */
             break;
 
     case TSO:
-      debugBelch("TSO("); 
+      debugBelch("TSO(");
       debugBelch("%lu (%p)",(unsigned long)(((StgTSO*)obj)->id), (StgTSO*)obj);
-      debugBelch(")\n"); 
+      debugBelch(")\n");
+      break;
+
+    case STACK:
+      debugBelch("STACK\n");
       break;
 
 #if 0
       /* Symptomatic of a problem elsewhere, have it fall-through & fail */
     case EVACUATED:
-      debugBelch("EVACUATED("); 
+      debugBelch("EVACUATED(");
       printClosure((StgEvacuated*)obj->evacuee);
-      debugBelch(")\n"); 
+      debugBelch(")\n");
       break;
 #endif
 
+    case COMPACT_NFDATA:
+        debugBelch("COMPACT_NFDATA(size=%" FMT_Word ")\n",
+                   (W_)((StgCompactNFData *)obj)->totalW * (W_)sizeof(W_));
+        break;
+
+    case TREC_CHUNK:
+        debugBelch("TREC_CHUNK\n");
+        break;
+
     default:
             //barf("printClosure %d",get_itbl(obj)->type);
             debugBelch("*** printClosure: unknown type %d ****\n",
@@ -372,84 +426,77 @@ printClosure( StgClosure *obj )
     }
 }
 
-/*
-void printGraph( StgClosure *obj )
+void
+printMutableList(bdescr *bd)
 {
- printClosure(obj);
-}
-*/
+    StgPtr p;
 
-StgPtr
-printStackObj( StgPtr sp )
-{
-    /*debugBelch("Stack[%d] = ", &stgStack[STACK_SIZE] - sp); */
-
-        StgClosure* c = (StgClosure*)(*sp);
-        printPtr((StgPtr)*sp);
-        if (c == (StgClosure*)&stg_ctoi_R1p_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_R1p_info\n" );
-       } else
-        if (c == (StgClosure*)&stg_ctoi_R1n_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_R1n_info\n" );
-       } else
-        if (c == (StgClosure*)&stg_ctoi_F1_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_F1_info\n" );
-       } else
-        if (c == (StgClosure*)&stg_ctoi_D1_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_D1_info\n" );
-       } else
-        if (c == (StgClosure*)&stg_ctoi_V_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_V_info\n" );
-       } else
-        if (get_itbl(c)->type == BCO) {
-           debugBelch("\t\t\t");
-           debugBelch("BCO(...)\n"); 
-        }
-        else {
-           debugBelch("\t\t\t");
-           printClosure ( (StgClosure*)(*sp));
+    debugBelch("mutable list %p: ", bd);
+
+    for (; bd != NULL; bd = bd->link) {
+        for (p = bd->start; p < bd->free; p++) {
+            debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
         }
-        sp += 1;
+    }
+    debugBelch("\n");
+}
 
-    return sp;
-    
+// If you know you have an UPDATE_FRAME, but want to know exactly which.
+const char *info_update_frame(const StgClosure *closure)
+{
+    // Note: We intentionally don't take the info table pointer as
+    // an argument. As it will be confusing whether one should pass
+    // it pointing to the code or struct members when compiling with
+    // TABLES_NEXT_TO_CODE.
+    const StgInfoTable *info = closure->header.info;
+    if (info == &stg_upd_frame_info) {
+        return "NORMAL_UPDATE_FRAME";
+    } else if (info == &stg_bh_upd_frame_info) {
+        return "BH_UPDATE_FRAME";
+    } else if (info == &stg_marked_upd_frame_info) {
+        return "MARKED_UPDATE_FRAME";
+    } else {
+        return "ERROR: Not an update frame!!!";
+    }
 }
 
 static void
-printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
+printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap,
+                    uint32_t size )
 {
-    nat i;
+    uint32_t i;
 
     for(i = 0; i < size; i++, bitmap >>= 1 ) {
-       debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i);
-       if ((bitmap & 1) == 0) {
-           printPtr((P_)payload[i]);
-           debugBelch("\n");
-       } else {
-           debugBelch("Word# %" FMT_SizeT "\n", (lnat)payload[i]);
-       }
+        debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i);
+        if ((bitmap & 1) == 0) {
+            printPtr((P_)payload[i]);
+            debugBelch("\n");
+        } else {
+            debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
+        }
     }
 }
 
 static void
-printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap, nat size )
+printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap,
+                    uint32_t size )
 {
     StgWord bmp;
-    nat i, j;
+    uint32_t i, j;
 
     i = 0;
     for (bmp=0; i < size; bmp++) {
-       StgWord bitmap = large_bitmap->bitmap[bmp];
-       j = 0;
-       for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
-           debugBelch("   stk[%" FMT_SizeT "] (%p) = ", (lnat)(spBottom-(payload+i)), payload+i);
-           if ((bitmap & 1) == 0) {
-               printPtr((P_)payload[i]);
-               debugBelch("\n");
-           } else {
-               debugBelch("Word# %" FMT_SizeT "\n", (lnat)payload[i]);
-           }
-       }
+        StgWord bitmap = large_bitmap->bitmap[bmp];
+        j = 0;
+        for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
+            debugBelch("   stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i);
+            if ((bitmap & 1) == 0) {
+                printPtr((P_)payload[i]);
+                debugBelch("\n");
+            } else {
+                debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
+            }
+        }
     }
 }
 
@@ -462,108 +509,141 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
     ASSERT(sp <= spBottom);
     for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
 
-       info = get_itbl((StgClosure *)sp);
+        info = get_itbl((StgClosure *)sp);
+
+        switch (info->type) {
 
-       switch (info->type) {
-           
-       case UPDATE_FRAME:
-       case CATCH_FRAME:
+        case UPDATE_FRAME:
+        case CATCH_FRAME:
         case UNDERFLOW_FRAME:
         case STOP_FRAME:
-            printObj((StgClosure*)sp);
-           continue;
-
-       case RET_DYN:
-       { 
-           StgRetDyn* r;
-           StgPtr p;
-           StgWord dyn;
-           nat size;
-
-           r = (StgRetDyn *)sp;
-           dyn = r->liveness;
-           debugBelch("RET_DYN (%p)\n", r);
-
-           p = (P_)(r->payload);
-           printSmallBitmap(spBottom, sp,
-                            RET_DYN_LIVENESS(r->liveness), 
-                            RET_DYN_BITMAP_SIZE);
-           p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE;
-
-           for (size = RET_DYN_NONPTRS(dyn); size > 0; size--) {
-               debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-p), p);
-               debugBelch("Word# %ld\n", (long)*p);
-               p++;
-           }
-       
-           for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
-               debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-p), p);
-               printPtr(p);
-               p++;
-           }
-           continue;
-       }
-
-       case RET_SMALL:
-           debugBelch("RET_SMALL (%p)\n", info);
-           bitmap = info->layout.bitmap;
-           printSmallBitmap(spBottom, sp+1, 
-                            BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
-           continue;
-
-       case RET_BCO: {
-           StgBCO *bco;
-           
-           bco = ((StgBCO *)sp[1]);
-
-           debugBelch("RET_BCO (%p)\n", sp);
-           printLargeBitmap(spBottom, sp+2,
-                            BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
-           continue;
-       }
-
-       case RET_BIG:
-           barf("todo");
-
-       case RET_FUN:
-       {
-           StgFunInfoTable *fun_info;
-           StgRetFun *ret_fun;
-
-           ret_fun = (StgRetFun *)sp;
-           fun_info = get_fun_itbl(ret_fun->fun);
-           debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type);
-           switch (fun_info->f.fun_type) {
-           case ARG_GEN:
-               printSmallBitmap(spBottom, sp+2,
-                                BITMAP_BITS(fun_info->f.b.bitmap),
-                                BITMAP_SIZE(fun_info->f.b.bitmap));
-               break;
-           case ARG_GEN_BIG:
-               printLargeBitmap(spBottom, sp+2,
-                                GET_FUN_LARGE_BITMAP(fun_info),
-                                GET_FUN_LARGE_BITMAP(fun_info)->size);
-               break;
-           default:
-               printSmallBitmap(spBottom, sp+2,
-                                BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
-                                BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
-               break;
-           }
-           continue;
-       }
-          
-       default:
-           debugBelch("unknown object %d\n", (int)info->type);
-           barf("printStackChunk");
-       }
+            printClosure((StgClosure*)sp);
+            continue;
+
+        case RET_SMALL: {
+            StgWord c = *sp;
+            if (c == (StgWord)&stg_ctoi_R1p_info) {
+                debugBelch("tstg_ctoi_ret_R1p_info\n" );
+            } else if (c == (StgWord)&stg_ctoi_R1n_info) {
+                debugBelch("stg_ctoi_ret_R1n_info\n" );
+            } else if (c == (StgWord)&stg_ctoi_F1_info) {
+                debugBelch("stg_ctoi_ret_F1_info\n" );
+            } else if (c == (StgWord)&stg_ctoi_D1_info) {
+                debugBelch("stg_ctoi_ret_D1_info\n" );
+            } else if (c == (StgWord)&stg_ctoi_V_info) {
+                debugBelch("stg_ctoi_ret_V_info\n" );
+            } else if (c == (StgWord)&stg_ap_v_info) {
+                debugBelch("stg_ap_v_info\n" );
+            } else if (c == (StgWord)&stg_ap_f_info) {
+                debugBelch("stg_ap_f_info\n" );
+            } else if (c == (StgWord)&stg_ap_d_info) {
+                debugBelch("stg_ap_d_info\n" );
+            } else if (c == (StgWord)&stg_ap_l_info) {
+                debugBelch("stg_ap_l_info\n" );
+            } else if (c == (StgWord)&stg_ap_n_info) {
+                debugBelch("stg_ap_n_info\n" );
+            } else if (c == (StgWord)&stg_ap_p_info) {
+                debugBelch("stg_ap_p_info\n" );
+            } else if (c == (StgWord)&stg_ap_pp_info) {
+                debugBelch("stg_ap_pp_info\n" );
+            } else if (c == (StgWord)&stg_ap_ppp_info) {
+                debugBelch("stg_ap_ppp_info\n" );
+            } else if (c == (StgWord)&stg_ap_pppp_info) {
+                debugBelch("stg_ap_pppp_info\n" );
+            } else if (c == (StgWord)&stg_ap_ppppp_info) {
+                debugBelch("stg_ap_ppppp_info\n" );
+            } else if (c == (StgWord)&stg_ap_pppppp_info) {
+                debugBelch("stg_ap_pppppp_info\n" );
+            } else if (c == (StgWord)&stg_ret_v_info) {
+                debugBelch("stg_ret_v_info\n" );
+            } else if (c == (StgWord)&stg_ret_p_info) {
+                debugBelch("stg_ret_p_info\n" );
+            } else if (c == (StgWord)&stg_ret_n_info) {
+                debugBelch("stg_ret_n_info\n" );
+            } else if (c == (StgWord)&stg_ret_f_info) {
+                debugBelch("stg_ret_f_info\n" );
+            } else if (c == (StgWord)&stg_ret_d_info) {
+                debugBelch("stg_ret_d_info\n" );
+            } else if (c == (StgWord)&stg_ret_l_info) {
+                debugBelch("stg_ret_l_info\n" );
+#if defined(PROFILING)
+            } else if (c == (StgWord)&stg_restore_cccs_info) {
+                debugBelch("stg_restore_cccs_info\n" );
+                fprintCCS(stderr, (CostCentreStack*)sp[1]);
+                debugBelch("\n" );
+                continue;
+            } else if (c == (StgWord)&stg_restore_cccs_eval_info) {
+                debugBelch("stg_restore_cccs_eval_info\n" );
+                fprintCCS(stderr, (CostCentreStack*)sp[1]);
+                debugBelch("\n" );
+                continue;
+#endif
+            } else {
+                debugBelch("RET_SMALL (%p)\n", info);
+            }
+            bitmap = info->layout.bitmap;
+            printSmallBitmap(spBottom, sp+1,
+                             BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
+            continue;
+        }
+
+        case RET_BCO: {
+            StgBCO *bco;
+
+            bco = ((StgBCO *)sp[1]);
+
+            debugBelch("RET_BCO (%p)\n", sp);
+            printLargeBitmap(spBottom, sp+2,
+                             BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
+            continue;
+        }
+
+        case RET_BIG:
+            barf("todo");
+
+        case RET_FUN:
+        {
+            const StgFunInfoTable *fun_info;
+            StgRetFun *ret_fun;
+
+            ret_fun = (StgRetFun *)sp;
+            fun_info = get_fun_itbl(ret_fun->fun);
+            debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, (int)fun_info->f.fun_type);
+            switch (fun_info->f.fun_type) {
+            case ARG_GEN:
+                printSmallBitmap(spBottom, sp+2,
+                                 BITMAP_BITS(fun_info->f.b.bitmap),
+                                 BITMAP_SIZE(fun_info->f.b.bitmap));
+                break;
+            case ARG_GEN_BIG:
+                printLargeBitmap(spBottom, sp+2,
+                                 GET_FUN_LARGE_BITMAP(fun_info),
+                                 GET_FUN_LARGE_BITMAP(fun_info)->size);
+                break;
+            default:
+                printSmallBitmap(spBottom, sp+2,
+                                 BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
+                                 BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
+                break;
+            }
+            continue;
+        }
+
+        default:
+            debugBelch("unknown object %d\n", (int)info->type);
+            barf("printStackChunk");
+        }
     }
 }
 
+static void printStack( StgStack *stack )
+{
+    printStackChunk( stack->sp, stack->stack + stack->stack_size );
+}
+
 void printTSO( StgTSO *tso )
 {
-    printStackChunk( tso->stackobj->sp,
-                     tso->stackobj->stack+tso->stackobj->stack_size);
+    printStack( tso->stackobj );
 }
 
 /* --------------------------------------------------------------------------
@@ -574,212 +654,17 @@ void printTSO( StgTSO *tso )
 
 /* --------------------------------------------------------------------------
  * Simple lookup table
- *
- * Current implementation is pretty dumb!
+ * address -> function name
  * ------------------------------------------------------------------------*/
 
-struct entry {
-    StgWord value;
-    const char *name;
-};
-
-static nat table_size;
-static struct entry* table;
-
-#ifdef USING_LIBBFD
-static nat max_table_size;
-
-static void reset_table( int size )
-{
-    max_table_size = size;
-    table_size = 0;
-    table = (struct entry *)stgMallocBytes(size * sizeof(struct entry), "Printer.c:reset_table()");
-}
-
-static void prepare_table( void )
-{
-    /* Could sort it...  */
-}
-
-static void insert( StgWord value, const char *name )
-{
-    if ( table_size >= max_table_size ) {
-        barf( "Symbol table overflow\n" );
-    }
-    table[table_size].value = value;
-    table[table_size].name = name;
-    table_size = table_size + 1;
-}
-#endif
-
-#if 0
-static rtsBool lookup_name( char *name, StgWord *result )
-{
-    nat i;
-    for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) {
-    }
-    if (i < table_size) {
-        *result = table[i].value;
-        return rtsTrue;
-    } else {
-        return rtsFalse;
-    }
-}
-#endif
-
-/* Code from somewhere inside GHC (circa 1994)
- * * Z-escapes:
- *     "std"++xs -> "Zstd"++xs
- *     char_to_c 'Z'  = "ZZ"
- *     char_to_c '&'  = "Za"
- *     char_to_c '|'  = "Zb"
- *     char_to_c ':'  = "Zc"
- *     char_to_c '/'  = "Zd"
- *     char_to_c '='  = "Ze"
- *     char_to_c '>'  = "Zg"
- *     char_to_c '#'  = "Zh"
- *     char_to_c '<'  = "Zl"
- *     char_to_c '-'  = "Zm"
- *     char_to_c '!'  = "Zn"
- *     char_to_c '.'  = "Zo"
- *     char_to_c '+'  = "Zp"
- *     char_to_c '\'' = "Zq"
- *     char_to_c '*'  = "Zt"
- *     char_to_c '_'  = "Zu"
- *     char_to_c c    = "Z" ++ show (ord c)
- */
-static char unZcode( char ch )
-{
-    switch (ch) {
-    case 'a'  : return ('&');
-    case 'b'  : return ('|');
-    case 'c'  : return (':');
-    case 'd'  : return ('/');
-    case 'e'  : return ('=');
-    case 'g'  : return ('>');
-    case 'h'  : return ('#');
-    case 'l'  : return ('<');
-    case 'm'  : return ('-');
-    case 'n'  : return ('!');
-    case 'o'  : return ('.');
-    case 'p'  : return ('+');
-    case 'q'  : return ('\'');
-    case 't'  : return ('*');
-    case 'u'  : return ('_');
-    case 'Z'  :
-    case '\0' : return ('Z');
-    default   : return (ch);
-    }
-}
-
-#if 0
-/* Precondition: out big enough to handle output (about twice length of in) */
-static void enZcode( char *in, char *out )
-{
-    int i, j;
-
-    j = 0;
-    out[ j++ ] = '_';
-    for( i = 0; in[i] != '\0'; ++i ) {
-        switch (in[i]) {
-        case 'Z'  : 
-                out[j++] = 'Z';
-                out[j++] = 'Z';
-                break;
-        case '&'  : 
-                out[j++] = 'Z';
-                out[j++] = 'a';
-                break;
-        case '|'  : 
-                out[j++] = 'Z';
-                out[j++] = 'b';
-                break;
-        case ':'  : 
-                out[j++] = 'Z';
-                out[j++] = 'c';
-                break;
-        case '/'  : 
-                out[j++] = 'Z';
-                out[j++] = 'd';
-                break;
-        case '='  : 
-                out[j++] = 'Z';
-                out[j++] = 'e';
-                break;
-        case '>'  : 
-                out[j++] = 'Z';
-                out[j++] = 'g';
-                break;
-        case '#'  : 
-                out[j++] = 'Z';
-                out[j++] = 'h';
-                break;
-        case '<'  : 
-                out[j++] = 'Z';
-                out[j++] = 'l';
-                break;
-        case '-'  : 
-                out[j++] = 'Z';
-                out[j++] = 'm';
-                break;
-        case '!'  : 
-                out[j++] = 'Z';
-                out[j++] = 'n';
-                break;
-        case '.'  : 
-                out[j++] = 'Z';
-                out[j++] = 'o';
-                break;
-        case '+'  : 
-                out[j++] = 'Z';
-                out[j++] = 'p';
-                break;
-        case '\'' : 
-                out[j++] = 'Z';
-                out[j++] = 'q';
-                break;
-        case '*'  : 
-                out[j++] = 'Z';
-                out[j++] = 't';
-                break;
-        case '_'  : 
-                out[j++] = 'Z';
-                out[j++] = 'u';
-                break;
-        default :
-                out[j++] = in[i];
-                break;
-        }
-    }
-    out[j] = '\0';
-}
-#endif
+static HashTable * add_to_fname_table = NULL;
 
 const char *lookupGHCName( void *addr )
 {
-    nat i;
-    for( i = 0; i < table_size && table[i].value != (StgWord) addr; ++i ) {
-    }
-    if (i < table_size) {
-        return table[i].name;
-    } else {
+    if (add_to_fname_table == NULL)
         return NULL;
-    }
-}
 
-static void printZcoded( const char *raw )
-{
-    nat j = 0;
-    
-    while ( raw[j] != '\0' ) {
-        if (raw[j] == 'Z') {
-            debugBelch("%c", unZcode(raw[j+1]));
-            j = j + 2;
-        } else {
-            debugBelch("%c", unZcode(raw[j+1]));
-            j = j + 1;
-        }
-    }
+    return lookupHashTable(add_to_fname_table, (StgWord)addr);
 }
 
 /* --------------------------------------------------------------------------
@@ -787,37 +672,45 @@ static void printZcoded( const char *raw )
  * ------------------------------------------------------------------------*/
 
 /* Causing linking trouble on Win32 plats, so I'm
-   disabling this for now. 
+   disabling this for now.
 */
-#ifdef USING_LIBBFD
-
-#include <bfd.h>
+#if defined(USING_LIBBFD)
+#    define PACKAGE 1
+#    define PACKAGE_VERSION 1
+/* Those PACKAGE_* defines are workarounds for bfd:
+ *     https://sourceware.org/bugzilla/show_bug.cgi?id=14243
+ * ghc's build system filter PACKAGE_* values out specifically to avoid clashes
+ * with user's autoconf-based Cabal packages.
+ * It's a shame <bfd.h> checks for unrelated fields instead of actually used
+ * macros.
+ */
+#    include <bfd.h>
 
 /* Fairly ad-hoc piece of code that seems to filter out a lot of
  * rubbish like the obj-splitting symbols
  */
 
-static rtsBool isReal( flagword flags STG_UNUSED, const char *name )
+static bool isReal( flagword flags STG_UNUSED, const char *name )
 {
 #if 0
     /* ToDo: make this work on BFD */
-    int tp = type & N_TYPE;    
+    int tp = type & N_TYPE;
     if (tp == N_TEXT || tp == N_DATA) {
         return (name[0] == '_' && name[1] != '_');
     } else {
-        return rtsFalse;
+        return false;
     }
 #else
-    if (*name == '\0'  || 
-       (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
-       (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
-       return rtsFalse;
+    if (*name == '\0'  ||
+        (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
+        (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
+        return false;
     }
-    return rtsTrue;
+    return true;
 #endif
 }
 
-extern void DEBUG_LoadSymbols( char *name )
+extern void DEBUG_LoadSymbols( const char *name )
 {
     bfd* abfd;
     char **matching;
@@ -825,76 +718,64 @@ extern void DEBUG_LoadSymbols( char *name )
     bfd_init();
     abfd = bfd_openr(name, "default");
     if (abfd == NULL) {
-       barf("can't open executable %s to get symbol table", name);
+        barf("can't open executable %s to get symbol table", name);
     }
     if (!bfd_check_format_matches (abfd, bfd_object, &matching)) {
-       barf("mismatch");
+        barf("mismatch");
     }
 
     {
-       long storage_needed;
-       asymbol **symbol_table;
-       long number_of_symbols;
+        long storage_needed;
+        asymbol **symbol_table;
+        long number_of_symbols;
         long num_real_syms = 0;
-       long i;
-     
-       storage_needed = bfd_get_symtab_upper_bound (abfd);
-     
-       if (storage_needed < 0) {
-           barf("can't read symbol table");
-       }     
-#if 0
-       if (storage_needed == 0) {
-           debugBelch("no storage needed");
-       }
-#endif
-       symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
+        long i;
+
+        storage_needed = bfd_get_symtab_upper_bound (abfd);
+
+        if (storage_needed < 0) {
+            barf("can't read symbol table");
+        }
+        symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
 
-       number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table);
-     
-       if (number_of_symbols < 0) {
-           barf("can't canonicalise symbol table");
-       }
+        number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table);
+
+        if (number_of_symbols < 0) {
+            barf("can't canonicalise symbol table");
+        }
+
+        if (add_to_fname_table == NULL)
+            add_to_fname_table = allocHashTable();
 
         for( i = 0; i != number_of_symbols; ++i ) {
             symbol_info info;
             bfd_get_symbol_info(abfd,symbol_table[i],&info);
-            /*debugBelch("\t%c\t0x%x      \t%s\n",info.type,(nat)info.value,info.name); */
             if (isReal(info.type, info.name)) {
+                insertHashTable(add_to_fname_table,
+                                info.value, (void*)info.name);
                 num_real_syms += 1;
             }
         }
-    
+
         IF_DEBUG(interpreter,
-                 debugBelch("Loaded %ld symbols. Of which %ld are real symbols\n", 
+                 debugBelch("Loaded %ld symbols. Of which %ld are real symbols\n",
                          number_of_symbols, num_real_syms)
                  );
 
-        reset_table( num_real_syms );
-    
-        for( i = 0; i != number_of_symbols; ++i ) {
-            symbol_info info;
-            bfd_get_symbol_info(abfd,symbol_table[i],&info);
-            if (isReal(info.type, info.name)) {
-                insert( info.value, info.name );
-            }
-        }
-
         stgFree(symbol_table);
     }
-    prepare_table();
 }
 
-#else /* HAVE_BFD_H */
+#else /* USING_LIBBFD */
 
-extern void DEBUG_LoadSymbols( char *name STG_UNUSED )
+extern void DEBUG_LoadSymbols( const char *name STG_UNUSED )
 {
   /* nothing, yet */
 }
 
-#endif /* HAVE_BFD_H */
+#endif /* USING_LIBBFD */
 
-void findPtr(P_ p, int);               /* keep gcc -Wall happy */
+void findPtr(P_ p, int);                /* keep gcc -Wall happy */
 
 int searched = 0;
 
@@ -905,7 +786,7 @@ findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i)
     for (; bd; bd = bd->link) {
         searched++;
         for (q = bd->start; q < bd->free; q++) {
-            if (UNTAG_CLOSURE((StgClosure*)*q) == (StgClosure *)p) {
+            if (UNTAG_CONST_CLOSURE((StgClosure*)*q) == (const StgClosure *)p) {
                 if (i < arr_size) {
                     for (r = bd->start; r < bd->free; r = end) {
                         // skip over zeroed-out slop
@@ -938,19 +819,37 @@ findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i)
 void
 findPtr(P_ p, int follow)
 {
-  nat g;
+  uint32_t g, n;
   bdescr *bd;
   const int arr_size = 1024;
   StgPtr arr[arr_size];
   int i = 0;
   searched = 0;
 
+#if 0
+  // We can't search the nursery, because we don't know which blocks contain
+  // valid data, because the bd->free pointers in the nursery are only reset
+  // just before a block is used.
+  for (n = 0; n < n_capabilities; n++) {
+      bd = nurseries[i].blocks;
+      i = findPtrBlocks(p,bd,arr,arr_size,i);
+      if (i >= arr_size) return;
+  }
+#endif
+
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
       bd = generations[g].blocks;
       i = findPtrBlocks(p,bd,arr,arr_size,i);
       bd = generations[g].large_objects;
       i = findPtrBlocks(p,bd,arr,arr_size,i);
       if (i >= arr_size) return;
+      for (n = 0; n < n_capabilities; n++) {
+          i = findPtrBlocks(p, gc_threads[n]->gens[g].part_list,
+                            arr, arr_size, i);
+          i = findPtrBlocks(p, gc_threads[n]->gens[g].todo_bd,
+                            arr, arr_size, i);
+      }
+      if (i >= arr_size) return;
   }
   if (follow && i == 1) {
       debugBelch("-->\n");
@@ -958,87 +857,7 @@ findPtr(P_ p, int follow)
   }
 }
 
-/* prettyPrintClosure() is for printing out a closure using the data constructor
-   names found in the info tables. Closures are printed in a fashion that resembles
-   their Haskell representation. Useful during debugging.
-
-   Todo: support for more closure types, and support for non pointer fields in the
-   payload.
-*/ 
-
-void prettyPrintClosure_ (StgClosure *);
-
-void prettyPrintClosure (StgClosure *obj)
-{
-   prettyPrintClosure_ (obj);
-   debugBelch ("\n");
-}
-
-void prettyPrintClosure_ (StgClosure *obj)
-{
-    StgInfoTable *info;
-    StgConInfoTable *con_info;
-
-    /* collapse any indirections */
-    unsigned int type;
-    type = get_itbl(obj)->type;
-           
-    while (type == IND ||
-           type == IND_STATIC ||
-           type == IND_PERM)
-    {
-      obj = ((StgInd *)obj)->indirectee;
-      type = get_itbl(obj)->type;
-    }
-
-    /* find the info table for this object */
-    info = get_itbl(obj);
-
-    /* determine what kind of object we have */
-    switch (info->type) 
-    {
-        /* full applications of data constructors */
-        case CONSTR:
-        case CONSTR_1_0: 
-        case CONSTR_0_1:
-        case CONSTR_1_1: 
-        case CONSTR_0_2: 
-        case CONSTR_2_0:
-        case CONSTR_STATIC:
-        case CONSTR_NOCAF_STATIC: 
-        {
-           nat i; 
-           char *descriptor;
-
-           /* find the con_info for the constructor */
-           con_info = get_con_itbl (obj);
-
-           /* obtain the name of the constructor */
-           descriptor = GET_CON_DESC(con_info);
-
-           debugBelch ("(%s", descriptor);
-
-           /* process the payload of the closure */
-           /* we don't handle non pointers at the moment */
-           for (i = 0; i < info->layout.payload.ptrs; i++)
-           {
-              debugBelch (" ");
-              prettyPrintClosure_ ((StgClosure *) obj->payload[i]);
-           }
-           debugBelch (")");
-           break;
-        }
-
-        /* if it isn't a constructor then just print the closure type */
-        default:
-        {
-           debugBelch ("<%s>", info_type(obj));
-           break;
-        }
-    }
-}
-
-char *what_next_strs[] = {
+const char *what_next_strs[] = {
   [0]               = "(unknown)",
   [ThreadRunGHC]    = "ThreadRunGHC",
   [ThreadInterpret] = "ThreadInterpret",
@@ -1051,7 +870,7 @@ void printPtr( StgPtr p )
 {
     debugBelch("ptr 0x%p (enable -DDEBUG for more info) " , p );
 }
-  
+
 void printObj( StgClosure *obj )
 {
     debugBelch("obj 0x%p (enable -DDEBUG for more info) " , obj );
@@ -1062,11 +881,12 @@ void printObj( StgClosure *obj )
 
 /* -----------------------------------------------------------------------------
    Closure types
-   
-   NOTE: must be kept in sync with the closure types in includes/ClosureTypes.h
+
+   NOTE: must be kept in sync with the closure types in
+   includes/rts/storage/ClosureTypes.h
    -------------------------------------------------------------------------- */
 
-char *closure_type_names[] = {
+const char *closure_type_names[] = {
  [INVALID_OBJECT]        = "INVALID_OBJECT",
  [CONSTR]                = "CONSTR",
  [CONSTR_1_0]            = "CONSTR_1_0",
@@ -1074,8 +894,7 @@ char *closure_type_names[] = {
  [CONSTR_2_0]            = "CONSTR_2_0",
  [CONSTR_1_1]            = "CONSTR_1_1",
  [CONSTR_0_2]            = "CONSTR_0_2",
- [CONSTR_STATIC]         = "CONSTR_STATIC",
- [CONSTR_NOCAF_STATIC]   = "CONSTR_NOCAF_STATIC",
+ [CONSTR_NOCAF]          = "CONSTR_NOCAF",
  [FUN]                   = "FUN",
  [FUN_1_0]               = "FUN_1_0",
  [FUN_0_1]               = "FUN_0_1",
@@ -1096,12 +915,10 @@ char *closure_type_names[] = {
  [PAP]                   = "PAP",
  [AP_STACK]              = "AP_STACK",
  [IND]                   = "IND",
- [IND_PERM]              = "IND_PERM",
  [IND_STATIC]            = "IND_STATIC",
  [RET_BCO]               = "RET_BCO",
  [RET_SMALL]             = "RET_SMALL",
  [RET_BIG]               = "RET_BIG",
- [RET_DYN]               = "RET_DYN",
  [RET_FUN]               = "RET_FUN",
  [UPDATE_FRAME]          = "UPDATE_FRAME",
  [CATCH_FRAME]           = "CATCH_FRAME",
@@ -1111,15 +928,16 @@ char *closure_type_names[] = {
  [BLACKHOLE]             = "BLACKHOLE",
  [MVAR_CLEAN]            = "MVAR_CLEAN",
  [MVAR_DIRTY]            = "MVAR_DIRTY",
+ [TVAR]                  = "TVAR",
  [ARR_WORDS]             = "ARR_WORDS",
  [MUT_ARR_PTRS_CLEAN]    = "MUT_ARR_PTRS_CLEAN",
  [MUT_ARR_PTRS_DIRTY]    = "MUT_ARR_PTRS_DIRTY",
- [MUT_ARR_PTRS_FROZEN0]  = "MUT_ARR_PTRS_FROZEN0",
- [MUT_ARR_PTRS_FROZEN]   = "MUT_ARR_PTRS_FROZEN",
+ [MUT_ARR_PTRS_FROZEN_DIRTY]  = "MUT_ARR_PTRS_FROZEN_DIRTY",
+ [MUT_ARR_PTRS_FROZEN_CLEAN]   = "MUT_ARR_PTRS_FROZEN_CLEAN",
  [MUT_VAR_CLEAN]         = "MUT_VAR_CLEAN",
  [MUT_VAR_DIRTY]         = "MUT_VAR_DIRTY",
  [WEAK]                  = "WEAK",
- [PRIM]                         = "PRIM",
+ [PRIM]                  = "PRIM",
  [MUT_PRIM]              = "MUT_PRIM",
  [TSO]                   = "TSO",
  [STACK]                 = "STACK",
@@ -1127,21 +945,29 @@ char *closure_type_names[] = {
  [ATOMICALLY_FRAME]      = "ATOMICALLY_FRAME",
  [CATCH_RETRY_FRAME]     = "CATCH_RETRY_FRAME",
  [CATCH_STM_FRAME]       = "CATCH_STM_FRAME",
- [WHITEHOLE]             = "WHITEHOLE"
+ [WHITEHOLE]             = "WHITEHOLE",
+ [SMALL_MUT_ARR_PTRS_CLEAN] = "SMALL_MUT_ARR_PTRS_CLEAN",
+ [SMALL_MUT_ARR_PTRS_DIRTY] = "SMALL_MUT_ARR_PTRS_DIRTY",
+ [SMALL_MUT_ARR_PTRS_FROZEN_DIRTY] = "SMALL_MUT_ARR_PTRS_FROZEN_DIRTY",
+ [SMALL_MUT_ARR_PTRS_FROZEN_CLEAN] = "SMALL_MUT_ARR_PTRS_FROZEN_CLEAN",
+ [COMPACT_NFDATA]        = "COMPACT_NFDATA"
 };
 
-char *
-info_type(StgClosure *closure){ 
+#if N_CLOSURE_TYPES != 64
+#error Closure types changed: update Printer.c!
+#endif
+
+const char *
+info_type(const StgClosure *closure){
   return closure_type_names[get_itbl(closure)->type];
 }
 
-char *
-info_type_by_ip(StgInfoTable *ip){ 
+const char *
+info_type_by_ip(const StgInfoTable *ip){
   return closure_type_names[ip->type];
 }
 
 void
-info_hdr_type(StgClosure *closure, char *res){ 
+info_hdr_type(const StgClosure *closure, char *res){
   strcpy(res,closure_type_names[get_itbl(closure)->type]);
 }
-