X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrinter.c;h=8290d220a0b0498373ec5ec47e4b370f2b09bcd4;hb=c56641e7752db313effe332b81f9e56275342fbd;hp=ef474f396bf955f77978610eb67fbd19971db311;hpb=0f3205e6c40575910d50bc2cc42020ccf55e07ba;p=ghc-hetmet.git

diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index ef474f3..8290d22 100644
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -33,7 +33,6 @@ int fixed_hs = sizeof(StgHeader), itbl_sz = sizeofW(StgInfoTable),
  * local function decls
  * ------------------------------------------------------------------------*/
 
-static void    printStdObject( StgClosure *obj, char* tag );
 static void    printStdObjPayload( StgClosure *obj );
 #ifdef USING_LIBBFD
 static void    reset_table   ( int size );
@@ -114,13 +113,6 @@ printThunkPayload( StgThunk *obj )
 }
 
 static void
-printStdObject( StgClosure *obj, char* tag )
-{
-    printStdObjHdr( obj, tag );
-    printStdObjPayload( obj );
-}
-
-static void
 printThunkObject( StgThunk *obj, char* tag )
 {
     printStdObjHdr( (StgClosure *)obj, tag );
@@ -146,9 +138,6 @@ printClosure( StgClosure *obj )
     case CONSTR_STATIC:
     case CONSTR_NOCAF_STATIC:
         {
-            /* We can't use printStdObject because we want to print the
-             * tag as well.
-	     */
             StgWord i, j;
 #ifdef PROFILING
 	    debugBelch("%s(", info->prof.closure_desc);
@@ -338,34 +327,22 @@ printClosure( StgClosure *obj )
                 putchar(arrWordsGetChar(obj,i));
 		} */
 	    for (i=0; i<((StgArrWords *)obj)->words; i++)
-	      debugBelch("%lu", ((StgArrWords *)obj)->payload[i]);
+	      debugBelch("%lu", (lnat)((StgArrWords *)obj)->payload[i]);
             debugBelch("\")\n");
             break;
         }
 
-    case MUT_ARR_PTRS:
-	debugBelch("MUT_ARR_PTRS(size=%ld)\n", ((StgMutArrPtrs *)obj)->ptrs);
+    case MUT_ARR_PTRS_CLEAN:
+	debugBelch("MUT_ARR_PTRS_CLEAN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
 	break;
 
-    case MUT_ARR_PTRS_FROZEN:
-#if !defined(XMLAMBDA)
-	debugBelch("MUT_ARR_PTRS_FROZEN(size=%ld)\n", ((StgMutArrPtrs *)obj)->ptrs);
+    case MUT_ARR_PTRS_DIRTY:
+	debugBelch("MUT_ARR_PTRS_DIRTY(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
 	break;
-#else
-          {
-            /* rows are mutarrays in xmlambda, maybe we should make a new type: ROW */
-            StgWord i;
-            StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,obj);
 
-            debugBelch("Row<%i>(",p->ptrs);
-            for (i = 0; i < p->ptrs; ++i) {
-                if (i > 0) debugBelch(", ");
-                printPtr((StgPtr)(p->payload[i]));
-            }
-            debugBelch(")\n");
-            break;
-          }
-#endif  
+    case MUT_ARR_PTRS_FROZEN:
+	debugBelch("MUT_ARR_PTRS_FROZEN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
+	break;
 
     case MVAR:
         {
@@ -374,10 +351,17 @@ printClosure( StgClosure *obj )
           break;
         }
 
-    case MUT_VAR:
+    case MUT_VAR_CLEAN:
         {
 	  StgMutVar* mv = (StgMutVar*)obj;
-	  debugBelch("MUT_VAR(var=%p)\n", mv->var);
+	  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);
           break;
         }
 
@@ -391,14 +375,8 @@ printClosure( StgClosure *obj )
 	    /* ToDo: chase 'link' ? */
             break;
 
-    case FOREIGN:
-            debugBelch("FOREIGN("); 
-            printPtr((StgPtr)( ((StgForeignObj*)obj)->data ));
-            debugBelch(")\n"); 
-            break;
-
     case STABLE_NAME:
-            debugBelch("STABLE_NAME(%ld)\n", ((StgStableName*)obj)->sn); 
+            debugBelch("STABLE_NAME(%lu)\n", (lnat)((StgStableName*)obj)->sn); 
             break;
 
     case TSO:
@@ -515,12 +493,12 @@ printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
 
     p = payload;
     for(i = 0; i < size; i++, bitmap >>= 1 ) {
-	debugBelch("   stk[%ld] (%p) = ", spBottom-(payload+i), 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# %ld\n", payload[i]);
+	    debugBelch("Word# %lu\n", (lnat)payload[i]);
 	}
     }
 }
