X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FPrinter.c;h=1b6e57eae6341efd533ee393a26dd1e8cb780a8d;hb=6cf8982ac30be6836a0cdd8be5a6ac1a1a144213;hp=36fdf7bda4ba7831163e562144865fcc89ddeec7;hpb=f9e1c2af8fdd112019a657e66b0cd685d8df66f6;p=ghc-hetmet.git diff --git a/rts/Printer.c b/rts/Printer.c index 36fdf7b..1b6e57e 100644 --- a/rts/Printer.c +++ b/rts/Printer.c @@ -8,27 +8,18 @@ #include "PosixSource.h" #include "Rts.h" +#include "rts/Bytecodes.h" /* for InstrPtr */ + #include "Printer.h" #include "RtsUtils.h" +#include + #ifdef DEBUG -#include "RtsFlags.h" -#include "MBlock.h" -#include "Storage.h" -#include "Bytecodes.h" /* for InstrPtr */ #include "Disassembler.h" #include "Apply.h" -#include -#include - -#if defined(GRAN) || defined(PAR) -// HWL: explicit fixed header size to make debugging easier -int fixed_hs = sizeof(StgHeader), itbl_sz = sizeofW(StgInfoTable), - uf_sz=sizeofW(StgUpdateFrame); -#endif - /* -------------------------------------------------------------------------- * local function decls * ------------------------------------------------------------------------*/ @@ -37,14 +28,13 @@ static void printStdObjPayload( StgClosure *obj ); #ifdef USING_LIBBFD static void reset_table ( int size ); static void prepare_table ( void ); -static void insert ( unsigned value, const char *name ); +static void insert ( StgWord value, const char *name ); #endif #if 0 /* unused but might be useful sometime */ -static rtsBool lookup_name ( char *name, unsigned *result ); +static rtsBool lookup_name ( char *name, StgWord *result ); static void enZcode ( char *in, char *out ); #endif static char unZcode ( char ch ); -const char * lookupGHCName ( void *addr ); static void printZcoded ( const char *raw ); /* -------------------------------------------------------------------------- @@ -122,8 +112,9 @@ printThunkObject( StgThunk *obj, char* tag ) void printClosure( StgClosure *obj ) { + obj = UNTAG_CLOSURE(obj); + StgInfoTable *info; - info = get_itbl(obj); switch ( info->type ) { @@ -133,14 +124,13 @@ printClosure( StgClosure *obj ) 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: { StgWord i, j; + #ifdef PROFILING - debugBelch("%s(", info->prof.closure_desc); + debugBelch("%s(", GET_PROF_DESC(info)); debugBelch("%s", obj->header.prof.ccs->cc->label); #else debugBelch("CONSTR("); @@ -176,7 +166,7 @@ printClosure( StgClosure *obj ) case THUNK_STATIC: /* ToDo: will this work for THUNK_STATIC too? */ #ifdef PROFILING - printThunkObject((StgThunk *)obj,info->prof.closure_desc); + printThunkObject((StgThunk *)obj,GET_PROF_DESC(info)); #else printThunkObject((StgThunk *)obj,"THUNK"); #endif @@ -193,7 +183,7 @@ printClosure( StgClosure *obj ) case AP: { - StgAP* ap = stgCast(StgAP*,obj); + StgAP* ap = (StgAP*)obj; StgWord i; debugBelch("AP("); printPtr((StgPtr)ap->fun); for (i = 0; i < ap->n_args; ++i) { @@ -206,7 +196,7 @@ printClosure( StgClosure *obj ) case PAP: { - StgPAP* pap = stgCast(StgPAP*,obj); + StgPAP* pap = (StgPAP*)obj; StgWord i; debugBelch("PAP/%d(",pap->arity); printPtr((StgPtr)pap->fun); @@ -220,7 +210,7 @@ printClosure( StgClosure *obj ) case AP_STACK: { - StgAP_STACK* ap = stgCast(StgAP_STACK*,obj); + StgAP_STACK* ap = (StgAP_STACK*)obj; StgWord i; debugBelch("AP_STACK("); printPtr((StgPtr)ap->fun); for (i = 0; i < ap->size; ++i) { @@ -233,47 +223,45 @@ printClosure( StgClosure *obj ) case IND: debugBelch("IND("); - printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee); + printPtr((StgPtr)((StgInd*)obj)->indirectee); debugBelch(")\n"); break; case IND_OLDGEN: debugBelch("IND_OLDGEN("); - printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee); + printPtr((StgPtr)((StgInd*)obj)->indirectee); debugBelch(")\n"); break; case IND_PERM: debugBelch("IND("); - printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee); + printPtr((StgPtr)((StgInd*)obj)->indirectee); debugBelch(")\n"); break; case IND_OLDGEN_PERM: debugBelch("IND_OLDGEN_PERM("); - printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee); + printPtr((StgPtr)((StgInd*)obj)->indirectee); debugBelch(")\n"); break; case IND_STATIC: debugBelch("IND_STATIC("); - printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee); + printPtr((StgPtr)((StgInd*)obj)->indirectee); debugBelch(")\n"); break; /* 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); + StgUpdateFrame* u = (StgUpdateFrame*)obj; debugBelch("UPDATE_FRAME("); printPtr((StgPtr)GET_INFO(u)); debugBelch(","); @@ -284,7 +272,7 @@ printClosure( StgClosure *obj ) case CATCH_FRAME: { - StgCatchFrame* u = stgCast(StgCatchFrame*,obj); + StgCatchFrame* u = (StgCatchFrame*)obj; debugBelch("CATCH_FRAME("); printPtr((StgPtr)GET_INFO(u)); debugBelch(","); @@ -295,7 +283,7 @@ printClosure( StgClosure *obj ) case STOP_FRAME: { - StgStopFrame* u = stgCast(StgStopFrame*,obj); + StgStopFrame* u = (StgStopFrame*)obj; debugBelch("STOP_FRAME("); printPtr((StgPtr)GET_INFO(u)); debugBelch(")\n"); @@ -310,14 +298,6 @@ printClosure( StgClosure *obj ) debugBelch("BH\n"); break; - case SE_BLACKHOLE: - debugBelch("SE_BH\n"); - break; - - case SE_CAF_BLACKHOLE: - debugBelch("SE_CAF_BH\n"); - break; - case ARR_WORDS: { StgWord i; @@ -344,7 +324,8 @@ printClosure( StgClosure *obj ) debugBelch("MUT_ARR_PTRS_FROZEN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs); break; - case MVAR: + case MVAR_CLEAN: + case MVAR_DIRTY: { StgMVar* mv = (StgMVar*)obj; debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value); @@ -385,37 +366,6 @@ printClosure( StgClosure *obj ) debugBelch(")\n"); break; -#if defined(PAR) - case BLOCKED_FETCH: - debugBelch("BLOCKED_FETCH("); - printGA(&(stgCast(StgBlockedFetch*,obj)->ga)); - printPtr((StgPtr)(stgCast(StgBlockedFetch*,obj)->node)); - debugBelch(")\n"); - break; - - case FETCH_ME: - debugBelch("FETCH_ME("); - printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga); - debugBelch(")\n"); - break; - - case FETCH_ME_BQ: - debugBelch("FETCH_ME_BQ("); - // printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga); - printPtr((StgPtr)stgCast(StgFetchMeBlockingQueue*,obj)->blocking_queue); - debugBelch(")\n"); - break; -#endif - -#if defined(GRAN) || defined(PAR) - case RBH: - debugBelch("RBH("); - printPtr((StgPtr)stgCast(StgRBH*,obj)->blocking_queue); - debugBelch(")\n"); - break; - -#endif - #if 0 /* Symptomatic of a problem elsewhere, have it fall-through & fail */ case EVACUATED: @@ -425,14 +375,6 @@ printClosure( StgClosure *obj ) break; #endif -#if defined(PAR) && defined(DIST) - case REMOTE_REF: - debugBelch("REMOTE_REF("); - printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga); - debugBelch(")\n"); - break; -#endif - default: //barf("printClosure %d",get_itbl(obj)->type); debugBelch("*** printClosure: unknown type %d ****\n", @@ -579,7 +521,6 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) } case RET_SMALL: - case RET_VEC_SMALL: debugBelch("RET_SMALL (%p)\n", info); bitmap = info->layout.bitmap; printSmallBitmap(spBottom, sp+1, @@ -598,7 +539,6 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) } case RET_BIG: - case RET_VEC_BIG: barf("todo"); case RET_FUN: @@ -643,105 +583,6 @@ void printTSO( StgTSO *tso ) printStackChunk( tso->sp, tso->stack+tso->stack_size); } -/* ----------------------------------------------------------------------------- - Closure types - - NOTE: must be kept in sync with the closure types in includes/ClosureTypes.h - -------------------------------------------------------------------------- */ - -static char *closure_type_names[] = { - "INVALID_OBJECT", - "CONSTR", - "CONSTR_1", - "CONSTR_0", - "CONSTR_2", - "CONSTR_1", - "CONSTR_0", - "CONSTR_INTLIKE", - "CONSTR_CHARLIKE", - "CONSTR_STATIC", - "CONSTR_NOCAF_STATIC", - "FUN", - "FUN_1_0", - "FUN_0_1", - "FUN_2_0", - "FUN_1_1", - "FUN_0", - "FUN_STATIC", - "THUNK", - "THUNK_1_0", - "THUNK_0_1", - "THUNK_2_0", - "THUNK_1_1", - "THUNK_0", - "THUNK_STATIC", - "THUNK_SELECTOR", - "BCO", - "AP_UPD", - "PAP", - "AP_STACK", - "IND", - "IND_OLDGEN", - "IND_PERM", - "IND_OLDGEN_PERM", - "IND_STATIC", - "RET_BCO", - "RET_SMALL", - "RET_VEC_SMALL", - "RET_BIG", - "RET_VEC_BIG", - "RET_DYN", - "RET_FUN", - "UPDATE_FRAME", - "CATCH_FRAME", - "STOP_FRAME", - "CAF_BLACKHOLE", - "BLACKHOLE", - "BLACKHOLE_BQ", - "SE_BLACKHOLE", - "SE_CAF_BLACKHOLE", - "MVAR", - "ARR_WORDS", - "MUT_ARR_PTRS_CLEAN", - "MUT_ARR_PTRS_DIRTY", - "MUT_ARR_PTRS_FROZEN", - "MUT_VAR_CLEAN", - "MUT_VAR_DIRTY", - "MUT_CONS", - "WEAK", - "FOREIGN", - "STABLE_NAME", - "TSO", - "BLOCKED_FETCH", - "FETCH_ME", - "FETCH_ME_BQ", - "RBH", - "EVACUATED", - "REMOTE_REF", - "TVAR_WAIT_QUEUE", - "TVAR", - "TREC_CHUNK", - "TREC_HEADER", - "ATOMICALLY_FRAME", - "CATCH_RETRY_FRAME" -}; - - -char * -info_type(StgClosure *closure){ - return closure_type_names[get_itbl(closure)->type]; -} - -char * -info_type_by_ip(StgInfoTable *ip){ - return closure_type_names[ip->type]; -} - -void -info_hdr_type(StgClosure *closure, char *res){ - strcpy(res,closure_type_names[get_itbl(closure)->type]); -} - /* -------------------------------------------------------------------------- * Address printing code * @@ -755,7 +596,7 @@ info_hdr_type(StgClosure *closure, char *res){ * ------------------------------------------------------------------------*/ struct entry { - nat value; + StgWord value; const char *name; }; @@ -777,7 +618,7 @@ static void prepare_table( void ) /* Could sort it... */ } -static void insert( unsigned value, const char *name ) +static void insert( StgWord value, const char *name ) { if ( table_size >= max_table_size ) { barf( "Symbol table overflow\n" ); @@ -789,9 +630,9 @@ static void insert( unsigned value, const char *name ) #endif #if 0 -static rtsBool lookup_name( char *name, unsigned *result ) +static rtsBool lookup_name( char *name, StgWord *result ) { - int i; + nat i; for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) { } if (i < table_size) { @@ -934,7 +775,7 @@ static void enZcode( char *in, char *out ) const char *lookupGHCName( void *addr ) { nat i; - for( i = 0; i < table_size && table[i].value != (unsigned) addr; ++i ) { + for( i = 0; i < table_size && table[i].value != (StgWord) addr; ++i ) { } if (i < table_size) { return table[i].name; @@ -1072,11 +913,37 @@ extern void DEBUG_LoadSymbols( char *name STG_UNUSED ) void findPtr(P_ p, int); /* keep gcc -Wall happy */ +int searched = 0; + +static int +findPtrBlocks (StgPtr p, bdescr *bd, StgPtr arr[], int arr_size, int i) +{ + StgPtr q, r; + for (; bd; bd = bd->link) { + searched++; + for (q = bd->start; q < bd->free; q++) { + if (UNTAG_CLOSURE((StgClosure*)*q) == (StgClosure *)p) { + if (i < arr_size) { + r = q; + while (HEAP_ALLOCED((StgPtr)*r) || !LOOKS_LIKE_INFO_PTR(*r) || (P_)*r == NULL) { + r--; + } + debugBelch("%p = ", r); + printClosure((StgClosure *)r); + arr[i++] = r; + } else { + return i; + } + } + } + } + return i; +} + void findPtr(P_ p, int follow) { nat s, g; - P_ q, r; bdescr *bd; #if defined(__GNUC__) const int arr_size = 1024; @@ -1085,27 +952,15 @@ findPtr(P_ p, int follow) #endif StgPtr arr[arr_size]; int i = 0; + searched = 0; for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (s = 0; s < generations[g].n_steps; s++) { bd = generations[g].steps[s].blocks; - for (; bd; bd = bd->link) { - for (q = bd->start; q < bd->free; q++) { - if (*q == (W_)p) { - if (i < arr_size) { - r = q; - while (!LOOKS_LIKE_INFO_PTR(*r) || (P_)*r == NULL) { - r--; - } - debugBelch("%p = ", r); - printClosure((StgClosure *)r); - arr[i++] = r; - } else { - return; - } - } - } - } + i = findPtrBlocks(p,bd,arr,arr_size,i); + bd = generations[g].steps[s].large_objects; + i = findPtrBlocks(p,bd,arr,arr_size,i); + if (i >= arr_size) return; } } if (follow && i == 1) { @@ -1114,6 +969,97 @@ findPtr(P_ p, int follow) } } +/* prettyPrintClosure() is for printing out a closure using the data constructor + names found in the info tables. Closures are printed in a fashion that resembles + their Haskell representation. Useful during debugging. + + Todo: support for more closure types, and support for non pointer fields in the + payload. +*/ + +void prettyPrintClosure_ (StgClosure *); + +void prettyPrintClosure (StgClosure *obj) +{ + prettyPrintClosure_ (obj); + debugBelch ("\n"); +} + +void prettyPrintClosure_ (StgClosure *obj) +{ + StgInfoTable *info; + StgConInfoTable *con_info; + + /* collapse any indirections */ + unsigned int type; + type = get_itbl(obj)->type; + + while (type == IND || + type == IND_STATIC || + type == IND_OLDGEN || + type == IND_PERM || + type == IND_OLDGEN_PERM) + { + obj = ((StgInd *)obj)->indirectee; + type = get_itbl(obj)->type; + } + + /* find the info table for this object */ + info = get_itbl(obj); + + /* determine what kind of object we have */ + switch (info->type) + { + /* full applications of data constructors */ + case CONSTR: + case CONSTR_1_0: + case CONSTR_0_1: + case CONSTR_1_1: + case CONSTR_0_2: + case CONSTR_2_0: + case CONSTR_STATIC: + case CONSTR_NOCAF_STATIC: + { + nat i; + char *descriptor; + + /* find the con_info for the constructor */ + con_info = get_con_itbl (obj); + + /* obtain the name of the constructor */ + descriptor = GET_CON_DESC(con_info); + + debugBelch ("(%s", descriptor); + + /* process the payload of the closure */ + /* we don't handle non pointers at the moment */ + for (i = 0; i < info->layout.payload.ptrs; i++) + { + debugBelch (" "); + prettyPrintClosure_ ((StgClosure *) obj->payload[i]); + } + debugBelch (")"); + break; + } + + /* if it isn't a constructor then just print the closure type */ + default: + { + debugBelch ("<%s>", info_type(obj)); + break; + } + } +} + +char *what_next_strs[] = { + [0] = "(unknown)", + [ThreadRunGHC] = "ThreadRunGHC", + [ThreadInterpret] = "ThreadInterpret", + [ThreadKilled] = "ThreadKilled", + [ThreadRelocated] = "ThreadRelocated", + [ThreadComplete] = "ThreadComplete" +}; + #else /* DEBUG */ void printPtr( StgPtr p ) { @@ -1124,4 +1070,96 @@ void printObj( StgClosure *obj ) { debugBelch("obj 0x%p (enable -DDEBUG for more info) " , obj ); } + + #endif /* DEBUG */ + +/* ----------------------------------------------------------------------------- + Closure types + + NOTE: must be kept in sync with the closure types in includes/ClosureTypes.h + -------------------------------------------------------------------------- */ + +char *closure_type_names[] = { + [INVALID_OBJECT] = "INVALID_OBJECT", + [CONSTR] = "CONSTR", + [CONSTR_1_0] = "CONSTR_1_0", + [CONSTR_0_1] = "CONSTR_0_1", + [CONSTR_2_0] = "CONSTR_2_0", + [CONSTR_1_1] = "CONSTR_1_1", + [CONSTR_0_2] = "CONSTR_0_2", + [CONSTR_STATIC] = "CONSTR_STATIC", + [CONSTR_NOCAF_STATIC] = "CONSTR_NOCAF_STATIC", + [FUN] = "FUN", + [FUN_1_0] = "FUN_1_0", + [FUN_0_1] = "FUN_0_1", + [FUN_2_0] = "FUN_2_0", + [FUN_1_1] = "FUN_1_1", + [FUN_0_2] = "FUN_0_2", + [FUN_STATIC] = "FUN_STATIC", + [THUNK] = "THUNK", + [THUNK_1_0] = "THUNK_1_0", + [THUNK_0_1] = "THUNK_0_1", + [THUNK_2_0] = "THUNK_2_0", + [THUNK_1_1] = "THUNK_1_1", + [THUNK_0_2] = "THUNK_0_2", + [THUNK_STATIC] = "THUNK_STATIC", + [THUNK_SELECTOR] = "THUNK_SELECTOR", + [BCO] = "BCO", + [AP] = "AP", + [PAP] = "PAP", + [AP_STACK] = "AP_STACK", + [IND] = "IND", + [IND_OLDGEN] = "IND_OLDGEN", + [IND_PERM] = "IND_PERM", + [IND_OLDGEN_PERM] = "IND_OLDGEN_PERM", + [IND_STATIC] = "IND_STATIC", + [RET_BCO] = "RET_BCO", + [RET_SMALL] = "RET_SMALL", + [RET_BIG] = "RET_BIG", + [RET_DYN] = "RET_DYN", + [RET_FUN] = "RET_FUN", + [UPDATE_FRAME] = "UPDATE_FRAME", + [CATCH_FRAME] = "CATCH_FRAME", + [STOP_FRAME] = "STOP_FRAME", + [CAF_BLACKHOLE] = "CAF_BLACKHOLE", + [BLACKHOLE] = "BLACKHOLE", + [MVAR_CLEAN] = "MVAR_CLEAN", + [MVAR_DIRTY] = "MVAR_DIRTY", + [ARR_WORDS] = "ARR_WORDS", + [MUT_ARR_PTRS_CLEAN] = "MUT_ARR_PTRS_CLEAN", + [MUT_ARR_PTRS_DIRTY] = "MUT_ARR_PTRS_DIRTY", + [MUT_ARR_PTRS_FROZEN0] = "MUT_ARR_PTRS_FROZEN0", + [MUT_ARR_PTRS_FROZEN] = "MUT_ARR_PTRS_FROZEN", + [MUT_VAR_CLEAN] = "MUT_VAR_CLEAN", + [MUT_VAR_DIRTY] = "MUT_VAR_DIRTY", + [WEAK] = "WEAK", + [STABLE_NAME] = "STABLE_NAME", + [TSO] = "TSO", + [TVAR_WATCH_QUEUE] = "TVAR_WATCH_QUEUE", + [INVARIANT_CHECK_QUEUE] = "INVARIANT_CHECK_QUEUE", + [ATOMIC_INVARIANT] = "ATOMIC_INVARIANT", + [TVAR] = "TVAR", + [TREC_CHUNK] = "TREC_CHUNK", + [TREC_HEADER] = "TREC_HEADER", + [ATOMICALLY_FRAME] = "ATOMICALLY_FRAME", + [CATCH_RETRY_FRAME] = "CATCH_RETRY_FRAME", + [CATCH_STM_FRAME] = "CATCH_STM_FRAME", + [WHITEHOLE] = "WHITEHOLE" +}; + +char * +info_type(StgClosure *closure){ + return closure_type_names[get_itbl(closure)->type]; +} + +char * +info_type_by_ip(StgInfoTable *ip){ + return closure_type_names[ip->type]; +} + +void +info_hdr_type(StgClosure *closure, char *res){ + strcpy(res,closure_type_names[get_itbl(closure)->type]); +} +