X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrinter.c;h=8290d220a0b0498373ec5ec47e4b370f2b09bcd4;hb=c56641e7752db313effe332b81f9e56275342fbd;hp=9e8d09043c69e3a85c06fad362168ba054c33ac0;hpb=b4d045ae655e5eae25b88917cfe75d7dc7689c21;p=ghc-hetmet.git diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index 9e8d090..8290d22 100644 --- 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,46 +327,41 @@ printClosure( StgClosure *obj ) putchar(arrWordsGetChar(obj,i)); } */ for (i=0; i<((StgArrWords *)obj)->words; i++) - debugBelch("%u", ((StgArrWords *)obj)->payload[i]); + debugBelch("%lu", (lnat)((StgArrWords *)obj)->payload[i]); debugBelch("\")\n"); break; } - case MUT_ARR_PTRS: - debugBelch("MUT_ARR_PTRS(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs); + case MUT_ARR_PTRS_CLEAN: + debugBelch("MUT_ARR_PTRS_CLEAN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs); break; - case MUT_ARR_PTRS_FROZEN: -#if !defined(XMLAMBDA) - debugBelch("MUT_ARR_PTRS_FROZEN(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs); + case MUT_ARR_PTRS_DIRTY: + debugBelch("MUT_ARR_PTRS_DIRTY(size=%lu)\n", (lnat)((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); - debugBelch("Row<%i>(",p->ptrs); - for (i = 0; i < p->ptrs; ++i) { - if (i > 0) debugBelch(", "); - printPtr((StgPtr)(p->payload[i])); - } - debugBelch(")\n"); - break; - } -#endif + case MUT_ARR_PTRS_FROZEN: + debugBelch("MUT_ARR_PTRS_FROZEN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs); + break; 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_CLEAN: + { + StgMutVar* mv = (StgMutVar*)obj; + debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var); break; } - case MUT_VAR: + case MUT_VAR_DIRTY: { StgMutVar* mv = (StgMutVar*)obj; - debugBelch("MUT_VAR(var=%p, link=%p)\n", mv->var, mv->mut_link); + debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var); break; } @@ -375,14 +375,8 @@ printClosure( StgClosure *obj ) /* ToDo: chase 'link' ? */ break; - case FOREIGN: - debugBelch("FOREIGN("); - printPtr((StgPtr)( ((StgForeignObj*)obj)->data )); - debugBelch(")\n"); - break; - case STABLE_NAME: - debugBelch("STABLE_NAME(%d)\n", ((StgStableName*)obj)->sn); + debugBelch("STABLE_NAME(%lu)\n", (lnat)((StgStableName*)obj)->sn); break; case TSO: @@ -499,12 +493,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) = ", (long)(spBottom-(payload+i)), payload+i); if ((bitmap & 1) == 0) { printPtr((P_)payload[i]); debugBelch("\n"); } else { - debugBelch("Word# %d\n", payload[i]); + debugBelch("Word# %lu\n", (lnat)payload[i]); } } } @@ -520,12 +514,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[%lu] (%p) = ", (lnat)(spBottom-(payload+i)), payload+i); if ((bitmap & 1) == 0) { printPtr((P_)payload[i]); debugBelch("\n"); } else { - debugBelch("Word# %d\n", payload[i]); + debugBelch("Word# %lu\n", (lnat)payload[i]); } } } @@ -546,10 +540,13 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) case UPDATE_FRAME: case CATCH_FRAME: - case STOP_FRAME: printObj((StgClosure*)sp); continue; + case STOP_FRAME: + printObj((StgClosure*)sp); + return; + case RET_DYN: { StgRetDyn* r; @@ -583,7 +580,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) case RET_SMALL: case RET_VEC_SMALL: - debugBelch("RET_SMALL (%p)\n", sp); + debugBelch("RET_SMALL (%p)\n", info); bitmap = info->layout.bitmap; printSmallBitmap(spBottom, sp+1, BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap)); @@ -613,12 +610,12 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) ret_fun = (StgRetFun *)sp; fun_info = get_fun_itbl(ret_fun->fun); size = ret_fun->size; - debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun, fun_info->f.fun_type); + debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, fun_info->f.fun_type); 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)); + printSmallBitmap(spBottom, sp+2, + BITMAP_BITS(fun_info->f.b.bitmap), + BITMAP_SIZE(fun_info->f.b.bitmap)); break; case ARG_GEN_BIG: printLargeBitmap(spBottom, sp+2, @@ -626,7 +623,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) GET_FUN_LARGE_BITMAP(fun_info)->size); break; default: - printSmallBitmap(spBottom, sp+1, + printSmallBitmap(spBottom, sp+2, BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]), BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type])); break; @@ -705,9 +702,11 @@ static char *closure_type_names[] = { "SE_CAF_BLACKHOLE", "MVAR", "ARR_WORDS", - "MUT_ARR_PTRS", + "MUT_ARR_PTRS_CLEAN", + "MUT_ARR_PTRS_DIRTY", "MUT_ARR_PTRS_FROZEN", - "MUT_VAR", + "MUT_VAR_CLEAN", + "MUT_VAR_DIRTY", "MUT_CONS", "WEAK", "FOREIGN", @@ -718,7 +717,13 @@ static char *closure_type_names[] = { "FETCH_ME_BQ", "RBH", "EVACUATED", - "REMOTE_REF" + "REMOTE_REF", + "TVAR_WAIT_QUEUE", + "TVAR", + "TREC_CHUNK", + "TREC_HEADER", + "ATOMICALLY_FRAME", + "CATCH_RETRY_FRAME" }; @@ -1083,11 +1088,7 @@ findPtr(P_ p, int follow) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (s = 0; s < generations[g].n_steps; s++) { - if (RtsFlags.GcFlags.generations == 1) { - bd = generations[g].steps[s].to_blocks; - } else { - bd = generations[g].steps[s].blocks; - } + bd = generations[g].steps[s].blocks; for (; bd; bd = bd->link) { for (q = bd->start; q < bd->free; q++) { if (*q == (W_)p) {