X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FPrinter.c;h=a0040a5d4664997808eaf1b99dfe4a1e78ec08a6;hb=1a77fd719aef44c2f91a25ddf312c70651bce1f1;hp=b33d238476639b4fc790b36baea25a5d2ef8c4ef;hpb=62d948405f6b9a95fe4b31b7cffa387e5425d6db;p=ghc-hetmet.git

diff --git a/rts/Printer.c b/rts/Printer.c
index b33d238..a0040a5 100644
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -22,12 +22,6 @@
 #include <stdlib.h>
 #include <string.h>
 
-#if defined(GRAN) || defined(PAR)
-// HWL: explicit fixed header size to make debugging easier
-int fixed_hs = sizeof(StgHeader), itbl_sz = sizeofW(StgInfoTable), 
-    uf_sz=sizeofW(StgUpdateFrame); 
-#endif
-
 /* --------------------------------------------------------------------------
  * local function decls
  * ------------------------------------------------------------------------*/
@@ -121,8 +115,9 @@ printThunkObject( StgThunk *obj, char* tag )
 void
 printClosure( StgClosure *obj )
 {
+    obj = UNTAG_CLOSURE(obj);
+
     StgInfoTable *info;
-    
     info = get_itbl(obj);
 
     switch ( info->type ) {
@@ -138,7 +133,7 @@ printClosure( StgClosure *obj )
             StgWord i, j;
 
 #ifdef PROFILING
-	    debugBelch("%s(", info->prof.closure_desc);
+	    debugBelch("%s(", GET_PROF_DESC(info));
 	    debugBelch("%s", obj->header.prof.ccs->cc->label);
 #else
             debugBelch("CONSTR(");
@@ -174,7 +169,7 @@ printClosure( StgClosure *obj )
     case THUNK_STATIC:
             /* ToDo: will this work for THUNK_STATIC too? */
 #ifdef PROFILING
-	    printThunkObject((StgThunk *)obj,info->prof.closure_desc);
+            printThunkObject((StgThunk *)obj,GET_PROF_DESC(info));
 #else
             printThunkObject((StgThunk *)obj,"THUNK");
 #endif
@@ -306,14 +301,6 @@ printClosure( StgClosure *obj )
             debugBelch("BH\n"); 
             break;
 
-    case SE_BLACKHOLE:
-            debugBelch("SE_BH\n"); 
-            break;
-
-    case SE_CAF_BLACKHOLE:
-            debugBelch("SE_CAF_BH\n"); 
-            break;
-
     case ARR_WORDS:
         {
             StgWord i;
@@ -340,7 +327,8 @@ printClosure( StgClosure *obj )
 	debugBelch("MUT_ARR_PTRS_FROZEN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
 	break;
 
-    case MVAR:
+    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);
@@ -381,37 +369,6 @@ printClosure( StgClosure *obj )
       debugBelch(")\n"); 
       break;
 
-#if defined(PAR)
-    case BLOCKED_FETCH:
-      debugBelch("BLOCKED_FETCH("); 
-      printGA(&(stgCast(StgBlockedFetch*,obj)->ga));
-      printPtr((StgPtr)(stgCast(StgBlockedFetch*,obj)->node));
-      debugBelch(")\n"); 
-      break;
-
-    case FETCH_ME:
-      debugBelch("FETCH_ME("); 
-      printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
-      debugBelch(")\n"); 
-      break;
-
-    case FETCH_ME_BQ:
-      debugBelch("FETCH_ME_BQ("); 
-      // printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
-      printPtr((StgPtr)stgCast(StgFetchMeBlockingQueue*,obj)->blocking_queue);
-      debugBelch(")\n"); 
-      break;
-#endif
-
-#if defined(GRAN) || defined(PAR)
-    case RBH:
-      debugBelch("RBH("); 
-      printPtr((StgPtr)stgCast(StgRBH*,obj)->blocking_queue);
-      debugBelch(")\n"); 
-      break;
-
-#endif
-
 #if 0
       /* Symptomatic of a problem elsewhere, have it fall-through & fail */
     case EVACUATED:
@@ -421,14 +378,6 @@ printClosure( StgClosure *obj )
       break;
 #endif
 
-#if defined(PAR) && defined(DIST)
-    case REMOTE_REF:
-      debugBelch("REMOTE_REF("); 
-      printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
-      debugBelch(")\n"); 
-      break;
-#endif
-
     default:
             //barf("printClosure %d",get_itbl(obj)->type);
             debugBelch("*** printClosure: unknown type %d ****\n",
@@ -1064,11 +1013,37 @@ extern void DEBUG_LoadSymbols( char *name STG_UNUSED )
 
 void findPtr(P_ p, int);		/* keep gcc -Wall happy */
 
+int searched = 0;
+
+static int
+findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i)
+{
+    StgPtr q, r;
+    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--;
+                    }
+                    debugBelch("%p = ", r);
+                    printClosure((StgClosure *)r);
+                    arr[i++] = r;
+                } else {
+                    return i;
+                }
+            }
+        }
+    }
+    return i;
+}
+
 void
 findPtr(P_ p, int follow)
 {
   nat s, g;
-  P_ q, r;
   bdescr *bd;
 #if defined(__GNUC__)
   const int arr_size = 1024;
@@ -1077,27 +1052,15 @@ findPtr(P_ p, int follow)
 #endif
   StgPtr arr[arr_size];
   int i = 0;
+  searched = 0;
 
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
       for (s = 0; s < generations[g].n_steps; s++) {
 	  bd = generations[g].steps[s].blocks;
-	  for (; bd; bd = bd->link) {
-	      for (q = bd->start; q < bd->free; q++) {
-		  if (*q == (W_)p) {
-		      if (i < arr_size) {
-			  r = q;
-			  while (!LOOKS_LIKE_INFO_PTR(*r) || (P_)*r == NULL) {
-			      r--;
-			  }
-			  debugBelch("%p = ", r);
-			  printClosure((StgClosure *)r);
-			  arr[i++] = r;
-		      } else {
-			  return;
-		      }
-		  }
-	      }
-	  }
+          i = findPtrBlocks(p,bd,arr,arr_size,i);
+	  bd = generations[g].steps[s].large_objects;
+          i = findPtrBlocks(p,bd,arr,arr_size,i);
+          if (i >= arr_size) return;
       }
   }
   if (follow && i == 1) {