Add warning comment about Mach-O section name hack.
[ghc.git] / rts / Printer.c
index 6eecfab..db2e7be 100644 (file)
@@ -10,6 +10,7 @@
 #include "Rts.h"
 #include "rts/Bytecodes.h"  /* for InstrPtr */
 
+#include "sm/Storage.h"
 #include "Printer.h"
 #include "RtsUtils.h"
 
@@ -91,7 +92,7 @@ printThunkPayload( StgThunk *obj )
     StgWord i, j;
     const StgInfoTable* info;
 
-    info = get_itbl(obj);
+    info = get_itbl((StgClosure *)obj);
     for (i = 0; i < info->layout.payload.ptrs; ++i) {
         debugBelch(", ");
         printPtr((StgPtr)obj->payload[i]);
@@ -128,21 +129,16 @@ printClosure( StgClosure *obj )
     case CONSTR_NOCAF_STATIC:
         {
             StgWord i, j;
+            StgConInfoTable *con_info = get_con_itbl (obj);
 
-#ifdef PROFILING
-           debugBelch("%s(", GET_PROF_DESC(info));
-           debugBelch("%s", obj->header.prof.ccs->cc->label);
-#else
-            debugBelch("CONSTR(");
-            printPtr((StgPtr)obj->header.info);
-            debugBelch("(tag=%d)",info->srt_bitmap);
-#endif
+            debugBelch("%s(", GET_CON_DESC(con_info));
             for (i = 0; i < info->layout.payload.ptrs; ++i) {
-               debugBelch(", ");
+               if (i != 0) debugBelch(", ");
                 printPtr((StgPtr)obj->payload[i]);
             }
             for (j = 0; j < info->layout.payload.nptrs; ++j) {
-                debugBelch(", %p#", obj->payload[i+j]);
+               if (i != 0 || j != 0) debugBelch(", ");
+                debugBelch("%p#", obj->payload[i+j]);
             }
             debugBelch(")\n");
             break;
@@ -152,7 +148,7 @@ printClosure( StgClosure *obj )
     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(",itbl_to_fun_itbl(info)->f.arity);
+       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);
@@ -166,6 +162,12 @@ printClosure( StgClosure *obj )
        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:
@@ -204,7 +206,7 @@ printClosure( StgClosure *obj )
         {
            StgPAP* pap = (StgPAP*)obj;
             StgWord i;
-            debugBelch("PAP/%d(",pap->arity); 
+            debugBelch("PAP/%d(",(int)pap->arity); 
            printPtr((StgPtr)pap->fun);
             for (i = 0; i < pap->n_args; ++i) {
                 debugBelch(", ");
@@ -233,24 +235,12 @@ printClosure( StgClosure *obj )
             debugBelch(")\n"); 
             break;
 
-    case IND_OLDGEN:
-            debugBelch("IND_OLDGEN("); 
-            printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
-            break;
-
     case IND_PERM:
             debugBelch("IND("); 
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
             debugBelch(")\n"); 
             break;
 
-    case IND_OLDGEN_PERM:
-            debugBelch("IND_OLDGEN_PERM("); 
-            printPtr((StgPtr)((StgInd*)obj)->indirectee);
-            debugBelch(")\n"); 
-            break;
-
     case IND_STATIC:
             debugBelch("IND_STATIC("); 
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
@@ -267,7 +257,6 @@ printClosure( StgClosure *obj )
     case RET_BCO:
     case RET_SMALL:
     case RET_BIG:
-    case RET_DYN:
     case RET_FUN:
     */
 
@@ -275,7 +264,7 @@ printClosure( StgClosure *obj )
         {
             StgUpdateFrame* u = (StgUpdateFrame*)obj;
             debugBelch("UPDATE_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
+            printPtr((StgPtr)GET_INFO((StgClosure *)u));
             debugBelch(",");
             printPtr((StgPtr)u->updatee);
             debugBelch(")\n"); 
@@ -286,18 +275,27 @@ 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"); 
             break;
         }
 
+    case UNDERFLOW_FRAME:
+        {
+            StgUnderflowFrame* u = (StgUnderflowFrame*)obj;
+            debugBelch("UNDERFLOW_FRAME(");
+            printPtr((StgPtr)u->next_chunk);
+            debugBelch(")\n"); 
+            break;
+        }
+
     case STOP_FRAME:
         {
             StgStopFrame* u = (StgStopFrame*)obj;
             debugBelch("STOP_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
+            printPtr((StgPtr)GET_INFO((StgClosure *)u));
             debugBelch(")\n"); 
             break;
         }
@@ -306,26 +304,22 @@ printClosure( StgClosure *obj )
         {
             StgWord i;
             debugBelch("ARR_WORDS(\"");
-            /* ToDo: we can't safely assume that this is a string! 
-            for (i = 0; arrWordsGetChar(obj,i); ++i) {
-                putchar(arrWordsGetChar(obj,i));
-               } */
-           for (i=0; i<((StgArrWords *)obj)->words; i++)
-             debugBelch("%lu", (lnat)((StgArrWords *)obj)->payload[i]);
+           for (i=0; i<arr_words_words((StgArrWords *)obj); i++)
+             debugBelch("%" FMT_Word, (W_)((StgArrWords *)obj)->payload[i]);
             debugBelch("\")\n");
             break;
         }
 
     case MUT_ARR_PTRS_CLEAN:
-       debugBelch("MUT_ARR_PTRS_CLEAN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
+       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=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
+       debugBelch("MUT_ARR_PTRS_DIRTY(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
        break;
 
     case MUT_ARR_PTRS_FROZEN:
-       debugBelch("MUT_ARR_PTRS_FROZEN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
+       debugBelch("MUT_ARR_PTRS_FROZEN(size=%" FMT_Word ")\n", (W_)((StgMutArrPtrs *)obj)->ptrs);
        break;
 
     case MVAR_CLEAN:
@@ -336,6 +330,13 @@ printClosure( StgClosure *obj )
           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;
@@ -366,6 +367,10 @@ printClosure( StgClosure *obj )
       debugBelch(")\n"); 
       break;
 
+    case STACK:
+      debugBelch("STACK");
+      break;
+
 #if 0
       /* Symptomatic of a problem elsewhere, have it fall-through & fail */
     case EVACUATED:
@@ -378,7 +383,7 @@ printClosure( StgClosure *obj )
     default:
             //barf("printClosure %d",get_itbl(obj)->type);
             debugBelch("*** printClosure: unknown type %d ****\n",
-                    get_itbl(obj)->type );
+                    (int)get_itbl(obj)->type );
             barf("printClosure %d",get_itbl(obj)->type);
             return;
     }
@@ -430,17 +435,15 @@ printStackObj( StgPtr sp )
 static void
 printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
 {
-    StgPtr p;
     nat i;
 
-    p = payload;
     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# %lu\n", (lnat)payload[i]);
+           debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
        }
     }
 }
@@ -456,12 +459,12 @@ printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap,
        StgWord bitmap = large_bitmap->bitmap[bmp];
        j = 0;
        for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
-           debugBelch("   stk[%lu] (%p) = ", (lnat)(spBottom-(payload+i)), payload+i);
+           debugBelch("   stk[%" FMT_Word "] (%p) = ", (W_)(spBottom-(payload+i)), payload+i);
            if ((bitmap & 1) == 0) {
                printPtr((P_)payload[i]);
                debugBelch("\n");
            } else {
-               debugBelch("Word# %lu\n", (lnat)payload[i]);
+               debugBelch("Word# %" FMT_Word "\n", (W_)payload[i]);
            }
        }
     }
@@ -482,45 +485,12 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
            
        case UPDATE_FRAME:
        case CATCH_FRAME:
-           printObj((StgClosure*)sp);
-           continue;
-
-       case STOP_FRAME:
-           printObj((StgClosure*)sp);
-           return;
-
-       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++;
-           }
+        case UNDERFLOW_FRAME:
+        case STOP_FRAME:
+            printObj((StgClosure*)sp);
            continue;
-       }
 
-       case RET_SMALL:
+        case RET_SMALL:
            debugBelch("RET_SMALL (%p)\n", info);
            bitmap = info->layout.bitmap;
            printSmallBitmap(spBottom, sp+1, 
@@ -545,12 +515,10 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
        {
            StgFunInfoTable *fun_info;
            StgRetFun *ret_fun;
-           nat size;
 
            ret_fun = (StgRetFun *)sp;
            fun_info = get_fun_itbl(ret_fun->fun);
-           size = ret_fun->size;
-           debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, fun_info->f.fun_type);
+           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,
@@ -572,7 +540,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
        }
           
        default:
-           debugBelch("unknown object %d\n", info->type);
+           debugBelch("unknown object %d\n", (int)info->type);
            barf("printStackChunk");
        }
     }
