Commit 95ca6bff authored by simonmar's avatar simonmar

[project @ 2004-09-03 15:28:18 by simonmar]

Cleanup: all (well, most) messages from the RTS now go through the
functions in RtsUtils: barf(), debugBelch() and errorBelch().  The
latter two were previously called belch() and prog_belch()
respectively.  See the comments for the right usage of these message
functions.

One reason for doing this is so that we can avoid spurious uses of
stdout/stderr by Haskell apps on platforms where we shouldn't be using
them (eg. non-console apps on Windows).
parent aa07427a
......@@ -501,7 +501,7 @@ freeHaskellFunctionPtr(void* ptr)
#if defined(i386_TARGET_ARCH)
if ( *(unsigned char*)ptr != 0x68 &&
*(unsigned char*)ptr != 0x58 ) {
prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
return;
}
......@@ -513,7 +513,7 @@ freeHaskellFunctionPtr(void* ptr)
}
#elif defined(sparc_TARGET_ARCH)
if ( *(unsigned long*)ptr != 0x9C23A008UL ) {
prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
return;
}
......@@ -521,7 +521,7 @@ freeHaskellFunctionPtr(void* ptr)
freeStablePtr(*((StgStablePtr*)((unsigned long*)ptr + 11)));
#elif defined(alpha_TARGET_ARCH)
if ( *(StgWord64*)ptr != 0xa77b0018a61b0010L ) {
prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
return;
}
......@@ -529,7 +529,7 @@ freeHaskellFunctionPtr(void* ptr)
freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
#elif defined(powerpc_TARGET_ARCH)
if ( *(StgWord*)ptr != 0x7d0a4378 ) {
prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
return;
}
freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 4*12)));
......@@ -538,7 +538,7 @@ freeHaskellFunctionPtr(void* ptr)
StgWord64 *code = (StgWord64 *)(fdesc+1);
if (fdesc->ip != (StgWord64)code) {
prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
return;
}
freeStablePtr((StgStablePtr)code[16]);
......
/* -----------------------------------------------------------------------------
* $Id: BlockAlloc.c,v 1.17 2003/11/12 17:49:05 sof Exp $
* $Id: BlockAlloc.c,v 1.18 2004/09/03 15:28:19 simonmar Exp $
*
* (c) The GHC Team 1998-2000
*
......@@ -325,8 +325,8 @@ checkFreeListSanity(void)
for (bd = free_list; bd != NULL; bd = bd->link) {
IF_DEBUG(block_alloc,
fprintf(stderr,"group at 0x%x, length %d blocks\n",
(nat)bd->start, bd->blocks));
debugBelch("group at 0x%x, length %d blocks\n",
(nat)bd->start, bd->blocks));
ASSERT(bd->blocks > 0);
checkWellFormedGroup(bd);
if (bd->link != NULL) {
......
This diff is collapsed.
/* -----------------------------------------------------------------------------
* $Id: FrontPanel.c,v 1.9 2004/08/13 13:09:49 simonmar Exp $
* $Id: FrontPanel.c,v 1.10 2004/09/03 15:28:20 simonmar Exp $
*
* (c) The GHC Team 2000
*
......@@ -102,7 +102,7 @@ configure_event( GtkWidget *widget, GdkEventConfigure *event STG_UNUSED,
widget->allocation.width,
widget->allocation.height);
fprintf(stderr, "configure!\n");
debugBelch("configure!\n");
updateFrontPanel();
return TRUE;
}
......
/* -----------------------------------------------------------------------------
* $Id: GC.c,v 1.168 2004/08/13 13:09:49 simonmar Exp $
* $Id: GC.c,v 1.169 2004/09/03 15:28:20 simonmar Exp $
*
* (c) The GHC Team 1998-2003
*
......@@ -307,7 +307,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
#endif
#if defined(DEBUG) && defined(GRAN)
IF_DEBUG(gc, belch("@@ Starting garbage collection at %ld (%lx)\n",
IF_DEBUG(gc, debugBelch("@@ Starting garbage collection at %ld (%lx)\n",
Now, Now));
#endif
......@@ -440,7 +440,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
stp->bitmap = bitmap_bdescr;
bitmap = bitmap_bdescr->start;
IF_DEBUG(gc, belch("bitmap_size: %d, bitmap: %p",
IF_DEBUG(gc, debugBelch("bitmap_size: %d, bitmap: %p",
bitmap_size, bitmap););
// don't forget to fill it with zeros!
......@@ -851,10 +851,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
oldest_gen->steps[0].n_blocks >
(RtsFlags.GcFlags.compactThreshold * max) / 100))) {
oldest_gen->steps[0].is_compacted = 1;
// fprintf(stderr,"compaction: on\n", live);
// debugBelch("compaction: on\n", live);
} else {
oldest_gen->steps[0].is_compacted = 0;
// fprintf(stderr,"compaction: off\n", live);
// debugBelch("compaction: off\n", live);
}
// if we're going to go over the maximum heap size, reduce the
......@@ -886,7 +886,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
}
#if 0
fprintf(stderr,"live: %d, min_alloc: %d, size : %d, max = %d\n", live,
debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live,
min_alloc, size, max);
#endif
......@@ -968,7 +968,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
int pc_free;
adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
IF_DEBUG(gc, belch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks));
IF_DEBUG(gc, debugBelch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks));
pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ {
heapOverflow();
......@@ -1196,7 +1196,7 @@ traverse_weak_ptr_list(void)
w->link = weak_ptr_list;
weak_ptr_list = w;
flag = rtsTrue;
IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p",
IF_DEBUG(weak, debugBelch("Weak pointer still alive at %p -> %p",
w, w->key));
continue;
}
......@@ -1958,7 +1958,7 @@ loop:
//ToDo: derive size etc from reverted IP
//to = copy(q,size,stp);
IF_DEBUG(gc,
belch("@@ evacuate: RBH %p (%s) to %p (%s)",
debugBelch("@@ evacuate: RBH %p (%s) to %p (%s)",
q, info_type(q), to, info_type(to)));
return to;
}
......@@ -1967,7 +1967,7 @@ loop:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE);
to = copy(q,sizeofW(StgBlockedFetch),stp);
IF_DEBUG(gc,
belch("@@ evacuate: %p (%s) to %p (%s)",
debugBelch("@@ evacuate: %p (%s) to %p (%s)",
q, info_type(q), to, info_type(to)));
return to;
......@@ -1978,7 +1978,7 @@ loop:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
to = copy(q,sizeofW(StgFetchMe),stp);
IF_DEBUG(gc,
belch("@@ evacuate: %p (%s) to %p (%s)",
debugBelch("@@ evacuate: %p (%s) to %p (%s)",
q, info_type(q), to, info_type(to)));
return to;
......@@ -1986,7 +1986,7 @@ loop:
ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp);
IF_DEBUG(gc,
belch("@@ evacuate: %p (%s) to %p (%s)",
debugBelch("@@ evacuate: %p (%s) to %p (%s)",
q, info_type(q), to, info_type(to)));
return to;
#endif
......@@ -2750,7 +2750,7 @@ scavenge(step *stp)
recordMutable((StgMutClosure *)to);
failed_to_evac = rtsFalse; // mutable anyhow.
IF_DEBUG(gc,
belch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
p, info_type(p), (StgClosure *)rbh->blocking_queue));
// ToDo: use size of reverted closure here!
p += BLACKHOLE_sizeW();
......@@ -2771,7 +2771,7 @@ scavenge(step *stp)
recordMutable((StgMutClosure *)bf);
}
IF_DEBUG(gc,
belch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
bf, info_type((StgClosure *)bf),
bf->node, info_type(bf->node)));
p += sizeofW(StgBlockedFetch);
......@@ -2795,7 +2795,7 @@ scavenge(step *stp)
recordMutable((StgMutClosure *)fmbq);
}
IF_DEBUG(gc,
belch("@@ scavenge: %p (%s) exciting, isn't it",
debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
p, info_type((StgClosure *)p)));
p += sizeofW(StgFetchMeBlockingQueue);
break;
......@@ -3059,7 +3059,7 @@ linear_scan:
recordMutable((StgMutClosure *)rbh);
failed_to_evac = rtsFalse; // mutable anyhow.
IF_DEBUG(gc,
belch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
p, info_type(p), (StgClosure *)rbh->blocking_queue));
break;
}
......@@ -3078,7 +3078,7 @@ linear_scan:
recordMutable((StgMutClosure *)bf);
}
IF_DEBUG(gc,
belch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
bf, info_type((StgClosure *)bf),
bf->node, info_type(bf->node)));
break;
......@@ -3100,7 +3100,7 @@ linear_scan:
recordMutable((StgMutClosure *)fmbq);
}
IF_DEBUG(gc,
belch("@@ scavenge: %p (%s) exciting, isn't it",
debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
p, info_type((StgClosure *)p)));
break;
}
......@@ -3123,7 +3123,7 @@ linear_scan:
// start a new linear scan if the mark stack overflowed at some point
if (mark_stack_overflowed && oldgen_scan_bd == NULL) {
IF_DEBUG(gc, belch("scavenge_mark_stack: starting linear scan"));
IF_DEBUG(gc, debugBelch("scavenge_mark_stack: starting linear scan"));
mark_stack_overflowed = rtsFalse;
oldgen_scan_bd = oldest_gen->steps[0].blocks;
oldgen_scan = oldgen_scan_bd->start;
......@@ -3367,7 +3367,7 @@ scavenge_mut_once_list(generation *gen)
} else {
size = gen->steps[0].scan - start;
}
belch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
}
#endif
......@@ -3743,7 +3743,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
StgWord bitmap;
nat size;
//IF_DEBUG(sanity, belch(" scavenging stack between %p and %p", p, stack_end));
//IF_DEBUG(sanity, debugBelch(" scavenging stack between %p and %p", p, stack_end));
/*
* Each time around this loop, we are looking at a chunk of stack
......@@ -3987,7 +3987,7 @@ gcCAFs(void)
ASSERT(info->type == IND_STATIC);
if (STATIC_LINK(info,p) == NULL) {
IF_DEBUG(gccafs, belch("CAF gc'd at 0x%04lx", (long)p));
IF_DEBUG(gccafs, debugBelch("CAF gc'd at 0x%04lx", (long)p));
// black hole it
SET_INFO(p,&stg_BLACKHOLE_info);
p = STATIC_LINK2(info,p);
......@@ -4001,7 +4001,7 @@ gcCAFs(void)
}
// belch("%d CAFs live", i);
// debugBelch("%d CAFs live", i);
}
#endif
......@@ -4048,7 +4048,7 @@ threadLazyBlackHole(StgTSO *tso)
if (bh->header.info != &stg_BLACKHOLE_BQ_info &&
bh->header.info != &stg_CAF_BLACKHOLE_info) {
#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
belch("Unexpected lazy BHing required at 0x%04x",(int)bh);
debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);
#endif
#ifdef PROFILING
// @LDV profiling
......@@ -4175,7 +4175,7 @@ threadSqueezeStack(StgTSO *tso)
bh->header.info != &stg_BLACKHOLE_BQ_info &&
bh->header.info != &stg_CAF_BLACKHOLE_info) {
#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
belch("Unexpected lazy BHing required at 0x%04x",(int)bh);
debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);
#endif
#ifdef DEBUG
/* zero out the slop so that the sanity checker can tell
......@@ -4310,12 +4310,12 @@ printMutOnceList(generation *gen)
p = gen->mut_once_list;
next = p->mut_link;
fprintf(stderr, "@@ Mut once list %p: ", gen->mut_once_list);
debugBelch("@@ Mut once list %p: ", gen->mut_once_list);
for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
fprintf(stderr, "%p (%s), ",
debugBelch("%p (%s), ",
p, info_type((StgClosure *)p));
}
fputc('\n', stderr);
debugBelch("\n");
}
void
......@@ -4326,12 +4326,12 @@ printMutableList(generation *gen)
p = gen->mut_list;
next = p->mut_link;
fprintf(stderr, "@@ Mutable list %p: ", gen->mut_list);
debugBelch("@@ Mutable list %p: ", gen->mut_list);
for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
fprintf(stderr, "%p (%s), ",
debugBelch("%p (%s), ",
p, info_type((StgClosure *)p));
}
fputc('\n', stderr);
debugBelch("\n");
}
STATIC_INLINE rtsBool
......
/* -----------------------------------------------------------------------------
* $Id: GCCompact.c,v 1.19 2004/08/13 13:09:56 simonmar Exp $
* $Id: GCCompact.c,v 1.20 2004/09/03 15:28:26 simonmar Exp $
*
* (c) The GHC Team 2001
*
......@@ -72,15 +72,15 @@ thread( StgPtr p )
STATIC_INLINE void
unthread( StgPtr p, StgPtr free )
{
StgPtr q = (StgPtr)*p, r;
StgWord q = *p, r;
while (((StgWord)q & 1) != 0) {
(StgWord)q -= 1; // unset the low bit again
r = (StgPtr)*q;
*q = (StgWord)free;
while ((q & 1) != 0) {
q -= 1; // unset the low bit again
r = *((StgPtr)q);
*((StgPtr)q) = (StgWord)free;
q = r;
}
*p = (StgWord)q;
*p = q;
}
STATIC_INLINE StgInfoTable *
......@@ -880,12 +880,12 @@ compact( void (*get_roots)(evac_fn) )
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
for (s = 0; s < generations[g].n_steps; s++) {
stp = &generations[g].steps[s];
IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d\n", stp->gen->no, stp->no););
IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no););
update_fwd(stp->to_blocks);
update_fwd_large(stp->scavenged_large_objects);
if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
update_fwd_compact(stp->blocks);
}
}
......@@ -895,7 +895,7 @@ compact( void (*get_roots)(evac_fn) )
stp = &oldest_gen->steps[0];
if (stp->blocks != NULL) {
blocks = update_bkwd_compact(stp);
IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
stp->gen->no, stp->no,
stp->n_blocks, blocks););
stp->n_blocks = blocks;
......
......@@ -111,22 +111,22 @@ void interp_startup ( void )
void interp_shutdown ( void )
{
int i, j, k, o_max, i_max, j_max;
fprintf(stderr, "%d constrs entered -> (%d BCO, %d UPD, %d ??? )\n",
debugBelch("%d constrs entered -> (%d BCO, %d UPD, %d ??? )\n",
it_retto_BCO + it_retto_UPDATE + it_retto_other,
it_retto_BCO, it_retto_UPDATE, it_retto_other );
fprintf(stderr, "%d total entries, %d unknown entries \n",
debugBelch("%d total entries, %d unknown entries \n",
it_total_entries, it_total_unknown_entries);
for (i = 0; i < N_CLOSURE_TYPES; i++) {
if (it_unknown_entries[i] == 0) continue;
fprintf(stderr, " type %2d: unknown entries (%4.1f%%) == %d\n",
debugBelch(" type %2d: unknown entries (%4.1f%%) == %d\n",
i, 100.0 * ((double)it_unknown_entries[i]) /
((double)it_total_unknown_entries),
it_unknown_entries[i]);
}
fprintf(stderr, "%d insns, %d slides, %d BCO_entries\n",
debugBelch("%d insns, %d slides, %d BCO_entries\n",
it_insns, it_slides, it_BCO_entries);
for (i = 0; i < 27; i++)
fprintf(stderr, "opcode %2d got %d\n", i, it_ofreq[i] );
debugBelch("opcode %2d got %d\n", i, it_ofreq[i] );
for (k = 1; k < 20; k++) {
o_max = 0;
......@@ -140,7 +140,7 @@ void interp_shutdown ( void )
}
}
fprintf ( stderr, "%d: count (%4.1f%%) %6d is %d then %d\n",
debugBelch("%d: count (%4.1f%%) %6d is %d then %d\n",
k, ((double)o_max) * 100.0 / ((double)it_insns), o_max,
i_max, j_max );
it_oofreq[i_max][j_max] = 0;
......@@ -228,14 +228,14 @@ eval_obj:
INTERP_TICK(it_total_evals);
IF_DEBUG(interpreter,
fprintf(stderr,
debugBelch(
"\n---------------------------------------------------------------\n");
fprintf(stderr,"Evaluating: "); printObj(obj);
fprintf(stderr,"Sp = %p\n", Sp);
fprintf(stderr, "\n" );
debugBelch("Evaluating: "); printObj(obj);
debugBelch("Sp = %p\n", Sp);
debugBelch("\n" );
printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
fprintf(stderr, "\n\n");
debugBelch("\n\n");
);
IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
......@@ -327,7 +327,7 @@ eval_obj:
{
// Can't handle this object; yield to scheduler
IF_DEBUG(interpreter,
fprintf(stderr, "evaluating unknown closure -- yielding to sched\n");
debugBelch("evaluating unknown closure -- yielding to sched\n");
printObj(obj);
);
Sp -= 2;
......@@ -344,13 +344,13 @@ do_return:
ASSERT(closure_HNF(obj));
IF_DEBUG(interpreter,
fprintf(stderr,
debugBelch(
"\n---------------------------------------------------------------\n");
fprintf(stderr,"Returning: "); printObj(obj);
fprintf(stderr,"Sp = %p\n", Sp);
fprintf(stderr, "\n" );
debugBelch("Returning: "); printObj(obj);
debugBelch("Sp = %p\n", Sp);
debugBelch("\n" );
printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
fprintf(stderr, "\n\n");
debugBelch("\n\n");
);
IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
......@@ -422,7 +422,7 @@ do_return:
// Can't handle this return address; yield to scheduler
INTERP_TICK(it_retto_other);
IF_DEBUG(interpreter,
fprintf(stderr, "returning to unknown frame -- yielding to sched\n");
debugBelch("returning to unknown frame -- yielding to sched\n");
printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
);
Sp -= 2;
......@@ -485,7 +485,7 @@ do_return_unboxed:
// Can't handle this return address; yield to scheduler
INTERP_TICK(it_retto_other);
IF_DEBUG(interpreter,
fprintf(stderr, "returning to unknown frame -- yielding to sched\n");
debugBelch("returning to unknown frame -- yielding to sched\n");
printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
);
RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding);
......@@ -729,18 +729,18 @@ run_BCO:
ASSERT(bciPtr <= instrs[0]);
IF_DEBUG(interpreter,
//if (do_print_stack) {
//fprintf(stderr, "\n-- BEGIN stack\n");
//debugBelch("\n-- BEGIN stack\n");
//printStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
//fprintf(stderr, "-- END stack\n\n");
//debugBelch("-- END stack\n\n");
//}
fprintf(stderr,"Sp = %p pc = %d ", Sp, bciPtr);
debugBelch("Sp = %p pc = %d ", Sp, bciPtr);
disInstr(bco,bciPtr);
if (0) { int i;
fprintf(stderr,"\n");
debugBelch("\n");
for (i = 8; i >= 0; i--) {
fprintf(stderr, "%d %p\n", i, (StgPtr)(*(Sp+i)));
debugBelch("%d %p\n", i, (StgPtr)(*(Sp+i)));
}
fprintf(stderr,"\n");
debugBelch("\n");
}
//if (do_print_stack) checkStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
);
......@@ -962,7 +962,7 @@ run_BCO:
ap->payload[i] = (StgClosure*)Sp[i+1];
Sp += n_payload+1;
IF_DEBUG(interpreter,
fprintf(stderr,"\tBuilt ");
debugBelch("\tBuilt ");
printObj((StgClosure*)ap);
);
goto nextInsn;
......@@ -997,7 +997,7 @@ run_BCO:
Sp --;
Sp[0] = (W_)con;
IF_DEBUG(interpreter,
fprintf(stderr,"\tBuilt ");
debugBelch("\tBuilt ");
printObj((StgClosure*)con);
);
goto nextInsn;
......
/* -----------------------------------------------------------------------------
* $Id: Itimer.c,v 1.36 2003/12/22 16:27:10 simonmar Exp $
* $Id: Itimer.c,v 1.37 2004/09/03 15:28:29 simonmar Exp $
*
* (c) The GHC Team, 1995-1999
*
......@@ -92,7 +92,7 @@ int
startTicker(nat ms, TickProc handle_tick)
{
# ifndef HAVE_SETITIMER
/* fprintf(stderr, "No virtual timer on this system\n"); */
/* debugBelch("No virtual timer on this system\n"); */
return -1;
# else
struct itimerval it;
......@@ -112,7 +112,7 @@ int
stopTicker()
{
# ifndef HAVE_SETITIMER
/* fprintf(stderr, "No virtual timer on this system\n"); */
/* debugBelch("No virtual timer on this system\n"); */
return -1;
# else
struct itimerval it;
......
This diff is collapsed.
/* -----------------------------------------------------------------------------
* $Id: MBlock.c,v 1.50 2003/10/31 16:21:27 sof Exp $
* $Id: MBlock.c,v 1.51 2004/09/03 15:28:33 simonmar Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -133,7 +133,7 @@ my_mmap (void *addr, lnat size)
(errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
// If we request more than 3Gig, then we get EINVAL
// instead of ENOMEM (at least on Linux).
prog_belch("out of memory (requested %d bytes)", size);
errorBelch("out of memory (requested %d bytes)", size);
stg_exit(EXIT_FAILURE);
} else {
barf("getMBlock: mmap: %s", strerror(errno));
......@@ -205,7 +205,7 @@ getMBlocks(nat n)
if (((W_)ret & MBLOCK_MASK) != 0) {
// misaligned block!
#if 0 // defined(DEBUG)
belch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
#endif
// unmap this block...
......@@ -221,7 +221,7 @@ getMBlocks(nat n)
// ToDo: check that we haven't already grabbed the memory at next_request
next_request = ret + size;
IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at %p\n",n,ret));
// fill in the table
for (i = 0; i < n; i++) {
......@@ -291,19 +291,19 @@ getMBlocks(nat n)
, PAGE_READWRITE
);
if ( base_non_committed == 0 ) {
fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
errorBelch("getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
ret=(void*)-1;
} else {
end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
/* The returned pointer is not aligned on a mega-block boundary. Make it. */
base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE;
# if 0
fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n",
(unsigned)base_mblocks - (unsigned)base_non_committed);
debugBelch("getMBlocks: Dropping %d bytes off of 256M chunk\n",
(unsigned)base_mblocks - (unsigned)base_non_committed);
# endif
if ( ((char*)base_mblocks + size) > end_non_committed ) {
fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
debugBelch("getMBlocks: oops, committed too small a region to start with.");
ret=(void*)-1;
} else {
next_request = base_mblocks;
......@@ -314,7 +314,7 @@ getMBlocks(nat n)
if ( ret != (void*)-1 ) {
ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
if (ret == NULL) {
fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
debugBelch("getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
ret=(void*)-1;
}
}
......@@ -327,7 +327,7 @@ getMBlocks(nat n)
barf("getMBlocks: unknown memory allocation failure on Win32.");
}
IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
next_request = (char*)next_request + size;
mblocks_allocated += n;
......@@ -356,7 +356,7 @@ freeMBlock(void* p, nat n)
if (rc == FALSE) {
# ifdef DEBUG
fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
debugBelch("freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
# endif
}
......
/* -----------------------------------------------------------------------------
* $Id: Main.c,v 1.41 2004/08/13 13:10:10 simonmar Exp $
* $Id: Main.c,v 1.42 2004/09/03 15:28:34 simonmar Exp $
*
* (c) The GHC Team 1998-2000
*
......@@ -78,14 +78,14 @@ int main(int argc, char *argv[])
if (IAmMainThread == rtsTrue) {
IF_PAR_DEBUG(verbose,
fprintf(stderr, "==== [%x] Main Thread Started ...\n", mytid));
debugBelch("==== [%x] Main Thread Started ...\n", mytid));
/* ToDo: Dump event for the main thread */
status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL);
} else {
/* Just to show we're alive */
IF_PAR_DEBUG(verbose,
fprintf(stderr, "== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
mytid));
/* all non-main threads enter the scheduler without work */
......@@ -110,11 +110,11 @@ int main(int argc, char *argv[])
/* check the status of the entire Haskell computation */
switch (status) {
case Killed:
prog_belch("main thread exited (uncaught exception)");
errorBelch("main thread exited (uncaught exception)");
exit_status = EXIT_KILLED;
break;
case Interrupted:
prog_belch("interrupted");
errorBelch("interrupted");
exit_status = EXIT_INTERRUPTED;
break;
case Success:
......@@ -122,7 +122,7 @@ int main(int argc, char *argv[])
break;
#if defined(PAR)
case NoStatus:
prog_belch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
exit_status = EXIT_KILLED;
break;
#endif
......
......@@ -144,7 +144,7 @@ initCondition( Condition* pCond )
NULL); /* unnamed => process-local. */
if ( h == NULL ) {
belch("initCondition: unable to create");
errorBelch("initCondition: unable to create");
}
*pCond = h;
return;
......@@ -154,7 +154,7 @@ void
closeCondition( Condition* pCond )
{
if ( CloseHandle(*pCond) == 0 ) {
belch("closeCondition: failed to close");
errorBelch("closeCondition: failed to close");
}
return;
}
......
......@@ -21,8 +21,8 @@ typedef pthread_t OSThreadId;
#define INIT_COND_VAR PTHREAD_COND_INITIALIZER
#ifdef LOCK_DEBUG
#define ACQUIRE_LOCK(mutex) fprintf(stderr, "ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); fflush(stderr); pthread_mutex_lock(mutex)
#define RELEASE_LOCK(mutex) fprintf(stderr, "RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); fflush(stderr); pthread_mutex_unlock(mutex)
#define ACQUIRE_LOCK(mutex) debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); pthread_mutex_lock(mutex)
#define RELEASE_LOCK(mutex) debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); pthread_mutex_unlock(mutex)
#else
#define ACQUIRE_LOCK(mutex) pthread_mutex_lock(mutex)
#define RELEASE_LOCK(mutex) pthread_mutex_unlock(mutex)
......
This diff is collapsed.
/* -----------------------------------------------------------------------------
* $Id: ProfHeap.c,v 1.53 2004/08/13 13:10:25 simonmar Exp $
* $Id: ProfHeap.c,v 1.54 2004/09/03 15:28:35 simonmar Exp $
*
* (c) The GHC Team, 1998-2003
*
......@@ -332,7 +332,7 @@ nextEra( void )
era++;
if (era == max_era) {
prog_belch("maximum number of censuses reached; use +RTS -i to reduce");
errorBelch("maximum number of censuses reached; use +RTS -i to reduce");
stg_exit(EXIT_FAILURE);
}
......@@ -368,7 +368,7 @@ void initProfiling2( void )
/* open the log file */
if ((hp_file = fopen(hp_filename, "w")) == NULL) {