X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrinter.c;h=a9f087ba1ee106d05b9f30e424888040b85fc643;hb=91b07216be1cb09230b7d1b417899ddea8620ff3;hp=7074a434cb385f157414976be74f3ca5e9fd0a0f;hpb=95ca6bff6fc9918203173b442192d9298ef9757a;p=ghc-hetmet.git diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index 7074a43..a9f087b 100644 --- a/ghc/rts/Printer.c +++ b/ghc/rts/Printer.c @@ -1,5 +1,4 @@ /* ----------------------------------------------------------------------------- - * $Id: Printer.c,v 1.64 2004/09/03 15:28:35 simonmar Exp $ * * (c) The GHC Team, 1994-2000. * @@ -34,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 ); @@ -98,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 @@ -123,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); @@ -164,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; @@ -181,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) { @@ -291,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; @@ -323,39 +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_DIRTY: + debugBelch("MUT_ARR_PTRS_DIRTY(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); + debugBelch("MUT_ARR_PTRS_FROZEN(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 MVAR: + { + StgMVar* mv = (StgMVar*)obj; + debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value); + break; + } - case MUT_VAR: + case MUT_VAR_CLEAN: { StgMutVar* mv = (StgMutVar*)obj; - debugBelch("MUT_VAR(var=%p, link=%p)\n", mv->var, mv->mut_link); + debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var); + break; + } + + case MUT_VAR_DIRTY: + { + StgMutVar* mv = (StgMutVar*)obj; + debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var); break; } @@ -369,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: @@ -493,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]); } } } @@ -514,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]); } } } @@ -611,13 +611,13 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) 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)); + BITMAP_BITS(fun_info->f.b.bitmap), + BITMAP_SIZE(fun_info->f.b.bitmap)); break; case ARG_GEN_BIG: printLargeBitmap(spBottom, sp+2, - (StgLargeBitmap *)fun_info->f.bitmap, - BITMAP_SIZE(fun_info->f.bitmap)); + GET_FUN_LARGE_BITMAP(fun_info), + GET_FUN_LARGE_BITMAP(fun_info)->size); break; default: printSmallBitmap(spBottom, sp+1, @@ -699,9 +699,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", @@ -712,7 +714,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" }; @@ -1077,11 +1085,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) {