X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FPrinter.c;h=565a11ed7743891177fa413737d34f636897beb7;hb=d108044bef62f6a0d579c92ced5e8188f72edc2d;hp=e9813299d82d2d031ae14c32fcd268d73b124d34;hpb=7408b39235bccdcde48df2a73337ff976fbc09b7;p=ghc-hetmet.git

diff --git a/rts/Printer.c b/rts/Printer.c
index e981329..565a11e 100644
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -128,21 +128,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;
@@ -233,26 +228,20 @@ 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("); 
+    case IND_STATIC:
+            debugBelch("IND_STATIC("); 
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
             debugBelch(")\n"); 
             break;
 
-    case IND_STATIC:
-            debugBelch("IND_STATIC("); 
+    case BLACKHOLE:
+            debugBelch("BLACKHOLE("); 
             printPtr((StgPtr)((StgInd*)obj)->indirectee);
             debugBelch(")\n"); 
             break;
@@ -296,23 +285,11 @@ printClosure( StgClosure *obj )
             break;
         }
 
-    case CAF_BLACKHOLE:
-            debugBelch("CAF_BH"); 
-            break;
-
-    case BLACKHOLE:
-            debugBelch("BH\n"); 
-            break;
-
     case ARR_WORDS:
         {
             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++)
+	    for (i=0; i<arr_words_words((StgArrWords *)obj); i++)
 	      debugBelch("%lu", (lnat)((StgArrWords *)obj)->payload[i]);
             debugBelch("\")\n");
             break;
@@ -920,19 +897,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;
                 }
@@ -947,11 +936,7 @@ findPtr(P_ p, int follow)
 {
   nat g;
   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;
@@ -996,9 +981,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;
@@ -1110,9 +1093,7 @@ 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",
@@ -1122,8 +1103,8 @@ char *closure_type_names[] = {
  [UPDATE_FRAME]          = "UPDATE_FRAME",
  [CATCH_FRAME]           = "CATCH_FRAME",
  [STOP_FRAME]            = "STOP_FRAME",
- [CAF_BLACKHOLE]         = "CAF_BLACKHOLE",
  [BLACKHOLE]             = "BLACKHOLE",
+ [BLOCKING_QUEUE]        = "BLOCKING_QUEUE",
  [MVAR_CLEAN]            = "MVAR_CLEAN",
  [MVAR_DIRTY]            = "MVAR_DIRTY",
  [ARR_WORDS]             = "ARR_WORDS",