[project @ 2005-04-24 20:17:28 by panne]

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

diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index 67ca672..134dce4 100644 (file)
--- 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 );
@@ -97,10 +96,27 @@ printStdObjPayload( StgClosure *obj )
 }
 
 static void
-printStdObject( StgClosure *obj, char* tag )
+printThunkPayload( StgThunk *obj )
 {
-    printStdObjHdr( obj, tag );
-    printStdObjPayload( obj );
+    StgWord i, j;
+    const StgInfoTable* info;
+
+    info = get_itbl(obj);
+    for (i = 0; i < info->layout.payload.ptrs; ++i) {
+        debugBelch(", ");
+        printPtr((StgPtr)obj->payload[i]);
+    }
+    for (j = 0; j < info->layout.payload.nptrs; ++j) {
+        debugBelch(", %pd#",obj->payload[i+j]);
+    }
+    debugBelch(")\n");
+}
+
+static void
+printThunkObject( StgThunk *obj, char* tag )
+{
+    printStdObjHdr( (StgClosure *)obj, tag );
+    printThunkPayload( obj );
 }
 
 void
@@ -122,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);
@@ -163,9 +176,9 @@ printClosure( StgClosure *obj )
     case THUNK_STATIC:
             /* ToDo: will this work for THUNK_STATIC too? */
 #ifdef PROFILING
-           printStdObject(obj,info->prof.closure_desc);
+           printThunkObject((StgThunk *)obj,info->prof.closure_desc);
 #else
-            printStdObject(obj,"THUNK");
+            printThunkObject((StgThunk *)obj,"THUNK");
 #endif
             break;
 
@@ -180,7 +193,7 @@ printClosure( StgClosure *obj )
 
     case AP:
         {
-           StgPAP* ap = stgCast(StgPAP*,obj);
+           StgAP* ap = stgCast(StgAP*,obj);
             StgWord i;
             debugBelch("AP("); printPtr((StgPtr)ap->fun);
             for (i = 0; i < ap->n_args; ++i) {
@@ -290,21 +303,13 @@ printClosure( StgClosure *obj )
         }
 
     case CAF_BLACKHOLE:
-            debugBelch("CAF_BH("); 
-            printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
-            debugBelch(")\n"); 
+            debugBelch("CAF_BH"); 
             break;
 
     case BLACKHOLE:
             debugBelch("BH\n"); 
             break;
 
-    case BLACKHOLE_BQ:
-            debugBelch("BQ("); 
-            printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
-            debugBelch(")\n"); 
-            break;
-
     case SE_BLACKHOLE:
             debugBelch("SE_BH\n"); 
             break;
@@ -322,18 +327,18 @@ printClosure( StgClosure *obj )
                 putchar(arrWordsGetChar(obj,i));
                } */
            for (i=0; i<((StgArrWords *)obj)->words; i++)
-             debugBelch("%u", ((StgArrWords *)obj)->payload[i]);
+             debugBelch("%lu", ((StgArrWords *)obj)->payload[i]);
             debugBelch("\")\n");
             break;
         }
 
     case MUT_ARR_PTRS:
-       debugBelch("MUT_ARR_PTRS(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
+       debugBelch("MUT_ARR_PTRS(size=%ld)\n", ((StgMutArrPtrs *)obj)->ptrs);
        break;
 
     case MUT_ARR_PTRS_FROZEN:
 #if !defined(XMLAMBDA)
-       debugBelch("MUT_ARR_PTRS_FROZEN(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
+       debugBelch("MUT_ARR_PTRS_FROZEN(size=%ld)\n", ((StgMutArrPtrs *)obj)->ptrs);
        break;
 #else
           {
@@ -354,14 +359,14 @@ printClosure( StgClosure *obj )
     case MVAR:
         {
          StgMVar* mv = (StgMVar*)obj;
-         debugBelch("MVAR(head=%p, link=%p, tail=%p, value=%p)\n", mv->head, mv->mut_link, mv->tail, mv->value);
+         debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value);
           break;
         }
 
     case MUT_VAR:
         {
          StgMutVar* mv = (StgMutVar*)obj;
-         debugBelch("MUT_VAR(var=%p, link=%p)\n", mv->var, mv->mut_link);
+         debugBelch("MUT_VAR(var=%p)\n", mv->var);
           break;
         }
 
@@ -382,7 +387,7 @@ printClosure( StgClosure *obj )
             break;
 
     case STABLE_NAME:
-            debugBelch("STABLE_NAME(%d)\n", ((StgStableName*)obj)->sn); 
+            debugBelch("STABLE_NAME(%ld)\n", ((StgStableName*)obj)->sn); 
             break;
 
     case TSO:
@@ -499,12 +504,12 @@ printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
 
     p = payload;
     for(i = 0; i < size; i++, bitmap >>= 1 ) {
-       debugBelch("   stk[%d] (%p) = ", spBottom-(payload+i), payload+i);
+       debugBelch("   stk[%ld] (%p) = ", spBottom-(payload+i), payload+i);
        if ((bitmap & 1) == 0) {
            printPtr((P_)payload[i]);
            debugBelch("\n");
        } else {
-           debugBelch("Word# %d\n", payload[i]);
+           debugBelch("Word# %ld\n", payload[i]);
        }
     }
 }
@@ -520,12 +525,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[%d] (%p) = ", spBottom-(payload+i), payload+i);
+           debugBelch("   stk[%ld] (%p) = ", spBottom-(payload+i), payload+i);
            if ((bitmap & 1) == 0) {
                printPtr((P_)payload[i]);
                debugBelch("\n");
            } else {
-               debugBelch("Word# %d\n", payload[i]);
+               debugBelch("Word# %ld\n", payload[i]);
            }
        }
     }
@@ -617,8 +622,8 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
            switch (fun_info->f.fun_type) {
            case ARG_GEN:
                printSmallBitmap(spBottom, sp+1,
-                                BITMAP_BITS(fun_info->f.bitmap),
-                                BITMAP_SIZE(fun_info->f.bitmap));
+                                BITMAP_BITS(fun_info->f.b.bitmap),
+                                BITMAP_SIZE(fun_info->f.b.bitmap));
                break;
            case ARG_GEN_BIG:
                printLargeBitmap(spBottom, sp+2,