/* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.59 2003/04/22 16:25:12 simonmar Exp $
*
* (c) The GHC Team, 1994-2000.
*
#include "PosixSource.h"
#include "Rts.h"
#include "Printer.h"
-
-#include <stdio.h>
+#include "RtsUtils.h"
#ifdef DEBUG
-#include "RtsUtils.h"
#include "RtsFlags.h"
#include "MBlock.h"
#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
* local function decls
* ------------------------------------------------------------------------*/
-static void printStdObject( StgClosure *obj, char* tag );
static void printStdObjPayload( StgClosure *obj );
#ifdef USING_LIBBFD
static void reset_table ( int size );
if (raw != NULL) {
printZcoded(raw);
} else {
- fprintf(stderr, "%p", p);
+ debugBelch("%p", p);
}
}
void printObj( StgClosure *obj )
{
- fprintf(stderr,"Object "); printPtr((StgPtr)obj); fprintf(stderr," = ");
+ debugBelch("Object "); printPtr((StgPtr)obj); debugBelch(" = ");
printClosure(obj);
}
-static inline void
+STATIC_INLINE void
printStdObjHdr( StgClosure *obj, char* tag )
{
- fprintf(stderr,"%s(",tag);
+ debugBelch("%s(",tag);
printPtr((StgPtr)obj->header.info);
#ifdef PROFILING
- fprintf(stderr,", %s", obj->header.prof.ccs->cc->label);
+ debugBelch(", %s", obj->header.prof.ccs->cc->label);
#endif
}
info = get_itbl(obj);
for (i = 0; i < info->layout.payload.ptrs; ++i) {
- fprintf(stderr,", ");
+ debugBelch(", ");
printPtr((StgPtr)obj->payload[i]);
}
for (j = 0; j < info->layout.payload.nptrs; ++j) {
- fprintf(stderr,", %pd#",obj->payload[i+j]);
+ debugBelch(", %pd#",obj->payload[i+j]);
}
- fprintf(stderr,")\n");
+ debugBelch(")\n");
}
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
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);
+ debugBelch("%s(", info->prof.closure_desc);
+ debugBelch("%s", obj->header.prof.ccs->cc->label);
#else
- fprintf(stderr,"CONSTR(");
+ debugBelch("CONSTR(");
printPtr((StgPtr)obj->header.info);
- fprintf(stderr,"(tag=%d)",info->srt_len);
+ debugBelch("(tag=%d)",info->srt_bitmap);
#endif
for (i = 0; i < info->layout.payload.ptrs; ++i) {
- fprintf(stderr,", ");
+ debugBelch(", ");
printPtr((StgPtr)obj->payload[i]);
}
for (j = 0; j < info->layout.payload.nptrs; ++j) {
- fprintf(stderr,", %p#", obj->payload[i+j]);
+ debugBelch(", %p#", obj->payload[i+j]);
}
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
}
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);
+ debugBelch("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);
+ debugBelch(", %s", obj->header.prof.ccs->cc->label);
#endif
printStdObjPayload(obj);
break;
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;
case THUNK_SELECTOR:
printStdObjHdr(obj, "THUNK_SELECTOR");
- fprintf(stderr, ", %p)\n", ((StgSelector *)obj)->selectee);
+ debugBelch(", %p)\n", ((StgSelector *)obj)->selectee);
break;
case BCO:
case AP:
{
- StgPAP* ap = stgCast(StgPAP*,obj);
+ StgAP* ap = stgCast(StgAP*,obj);
StgWord i;
- fprintf(stderr,"AP("); printPtr((StgPtr)ap->fun);
+ debugBelch("AP("); printPtr((StgPtr)ap->fun);
for (i = 0; i < ap->n_args; ++i) {
- fprintf(stderr,", ");
+ debugBelch(", ");
printPtr((P_)ap->payload[i]);
}
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
}
{
StgPAP* pap = stgCast(StgPAP*,obj);
StgWord i;
- fprintf(stderr,"PAP/%d(",pap->arity);
+ debugBelch("PAP/%d(",pap->arity);
printPtr((StgPtr)pap->fun);
for (i = 0; i < pap->n_args; ++i) {
- fprintf(stderr,", ");
+ debugBelch(", ");
printPtr((StgPtr)pap->payload[i]);
}
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
}
{
StgAP_STACK* ap = stgCast(StgAP_STACK*,obj);
StgWord i;
- fprintf(stderr,"AP_STACK("); printPtr((StgPtr)ap->fun);
+ debugBelch("AP_STACK("); printPtr((StgPtr)ap->fun);
for (i = 0; i < ap->size; ++i) {
- fprintf(stderr,", ");
+ debugBelch(", ");
printPtr((P_)ap->payload[i]);
}
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
}
case IND:
- fprintf(stderr,"IND(");
+ debugBelch("IND(");
printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
case IND_OLDGEN:
- fprintf(stderr,"IND_OLDGEN(");
+ debugBelch("IND_OLDGEN(");
printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
case IND_PERM:
- fprintf(stderr,"IND(");
+ debugBelch("IND(");
printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
case IND_OLDGEN_PERM:
- fprintf(stderr,"IND_OLDGEN_PERM(");
+ debugBelch("IND_OLDGEN_PERM(");
printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
case IND_STATIC:
- fprintf(stderr,"IND_STATIC(");
+ debugBelch("IND_STATIC(");
printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
/* Cannot happen -- use default case.
case UPDATE_FRAME:
{
StgUpdateFrame* u = stgCast(StgUpdateFrame*,obj);
- fprintf(stderr,"UPDATE_FRAME(");
+ debugBelch("UPDATE_FRAME(");
printPtr((StgPtr)GET_INFO(u));
- fprintf(stderr,",");
+ debugBelch(",");
printPtr((StgPtr)u->updatee);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
}
case CATCH_FRAME:
{
StgCatchFrame* u = stgCast(StgCatchFrame*,obj);
- fprintf(stderr,"CATCH_FRAME(");
+ debugBelch("CATCH_FRAME(");
printPtr((StgPtr)GET_INFO(u));
- fprintf(stderr,",");
+ debugBelch(",");
printPtr((StgPtr)u->handler);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
}
case STOP_FRAME:
{
StgStopFrame* u = stgCast(StgStopFrame*,obj);
- fprintf(stderr,"STOP_FRAME(");
+ debugBelch("STOP_FRAME(");
printPtr((StgPtr)GET_INFO(u));
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
}
case CAF_BLACKHOLE:
- fprintf(stderr,"CAF_BH(");
- printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
- fprintf(stderr,")\n");
+ debugBelch("CAF_BH");
break;
case BLACKHOLE:
- fprintf(stderr,"BH\n");
- break;
-
- case BLACKHOLE_BQ:
- fprintf(stderr,"BQ(");
- printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
- fprintf(stderr,")\n");
+ debugBelch("BH\n");
break;
case SE_BLACKHOLE:
- fprintf(stderr,"SE_BH\n");
+ debugBelch("SE_BH\n");
break;
case SE_CAF_BLACKHOLE:
- fprintf(stderr,"SE_CAF_BH\n");
+ debugBelch("SE_CAF_BH\n");
break;
case ARR_WORDS:
{
StgWord i;
- fprintf(stderr,"ARR_WORDS(\"");
+ debugBelch("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");
+ debugBelch("%lu", (lnat)((StgArrWords *)obj)->payload[i]);
+ debugBelch("\")\n");
break;
}
- case MUT_ARR_PTRS:
- fprintf(stderr,"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)
- fprintf(stderr,"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);
- 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 MVAR:
+ {
+ StgMVar* mv = (StgMVar*)obj;
+ debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value);
+ break;
+ }
case MUT_VAR:
{
StgMutVar* mv = (StgMutVar*)obj;
- fprintf(stderr,"MUT_VAR(var=%p, link=%p)\n", mv->var, mv->mut_link);
+ debugBelch("MUT_VAR(var=%p)\n", mv->var);
break;
}
case WEAK:
- fprintf(stderr,"WEAK(");
- fprintf(stderr," key=%p value=%p finalizer=%p",
+ debugBelch("WEAK(");
+ debugBelch(" key=%p value=%p finalizer=%p",
(StgPtr)(((StgWeak*)obj)->key),
(StgPtr)(((StgWeak*)obj)->value),
(StgPtr)(((StgWeak*)obj)->finalizer));
- fprintf(stderr,")\n");
+ debugBelch(")\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);
+ debugBelch("STABLE_NAME(%lu)\n", (lnat)((StgStableName*)obj)->sn);
break;
case TSO:
- fprintf(stderr,"TSO(");
- fprintf(stderr,"%d (%p)",((StgTSO*)obj)->id, (StgTSO*)obj);
- fprintf(stderr,")\n");
+ debugBelch("TSO(");
+ debugBelch("%d (%p)",((StgTSO*)obj)->id, (StgTSO*)obj);
+ debugBelch(")\n");
break;
#if defined(PAR)
case BLOCKED_FETCH:
- fprintf(stderr,"BLOCKED_FETCH(");
+ debugBelch("BLOCKED_FETCH(");
printGA(&(stgCast(StgBlockedFetch*,obj)->ga));
printPtr((StgPtr)(stgCast(StgBlockedFetch*,obj)->node));
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
case FETCH_ME:
- fprintf(stderr,"FETCH_ME(");
+ debugBelch("FETCH_ME(");
printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
case FETCH_ME_BQ:
- fprintf(stderr,"FETCH_ME_BQ(");
+ debugBelch("FETCH_ME_BQ(");
// printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
printPtr((StgPtr)stgCast(StgFetchMeBlockingQueue*,obj)->blocking_queue);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
#endif
#if defined(GRAN) || defined(PAR)
case RBH:
- fprintf(stderr,"RBH(");
+ debugBelch("RBH(");
printPtr((StgPtr)stgCast(StgRBH*,obj)->blocking_queue);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
#endif
#if 0
/* Symptomatic of a problem elsewhere, have it fall-through & fail */
case EVACUATED:
- fprintf(stderr,"EVACUATED(");
+ debugBelch("EVACUATED(");
printClosure((StgEvacuated*)obj->evacuee);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
#endif
#if defined(PAR) && defined(DIST)
case REMOTE_REF:
- fprintf(stderr,"REMOTE_REF(");
+ debugBelch("REMOTE_REF(");
printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
#endif
default:
//barf("printClosure %d",get_itbl(obj)->type);
- fprintf(stderr, "*** printClosure: unknown type %d ****\n",
+ debugBelch("*** printClosure: unknown type %d ****\n",
get_itbl(obj)->type );
barf("printClosure %d",get_itbl(obj)->type);
return;
StgPtr
printStackObj( StgPtr sp )
{
- /*fprintf(stderr,"Stack[%d] = ", &stgStack[STACK_SIZE] - sp); */
+ /*debugBelch("Stack[%d] = ", &stgStack[STACK_SIZE] - sp); */
StgClosure* c = (StgClosure*)(*sp);
printPtr((StgPtr)*sp);
- if (c == (StgClosure*)&stg_ctoi_ret_R1p_info) {
- fprintf(stderr, "\t\t\tstg_ctoi_ret_R1p_info\n" );
+ if (c == (StgClosure*)&stg_ctoi_R1p_info) {
+ debugBelch("\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" );
+ if (c == (StgClosure*)&stg_ctoi_R1n_info) {
+ debugBelch("\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" );
+ if (c == (StgClosure*)&stg_ctoi_F1_info) {
+ debugBelch("\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" );
+ if (c == (StgClosure*)&stg_ctoi_D1_info) {
+ debugBelch("\t\t\tstg_ctoi_ret_D1_info\n" );
} else
- if (c == (StgClosure*)&stg_ctoi_ret_V_info) {
- fprintf(stderr, "\t\t\tstg_ctoi_ret_V_info\n" );
+ if (c == (StgClosure*)&stg_ctoi_V_info) {
+ debugBelch("\t\t\tstg_ctoi_ret_V_info\n" );
} else
if (get_itbl(c)->type == BCO) {
- fprintf(stderr, "\t\t\t");
- fprintf(stderr, "BCO(...)\n");
+ debugBelch("\t\t\t");
+ debugBelch("BCO(...)\n");
}
else {
- fprintf(stderr, "\t\t\t");
+ debugBelch("\t\t\t");
printClosure ( (StgClosure*)(*sp));
}
sp += 1;
p = payload;
for(i = 0; i < size; i++, bitmap >>= 1 ) {
- fprintf(stderr," 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]);
- fprintf(stderr,"\n");
+ debugBelch("\n");
} else {
- fprintf(stderr,"Word# %d\n", payload[i]);
+ debugBelch("Word# %lu\n", (lnat)payload[i]);
}
}
}
StgWord bitmap = large_bitmap->bitmap[bmp];
j = 0;
for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
- fprintf(stderr," 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]);
- fprintf(stderr,"\n");
+ debugBelch("\n");
} else {
- fprintf(stderr,"Word# %d\n", payload[i]);
+ debugBelch("Word# %lu\n", (lnat)payload[i]);
}
}
}
r = (StgRetDyn *)sp;
dyn = r->liveness;
- fprintf(stderr, "RET_DYN (%p)\n", r);
+ debugBelch("RET_DYN (%p)\n", r);
p = (P_)(r->payload);
printSmallBitmap(spBottom, sp,
- GET_LIVENESS(r->liveness), RET_DYN_BITMAP_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) = ", (long)(spBottom-p), p);
- fprintf(stderr,"Word# %ld\n", (long)*p);
+ for (size = RET_DYN_NONPTRS(dyn); size > 0; size--) {
+ debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-p), p);
+ debugBelch("Word# %ld\n", (long)*p);
p++;
}
- for (size = GET_PTRS(dyn); size > 0; size--) {
- fprintf(stderr," stk[%ld] (%p) = ", (long)(spBottom-p), p);
+ for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
+ debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-p), p);
printPtr(p);
p++;
}
case RET_SMALL:
case RET_VEC_SMALL:
- fprintf(stderr, "RET_SMALL (%p)\n", sp);
+ debugBelch("RET_SMALL (%p)\n", sp);
bitmap = info->layout.bitmap;
printSmallBitmap(spBottom, sp+1,
BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
bco = ((StgBCO *)sp[1]);
- fprintf(stderr, "RET_BCO (%p)\n", sp);
+ debugBelch("RET_BCO (%p)\n", sp);
printLargeBitmap(spBottom, sp+2,
BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
continue;
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;
+ debugBelch("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.b.bitmap),
+ BITMAP_SIZE(fun_info->f.b.bitmap));
+ break;
+ case ARG_GEN_BIG:
+ printLargeBitmap(spBottom, sp+2,
+ GET_FUN_LARGE_BITMAP(fun_info),
+ GET_FUN_LARGE_BITMAP(fun_info)->size);
+ 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:
+ debugBelch("unknown object %d\n", info->type);
barf("printStackChunk");
}
}
"FETCH_ME_BQ",
"RBH",
"EVACUATED",
- "REMOTE_REF"
+ "REMOTE_REF",
+ "TVAR_WAIT_QUEUE",
+ "TVAR",
+ "TREC_CHUNK",
+ "TREC_HEADER",
+ "ATOMICALLY_FRAME",
+ "CATCH_RETRY_FRAME"
};
while ( raw[j] != '\0' ) {
if (raw[j] == 'Z') {
- fputc(unZcode(raw[j+1]),stderr);
+ debugBelch("%c", unZcode(raw[j+1]));
j = j + 2;
} else {
- fputc(raw[j],stderr);
+ debugBelch("%c", unZcode(raw[j+1]));
j = j + 1;
}
}
}
#if 0
if (storage_needed == 0) {
- belch("no storage needed");
+ debugBelch("no storage needed");
}
#endif
symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
for( i = 0; i != number_of_symbols; ++i ) {
symbol_info info;
bfd_get_symbol_info(abfd,symbol_table[i],&info);
- /*fprintf(stderr,"\t%c\t0x%x \t%s\n",info.type,(nat)info.value,info.name); */
+ /*debugBelch("\t%c\t0x%x \t%s\n",info.type,(nat)info.value,info.name); */
if (isReal(info.type, info.name)) {
num_real_syms += 1;
}
}
IF_DEBUG(interpreter,
- fprintf(stderr,"Loaded %ld symbols. Of which %ld are real symbols\n",
+ debugBelch("Loaded %ld symbols. Of which %ld are real symbols\n",
number_of_symbols, num_real_syms)
);
#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;
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) {
while (!LOOKS_LIKE_INFO_PTR(*r) || (P_)*r == NULL) {
r--;
}
- fprintf(stderr, "%p = ", r);
+ debugBelch("%p = ", r);
printClosure((StgClosure *)r);
arr[i++] = r;
} else {
}
}
if (follow && i == 1) {
- fprintf(stderr, "-->\n");
+ debugBelch("-->\n");
findPtr(arr[0], 1);
}
}
#else /* DEBUG */
void printPtr( StgPtr p )
{
- fprintf(stderr, "ptr 0x%p (enable -DDEBUG for more info) " , p );
+ debugBelch("ptr 0x%p (enable -DDEBUG for more info) " , p );
}
void printObj( StgClosure *obj )
{
- fprintf(stderr, "obj 0x%p (enable -DDEBUG for more info) " , obj );
+ debugBelch("obj 0x%p (enable -DDEBUG for more info) " , obj );
}
#endif /* DEBUG */
projects / ghc-hetmet.git / blobdiff