@@ -580,7 +548,8 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
 
 void printTSO( StgTSO *tso )
 {
-    printStackChunk( tso->sp, tso->stack+tso->stack_size);
+    printStackChunk( tso->stackobj->sp,
+                     tso->stackobj->stack+tso->stackobj->stack_size);
 }
 
 /* --------------------------------------------------------------------------
@@ -918,19 +887,31 @@ int searched = 0;
 static int
 findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i)
 {
-    StgPtr q, r;
+    StgPtr q, r, end;
     for (; bd; bd = bd->link) {
         searched++;
         for (q = bd->start; q < bd->free; q++) {
             if (UNTAG_CLOSURE((StgClosure*)*q) == (StgClosure *)p) {
                 if (i < arr_size) {
-                    r = q;
-                    while (HEAP_ALLOCED((StgPtr)*r) || !LOOKS_LIKE_INFO_PTR(*r) || (P_)*r == NULL) {
-                        r--;
+                    for (r = bd->start; r < bd->free; r = end) {
+                        // skip over zeroed-out slop
+                        while (*r == 0) r++;
+                        if (!LOOKS_LIKE_CLOSURE_PTR(r)) {
+                            debugBelch("%p found at %p, no closure at %p\n",
+                                       p, q, r);
+                            break;
+                        }
+                        end = r + closure_sizeW((StgClosure*)r);
+                        if (q < end) {
+                            debugBelch("%p = ", r);
+                            printClosure((StgClosure *)r);
+                            arr[i++] = r;
+                            break;
+                        }
+                    }
+                    if (r >= bd->free) {
+                        debugBelch("%p found at %p, closure?", p, q);
                     }
-                    debugBelch("%p = ", r);
-                    printClosure((StgClosure *)r);
-                    arr[i++] = r;
                 } else {
                     return i;
                 }
@@ -943,17 +924,19 @@ findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i)
 void
 findPtr(P_ p, int follow)
 {
-  nat g;
+  nat g, n;
   bdescr *bd;
-#if defined(__GNUC__)
   const int arr_size = 1024;
-#else
-#define arr_size 1024
-#endif
   StgPtr arr[arr_size];
   int i = 0;
   searched = 0;
 
+  for (n = 0; n < n_capabilities; n++) {
+      bd = nurseries[i].blocks;
+      i = findPtrBlocks(p,bd,arr,arr_size,i);
+      if (i >= arr_size) return;
+  }
+
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
       bd = generations[g].blocks;
       i = findPtrBlocks(p,bd,arr,arr_size,i);
@@ -994,9 +977,7 @@ void prettyPrintClosure_ (StgClosure *obj)
            
     while (type == IND ||
            type == IND_STATIC ||
-           type == IND_OLDGEN ||
-           type == IND_PERM ||
-           type == IND_OLDGEN_PERM) 
+           type == IND_PERM)
     {
       obj = ((StgInd *)obj)->indirectee;
       type = get_itbl(obj)->type;
@@ -1054,7 +1035,6 @@ char *what_next_strs[] = {
   [ThreadRunGHC]    = "ThreadRunGHC",
   [ThreadInterpret] = "ThreadInterpret",
   [ThreadKilled]    = "ThreadKilled",
-  [ThreadRelocated] = "ThreadRelocated",
   [ThreadComplete]  = "ThreadComplete"
 };
 
@@ -1108,22 +1088,21 @@ char *closure_type_names[] = {
  [PAP]                   = "PAP",
  [AP_STACK]              = "AP_STACK",
  [IND]                   = "IND",
- [IND_OLDGEN]            = "IND_OLDGEN",
  [IND_PERM]              = "IND_PERM",
- [IND_OLDGEN_PERM]       = "IND_OLDGEN_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",
+ [UNDERFLOW_FRAME]       = "UNDERFLOW_FRAME",
  [STOP_FRAME]            = "STOP_FRAME",
- [BLACKHOLE]             = "BLACKHOLE",
  [BLOCKING_QUEUE]        = "BLOCKING_QUEUE",
+ [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",
@@ -1135,6 +1114,7 @@ char *closure_type_names[] = {
  [PRIM]                         = "PRIM",
  [MUT_PRIM]              = "MUT_PRIM",
  [TSO]                   = "TSO",
+ [STACK]                 = "STACK",
  [TREC_CHUNK]            = "TREC_CHUNK",
  [ATOMICALLY_FRAME]      = "ATOMICALLY_FRAME",
  [CATCH_RETRY_FRAME]     = "CATCH_RETRY_FRAME",