[project @ 2000-11-14 10:56:08 by simonmar]

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

diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index c8059ab..a024518 100644 (file)
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.20 2000/01/14 14:56:40 simonmar Exp $
+ * $Id: Printer.c,v 1.28 2000/08/15 11:48:06 simonmar Exp $
  *
  * (c) The GHC Team, 1994-2000.
  *
@@ -43,17 +43,8 @@ static void    printZcoded   ( const char *raw );
  * Printer
  * ------------------------------------------------------------------------*/
 
-
 #ifdef INTERPRETER
-extern void* itblNames[];
-extern int   nItblNames;
-char* lookupHugsItblName ( void* v )
-{
-   int i;
-   for (i = 0; i < nItblNames; i += 2)
-      if (itblNames[i] == v) return itblNames[i+1];
-   return NULL;
-}
+char* lookupHugsItblName ( void* itbl );
 #endif
 
 void printPtr( StgPtr p )
@@ -89,10 +80,10 @@ static void printStdObject( StgClosure *obj, char* tag )
     printPtr((StgPtr)obj->header.info);
     for (i = 0; i < info->layout.payload.ptrs; ++i) {
         fprintf(stderr,", ");
-        printPtr(payloadPtr(obj,i));
+        printPtr((StgPtr)obj->payload[i]);
     }
     for (j = 0; j < info->layout.payload.nptrs; ++j) {
-        fprintf(stderr,", %xd#",payloadWord(obj,i+j));
+        fprintf(stderr,", %pd#",obj->payload[i+j]);
     }
     fprintf(stderr,")\n");
 }
@@ -116,7 +107,7 @@ void printClosure( StgClosure *obj )
             fprintf(stderr,"AP_UPD("); printPtr((StgPtr)ap->fun);
             for (i = 0; i < ap->n_args; ++i) {
                 fprintf(stderr,", ");
-                printPtr(payloadPtr(ap,i));
+                printPtr((P_)ap->payload[i]);
             }
             fprintf(stderr,")\n");
             break;
@@ -129,7 +120,7 @@ void printClosure( StgClosure *obj )
             fprintf(stderr,"PAP("); printPtr((StgPtr)pap->fun);
             for (i = 0; i < pap->n_args; ++i) {
                 fprintf(stderr,", ");
-                printPtr(payloadPtr(pap,i));
+                printPtr((StgPtr)pap->payload[i]);
             }
             fprintf(stderr,")\n");
             break;
@@ -161,7 +152,7 @@ void printClosure( StgClosure *obj )
             fprintf(stderr,", ");
             printPtr((StgPtr)caf->value); /* should be null */
             fprintf(stderr,", ");
-            printPtr((StgPtr)caf->link);  /* should be null */
+            printPtr((StgPtr)caf->link);
             fprintf(stderr,")\n"); 
             break;
         }
@@ -203,12 +194,40 @@ void printClosure( StgClosure *obj )
             fprintf(stderr,")\n"); 
             break;
 
+    case TSO:
+      fprintf(stderr,"TSO("); 
+      fprintf(stderr,"%d (%p)",((StgTSO*)obj)->id, (StgTSO*)obj);
+      fprintf(stderr,")\n"); 
+      break;
+
+#if defined(PAR)
+    case BLOCKED_FETCH:
+      fprintf(stderr,"BLOCKED_FETCH("); 
+      printGA(&(stgCast(StgBlockedFetch*,obj)->ga));
+      printPtr((StgPtr)(stgCast(StgBlockedFetch*,obj)->node));
+      fprintf(stderr,")\n"); 
+      break;
+
+    case FETCH_ME:
+      fprintf(stderr,"FETCH_ME("); 
+      printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
+      fprintf(stderr,")\n"); 
+      break;
+
+    case FETCH_ME_BQ:
+      fprintf(stderr,"FETCH_ME_BQ("); 
+      // printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
+      printPtr((StgPtr)stgCast(StgFetchMeBlockingQueue*,obj)->blocking_queue);
+      fprintf(stderr,")\n"); 
+      break;
+#endif
 #if defined(GRAN) || defined(PAR)
     case RBH:
       fprintf(stderr,"RBH("); 
       printPtr((StgPtr)stgCast(StgRBH*,obj)->blocking_queue);
       fprintf(stderr,")\n"); 
       break;
