X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrinter.c;h=389dd801e8471752de63d4820999287ca3b68aa7;hb=5910d12358c27b284f2737f69c089ec72b39f161;hp=c8059ab43bc5bdd813347dfe49703e37141057e8;hpb=7c1923545f7ea643a03ff37084dcb9a92695133e;p=ghc-hetmet.git diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index c8059ab..389dd80 100644 --- 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.33 2001/01/15 16:55:25 sewardj Exp $ * * (c) The GHC Team, 1994-2000. * @@ -14,6 +14,8 @@ #include "RtsUtils.h" #include "RtsFlags.h" +#include "MBlock.h" +#include "Storage.h" #include "Bytecodes.h" /* for InstrPtr */ #include "Disassembler.h" @@ -43,17 +45,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 +82,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"); } @@ -102,10 +95,9 @@ void printClosure( StgClosure *obj ) switch ( get_itbl(obj)->type ) { case INVALID_OBJECT: barf("Invalid object"); -#ifdef INTERPRETER +#ifdef GHCI case BCO: - fprintf(stderr,"BCO\n"); - disassemble(stgCast(StgBCO*,obj),"\t"); + disassemble( (StgBCO*)obj ); break; #endif @@ -116,7 +108,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 +121,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 +153,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 +195,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 +249,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 +289,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); @@ -341,15 +384,19 @@ StgPtr printStackObj( StgPtr sp ) } else { StgClosure* c = (StgClosure*)(*sp); printPtr((StgPtr)*sp); -#ifdef INTERPRETER - if (c == &ret_bco_info) { - fprintf(stderr, "\t\t"); - fprintf(stderr, "ret_bco_info\n" ); +#ifdef GHCI + if (c == (StgClosure*)&stg_ctoi_ret_R1p_info) { + fprintf(stderr, "\t\t\tstg_ctoi_ret_R1p_info\n" ); + } else + if (c == (StgClosure*)&stg_ctoi_ret_R1n_info) { + fprintf(stderr, "\t\t\tstg_ctoi_ret_R1n_info\n" ); + } else + if (c == (StgClosure*)&stg_ctoi_ret_F1_info) { + fprintf(stderr, "\t\t\tstg_ctoi_ret_F1_info\n" ); + } else + if (c == (StgClosure*)&stg_ctoi_ret_D1_info) { + fprintf(stderr, "\t\t\tstg_ctoi_ret_D1_info\n" ); } else - if (IS_HUGS_CONSTR_INFO(GET_INFO(c))) { - fprintf(stderr, "\t\t\t"); - fprintf(stderr, "ConstrInfoTable\n" ); - } else #endif if (get_itbl(c)->type == BCO) { fprintf(stderr, "\t\t\t"); @@ -410,7 +457,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 +590,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 +942,8 @@ extern void DEBUG_LoadSymbols( char *name STG_UNUSED ) #include "StoragePriv.h" +void findPtr(P_ p); /* keep gcc -Wall happy */ + void findPtr(P_ p) {