@@ -536,12 +514,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[%ld] (%p) = ", spBottom-(payload+i), payload+i);
+	    debugBelch("   stk[%lu] (%p) = ", (lnat)(spBottom-(payload+i)), payload+i);
 	    if ((bitmap & 1) == 0) {
 		printPtr((P_)payload[i]);
 		debugBelch("\n");
 	    } else {
-		debugBelch("Word# %ld\n", payload[i]);
+		debugBelch("Word# %lu\n", (lnat)payload[i]);
 	    }
 	}
     }
@@ -562,10 +540,13 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
 	    
 	case UPDATE_FRAME:
 	case CATCH_FRAME:
-	case STOP_FRAME:
 	    printObj((StgClosure*)sp);
 	    continue;
 
+	case STOP_FRAME:
+	    printObj((StgClosure*)sp);
+	    return;
+
 	case RET_DYN:
 	{ 
 	    StgRetDyn* r;
@@ -599,7 +580,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
 
 	case RET_SMALL:
 	case RET_VEC_SMALL:
-	    debugBelch("RET_SMALL (%p)\n", sp);
+	    debugBelch("RET_SMALL (%p)\n", info);
 	    bitmap = info->layout.bitmap;
 	    printSmallBitmap(spBottom, sp+1, 
 			     BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
@@ -629,10 +610,10 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
 	    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_info->f.fun_type);
+	    debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, fun_info->f.fun_type);
 	    switch (fun_info->f.fun_type) {
 	    case ARG_GEN:
-		printSmallBitmap(spBottom, sp+1,
+		printSmallBitmap(spBottom, sp+2,
 				 BITMAP_BITS(fun_info->f.b.bitmap),
 				 BITMAP_SIZE(fun_info->f.b.bitmap));
 		break;
@@ -642,7 +623,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
 				 GET_FUN_LARGE_BITMAP(fun_info)->size);
 		break;
 	    default:
-		printSmallBitmap(spBottom, sp+1,
+		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;
@@ -721,9 +702,11 @@ static char *closure_type_names[] = {
     "SE_CAF_BLACKHOLE",
     "MVAR",
     "ARR_WORDS",
-    "MUT_ARR_PTRS",
+    "MUT_ARR_PTRS_CLEAN",
+    "MUT_ARR_PTRS_DIRTY",
     "MUT_ARR_PTRS_FROZEN",
-    "MUT_VAR",
+    "MUT_VAR_CLEAN",
+    "MUT_VAR_DIRTY",
     "MUT_CONS",
     "WEAK",
     "FOREIGN",
@@ -1105,11 +1088,7 @@ findPtr(P_ p, int follow)
 
   for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
       for (s = 0; s < generations[g].n_steps; s++) {
-	  if (RtsFlags.GcFlags.generations == 1) {
-	      bd = generations[g].steps[s].to_blocks;
-	  } else {
-	      bd = generations[g].steps[s].blocks;
-	  }
+	  bd = generations[g].steps[s].blocks;
 	  for (; bd; bd = bd->link) {
 	      for (q = bd->start; q < bd->free; q++) {
 		  if (*q == (W_)p) {