/* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.57 2003/03/25 17:58:48 sof Exp $
+ * $Id: Printer.c,v 1.63 2004/08/13 13:10:23 simonmar Exp $
*
* (c) The GHC Team, 1994-2000.
*
#include "Storage.h"
#include "Bytecodes.h" /* for InstrPtr */
#include "Disassembler.h"
+#include "Apply.h"
#include <stdlib.h>
#include <string.h>
#if defined(GRAN) || defined(PAR)
// HWL: explicit fixed header size to make debugging easier
-int fixed_hs = FIXED_HS, itbl_sz = sizeofW(StgInfoTable),
+int fixed_hs = sizeof(StgHeader), itbl_sz = sizeofW(StgInfoTable),
uf_sz=sizeofW(StgUpdateFrame);
#endif
printClosure(obj);
}
-static inline void
+STATIC_INLINE void
printStdObjHdr( StgClosure *obj, char* tag )
{
fprintf(stderr,"%s(",tag);
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)->f.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);
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(");
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(");
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;
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:
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);
fprintf(stderr,")\n");
break;
#endif
+
#if defined(GRAN) || defined(PAR)
case RBH:
fprintf(stderr,"RBH(");
#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",
StgClosure* c = (StgClosure*)(*sp);
printPtr((StgPtr)*sp);
- if (c == (StgClosure*)&stg_ctoi_ret_R1p_info) {
+ if (c == (StgClosure*)&stg_ctoi_R1p_info) {
fprintf(stderr, "\t\t\tstg_ctoi_ret_R1p_info\n" );
} else
- if (c == (StgClosure*)&stg_ctoi_ret_R1n_info) {
+ if (c == (StgClosure*)&stg_ctoi_R1n_info) {
fprintf(stderr, "\t\t\tstg_ctoi_ret_R1n_info\n" );
} else
- if (c == (StgClosure*)&stg_ctoi_ret_F1_info) {
+ if (c == (StgClosure*)&stg_ctoi_F1_info) {
fprintf(stderr, "\t\t\tstg_ctoi_ret_F1_info\n" );
} else
- if (c == (StgClosure*)&stg_ctoi_ret_D1_info) {
+ if (c == (StgClosure*)&stg_ctoi_D1_info) {
fprintf(stderr, "\t\t\tstg_ctoi_ret_D1_info\n" );
} else
- if (c == (StgClosure*)&stg_ctoi_ret_V_info) {
+ if (c == (StgClosure*)&stg_ctoi_V_info) {
fprintf(stderr, "\t\t\tstg_ctoi_ret_V_info\n" );
} else
if (get_itbl(c)->type == BCO) {
p = (P_)(r->payload);
printSmallBitmap(spBottom, sp,
- GET_LIVENESS(r->liveness), RET_DYN_SIZE);
- p += RET_DYN_SIZE;
+ RET_DYN_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);
+ for (size = RET_DYN_NONPTRS(dyn); size > 0; size--) {
+ 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);
+ for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
+ fprintf(stderr," stk[%ld] (%p) = ", (long)(spBottom-p), p);
printPtr(p);
p++;
}
case RET_VEC_BIG:
barf("todo");
+ case RET_FUN:
+ {
+ StgFunInfoTable *fun_info;
+ StgRetFun *ret_fun;
+ nat size;
+
+ ret_fun = (StgRetFun *)sp;
+ fun_info = get_fun_itbl(ret_fun->fun);
+ size = ret_fun->size;
+ fprintf(stderr,"RET_FUN (%p) (type=%d)\n", ret_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));
+ break;
+ case ARG_GEN_BIG:
+ printLargeBitmap(spBottom, sp+2,
+ (StgLargeBitmap *)fun_info->f.bitmap,
+ BITMAP_SIZE(fun_info->f.bitmap));
+ break;
+ default:
+ printSmallBitmap(spBottom, sp+1,
+ BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
+ BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
+ break;
+ }
+ continue;
+ }
+
default:
+ fprintf(stderr, "unknown object %d\n", info->type);
barf("printStackChunk");
}
}
"BCO",
"AP_UPD",
"PAP",
+ "AP_STACK",
"IND",
"IND_OLDGEN",
"IND_PERM",
#endif /* HAVE_BFD_H */
-#include "StoragePriv.h"
-
void findPtr(P_ p, int); /* keep gcc -Wall happy */
void
nat s, g;
P_ q, r;
bdescr *bd;
+#if defined(__GNUC__)
const int arr_size = 1024;
+#else
+#define arr_size 1024
+#endif
StgPtr arr[arr_size];
int i = 0;
projects / ghc-hetmet.git / blobdiff