+
 #endif
 
     case CONSTR:
@@ -229,15 +248,32 @@ void printClosure( StgClosure *obj )
             fprintf(stderr,"(tag=%d)",info->srt_len);
             for (i = 0; i < info->layout.payload.ptrs; ++i) {
                 fprintf(stderr,", ");
-                printPtr(payloadPtr(obj,i));
+                printPtr((StgPtr)obj->payload[i]);
             }
             for (j = 0; j < info->layout.payload.nptrs; ++j) {
-                fprintf(stderr,", %x#",payloadWord(obj,i+j));
+                fprintf(stderr,", %p#", obj->payload[i+j]);
             }
             fprintf(stderr,")\n");
             break;
         }
 
+#ifdef XMLAMBDA
+/* rows are mutarrays in xmlambda, maybe we should make a new type: ROW */
+    case MUT_ARR_PTRS_FROZEN:
+          {
+            StgWord i;
+            StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,obj);
+
+            fprintf(stderr,"Row<%i>(",p->ptrs);
+            for (i = 0; i < p->ptrs; ++i) {
+                if (i > 0) fprintf(stderr,", ");
+                printPtr((StgPtr)(p->payload[i]));
+            }
+            fprintf(stderr,")\n");
+            break;
+          }
+#endif  
+
     case FUN:
     case FUN_1_0: case FUN_0_1: 
     case FUN_1_1: case FUN_0_2: case FUN_2_0:
@@ -252,19 +288,25 @@ void printClosure( StgClosure *obj )
             /* ToDo: will this work for THUNK_STATIC too? */
             printStdObject(obj,"THUNK");
             break;
-#if 0
+
+    case THUNK_SELECTOR:
+            printStdObject(obj,"THUNK_SELECTOR");
+            break;
+
     case ARR_WORDS:
         {
             StgWord i;
             fprintf(stderr,"ARR_WORDS(\"");
-            /* ToDo: we can't safely assume that this is a string! */
+            /* 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++)
+             fprintf(stderr, "%d", ((StgArrWords *)obj)->payload[i]);
             fprintf(stderr,"\")\n");
             break;
         }
-#endif
+
     case UPDATE_FRAME:
         {
             StgUpdateFrame* u = stgCast(StgUpdateFrame*,obj);
@@ -410,7 +452,7 @@ void printStackChunk( StgPtr sp, StgPtr spBottom )
          sp++;
        small_bitmap:
          while (bitmap != 0) {
-           fprintf(stderr,"Stack[%d] (%p) = ", spBottom-sp, sp);
+           fprintf(stderr,"   stk[%d] (%p) = ", spBottom-sp, sp);
            if ((bitmap & 1) == 0) {
              printPtr((P_)*sp);
              fprintf(stderr,"\n");
@@ -543,11 +585,11 @@ static char *closure_type_names[] = {
   "STABLE_NAME",               /* 58 */
   "TSO",                       /* 59 */
   "BLOCKED_FETCH",             /* 60 */
-  "FETCH_ME",                  /* 61 */
-  "EVACUATED",                 /* 62 */
-  "N_CLOSURE_TYPES",           /* 63 */
-  "FETCH_ME_BQ",               /* 64 */
-  "RBH"                        /* 65 */
+  "FETCH_ME",                   /* 61 */
+  "FETCH_ME_BQ",                /* 62 */
+  "RBH",                        /* 63 */
+  "EVACUATED",                  /* 64 */
+  "N_CLOSURE_TYPES"            /* 65 */
 };
 
 char *
@@ -895,6 +937,8 @@ extern void DEBUG_LoadSymbols( char *name STG_UNUSED )
 
 #include "StoragePriv.h"
 
+void findPtr(P_ p);            /* keep gcc -Wall happy */
+
 void
 findPtr(P_ p)
 {