X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrinter.c;h=b73b79ec86d54a17e7dd66c6183552c5b0fa9586;hb=7d71bf0b4e294a7cb62037aedd087519ead9ade8;hp=0b340df1f26d3c77fb1d25b5ef734cc6fb4ed7c8;hpb=501915cc60b1224bb9e2ec52bc1d450294f0aee0;p=ghc-hetmet.git

diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
index 0b340df..b73b79e 100644
--- a/ghc/rts/Printer.c
+++ b/ghc/rts/Printer.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.56 2003/03/25 17:23:05 sof Exp $
+ * $Id: Printer.c,v 1.60 2003/05/14 09:13:59 simonmar Exp $
  *
  * (c) The GHC Team, 1994-2000.
  *
@@ -115,30 +115,71 @@ printClosure( StgClosure *obj )
     switch ( info->type ) {
     case INVALID_OBJECT:
             barf("Invalid object");
-    case BCO:
-            disassemble( (StgBCO*)obj );
-            break;
 
-    case MUT_VAR:
-        {
-	  StgMutVar* mv = (StgMutVar*)obj;
-	  fprintf(stderr,"MUT_VAR(var=%p, link=%p)\n", mv->var, mv->mut_link);
-          break;
-        }
-
-    case AP_STACK:
+    case CONSTR:
+    case CONSTR_1_0: case CONSTR_0_1:
+    case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
+    case CONSTR_INTLIKE:
+    case CONSTR_CHARLIKE:
+    case CONSTR_STATIC:
+    case CONSTR_NOCAF_STATIC:
         {
-	    StgAP_STACK* ap = stgCast(StgAP_STACK*,obj);
-            StgWord i;
-            fprintf(stderr,"AP_STACK("); printPtr((StgPtr)ap->fun);
-            for (i = 0; i < ap->size; ++i) {
-                fprintf(stderr,", ");
-                printPtr((P_)ap->payload[i]);
+            /* We can't use printStdObject because we want to print the
+             * tag as well.
+	     */
+            StgWord i, j;
+#ifdef PROFILING
+	    fprintf(stderr,"%s(", info->prof.closure_desc);
+	    fprintf(stderr,"%s", obj->header.prof.ccs->cc->label);
+#else
+            fprintf(stderr,"CONSTR(");
+            printPtr((StgPtr)obj->header.info);
+            fprintf(stderr,"(tag=%d)",info->srt_bitmap);
+#endif
+            for (i = 0; i < info->layout.payload.ptrs; ++i) {
+		fprintf(stderr,", ");
+                printPtr((StgPtr)obj->payload[i]);
+            }
+            for (j = 0; j < info->layout.payload.nptrs; ++j) {
+                fprintf(stderr,", %p#", obj->payload[i+j]);
             }
             fprintf(stderr,")\n");
             break;
         }
 
+    case FUN:
+    case FUN_1_0: case FUN_0_1: 
+    case FUN_1_1: case FUN_0_2: case FUN_2_0:
+    case FUN_STATIC:
+	fprintf(stderr,"FUN/%d(",itbl_to_fun_itbl(info)->arity);
+	printPtr((StgPtr)obj->header.info);
+#ifdef PROFILING
+	fprintf(stderr,", %s", obj->header.prof.ccs->cc->label);
+#endif
+	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:
+    case THUNK_STATIC:
+            /* ToDo: will this work for THUNK_STATIC too? */
+#ifdef PROFILING
+	    printStdObject(obj,info->prof.closure_desc);
+#else
+            printStdObject(obj,"THUNK");
+#endif
+            break;
+
+    case THUNK_SELECTOR:
+	printStdObjHdr(obj, "THUNK_SELECTOR");
+	fprintf(stderr, ", %p)\n", ((StgSelector *)obj)->selectee);
+	break;
+
+    case BCO:
+            disassemble( (StgBCO*)obj );
+            break;
+
     case AP:
         {
 	    StgPAP* ap = stgCast(StgPAP*,obj);
@@ -166,11 +207,18 @@ printClosure( StgClosure *obj )
             break;
         }
 
-    case FOREIGN:
-            fprintf(stderr,"FOREIGN("); 
-            printPtr((StgPtr)( ((StgForeignObj*)obj)->data ));
-            fprintf(stderr,")\n"); 
+    case AP_STACK:
+        {
+	    StgAP_STACK* ap = stgCast(StgAP_STACK*,obj);
+            StgWord i;
+            fprintf(stderr,"AP_STACK("); printPtr((StgPtr)ap->fun);
+            for (i = 0; i < ap->size; ++i) {
+                fprintf(stderr,", ");
+                printPtr((P_)ap->payload[i]);
+            }
+            fprintf(stderr,")\n");
             break;
+        }
 
     case IND:
             fprintf(stderr,"IND("); 
@@ -178,23 +226,70 @@ printClosure( StgClosure *obj )
             fprintf(stderr,")\n"); 
             break;
 
+    case IND_OLDGEN:
+            fprintf(stderr,"IND_OLDGEN("); 
+            printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
+            fprintf(stderr,")\n"); 
+            break;
+
     case IND_PERM:
             fprintf(stderr,"IND("); 
             printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
             fprintf(stderr,")\n"); 
             break;
 
+    case IND_OLDGEN_PERM:
+            fprintf(stderr,"IND_OLDGEN_PERM("); 
+            printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
+            fprintf(stderr,")\n"); 
+            break;
+
     case IND_STATIC:
             fprintf(stderr,"IND_STATIC("); 
             printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
             fprintf(stderr,")\n"); 
             break;
 
-    case IND_OLDGEN:
-            fprintf(stderr,"IND_OLDGEN("); 
-            printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
+    /* Cannot happen -- use default case.
+    case RET_BCO:
+    case RET_SMALL:
+    case RET_VEC_SMALL:
+    case RET_BIG:
+    case RET_VEC_BIG:
+    case RET_DYN:
+    case RET_FUN:
+    */
+
+    case UPDATE_FRAME:
+        {
+            StgUpdateFrame* u = stgCast(StgUpdateFrame*,obj);
+            fprintf(stderr,"UPDATE_FRAME(");
+            printPtr((StgPtr)GET_INFO(u));
+            fprintf(stderr,",");
+            printPtr((StgPtr)u->updatee);
             fprintf(stderr,")\n"); 
             break;
+        }
+
+    case CATCH_FRAME:
+        {
+            StgCatchFrame* u = stgCast(StgCatchFrame*,obj);
+            fprintf(stderr,"CATCH_FRAME(");
+            printPtr((StgPtr)GET_INFO(u));
+            fprintf(stderr,",");
+            printPtr((StgPtr)u->handler);
+            fprintf(stderr,")\n"); 
+            break;
+        }
+
+    case STOP_FRAME:
+        {
+            StgStopFrame* u = stgCast(StgStopFrame*,obj);
+            fprintf(stderr,"STOP_FRAME(");
+            printPtr((StgPtr)GET_INFO(u));
+            fprintf(stderr,")\n"); 
+            break;
+        }
 
     case CAF_BLACKHOLE:
             fprintf(stderr,"CAF_BH("); 
@@ -202,6 +297,16 @@ printClosure( StgClosure *obj )
             fprintf(stderr,")\n"); 
             break;
 
+    case BLACKHOLE:
+            fprintf(stderr,"BH\n"); 
+            break;
+
+    case BLACKHOLE_BQ:
+            fprintf(stderr,"BQ("); 
+            printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
+            fprintf(stderr,")\n"); 
+            break;
+
     case SE_BLACKHOLE:
             fprintf(stderr,"SE_BH\n"); 
             break;
@@ -210,14 +315,69 @@ printClosure( StgClosure *obj )
             fprintf(stderr,"SE_CAF_BH\n"); 
             break;
 
-    case BLACKHOLE:
-            fprintf(stderr,"BH\n"); 
+    case ARR_WORDS:
+        {
+            StgWord i;
+            fprintf(stderr,"ARR_WORDS(\"");
+            /* 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, "%u", ((StgArrWords *)obj)->payload[i]);
+            fprintf(stderr,"\")\n");
             break;
+        }
 
-    case BLACKHOLE_BQ:
-            fprintf(stderr,"BQ("); 
-            printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
+    case MUT_ARR_PTRS:
+	fprintf(stderr,"MUT_ARR_PTRS(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
+	break;
+
+    case MUT_ARR_PTRS_FROZEN:
+#if !defined(XMLAMBDA)
+	fprintf(stderr,"MUT_ARR_PTRS_FROZEN(size=%d)\n", ((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);
+
+            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 MUT_VAR:
+        {
+	  StgMutVar* mv = (StgMutVar*)obj;
+	  fprintf(stderr,"MUT_VAR(var=%p, link=%p)\n", mv->var, mv->mut_link);
+          break;
+        }
+
+    case WEAK:
+            fprintf(stderr,"WEAK("); 
+	    fprintf(stderr," key=%p value=%p finalizer=%p", 
+		    (StgPtr)(((StgWeak*)obj)->key),
+		    (StgPtr)(((StgWeak*)obj)->value),
+		    (StgPtr)(((StgWeak*)obj)->finalizer));
             fprintf(stderr,")\n"); 
+	    /* ToDo: chase 'link' ? */
+            break;
+
+    case FOREIGN:
+            fprintf(stderr,"FOREIGN("); 
+            printPtr((StgPtr)( ((StgForeignObj*)obj)->data ));
+            fprintf(stderr,")\n"); 
+            break;
+
+    case STABLE_NAME:
+            fprintf(stderr,"STABLE_NAME(%d)\n", ((StgStableName*)obj)->sn); 
             break;
 
     case TSO:
@@ -240,14 +400,6 @@ printClosure( StgClosure *obj )
       fprintf(stderr,")\n"); 
       break;
 
-#ifdef DIST      
-    case REMOTE_REF:
-      fprintf(stderr,"REMOTE_REF("); 
-      printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
-      fprintf(stderr,")\n"); 
-      break;
-#endif
-  
     case FETCH_ME_BQ:
       fprintf(stderr,"FETCH_ME_BQ("); 
       // printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
@@ -255,6 +407,7 @@ printClosure( StgClosure *obj )
       fprintf(stderr,")\n"); 
       break;
 #endif
+
 #if defined(GRAN) || defined(PAR)
     case RBH:
       fprintf(stderr,"RBH("); 
@@ -264,134 +417,23 @@ printClosure( StgClosure *obj )
 
 #endif
 
-    case CONSTR:
-    case CONSTR_1_0: case CONSTR_0_1:
-    case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-    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
-	    fprintf(stderr,"%s(", info->prof.closure_desc);
-	    fprintf(stderr,"%s", obj->header.prof.ccs->cc->label);
-#else
-            fprintf(stderr,"CONSTR(");
-            printPtr((StgPtr)obj->header.info);
-            fprintf(stderr,"(tag=%d)",info->srt_len);
-#endif
-            for (i = 0; i < info->layout.payload.ptrs; ++i) {
-		fprintf(stderr,", ");
-                printPtr((StgPtr)obj->payload[i]);
-            }
-            for (j = 0; j < info->layout.payload.nptrs; ++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:
-    case FUN_STATIC:
-	fprintf(stderr,"FUN/%d(",itbl_to_fun_itbl(info)->arity);
-	printPtr((StgPtr)obj->header.info);
-#ifdef PROFILING
-	fprintf(stderr,", %s", obj->header.prof.ccs->cc->label);
+#if 0
+      /* Symptomatic of a problem elsewhere, have it fall-through & fail */
+    case EVACUATED:
+      fprintf(stderr,"EVACUATED("); 
+      printClosure((StgEvacuated*)obj->evacuee);
+      fprintf(stderr,")\n"); 
+      break;
 #endif
-	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:
-    case THUNK_STATIC:
-            /* ToDo: will this work for THUNK_STATIC too? */
-#ifdef PROFILING
-	    printStdObject(obj,info->prof.closure_desc);
-#else
-            printStdObject(obj,"THUNK");
+#if defined(PAR) && defined(DIST)
+    case REMOTE_REF:
+      fprintf(stderr,"REMOTE_REF("); 
+      printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
+      fprintf(stderr,")\n"); 
+      break;
 #endif
-            break;
-
-    case THUNK_SELECTOR:
-	printStdObjHdr(obj, "THUNK_SELECTOR");
-	fprintf(stderr, ", %p)\n", ((StgSelector *)obj)->selectee);
-	break;
 
-    case MUT_ARR_PTRS:
-	fprintf(stderr,"MUT_ARR_PTRS(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
-	break;
-    case MUT_ARR_PTRS_FROZEN:
-	fprintf(stderr,"MUT_ARR_PTRS_FROZEN(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
-	break;
-
-    case ARR_WORDS:
-        {
-            StgWord i;
-            fprintf(stderr,"ARR_WORDS(\"");
-            /* 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, "%u", ((StgArrWords *)obj)->payload[i]);
-            fprintf(stderr,"\")\n");
-            break;
-        }
-
-    case UPDATE_FRAME:
-        {
-            StgUpdateFrame* u = stgCast(StgUpdateFrame*,obj);
-            fprintf(stderr,"UPDATE_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
-            fprintf(stderr,",");
-            printPtr((StgPtr)u->updatee);
-            fprintf(stderr,")\n"); 
-            break;
-        }
-
-    case CATCH_FRAME:
-        {
-            StgCatchFrame* u = stgCast(StgCatchFrame*,obj);
-            fprintf(stderr,"CATCH_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
-            fprintf(stderr,",");
-            printPtr((StgPtr)u->handler);
-            fprintf(stderr,")\n"); 
-            break;
-        }
-
-    case STOP_FRAME:
-        {
-            StgStopFrame* u = stgCast(StgStopFrame*,obj);
-            fprintf(stderr,"STOP_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
-            fprintf(stderr,")\n"); 
-            break;
-        }
     default:
             //barf("printClosure %d",get_itbl(obj)->type);
             fprintf(stderr, "*** printClosure: unknown type %d ****\n",
@@ -516,17 +558,17 @@ printStackChunk( StgPtr sp, StgPtr spBottom )
 
 	    p = (P_)(r->payload);
 	    printSmallBitmap(spBottom, sp,
-			     GET_LIVENESS(r->liveness), RET_DYN_SIZE);
-	    p += RET_DYN_SIZE;
+			     GET_LIVENESS(r->liveness), RET_DYN_BITMAP_SIZE);
+	    p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE;
 
 	    for (size = GET_NONPTRS(dyn); size > 0; size--) {
-		fprintf(stderr,"   stk[%ld] (%p) = ", spBottom-p, p);
-		fprintf(stderr,"Word# %ld\n", *p);
+		fprintf(stderr,"   stk[%ld] (%p) = ", (long)(spBottom-p), p);
+		fprintf(stderr,"Word# %ld\n", (long)*p);
 		p++;
 	    }
 	
 	    for (size = GET_PTRS(dyn); size > 0; size--) {
-		fprintf(stderr,"   stk[%ld] (%p) = ", spBottom-p, p);
+		fprintf(stderr,"   stk[%ld] (%p) = ", (long)(spBottom-p), p);
 		printPtr(p);
 		p++;
 	    }
@@ -603,6 +645,7 @@ static char *closure_type_names[] = {
     "BCO",
     "AP_UPD",
     "PAP",
+    "AP_STACK",
     "IND",
     "IND_OLDGEN",
     "IND_PERM",
@@ -971,7 +1014,7 @@ extern void DEBUG_LoadSymbols( char *name )
             }
         }
 
-        free(symbol_table);
+        stgFree(symbol_table);
     }
     prepare_table();
 }