New implementation of BLACKHOLEs

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

diff --git a/rts/Printer.c b/rts/Printer.c
index 91bc6c8..6eecfab 100644 (file)
--- a/rts/Printer.c
+++ b/rts/Printer.c
@@ -160,6 +160,12 @@ printClosure( StgClosure *obj )
        printStdObjPayload(obj);
        break;
 
+    case PRIM:
+       debugBelch("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:
@@ -251,6 +257,12 @@ printClosure( StgClosure *obj )
             debugBelch(")\n"); 
             break;
 
+    case BLACKHOLE:
+            debugBelch("BLACKHOLE("); 
+            printPtr((StgPtr)((StgInd*)obj)->indirectee);
+            debugBelch(")\n"); 
+            break;
+
     /* Cannot happen -- use default case.
     case RET_BCO:
     case RET_SMALL:
@@ -290,14 +302,6 @@ printClosure( StgClosure *obj )
             break;
         }
 
-    case CAF_BLACKHOLE:
-            debugBelch("CAF_BH"); 
-            break;
-
-    case BLACKHOLE:
-            debugBelch("BH\n"); 
-            break;
-
     case ARR_WORDS:
         {
             StgWord i;
@@ -356,10 +360,6 @@ printClosure( StgClosure *obj )
            /* ToDo: chase 'link' ? */
             break;
 
-    case STABLE_NAME:
-            debugBelch("STABLE_NAME(%lu)\n", (lnat)((StgStableName*)obj)->sn); 
-            break;
-
     case TSO:
       debugBelch("TSO("); 
       debugBelch("%lu (%p)",(unsigned long)(((StgTSO*)obj)->id), (StgTSO*)obj);
@@ -943,7 +943,7 @@ findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i)
 void
 findPtr(P_ p, int follow)
 {
-  nat s, g;
+  nat g;
   bdescr *bd;
 #if defined(__GNUC__)
   const int arr_size = 1024;
@@ -955,13 +955,11 @@ findPtr(P_ p, int follow)
   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;
-          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;
-      }
+      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;
   }
   if (follow && i == 1) {
       debugBelch("-->\n");
@@ -1051,6 +1049,15 @@ void prettyPrintClosure_ (StgClosure *obj)
     }
 }
 
+char *what_next_strs[] = {
+  [0]               = "(unknown)",
+  [ThreadRunGHC]    = "ThreadRunGHC",
+  [ThreadInterpret] = "ThreadInterpret",
+  [ThreadKilled]    = "ThreadKilled",
+  [ThreadRelocated] = "ThreadRelocated",
+  [ThreadComplete]  = "ThreadComplete"
+};
+
 #else /* DEBUG */
 void printPtr( StgPtr p )
 {
@@ -1113,8 +1120,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",
@@ -1125,14 +1132,10 @@ char *closure_type_names[] = {
  [MUT_VAR_CLEAN]         = "MUT_VAR_CLEAN",
  [MUT_VAR_DIRTY]         = "MUT_VAR_DIRTY",
  [WEAK]                  = "WEAK",
- [STABLE_NAME]           = "STABLE_NAME",
+ [PRIM]                         = "PRIM",
+ [MUT_PRIM]              = "MUT_PRIM",
  [TSO]                   = "TSO",
- [TVAR_WATCH_QUEUE]      = "TVAR_WATCH_QUEUE",
- [INVARIANT_CHECK_QUEUE] = "INVARIANT_CHECK_QUEUE",
- [ATOMIC_INVARIANT]      = "ATOMIC_INVARIANT",
- [TVAR]                  = "TVAR",
  [TREC_CHUNK]            = "TREC_CHUNK",
- [TREC_HEADER]           = "TREC_HEADER",
  [ATOMICALLY_FRAME]      = "ATOMICALLY_FRAME",
  [CATCH_RETRY_FRAME]     = "CATCH_RETRY_FRAME",
  [CATCH_STM_FRAME]       = "CATCH_STM_FRAME",