#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;
}
}
#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;
}
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;
}
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)));
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
*
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) {
* Copyright (c) 1994-2002.
*
* $RCSfile: Disassembler.c,v $
- * $Revision: 1.28 $
- * $Date: 2004/08/13 13:09:46 $
+ * $Revision: 1.29 $
+ * $Date: 2004/09/03 15:28:19 $
* ---------------------------------------------------------------------------*/
#ifdef DEBUG
#include "Disassembler.h"
#include "Interpreter.h"
-#include <stdio.h>
-
/* --------------------------------------------------------------------------
* Disassembler
* ------------------------------------------------------------------------*/
switch (instrs[pc++]) {
case bci_SWIZZLE:
- fprintf(stderr, "SWIZZLE stkoff %d by %d\n",
+ debugBelch("SWIZZLE stkoff %d by %d\n",
instrs[pc], (signed int)instrs[pc+1]);
pc += 2; break;
case bci_CCALL:
- fprintf(stderr, "CCALL marshaller at 0x%x\n",
+ debugBelch("CCALL marshaller at 0x%x\n",
literals[instrs[pc]] );
pc += 1; break;
case bci_STKCHECK:
- fprintf(stderr, "STKCHECK %d\n", instrs[pc] );
+ debugBelch("STKCHECK %d\n", instrs[pc] );
pc += 1; break;
case bci_PUSH_L:
- fprintf(stderr, "PUSH_L %d\n", instrs[pc] );
+ debugBelch("PUSH_L %d\n", instrs[pc] );
pc += 1; break;
case bci_PUSH_LL:
- fprintf(stderr, "PUSH_LL %d %d\n", instrs[pc], instrs[pc+1] );
+ debugBelch("PUSH_LL %d %d\n", instrs[pc], instrs[pc+1] );
pc += 2; break;
case bci_PUSH_LLL:
- fprintf(stderr, "PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1],
+ debugBelch("PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1],
instrs[pc+2] );
pc += 3; break;
case bci_PUSH_G:
- fprintf(stderr, "PUSH_G " ); printPtr( ptrs[instrs[pc]] );
- fprintf(stderr, "\n" );
+ debugBelch("PUSH_G " ); printPtr( ptrs[instrs[pc]] );
+ debugBelch("\n" );
pc += 1; break;
case bci_PUSH_ALTS:
- fprintf(stderr, "PUSH_ALTS " ); printPtr( ptrs[instrs[pc]] );
- fprintf(stderr, "\n");
+ debugBelch("PUSH_ALTS " ); printPtr( ptrs[instrs[pc]] );
+ debugBelch("\n");
pc += 1; break;
case bci_PUSH_ALTS_P:
- fprintf(stderr, "PUSH_ALTS_P " ); printPtr( ptrs[instrs[pc]] );
- fprintf(stderr, "\n");
+ debugBelch("PUSH_ALTS_P " ); printPtr( ptrs[instrs[pc]] );
+ debugBelch("\n");
pc += 1; break;
case bci_PUSH_ALTS_N:
- fprintf(stderr, "PUSH_ALTS_N " ); printPtr( ptrs[instrs[pc]] );
- fprintf(stderr, "\n");
+ debugBelch("PUSH_ALTS_N " ); printPtr( ptrs[instrs[pc]] );
+ debugBelch("\n");
pc += 1; break;
case bci_PUSH_ALTS_F:
- fprintf(stderr, "PUSH_ALTS_F " ); printPtr( ptrs[instrs[pc]] );
- fprintf(stderr, "\n");
+ debugBelch("PUSH_ALTS_F " ); printPtr( ptrs[instrs[pc]] );
+ debugBelch("\n");
pc += 1; break;
case bci_PUSH_ALTS_D:
- fprintf(stderr, "PUSH_ALTS_D " ); printPtr( ptrs[instrs[pc]] );
- fprintf(stderr, "\n");
+ debugBelch("PUSH_ALTS_D " ); printPtr( ptrs[instrs[pc]] );
+ debugBelch("\n");
pc += 1; break;
case bci_PUSH_ALTS_L:
- fprintf(stderr, "PUSH_ALTS_L " ); printPtr( ptrs[instrs[pc]] );
- fprintf(stderr, "\n");
+ debugBelch("PUSH_ALTS_L " ); printPtr( ptrs[instrs[pc]] );
+ debugBelch("\n");
pc += 1; break;
case bci_PUSH_ALTS_V:
- fprintf(stderr, "PUSH_ALTS_V " ); printPtr( ptrs[instrs[pc]] );
- fprintf(stderr, "\n");
+ debugBelch("PUSH_ALTS_V " ); printPtr( ptrs[instrs[pc]] );
+ debugBelch("\n");
pc += 1; break;
case bci_PUSH_UBX:
- fprintf(stderr, "PUSH_UBX ");
+ debugBelch("PUSH_UBX ");
for (i = 0; i < instrs[pc+1]; i++)
- fprintf(stderr, "0x%x ", literals[i + instrs[pc]] );
- fprintf(stderr, "\n");
+ debugBelch("0x%x ", literals[i + instrs[pc]] );
+ debugBelch("\n");
pc += 2; break;
case bci_PUSH_APPLY_N:
- fprintf(stderr, "PUSH_APPLY_N\n");
+ debugBelch("PUSH_APPLY_N\n");
break;
case bci_PUSH_APPLY_V:
- fprintf(stderr, "PUSH_APPLY_V\n");
+ debugBelch("PUSH_APPLY_V\n");
break;
case bci_PUSH_APPLY_F:
- fprintf(stderr, "PUSH_APPLY_F\n");
+ debugBelch("PUSH_APPLY_F\n");
break;
case bci_PUSH_APPLY_D:
- fprintf(stderr, "PUSH_APPLY_D\n");
+ debugBelch("PUSH_APPLY_D\n");
break;
case bci_PUSH_APPLY_L:
- fprintf(stderr, "PUSH_APPLY_L\n");
+ debugBelch("PUSH_APPLY_L\n");
break;
case bci_PUSH_APPLY_P:
- fprintf(stderr, "PUSH_APPLY_P\n");
+ debugBelch("PUSH_APPLY_P\n");
break;
case bci_PUSH_APPLY_PP:
- fprintf(stderr, "PUSH_APPLY_PP\n");
+ debugBelch("PUSH_APPLY_PP\n");
break;
case bci_PUSH_APPLY_PPP:
- fprintf(stderr, "PUSH_APPLY_PPP\n");
+ debugBelch("PUSH_APPLY_PPP\n");
break;
case bci_PUSH_APPLY_PPPP:
- fprintf(stderr, "PUSH_APPLY_PPPP\n");
+ debugBelch("PUSH_APPLY_PPPP\n");
break;
case bci_PUSH_APPLY_PPPPP:
- fprintf(stderr, "PUSH_APPLY_PPPPP\n");
+ debugBelch("PUSH_APPLY_PPPPP\n");
break;
case bci_PUSH_APPLY_PPPPPP:
- fprintf(stderr, "PUSH_APPLY_PPPPPP\n");
+ debugBelch("PUSH_APPLY_PPPPPP\n");
break;
case bci_SLIDE:
- fprintf(stderr, "SLIDE %d down by %d\n", instrs[pc], instrs[pc+1] );
+ debugBelch("SLIDE %d down by %d\n", instrs[pc], instrs[pc+1] );
pc += 2; break;
case bci_ALLOC_AP:
- fprintf(stderr, "ALLOC_AP %d words\n", instrs[pc] );
+ debugBelch("ALLOC_AP %d words\n", instrs[pc] );
pc += 1; break;
case bci_ALLOC_PAP:
- fprintf(stderr, "ALLOC_PAP %d words, %d arity\n",
+ debugBelch("ALLOC_PAP %d words, %d arity\n",
instrs[pc], instrs[pc+1] );
pc += 2; break;
case bci_MKAP:
- fprintf(stderr, "MKAP %d words, %d stkoff\n", instrs[pc+1],
+ debugBelch("MKAP %d words, %d stkoff\n", instrs[pc+1],
instrs[pc] );
pc += 2; break;
case bci_UNPACK:
- fprintf(stderr, "UNPACK %d\n", instrs[pc] );
+ debugBelch("UNPACK %d\n", instrs[pc] );
pc += 1; break;
case bci_PACK:
- fprintf(stderr, "PACK %d words with itbl ", instrs[pc+1] );
+ debugBelch("PACK %d words with itbl ", instrs[pc+1] );
printPtr( (StgPtr)itbls[instrs[pc]] );
- fprintf(stderr, "\n");
+ debugBelch("\n");
pc += 2; break;
case bci_TESTLT_I:
- fprintf(stderr, "TESTLT_I %d, fail to %d\n", literals[instrs[pc]],
+ debugBelch("TESTLT_I %d, fail to %d\n", literals[instrs[pc]],
instrs[pc+1]);
pc += 2; break;
case bci_TESTEQ_I:
- fprintf(stderr, "TESTEQ_I %d, fail to %d\n", literals[instrs[pc]],
+ debugBelch("TESTEQ_I %d, fail to %d\n", literals[instrs[pc]],
instrs[pc+1]);
pc += 2; break;
case bci_TESTLT_F:
- fprintf(stderr, "TESTLT_F %d, fail to %d\n", literals[instrs[pc]],
+ debugBelch("TESTLT_F %d, fail to %d\n", literals[instrs[pc]],
instrs[pc+1]);
pc += 2; break;
case bci_TESTEQ_F:
- fprintf(stderr, "TESTEQ_F %d, fail to %d\n", literals[instrs[pc]],
+ debugBelch("TESTEQ_F %d, fail to %d\n", literals[instrs[pc]],
instrs[pc+1]);
pc += 2; break;
case bci_TESTLT_D:
- fprintf(stderr, "TESTLT_D %d, fail to %d\n", literals[instrs[pc]],
+ debugBelch("TESTLT_D %d, fail to %d\n", literals[instrs[pc]],
instrs[pc+1]);
pc += 2; break;
case bci_TESTEQ_D:
- fprintf(stderr, "TESTEQ_D %d, fail to %d\n", literals[instrs[pc]],
+ debugBelch("TESTEQ_D %d, fail to %d\n", literals[instrs[pc]],
instrs[pc+1]);
pc += 2; break;
case bci_TESTLT_P:
- fprintf(stderr, "TESTLT_P %d, fail to %d\n", instrs[pc],
+ debugBelch("TESTLT_P %d, fail to %d\n", instrs[pc],
instrs[pc+1]);
pc += 2; break;
case bci_TESTEQ_P:
- fprintf(stderr, "TESTEQ_P %d, fail to %d\n", instrs[pc],
+ debugBelch("TESTEQ_P %d, fail to %d\n", instrs[pc],
instrs[pc+1]);
pc += 2; break;
case bci_CASEFAIL:
- fprintf(stderr, "CASEFAIL\n" );
+ debugBelch("CASEFAIL\n" );
break;
case bci_JMP:
- fprintf(stderr, "JMP to %d\n", instrs[pc]);
+ debugBelch("JMP to %d\n", instrs[pc]);
pc += 1; break;
case bci_ENTER:
- fprintf(stderr, "ENTER\n");
+ debugBelch("ENTER\n");
break;
case bci_RETURN:
- fprintf(stderr, "RETURN\n" );
+ debugBelch("RETURN\n" );
break;
case bci_RETURN_P:
- fprintf(stderr, "RETURN_P\n" );
+ debugBelch("RETURN_P\n" );
break;
case bci_RETURN_N:
- fprintf(stderr, "RETURN_N\n" );
+ debugBelch("RETURN_N\n" );
break;
case bci_RETURN_F:
- fprintf(stderr, "RETURN_F\n" );
+ debugBelch("RETURN_F\n" );
break;
case bci_RETURN_D:
- fprintf(stderr, "RETURN_D\n" );
+ debugBelch("RETURN_D\n" );
break;
case bci_RETURN_L:
- fprintf(stderr, "RETURN_L\n" );
+ debugBelch("RETURN_L\n" );
break;
case bci_RETURN_V:
- fprintf(stderr, "RETURN_V\n" );
+ debugBelch("RETURN_V\n" );
break;
default:
nat nbcs = (int)instrs[0];
nat pc = 1;
- fprintf(stderr, "BCO\n" );
+ debugBelch("BCO\n" );
pc = 1;
while (pc <= nbcs) {
- fprintf(stderr, "\t%2d: ", pc );
+ debugBelch("\t%2d: ", pc );
pc = disInstr ( bco, pc );
}
- fprintf(stderr, "INSTRS:\n " );
+ debugBelch("INSTRS:\n " );
j = 16;
for (i = 0; i < nbcs; i++) {
- fprintf(stderr, "%3d ", (int)instrs[i] );
+ debugBelch("%3d ", (int)instrs[i] );
j--;
- if (j == 0) { j = 16; fprintf(stderr, "\n "); };
+ if (j == 0) { j = 16; debugBelch("\n "); };
}
- fprintf(stderr, "\n");
+ debugBelch("\n");
- fprintf(stderr, "PTRS:\n " );
+ debugBelch("PTRS:\n " );
j = 8;
for (i = 0; i < ptrs->ptrs; i++) {
- fprintf(stderr, "%8p ", ptrs->payload[i] );
+ debugBelch("%8p ", ptrs->payload[i] );
j--;
- if (j == 0) { j = 8; fprintf(stderr, "\n "); };
+ if (j == 0) { j = 8; debugBelch("\n "); };
}
- fprintf(stderr, "\n");
+ debugBelch("\n");
- fprintf(stderr, "\n");
+ debugBelch("\n");
ASSERT(pc == nbcs+1);
}
/* -----------------------------------------------------------------------------
- * $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
*
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
*
#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
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!
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
}
#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
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();
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;
}
//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;
}
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;
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;
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
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();
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);
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;
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;
}
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;
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;
}
// 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;
} 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
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
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);
}
- // belch("%d CAFs live", i);
+ // debugBelch("%d CAFs live", i);
}
#endif
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
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
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
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
*
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 *
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);
}
}
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;
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;
}
}
- 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;
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));
{
// 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;
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));
// 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;
// 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);
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);
);
ap->payload[i] = (StgClosure*)Sp[i+1];
Sp += n_payload+1;
IF_DEBUG(interpreter,
- fprintf(stderr,"\tBuilt ");
+ debugBelch("\tBuilt ");
printObj((StgClosure*)ap);
);
goto nextInsn;
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
*
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;
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;
insertStrHashTable(table, (StgWord)key, data);
return;
}
- fprintf(stderr,
+ debugBelch(
"\n\n"
"GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
" %s\n"
initLinker();
- /* fprintf(stderr, "\naddDLL; dll_name = `%s'\n", dll_name); */
+ /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
/* See if we've already got it, and ignore if so. */
for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
OpenedDLL* o_dll;
void* sym;
for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
- /* fprintf(stderr, "look in %s for %s\n", o_dll->name, lbl); */
+ /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
if (lbl[0] == '_') {
/* HACK: if the name has an initial underscore, try stripping
it off & look that up first. I've yet to verify whether there's
*/
sym = GetProcAddress(o_dll->instance, (lbl+1));
if (sym != NULL) {
- /*fprintf(stderr, "found %s in %s\n", lbl+1,o_dll->name); fflush(stderr);*/
+ /*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
return sym;
}
}
sym = GetProcAddress(o_dll->instance, lbl);
if (sym != NULL) {
- /*fprintf(stderr, "found %s in %s\n", lbl,o_dll->name); fflush(stderr);*/
+ /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
return sym;
}
}
for (i = 0; i < oc->n_symbols; i++) {
sym = oc->symbols[i];
if (sym == NULL) continue;
- // fprintf(stderr, "enquire %p %p\n", sym, oc->lochash);
+ // debugBelch("enquire %p %p\n", sym, oc->lochash);
a = NULL;
if (oc->lochash != NULL) {
a = lookupStrHashTable(oc->lochash, sym);
a = lookupStrHashTable(symhash, sym);
}
if (a == NULL) {
- // fprintf(stderr, "ghci_enquire: can't find %s\n", sym);
+ // debugBelch("ghci_enquire: can't find %s\n", sym);
}
else if (addr-DELTA <= a && a <= addr+DELTA) {
- fprintf(stderr, "%p + %3d == `%s'\n", addr, a - addr, sym);
+ debugBelch("%p + %3d == `%s'\n", addr, a - addr, sym);
}
}
}
initLinker();
- /* fprintf(stderr, "loadObj %s\n", path ); */
+ /* debugBelch("loadObj %s\n", path ); */
/* Check that we haven't already loaded this object.
Ignore requests to load multiple times */
}
}
if (is_dup) {
- IF_DEBUG(linker, belch(
+ IF_DEBUG(linker, debugBelch(
"GHCi runtime linker: warning: looks like you're trying to load the\n"
"same object file twice:\n"
" %s\n"
}
}
- belch("unloadObj: can't find `%s' to unload", path);
+ errorBelch("unloadObj: can't find `%s' to unload", path);
return 0;
}
{
ProddableBlock* pb
= stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
- /* fprintf(stderr, "aPB %p %p %d\n", oc, start, size); */
+ /* debugBelch("aPB %p %p %d\n", oc, start, size); */
ASSERT(size > 0);
pb->start = start;
pb->size = size;
s->next = oc->sections;
oc->sections = s;
/*
- fprintf(stderr, "addSection: %p-%p (size %d), kind %d\n",
+ debugBelch("addSection: %p-%p (size %d), kind %d\n",
start, ((char*)end)-1, end - start + 1, kind );
*/
}
{
if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
UInt32 strtab_offset = * (UInt32*)(name+4);
- fprintf ( stderr, "%s", strtab + strtab_offset );
+ debugBelch("%s", strtab + strtab_offset );
} else {
int i;
for (i = 0; i < 8; i++) {
if (name[i] == 0) break;
- fprintf ( stderr, "%c", name[i] );
+ debugBelch("%c", name[i] );
}
}
}
COFF_section* sectab;
COFF_symbol* symtab;
UChar* strtab;
- /* fprintf(stderr, "\nLOADING %s\n", oc->fileName); */
+ /* debugBelch("\nLOADING %s\n", oc->fileName); */
hdr = (COFF_header*)(oc->image);
sectab = (COFF_section*) (
((UChar*)(oc->image))
+ hdr->NumberOfSymbols * sizeof_COFF_symbol;
if (hdr->Machine != 0x14c) {
- belch("Not x86 PEi386");
+ errorBelch("Not x86 PEi386");
return 0;
}
if (hdr->SizeOfOptionalHeader != 0) {
- belch("PEi386 with nonempty optional header");
+ errorBelch("PEi386 with nonempty optional header");
return 0;
}
if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
(hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
(hdr->Characteristics & MYIMAGE_FILE_DLL) ||
(hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
- belch("Not a PEi386 object file");
+ errorBelch("Not a PEi386 object file");
return 0;
}
if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
/* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
- belch("Invalid PEi386 word size or endiannness: %d",
+ errorBelch("Invalid PEi386 word size or endiannness: %d",
(int)(hdr->Characteristics));
return 0;
}
/* If the string table size is way crazy, this might indicate that
there are more than 64k relocations, despite claims to the
contrary. Hence this test. */
- /* fprintf(stderr, "strtab size %d\n", * (UInt32*)strtab); */
+ /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
#if 0
if ( (*(UInt32*)strtab) > 600000 ) {
/* Note that 600k has no special significance other than being
big enough to handle the almost-2MB-sized lumps that
constitute HSwin32*.o. */
- belch("PEi386 object has suspiciously large string table; > 64k relocs?");
+ debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
return 0;
}
#endif
IF_DEBUG(linker, i=1);
if (i == 0) return 1;
- fprintf ( stderr,
- "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
- fprintf ( stderr,
- "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
- fprintf ( stderr,
- "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
-
- fprintf ( stderr, "\n" );
- fprintf ( stderr,
- "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
- fprintf ( stderr,
- "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
- fprintf ( stderr,
- "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
- fprintf ( stderr,
- "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
- fprintf ( stderr,
- "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
- fprintf ( stderr,
- "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
- fprintf ( stderr,
- "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
+ debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
+ debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
+ debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
+
+ debugBelch("\n" );
+ debugBelch( "Machine: 0x%x\n", (UInt32)(hdr->Machine) );
+ debugBelch( "# sections: %d\n", (UInt32)(hdr->NumberOfSections) );
+ debugBelch( "time/date: 0x%x\n", (UInt32)(hdr->TimeDateStamp) );
+ debugBelch( "symtab offset: %d\n", (UInt32)(hdr->PointerToSymbolTable) );
+ debugBelch( "# symbols: %d\n", (UInt32)(hdr->NumberOfSymbols) );
+ debugBelch( "sz of opt hdr: %d\n", (UInt32)(hdr->SizeOfOptionalHeader) );
+ debugBelch( "characteristics: 0x%x\n", (UInt32)(hdr->Characteristics) );
/* Print the section table. */
- fprintf ( stderr, "\n" );
+ debugBelch("\n" );
for (i = 0; i < hdr->NumberOfSections; i++) {
COFF_reloc* reltab;
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
- fprintf ( stderr,
+ debugBelch(
"\n"
"section %d\n"
" name `",
i
);
printName ( sectab_i->Name, strtab );
- fprintf ( stderr,
+ debugBelch(
"'\n"
" vsize %d\n"
" vaddr %d\n"
COFF_symbol* sym;
COFF_reloc* rel = (COFF_reloc*)
myindex ( sizeof_COFF_reloc, reltab, j );
- fprintf ( stderr,
+ debugBelch(
" type 0x%-4x vaddr 0x%-8x name `",
(UInt32)rel->Type,
rel->VirtualAddress );
myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
/* Hmm..mysterious looking offset - what's it for? SOF */
printName ( sym->Name, strtab -10 );
- fprintf ( stderr, "'\n" );
+ debugBelch("'\n" );
}
- fprintf ( stderr, "\n" );
+ debugBelch("\n" );
}
- fprintf ( stderr, "\n" );
- fprintf ( stderr, "string table has size 0x%x\n", * (UInt32*)strtab );
- fprintf ( stderr, "---START of string table---\n");
+ debugBelch("\n" );
+ debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
+ debugBelch("---START of string table---\n");
for (i = 4; i < *(Int32*)strtab; i++) {
if (strtab[i] == 0)
- fprintf ( stderr, "\n"); else
- fprintf( stderr, "%c", strtab[i] );
+ debugBelch("\n"); else
+ debugBelch("%c", strtab[i] );
}
- fprintf ( stderr, "--- END of string table---\n");
+ debugBelch("--- END of string table---\n");
- fprintf ( stderr, "\n" );
+ debugBelch("\n" );
i = 0;
while (1) {
COFF_symbol* symtab_i;
if (i >= (Int32)(hdr->NumberOfSymbols)) break;
symtab_i = (COFF_symbol*)
myindex ( sizeof_COFF_symbol, symtab, i );
- fprintf ( stderr,
+ debugBelch(
"symbol %d\n"
" name `",
i
);
printName ( symtab_i->Name, strtab );
- fprintf ( stderr,
+ debugBelch(
"'\n"
" value 0x%x\n"
" 1+sec# %d\n"
i++;
}
- fprintf ( stderr, "\n" );
+ debugBelch("\n" );
return 1;
}
"ocGetNames_PEi386(anonymous bss)");
sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
addProddableBlock(oc, zspace, sectab_i->VirtualSize);
- /* fprintf(stderr, "BSS anon section at 0x%x\n", zspace); */
+ /* debugBelch("BSS anon section at 0x%x\n", zspace); */
}
/* Copy section information into the ObjectCode. */
COFF_section* sectab_i
= (COFF_section*)
myindex ( sizeof_COFF_section, sectab, i );
- IF_DEBUG(linker, belch("section name = %s\n", sectab_i->Name ));
+ IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
# if 0
/* I'm sure this is the Right Way to do it. However, the
&& 0 != strcmp(".stab", sectab_i->Name)
&& 0 != strcmp(".stabstr", sectab_i->Name)
) {
- belch("Unknown PEi386 section name `%s'", sectab_i->Name);
+ errorBelch("Unknown PEi386 section name `%s'", sectab_i->Name);
return 0;
}
addSection(oc, SECTIONKIND_RWDATA, addr,
((UChar*)addr) + symtab_i->Value - 1);
addProddableBlock(oc, addr, symtab_i->Value);
- /* fprintf(stderr, "BSS section at 0x%x\n", addr); */
+ /* debugBelch("BSS section at 0x%x\n", addr); */
}
if (addr != NULL ) {
sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
- /* fprintf(stderr,"addSymbol %p `%s \n", addr,sname); */
- IF_DEBUG(linker, belch("addSymbol %p `%s'\n", addr,sname);)
+ /* debugBelch("addSymbol %p `%s \n", addr,sname); */
+ IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
ASSERT(i >= 0 && i < oc->n_symbols);
/* cstring_from_COFF_symbol_name always succeeds. */
oc->symbols[i] = sname;
ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
} else {
# if 0
- fprintf ( stderr,
+ debugBelch(
"IGNORING symbol %d\n"
" name `",
i
);
printName ( symtab_i->Name, strtab );
- fprintf ( stderr,
+ debugBelch(
"'\n"
" value 0x%x\n"
" 1+sec# %d\n"
/* ToDo: should be variable-sized? But is at least safe in the
sense of buffer-overrun-proof. */
char symbol[1000];
- /* fprintf(stderr, "resolving for %s\n", oc->fileName); */
+ /* debugBelch("resolving for %s\n", oc->fileName); */
hdr = (COFF_header*)(oc->image);
sectab = (COFF_section*) (
COFF_reloc* rel = (COFF_reloc*)
myindex ( sizeof_COFF_reloc, reltab, 0 );
noRelocs = rel->VirtualAddress;
- fprintf(stderr, "WARNING: Overflown relocation field (# relocs found: %u)\n", noRelocs); fflush(stderr);
+ debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
+ noRelocs);
j = 1;
} else {
noRelocs = sectab_i->NumberOfRelocations;
myindex ( sizeof_COFF_symbol,
symtab, reltab_j->SymbolTableIndex );
IF_DEBUG(linker,
- fprintf ( stderr,
+ debugBelch(
"reloc sec %2d num %3d: type 0x%-4x "
"vaddr 0x%-8x name `",
i, j,
(UInt32)reltab_j->Type,
reltab_j->VirtualAddress );
printName ( sym->Name, strtab );
- fprintf ( stderr, "'\n" ));
+ debugBelch("'\n" ));
if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
COFF_section* section_sym
= findPEi386SectionCalled ( oc, sym->Name );
if (!section_sym) {
- belch("%s: can't find section `%s'", oc->fileName, sym->Name);
+ errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
return 0;
}
S = ((UInt32)(oc->image))
(void*)S = lookupSymbol( symbol );
if ((void*)S != NULL) goto foundit;
/* Newline first because the interactive linker has printed "linking..." */
- belch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
+ errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
return 0;
foundit:
}
*pP = S - ((UInt32)pP) - 4;
break;
default:
- belch("%s: unhandled PEi386 relocation type %d",
+ debugBelch(("%s: unhandled PEi386 relocation type %d",
oc->fileName, reltab_j->Type);
return 0;
}
}
}
- IF_DEBUG(linker, belch("completed %s", oc->fileName));
+ IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
return 1;
}
ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
ehdr->e_ident[EI_MAG3] != ELFMAG3) {
- belch("%s: not an ELF object", oc->fileName);
+ errorBelch("%s: not an ELF object", oc->fileName);
return 0;
}
if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
- belch("%s: unsupported ELF format", oc->fileName);
+ errorBelch("%s: unsupported ELF format", oc->fileName);
return 0;
}
if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
- IF_DEBUG(linker,belch( "Is little-endian" ));
+ IF_DEBUG(linker,debugBelch( "Is little-endian" ));
} else
if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
- IF_DEBUG(linker,belch( "Is big-endian" ));
+ IF_DEBUG(linker,debugBelch( "Is big-endian" ));
} else {
- belch("%s: unknown endiannness", oc->fileName);
+ errorBelch("%s: unknown endiannness", oc->fileName);
return 0;
}
if (ehdr->e_type != ET_REL) {
- belch("%s: not a relocatable object (.o) file", oc->fileName);
+ errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
return 0;
}
- IF_DEBUG(linker, belch( "Is a relocatable object (.o) file" ));
+ IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file" ));
- IF_DEBUG(linker,belch( "Architecture is " ));
+ IF_DEBUG(linker,debugBelch( "Architecture is " ));
switch (ehdr->e_machine) {
- case EM_386: IF_DEBUG(linker,belch( "x86" )); break;
- case EM_SPARC: IF_DEBUG(linker,belch( "sparc" )); break;
+ case EM_386: IF_DEBUG(linker,debugBelch( "x86" )); break;
+ case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
#ifdef EM_IA_64
- case EM_IA_64: IF_DEBUG(linker,belch( "ia64" )); break;
+ case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
#endif
- default: IF_DEBUG(linker,belch( "unknown" ));
- belch("%s: unknown architecture", oc->fileName);
+ default: IF_DEBUG(linker,debugBelch( "unknown" ));
+ errorBelch("%s: unknown architecture", oc->fileName);
return 0;
}
- IF_DEBUG(linker,belch(
+ IF_DEBUG(linker,debugBelch(
"\nSection header table: start %d, n_entries %d, ent_size %d",
ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize ));
shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
if (ehdr->e_shstrndx == SHN_UNDEF) {
- belch("%s: no section header string table", oc->fileName);
+ errorBelch("%s: no section header string table", oc->fileName);
return 0;
} else {
- IF_DEBUG(linker,belch( "Section header string table is section %d",
+ IF_DEBUG(linker,debugBelch( "Section header string table is section %d",
ehdr->e_shstrndx));
sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
}
for (i = 0; i < ehdr->e_shnum; i++) {
- IF_DEBUG(linker,fprintf(stderr, "%2d: ", i ));
- IF_DEBUG(linker,fprintf(stderr, "type=%2d ", (int)shdr[i].sh_type ));
- IF_DEBUG(linker,fprintf(stderr, "size=%4d ", (int)shdr[i].sh_size ));
- IF_DEBUG(linker,fprintf(stderr, "offs=%4d ", (int)shdr[i].sh_offset ));
- IF_DEBUG(linker,fprintf(stderr, " (%p .. %p) ",
+ IF_DEBUG(linker,debugBelch("%2d: ", i ));
+ IF_DEBUG(linker,debugBelch("type=%2d ", (int)shdr[i].sh_type ));
+ IF_DEBUG(linker,debugBelch("size=%4d ", (int)shdr[i].sh_size ));
+ IF_DEBUG(linker,debugBelch("offs=%4d ", (int)shdr[i].sh_offset ));
+ IF_DEBUG(linker,debugBelch(" (%p .. %p) ",
ehdrC + shdr[i].sh_offset,
ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
if (shdr[i].sh_type == SHT_REL) {
- IF_DEBUG(linker,fprintf(stderr, "Rel " ));
+ IF_DEBUG(linker,debugBelch("Rel " ));
} else if (shdr[i].sh_type == SHT_RELA) {
- IF_DEBUG(linker,fprintf(stderr, "RelA " ));
+ IF_DEBUG(linker,debugBelch("RelA " ));
} else {
- IF_DEBUG(linker,fprintf(stderr," "));
+ IF_DEBUG(linker,debugBelch(" "));
}
if (sh_strtab) {
- IF_DEBUG(linker,fprintf(stderr, "sname=%s\n", sh_strtab + shdr[i].sh_name ));
+ IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
}
}
- IF_DEBUG(linker,belch( "\nString tables" ));
+ IF_DEBUG(linker,debugBelch( "\nString tables" ));
strtab = NULL;
nstrtab = 0;
for (i = 0; i < ehdr->e_shnum; i++) {
debugging info. */
&& 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
) {
- IF_DEBUG(linker,belch(" section %d is a normal string table", i ));
+ IF_DEBUG(linker,debugBelch(" section %d is a normal string table", i ));
strtab = ehdrC + shdr[i].sh_offset;
nstrtab++;
}
}
if (nstrtab != 1) {
- belch("%s: no string tables, or too many", oc->fileName);
+ errorBelch("%s: no string tables, or too many", oc->fileName);
return 0;
}
nsymtabs = 0;
- IF_DEBUG(linker,belch( "\nSymbol tables" ));
+ IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
for (i = 0; i < ehdr->e_shnum; i++) {
if (shdr[i].sh_type != SHT_SYMTAB) continue;
- IF_DEBUG(linker,belch( "section %d is a symbol table", i ));
+ IF_DEBUG(linker,debugBelch( "section %d is a symbol table", i ));
nsymtabs++;
stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
nent = shdr[i].sh_size / sizeof(Elf_Sym);
- IF_DEBUG(linker,belch( " number of entries is apparently %d (%d rem)",
+ IF_DEBUG(linker,debugBelch( " number of entries is apparently %d (%d rem)",
nent,
shdr[i].sh_size % sizeof(Elf_Sym)
));
if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
- belch("%s: non-integral number of symbol table entries", oc->fileName);
+ errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
return 0;
}
for (j = 0; j < nent; j++) {
- IF_DEBUG(linker,fprintf(stderr, " %2d ", j ));
- IF_DEBUG(linker,fprintf(stderr, " sec=%-5d size=%-3d val=%5p ",
+ IF_DEBUG(linker,debugBelch(" %2d ", j ));
+ IF_DEBUG(linker,debugBelch(" sec=%-5d size=%-3d val=%5p ",
(int)stab[j].st_shndx,
(int)stab[j].st_size,
(char*)stab[j].st_value ));
- IF_DEBUG(linker,fprintf(stderr, "type=" ));
+ IF_DEBUG(linker,debugBelch("type=" ));
switch (ELF_ST_TYPE(stab[j].st_info)) {
- case STT_NOTYPE: IF_DEBUG(linker,fprintf(stderr, "notype " )); break;
- case STT_OBJECT: IF_DEBUG(linker,fprintf(stderr, "object " )); break;
- case STT_FUNC : IF_DEBUG(linker,fprintf(stderr, "func " )); break;
- case STT_SECTION: IF_DEBUG(linker,fprintf(stderr, "section" )); break;
- case STT_FILE: IF_DEBUG(linker,fprintf(stderr, "file " )); break;
- default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
+ case STT_NOTYPE: IF_DEBUG(linker,debugBelch("notype " )); break;
+ case STT_OBJECT: IF_DEBUG(linker,debugBelch("object " )); break;
+ case STT_FUNC : IF_DEBUG(linker,debugBelch("func " )); break;
+ case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
+ case STT_FILE: IF_DEBUG(linker,debugBelch("file " )); break;
+ default: IF_DEBUG(linker,debugBelch("? " )); break;
}
- IF_DEBUG(linker,fprintf(stderr, " " ));
+ IF_DEBUG(linker,debugBelch(" " ));
- IF_DEBUG(linker,fprintf(stderr, "bind=" ));
+ IF_DEBUG(linker,debugBelch("bind=" ));
switch (ELF_ST_BIND(stab[j].st_info)) {
- case STB_LOCAL : IF_DEBUG(linker,fprintf(stderr, "local " )); break;
- case STB_GLOBAL: IF_DEBUG(linker,fprintf(stderr, "global" )); break;
- case STB_WEAK : IF_DEBUG(linker,fprintf(stderr, "weak " )); break;
- default: IF_DEBUG(linker,fprintf(stderr, "? " )); break;
+ case STB_LOCAL : IF_DEBUG(linker,debugBelch("local " )); break;
+ case STB_GLOBAL: IF_DEBUG(linker,debugBelch("global" )); break;
+ case STB_WEAK : IF_DEBUG(linker,debugBelch("weak " )); break;
+ default: IF_DEBUG(linker,debugBelch("? " )); break;
}
- IF_DEBUG(linker,fprintf(stderr, " " ));
+ IF_DEBUG(linker,debugBelch(" " ));
- IF_DEBUG(linker,fprintf(stderr, "name=%s\n", strtab + stab[j].st_name ));
+ IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
}
}
if (nsymtabs == 0) {
- belch("%s: didn't find any symbol tables", oc->fileName);
+ errorBelch("%s: didn't find any symbol tables", oc->fileName);
return 0;
}
ASSERT(symhash != NULL);
if (!strtab) {
- belch("%s: no strtab", oc->fileName);
+ errorBelch("%s: no strtab", oc->fileName);
return 0;
}
"ocGetNames_ELF(BSS)");
shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
/*
- fprintf(stderr, "BSS section at 0x%x, size %d\n",
+ debugBelch("BSS section at 0x%x, size %d\n",
zspace, shdr[i].sh_size);
*/
}
isLocal = FALSE;
ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
/*
- fprintf(stderr, "COMMON symbol, size %d name %s\n",
+ debugBelch("COMMON symbol, size %d name %s\n",
stab[j].st_size, nm);
*/
/* Pointless to do addProddableBlock() for this area,
ASSERT(secno > 0 && secno < ehdr->e_shnum);
/*
if (shdr[secno].sh_type == SHT_NOBITS) {
- fprintf(stderr, " BSS symbol, size %d off %d name %s\n",
+ debugBelch(" BSS symbol, size %d off %d name %s\n",
stab[j].st_size, stab[j].st_value, nm);
}
*/
if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
#endif
- IF_DEBUG(linker,belch( "addOTabName(GLOB): %10p %s %s",
+ IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p %s %s",
ad, oc->fileName, nm ));
isLocal = FALSE;
}
}
} else {
/* Skip. */
- IF_DEBUG(linker,belch( "skipping `%s'",
+ IF_DEBUG(linker,debugBelch( "skipping `%s'",
strtab + stab[j].st_name ));
/*
- fprintf(stderr,
+ debugBelch(
"skipping bind = %d, type = %d, shndx = %d `%s'\n",
(int)ELF_ST_BIND(stab[j].st_info),
(int)ELF_ST_TYPE(stab[j].st_info),
stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
targ = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
- IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
+ IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d",
target_shndx, symtab_shndx ));
for (j = 0; j < nent; j++) {
void* S_tmp;
Elf_Addr value;
- IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p)",
+ IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
j, (void*)offset, (void*)info ));
if (!info) {
- IF_DEBUG(linker,belch( " ZERO" ));
+ IF_DEBUG(linker,debugBelch( " ZERO" ));
S = 0;
} else {
Elf_Sym sym = stab[ELF_R_SYM(info)];
S = (Elf_Addr)S_tmp;
}
if (!S) {
- belch("%s: unknown symbol `%s'", oc->fileName, symbol);
+ errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
return 0;
}
- IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
+ IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
}
- IF_DEBUG(linker,belch( "Reloc: P = %p S = %p A = %p",
+ IF_DEBUG(linker,debugBelch( "Reloc: P = %p S = %p A = %p",
(void*)P, (void*)S, (void*)A ));
checkProddableBlock ( oc, pP );
case R_386_PC32: *pP = value - P; break;
# endif
default:
- belch("%s: unhandled ELF relocation(Rel) type %d\n",
+ errorBelch("%s: unhandled ELF relocation(Rel) type %d\n",
oc->fileName, ELF_R_TYPE(info));
return 0;
}
stab = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
targ = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
- IF_DEBUG(linker,belch( "relocations for section %d using symtab %d",
+ IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d",
target_shndx, symtab_shndx ));
for (j = 0; j < nent; j++) {
Elf_Addr addr;
# endif
- IF_DEBUG(linker,belch( "Rel entry %3d is raw(%6p %6p %6p) ",
+ IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p) ",
j, (void*)offset, (void*)info,
(void*)A ));
if (!info) {
- IF_DEBUG(linker,belch( " ZERO" ));
+ IF_DEBUG(linker,debugBelch( " ZERO" ));
S = 0;
} else {
Elf_Sym sym = stab[ELF_R_SYM(info)];
/* If a function, already a function descriptor - we would
have to copy it to add an offset. */
if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
- belch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
+ errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
#endif
}
if (!S) {
- belch("%s: unknown symbol `%s'", oc->fileName, symbol);
+ errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
return 0;
}
- IF_DEBUG(linker,belch( "`%s' resolves to %p", symbol, (void*)S ));
+ IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
}
- IF_DEBUG(linker,fprintf ( stderr, "Reloc: P = %p S = %p A = %p\n",
+ IF_DEBUG(linker,debugBelch("Reloc: P = %p S = %p A = %p\n",
(void*)P, (void*)S, (void*)A ));
/* checkProddableBlock ( oc, (void*)P ); */
break;
# endif
default:
- belch("%s: unhandled ELF relocation(RelA) type %d\n",
+ errorBelch("%s: unhandled ELF relocation(RelA) type %d\n",
oc->fileName, ELF_R_TYPE(info));
return 0;
}
strtab = findElfSection ( ehdrC, SHT_STRTAB );
if (stab == NULL || strtab == NULL) {
- belch("%s: can't find string or symbol table", oc->fileName);
+ errorBelch("%s: can't find string or symbol table", oc->fileName);
return 0;
}
addr = lookupSymbol(nm);
if(!addr)
{
- belch("\n%s: unknown symbol `%s'", oc->fileName, nm);
+ errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
return 0;
}
ASSERT(addr);
unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm));
if(!symbolAddress)
{
- belch("\nunknown symbol `%s'", nm);
+ errorBelch("\nunknown symbol `%s'", nm);
return 0;
}
/* -----------------------------------------------------------------------------
- * $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
*
(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));
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...
// 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++) {
, 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;
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;
}
}
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;
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
*
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 */
/* 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:
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
NULL); /* unnamed => process-local. */
if ( h == NULL ) {
- belch("initCondition: unable to create");
+ errorBelch("initCondition: unable to create");
}
*pCond = h;
return;
closeCondition( Condition* pCond )
{
if ( CloseHandle(*pCond) == 0 ) {
- belch("closeCondition: failed to close");
+ errorBelch("closeCondition: failed to close");
}
return;
}
#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)
/* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.63 2004/08/13 13:10:23 simonmar Exp $
+ * $Id: Printer.c,v 1.64 2004/09/03 15:28:35 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"
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
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
*/
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_bitmap);
+ 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)->f.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_SELECTOR:
printStdObjHdr(obj, "THUNK_SELECTOR");
- fprintf(stderr, ", %p)\n", ((StgSelector *)obj)->selectee);
+ debugBelch(", %p)\n", ((StgSelector *)obj)->selectee);
break;
case BCO:
{
StgPAP* ap = stgCast(StgPAP*,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(");
+ debugBelch("CAF_BH(");
printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
case BLACKHOLE:
- fprintf(stderr,"BH\n");
+ debugBelch("BH\n");
break;
case BLACKHOLE_BQ:
- fprintf(stderr,"BQ(");
+ debugBelch("BQ(");
printPtr((StgPtr)stgCast(StgBlockingQueue*,obj)->blocking_queue);
- fprintf(stderr,")\n");
+ debugBelch(")\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("%u", ((StgArrWords *)obj)->payload[i]);
+ debugBelch("\")\n");
break;
}
case MUT_ARR_PTRS:
- fprintf(stderr,"MUT_ARR_PTRS(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
+ debugBelch("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);
+ debugBelch("MUT_ARR_PTRS_FROZEN(size=%d)\n", ((StgMutArrPtrs *)obj)->ptrs);
break;
#else
{
StgWord i;
StgMutArrPtrs* p = stgCast(StgMutArrPtrs*,obj);
- fprintf(stderr,"Row<%i>(",p->ptrs);
+ debugBelch("Row<%i>(",p->ptrs);
for (i = 0; i < p->ptrs; ++i) {
- if (i > 0) fprintf(stderr,", ");
+ if (i > 0) debugBelch(", ");
printPtr((StgPtr)(p->payload[i]));
}
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
}
#endif
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, link=%p)\n", mv->var, mv->mut_link);
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(");
+ debugBelch("FOREIGN(");
printPtr((StgPtr)( ((StgForeignObj*)obj)->data ));
- fprintf(stderr,")\n");
+ debugBelch(")\n");
break;
case STABLE_NAME:
- fprintf(stderr,"STABLE_NAME(%d)\n", ((StgStableName*)obj)->sn);
+ debugBelch("STABLE_NAME(%d)\n", ((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_R1p_info) {
- fprintf(stderr, "\t\t\tstg_ctoi_ret_R1p_info\n" );
+ debugBelch("\t\t\tstg_ctoi_ret_R1p_info\n" );
} else
if (c == (StgClosure*)&stg_ctoi_R1n_info) {
- fprintf(stderr, "\t\t\tstg_ctoi_ret_R1n_info\n" );
+ debugBelch("\t\t\tstg_ctoi_ret_R1n_info\n" );
} else
if (c == (StgClosure*)&stg_ctoi_F1_info) {
- fprintf(stderr, "\t\t\tstg_ctoi_ret_F1_info\n" );
+ debugBelch("\t\t\tstg_ctoi_ret_F1_info\n" );
} else
if (c == (StgClosure*)&stg_ctoi_D1_info) {
- fprintf(stderr, "\t\t\tstg_ctoi_ret_D1_info\n" );
+ debugBelch("\t\t\tstg_ctoi_ret_D1_info\n" );
} else
if (c == (StgClosure*)&stg_ctoi_V_info) {
- fprintf(stderr, "\t\t\tstg_ctoi_ret_V_info\n" );
+ 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[%d] (%p) = ", 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# %d\n", 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[%d] (%p) = ", 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# %d\n", 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,
p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE;
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);
+ debugBelch(" stk[%ld] (%p) = ", (long)(spBottom-p), p);
+ debugBelch("Word# %ld\n", (long)*p);
p++;
}
for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
- fprintf(stderr," stk[%ld] (%p) = ", (long)(spBottom-p), p);
+ 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;
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);
+ 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,
}
default:
- fprintf(stderr, "unknown object %d\n", info->type);
+ debugBelch("unknown object %d\n", info->type);
barf("printStackChunk");
}
}
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)
);
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 */
/* -----------------------------------------------------------------------------
- * $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
*
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);
}
/* open the log file */
if ((hp_file = fopen(hp_filename, "w")) == NULL) {
- fprintf(stderr, "Can't open profiling report file %s\n",
+ debugBelch("Can't open profiling report file %s\n",
hp_filename);
RtsFlags.ProfFlags.doHeapProfile = 0;
return;
#ifdef PROFILING
if (doingLDVProfiling() && doingRetainerProfiling()) {
- prog_belch("cannot mix -hb and -hr");
+ errorBelch("cannot mix -hb and -hr");
stg_exit(1);
}
#endif
strMatchesSelector( char* str, char* sel )
{
char* p;
- // fprintf(stderr, "str_matches_selector %s %s\n", str, sel);
+ // debugBelch("str_matches_selector %s %s\n", str, sel);
while (1) {
// Compare str against wherever we've got to in sel.
p = str;
// totals *must* be zero.
ASSERT(c->c.ldv.void_total == 0 && c->c.ldv.drag_total == 0);
- // fprintCCS(stderr,c->identity);
- // fprintf(stderr," census=%d void_total=%d drag_total=%d\n",
+ // debugCCS(c->identity);
+ // debugBelch(" census=%d void_total=%d drag_total=%d\n",
// t, c->c.ldv.void_total, c->c.ldv.drag_total);
} else {
d->c.ldv.void_total += c->c.ldv.void_total;
/* -----------------------------------------------------------------------------
- * $Id: Profiling.c,v 1.39 2004/09/01 08:43:23 simonmar Exp $
+ * $Id: Profiling.c,v 1.40 2004/09/03 15:28:37 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
/* open the log file */
if ((prof_file = fopen(prof_filename, "w")) == NULL) {
- fprintf(stderr, "Can't open profiling report file %s\n", prof_filename);
+ debugBelch("Can't open profiling report file %s\n", prof_filename);
RtsFlags.CcFlags.doCostCentres = 0;
// The following line was added by Sung; retainer/LDV profiling may need
// two output files, i.e., <program>.prof/hp.
/* open the log file */
if ((hp_file = fopen(hp_filename, "w")) == NULL) {
- fprintf(stderr, "Can't open profiling report file %s\n",
+ debugBelch("Can't open profiling report file %s\n",
hp_filename);
RtsFlags.ProfFlags.doHeapProfile = 0;
return;
#define PushCostCentre _PushCostCentre
{
IF_DEBUG(prof,
- fprintf(stderr,"Pushing %s on ", cc->label);
- fprintCCS(stderr,ccs);
- fprintf(stderr,"\n"));
+ debugBelch("Pushing %s on ", cc->label);
+ debugCCS(ccs);
+ debugBelch("\n"));
return PushCostCentre(ccs,cc);
}
#endif
{
IF_DEBUG(prof,
if (ccs1 != ccs2) {
- fprintf(stderr,"Appending ");
- fprintCCS(stderr,ccs1);
- fprintf(stderr," to ");
- fprintCCS(stderr,ccs2);
- fprintf(stderr,"\n");});
+ debugBelch("Appending ");
+ debugCCS(ccs1);
+ debugBelch(" to ");
+ debugCCS(ccs2);
+ debugBelch("\n");});
return AppendCCS(ccs1,ccs2);
}
#endif
fprintf(f,">");
}
+#ifdef DEBUG
+void
+debugCCS( CostCentreStack *ccs )
+{
+ debugBelch("<");
+ for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
+ debugBelch("%s.%s", ccs->cc->module, ccs->cc->label);
+ if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
+ debugBelch(",");
+ }
+ }
+ debugBelch(">");
+}
+#endif // DEBUG
+
#endif /* PROFILING */
*
* ---------------------------------------------------------------------------*/
+#include <stdio.h>
+
#if defined(PROFILING) || defined(DEBUG)
void initProfiling1 ( void );
void initProfiling2 ( void );
extern void fprintCCS( FILE *f, CostCentreStack *ccs );
+#ifdef DEBUG
+extern void debugCCS( CostCentreStack *ccs );
+#endif
+
#endif
/* -----------------------------------------------------------------------------
- * $Id: Proftimer.c,v 1.12 2003/02/22 04:51:52 sof Exp $
+ * $Id: Proftimer.c,v 1.13 2004/09/03 15:28:37 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "PosixSource.h"
-#include <stdio.h>
-
#include "Rts.h"
#include "Profiling.h"
#include "Timer.h"
/* -----------------------------------------------------------------------------
- * $Id: RetainerProfile.c,v 1.11 2004/08/13 13:10:28 simonmar Exp $
+ * $Id: RetainerProfile.c,v 1.12 2004/09/03 15:28:38 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
#define INLINE inline
#endif
-#include <stdio.h>
-
#include "Rts.h"
#include "RtsUtils.h"
#include "RetainerProfile.h"
bdescr *nbd; // Next Block Descriptor
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "push(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
+ // debugBelch("push(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
#endif
ASSERT(get_itbl(c)->type != TSO);
if (stackTop - 1 < stackBottom) {
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "push() to the next stack.\n");
+ // debugBelch("push() to the next stack.\n");
#endif
// currentStack->free is updated when the active stack is switched
// to the next stack.
stackSize++;
if (stackSize > maxStackSize) maxStackSize = stackSize;
// ASSERT(stackSize >= 0);
- // fprintf(stderr, "stackSize = %d\n", stackSize);
+ // debugBelch("stackSize = %d\n", stackSize);
#endif
}
bdescr *pbd; // Previous Block Descriptor
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "pop() to the previous stack.\n");
+ // debugBelch("pop() to the previous stack.\n");
#endif
ASSERT(stackTop + 1 == stackLimit);
if (stackSize > maxStackSize) maxStackSize = stackSize;
/*
ASSERT(stackSize >= 0);
- fprintf(stderr, "stackSize = %d\n", stackSize);
+ debugBelch("stackSize = %d\n", stackSize);
*/
#endif
return;
if (stackSize > maxStackSize) maxStackSize = stackSize;
/*
ASSERT(stackSize >= 0);
- fprintf(stderr, "stackSize = %d\n", stackSize);
+ debugBelch("stackSize = %d\n", stackSize);
*/
#endif
}
static INLINE void
popOff(void) {
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "\tpopOff(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
+ // debugBelch("\tpopOff(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
#endif
ASSERT(stackTop != stackLimit);
if (stackSize > maxStackSize) maxStackSize = stackSize;
/*
ASSERT(stackSize >= 0);
- fprintf(stderr, "stackSize = %d\n", stackSize);
+ debugBelch("stackSize = %d\n", stackSize);
*/
#endif
return;
stackElement *se;
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "pop(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
+ // debugBelch("pop(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
#endif
do {
currentStackBoundary = stackTop;
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary);
+ // debugBelch("retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary);
#endif
ASSERT(get_itbl(c)->type != TSO ||
// restore currentStackBoundary
currentStackBoundary = oldStackBoundary;
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "retainStack() finished: currentStackBoundary = 0x%x\n", currentStackBoundary);
+ // debugBelch("retainStack() finished: currentStackBoundary = 0x%x\n", currentStackBoundary);
#endif
#ifdef DEBUG_RETAINER
#ifdef DEBUG_RETAINER
// oldStackTop = stackTop;
- // fprintf(stderr, "retainClosure() called: c0 = 0x%x, cp0 = 0x%x, r0 = 0x%x\n", c0, cp0, r0);
+ // debugBelch("retainClosure() called: c0 = 0x%x, cp0 = 0x%x, r0 = 0x%x\n", c0, cp0, r0);
#endif
// (c, cp, r) = (c0, cp0, r0)
goto inner_loop;
loop:
- //fprintf(stderr, "loop");
+ //debugBelch("loop");
// pop to (c, cp, r);
pop(&c, &cp, &r);
if (c == NULL) {
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "retainClosure() ends: oldStackTop = 0x%x, stackTop = 0x%x\n", oldStackTop, stackTop);
+ // debugBelch("retainClosure() ends: oldStackTop = 0x%x, stackTop = 0x%x\n", oldStackTop, stackTop);
#endif
return;
}
- //fprintf(stderr, "inner_loop");
+ //debugBelch("inner_loop");
inner_loop:
// c = current closure under consideration,
if (((StgTSO *)c)->what_next == ThreadComplete ||
((StgTSO *)c)->what_next == ThreadKilled) {
#ifdef DEBUG_RETAINER
- fprintf(stderr, "ThreadComplete or ThreadKilled encountered in retainClosure()\n");
+ debugBelch("ThreadComplete or ThreadKilled encountered in retainClosure()\n");
#endif
goto loop;
}
if (((StgTSO *)c)->what_next == ThreadRelocated) {
#ifdef DEBUG_RETAINER
- fprintf(stderr, "ThreadRelocated encountered in retainClosure()\n");
+ debugBelch("ThreadRelocated encountered in retainClosure()\n");
#endif
c = (StgClosure *)((StgTSO *)c)->link;
goto inner_loop;
}
}
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "count in scavenged_static_objects = %d\n", count);
+ // debugBelch("count in scavenged_static_objects = %d\n", count);
#endif
}
#endif
#ifdef DEBUG_RETAINER
- fprintf(stderr, " < retainerProfile() invoked : %d>\n", retainerGeneration);
+ debugBelch(" < retainerProfile() invoked : %d>\n", retainerGeneration);
#endif
stat_startRP();
// We haven't flipped the bit yet.
#ifdef DEBUG_RETAINER
- fprintf(stderr, "Before traversing:\n");
+ debugBelch("Before traversing:\n");
sumOfCostLinear = 0;
for (i = 0;i < N_CLOSURE_TYPES; i++)
costArrayLinear[i] = 0;
totalHeapSize = checkHeapSanityForRetainerProfiling();
- fprintf(stderr, "\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
+ debugBelch("\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
/*
- fprintf(stderr, "costArrayLinear[] = ");
+ debugBelch("costArrayLinear[] = ");
for (i = 0;i < N_CLOSURE_TYPES; i++)
- fprintf(stderr, "[%u:%u] ", i, costArrayLinear[i]);
- fprintf(stderr, "\n");
+ debugBelch("[%u:%u] ", i, costArrayLinear[i]);
+ debugBelch("\n");
*/
ASSERT(sumOfCostLinear == totalHeapSize);
/*
#define pcostArrayLinear(index) \
if (costArrayLinear[index] > 0) \
- fprintf(stderr, "costArrayLinear[" #index "] = %u\n", costArrayLinear[index])
+ debugBelch("costArrayLinear[" #index "] = %u\n", costArrayLinear[index])
pcostArrayLinear(THUNK_STATIC);
pcostArrayLinear(FUN_STATIC);
pcostArrayLinear(CONSTR_STATIC);
timesAnyObjectVisited = 0;
#ifdef DEBUG_RETAINER
- fprintf(stderr, "During traversing:\n");
+ debugBelch("During traversing:\n");
sumOfNewCost = 0;
sumOfNewCostExtra = 0;
for (i = 0;i < N_CLOSURE_TYPES; i++)
computeRetainerSet();
#ifdef DEBUG_RETAINER
- fprintf(stderr, "After traversing:\n");
+ debugBelch("After traversing:\n");
sumOfCostLinear = 0;
for (i = 0;i < N_CLOSURE_TYPES; i++)
costArrayLinear[i] = 0;
totalHeapSize = checkHeapSanityForRetainerProfiling();
- fprintf(stderr, "\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
+ debugBelch("\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
ASSERT(sumOfCostLinear == totalHeapSize);
// now, compare the two results
1) Dead weak pointers, whose type is CONSTR. These objects are not
reachable from any roots.
*/
- fprintf(stderr, "Comparison:\n");
- fprintf(stderr, "\tcostArrayLinear[] (must be empty) = ");
+ debugBelch("Comparison:\n");
+ debugBelch("\tcostArrayLinear[] (must be empty) = ");
for (i = 0;i < N_CLOSURE_TYPES; i++)
if (costArray[i] != costArrayLinear[i])
// nothing should be printed except MUT_VAR after major GCs
- fprintf(stderr, "[%u:%u] ", i, costArrayLinear[i]);
- fprintf(stderr, "\n");
+ debugBelch("[%u:%u] ", i, costArrayLinear[i]);
+ debugBelch("\n");
- fprintf(stderr, "\tsumOfNewCost = %u\n", sumOfNewCost);
- fprintf(stderr, "\tsumOfNewCostExtra = %u\n", sumOfNewCostExtra);
- fprintf(stderr, "\tcostArray[] (must be empty) = ");
+ debugBelch("\tsumOfNewCost = %u\n", sumOfNewCost);
+ debugBelch("\tsumOfNewCostExtra = %u\n", sumOfNewCostExtra);
+ debugBelch("\tcostArray[] (must be empty) = ");
for (i = 0;i < N_CLOSURE_TYPES; i++)
if (costArray[i] != costArrayLinear[i])
// nothing should be printed except MUT_VAR after major GCs
- fprintf(stderr, "[%u:%u] ", i, costArray[i]);
- fprintf(stderr, "\n");
+ debugBelch("[%u:%u] ", i, costArray[i]);
+ debugBelch("\n");
// only for major garbage collection
ASSERT(sumOfNewCost + sumOfNewCostExtra == sumOfCostLinear);
if (get_itbl(c)->type == CONSTR &&
!strcmp(get_itbl(c)->prof.closure_type, "DEAD_WEAK") &&
!strcmp(get_itbl(c)->prof.closure_desc, "DEAD_WEAK")) {
- fprintf(stderr, "\tUnvisited dead weak pointer object found: c = %p\n", c);
+ debugBelch("\tUnvisited dead weak pointer object found: c = %p\n", c);
costArray[get_itbl(c)->type] += cost(c);
sumOfNewCost += cost(c);
} else
- fprintf(stderr,
+ debugBelch(
"Unvisited object: flip = %d, c = %p(%d, %s, %s), rs = %p\n",
flip, c, get_itbl(c)->type,
get_itbl(c)->prof.closure_type, get_itbl(c)->prof.closure_desc,
RSET(c));
} else {
- // fprintf(stderr, "sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
+ // debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
}
info = get_itbl(c);
nat costSum, g, s;
costSum = 0;
- fprintf(stderr, "START: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+ debugBelch("START: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
if (RtsFlags.GcFlags.generations == 1) {
costSum += heapCheck(g0s0->to_blocks);
- fprintf(stderr, "heapCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+ debugBelch("heapCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
costSum += chainCheck(g0s0->large_objects);
- fprintf(stderr, "chainCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+ debugBelch("chainCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
} else {
for (g = 0; g < RtsFlags.GcFlags.generations; g++)
for (s = 0; s < generations[g].n_steps; s++) {
*/
if (g == 0 && s == 0) {
costSum += smallObjectPoolCheck();
- fprintf(stderr, "smallObjectPoolCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+ debugBelch("smallObjectPoolCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
costSum += chainCheck(generations[g].steps[s].large_objects);
- fprintf(stderr, "chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+ debugBelch("chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
} else {
costSum += heapCheck(generations[g].steps[s].blocks);
- fprintf(stderr, "heapCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+ debugBelch("heapCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
costSum += chainCheck(generations[g].steps[s].large_objects);
- fprintf(stderr, "chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
+ debugBelch("chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
}
}
}
if (*q == (StgWord)p) {
r = q;
while (!LOOKS_LIKE_GHC_INFO(*r)) r--;
- fprintf(stderr, "Found in gen[%d], step[%d]: q = %p, r = %p\n", g, s, q, r);
+ debugBelch("Found in gen[%d], step[%d]: q = %p, r = %p\n", g, s, q, r);
// return;
}
}
if (*q == (StgWord)p) {
r = q;
while (*r == 0 || !LOOKS_LIKE_GHC_INFO(*r)) r--;
- fprintf(stderr, "Found in gen[%d], large_objects: %p\n", g, r);
+ debugBelch("Found in gen[%d], large_objects: %p\n", g, r);
// return;
}
}
bd = generations[g].steps[s].blocks;
for (; bd; bd = bd->link) {
if (bd->start <= p && p < bd->free) {
- fprintf(stderr, "Belongs to gen[%d], step[%d]", g, s);
+ debugBelch("Belongs to gen[%d], step[%d]", g, s);
return;
}
}
bd = generations[g].steps[s].large_objects;
for (; bd; bd = bd->link) {
if (bd->start <= p && p < bd->start + getHeapClosureSize((StgClosure *)bd->start)) {
- fprintf(stderr, "Found in gen[%d], large_objects: %p\n", g, bd->start);
+ debugBelch("Found in gen[%d], large_objects: %p\n", g, bd->start);
return;
}
}
/* -----------------------------------------------------------------------------
- * $Id: RetainerSet.c,v 1.5 2003/11/12 17:49:08 sof Exp $
+ * $Id: RetainerSet.c,v 1.6 2004/09/03 15:28:39 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
StgWord hk; // Hash Key
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "addElement(%p, %p) = ", r, rs);
+ // debugBelch("addElement(%p, %p) = ", r, rs);
#endif
ASSERT(rs != NULL);
if (i < rs->num) continue;
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "%p\n", nrs);
+ // debugBelch("%p\n", nrs);
#endif
// The set we are seeking already exists!
return nrs;
hashTable[hash(hk)] = nrs;
#ifdef DEBUG_RETAINER
- // fprintf(stderr, "%p\n", nrs);
+ // debugBelch("%p\n", nrs);
#endif
return nrs;
}
/* -----------------------------------------------------------------------------
- * $Id: RetainerSet.h,v 1.2 2001/11/26 16:54:21 simonmar Exp $
+ * $Id: RetainerSet.h,v 1.3 2004/09/03 15:28:39 simonmar Exp $
*
* (c) The GHC Team, 2001
* Author: Sungwoo Park
#ifndef RETAINERSET_H
#define RETAINERSET_H
+#include <stdio.h>
+
#ifdef PROFILING
/*
/* ----------------------------------------------------------------------------
- * $Id: RtsAPI.c,v 1.51 2003/12/17 12:17:18 simonmar Exp $
+ * $Id: RtsAPI.c,v 1.52 2004/09/03 15:28:39 simonmar Exp $
*
* (c) The GHC Team, 1998-2001
*
case Success:
return;
case Killed:
- prog_belch("%s: uncaught exception",site);
+ errorBelch("%s: uncaught exception",site);
stg_exit(EXIT_FAILURE);
case Interrupted:
- prog_belch("%s: interrupted", site);
+ errorBelch("%s: interrupted", site);
stg_exit(EXIT_FAILURE);
default:
- prog_belch("%s: Return code (%d) not ok",(site),(rc));
+ errorBelch("%s: Return code (%d) not ok",(site),(rc));
stg_exit(EXIT_FAILURE);
}
}
/* -----------------------------------------------------------------------------
- * $Id: RtsFlags.c,v 1.75 2004/08/13 13:10:29 simonmar Exp $
+ * $Id: RtsFlags.c,v 1.76 2004/09/03 15:28:40 simonmar Exp $
*
* (c) The AQUA Project, Glasgow University, 1994-1997
* (c) The GHC Team, 1998-1999
Static function decls
-------------------------------------------------------------------------- */
-static FILE * /* return NULL on error */
+static int /* return NULL on error */
open_stats_file (
I_ arg,
int argc, char *argv[],
int rts_argc, char *rts_argv[],
- const char *FILENAME_FMT);
+ const char *FILENAME_FMT,
+ FILE **file_ret);
static I_ decode(const char *s);
static void bad_option(const char *s);
for (arg = 0; arg < *rts_argc; arg++) {
if (rts_argv[arg][0] != '-') {
fflush(stdout);
- prog_belch("unexpected RTS argument: %s", rts_argv[arg]);
+ errorBelch("unexpected RTS argument: %s", rts_argv[arg]);
error = rtsTrue;
} else {
# define TICKY_BUILD_ONLY(x) x
#else
# define TICKY_BUILD_ONLY(x) \
-prog_belch("not built for: ticky-ticky stats"); \
+errorBelch("not built for: ticky-ticky stats"); \
error = rtsTrue;
#endif
# define COST_CENTRE_USING_BUILD_ONLY(x) x
#else
# define COST_CENTRE_USING_BUILD_ONLY(x) \
-prog_belch("not built for: -prof or -parallel"); \
+errorBelch("not built for: -prof or -parallel"); \
error = rtsTrue;
#endif
# define PROFILING_BUILD_ONLY(x) x
#else
# define PROFILING_BUILD_ONLY(x) \
-prog_belch("not built for: -prof"); \
+errorBelch("not built for: -prof"); \
error = rtsTrue;
#endif
# define SMP_BUILD_ONLY(x) x
#else
# define SMP_BUILD_ONLY(x) \
-prog_belch("not built for: -smp"); \
+errorBelch("not built for: -smp"); \
error = rtsTrue;
#endif
# define PAR_BUILD_ONLY(x) x
#else
# define PAR_BUILD_ONLY(x) \
-prog_belch("not built for: -parallel"); \
+errorBelch("not built for: -parallel"); \
error = rtsTrue;
#endif
# define PAR_OR_SMP_BUILD_ONLY(x) x
#else
# define PAR_OR_SMP_BUILD_ONLY(x) \
-prog_belch("not built for: -parallel or -smp"); \
+errorBelch("not built for: -parallel or -smp"); \
error = rtsTrue;
#endif
# define GRAN_BUILD_ONLY(x) x
#else
# define GRAN_BUILD_ONLY(x) \
-prog_belch("not built for: -gransim"); \
+errorBelch("not built for: -gransim"); \
error = rtsTrue;
#endif
#ifdef PAR
/* Opening all those files would almost certainly fail... */
// RtsFlags.ParFlags.ParStats.Full = rtsTrue;
- RtsFlags.GcFlags.statsFile = stderr; /* temporary; ToDo: rm */
+ RtsFlags.GcFlags.statsFile = NULL; /* temporary; ToDo: rm */
#else
- RtsFlags.GcFlags.statsFile
- = open_stats_file(arg, *argc, argv,
- *rts_argc, rts_argv, STAT_FILENAME_FMT);
-
- if (RtsFlags.GcFlags.statsFile == NULL) error = rtsTrue;
+ {
+ int r;
+ r = open_stats_file(arg, *argc, argv,
+ *rts_argc, rts_argv, STAT_FILENAME_FMT,
+ &RtsFlags.GcFlags.statsFile);
+ if (r == -1) { error = rtsTrue; }
+ }
#endif
break;
RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE;
break;
default:
- prog_belch("invalid heap profile option: %s",rts_argv[arg]);
+ errorBelch("invalid heap profile option: %s",rts_argv[arg]);
error = rtsTrue;
}
#else
}
if (RtsFlags.ProfFlags.doHeapProfile != 0) {
- prog_belch("multiple heap profile options");
+ errorBelch("multiple heap profile options");
error = rtsTrue;
break;
}
break;
default:
- prog_belch("invalid heap profile option: %s",rts_argv[arg]);
+ errorBelch("invalid heap profile option: %s",rts_argv[arg]);
error = rtsTrue;
}
)
RtsFlags.ParFlags.nNodes
= strtol(rts_argv[arg]+2, (char **) NULL, 10);
if (RtsFlags.ParFlags.nNodes <= 0) {
- prog_belch("bad value for -N");
+ errorBelch("bad value for -N");
error = rtsTrue;
}
}
RtsFlags.ParFlags.maxLocalSparks
= strtol(rts_argv[arg]+2, (char **) NULL, 10);
if (RtsFlags.ParFlags.maxLocalSparks <= 0) {
- prog_belch("bad value for -e");
+ errorBelch("bad value for -e");
error = rtsTrue;
}
}
TICKY_BUILD_ONLY(
RtsFlags.TickyFlags.showTickyStats = rtsTrue;
- RtsFlags.TickyFlags.tickyFile
- = open_stats_file(arg, *argc, argv,
- *rts_argc, rts_argv, TICKY_FILENAME_FMT);
- if (RtsFlags.TickyFlags.tickyFile == NULL) error = rtsTrue;
+ {
+ int r;
+ r = open_stats_file(arg, *argc, argv,
+ *rts_argc, rts_argv, TICKY_FILENAME_FMT,
+ &RtsFlags.TickyFlags.tickyFile);
+ if (r == -1) { error = rtsTrue; }
+ }
) break;
/* =========== EXTENDED OPTIONS =================== */
case 'x': /* Extend the argument space */
switch(rts_argv[arg][2]) {
case '\0':
- prog_belch("incomplete RTS option: %s",rts_argv[arg]);
+ errorBelch("incomplete RTS option: %s",rts_argv[arg]);
error = rtsTrue;
break;
/* The option prefix '-xx' is reserved for future extension. KSW 1999-11. */
default:
- prog_belch("unknown RTS option: %s",rts_argv[arg]);
+ errorBelch("unknown RTS option: %s",rts_argv[arg]);
error = rtsTrue;
break;
}
/* =========== OH DEAR ============================ */
default:
- prog_belch("unknown RTS option: %s",rts_argv[arg]);
+ errorBelch("unknown RTS option: %s",rts_argv[arg]);
error = rtsTrue;
break;
}
fflush(stdout);
for (p = usage_text; *p; p++)
- belch("%s", *p);
+ errorBelch("%s", *p);
stg_exit(EXIT_FAILURE);
}
}
static void
enable_GranSimLight(void) {
- fprintf(stderr,"GrAnSim Light enabled (infinite number of processors; 0 communication costs)\n");
+ debugBelch("GrAnSim Light enabled (infinite number of processors; 0 communication costs)\n");
RtsFlags.GranFlags.Light=rtsTrue;
RtsFlags.GranFlags.Costs.latency =
RtsFlags.GranFlags.Costs.fetchtime =
RtsFlags.GranFlags.Costs.pri_spark_overhead = decode(rts_argv[arg]+3);
else
RtsFlags.GranFlags.Costs.pri_spark_overhead = PRI_SPARK_OVERHEAD;
- fprintf(stderr,"Overhead for pri spark: %d (per elem).\n",
+ debugBelch("Overhead for pri spark: %d (per elem).\n",
RtsFlags.GranFlags.Costs.pri_spark_overhead);
break;
RtsFlags.GranFlags.Costs.pri_sched_overhead = decode(rts_argv[arg]+3);
else
RtsFlags.GranFlags.Costs.pri_sched_overhead = PRI_SCHED_OVERHEAD;
- fprintf(stderr,"Overhead for pri sched: %d (per elem).\n",
+ debugBelch("Overhead for pri sched: %d (per elem).\n",
RtsFlags.GranFlags.Costs.pri_sched_overhead);
break;
} else if (RtsFlags.GranFlags.proc > MAX_PROC ||
RtsFlags.GranFlags.proc < 1)
{
- fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n",
+ debugBelch("setupRtsFlags: no more than %u processors allowed\n",
MAX_PROC);
*error = rtsTrue;
}
break;
case 'G':
- fprintf(stderr,"Bulk fetching enabled.\n");
+ debugBelch("Bulk fetching enabled.\n");
RtsFlags.GranFlags.DoBulkFetching=rtsTrue;
break;
case 'M':
- fprintf(stderr,"Thread migration enabled.\n");
+ debugBelch("Thread migration enabled.\n");
RtsFlags.GranFlags.DoThreadMigration=rtsTrue;
break;
case 'R':
- fprintf(stderr,"Fair Scheduling enabled.\n");
+ debugBelch("Fair Scheduling enabled.\n");
RtsFlags.GranFlags.DoFairSchedule=rtsTrue;
break;
case 'I':
- fprintf(stderr,"Priority Scheduling enabled.\n");
+ debugBelch("Priority Scheduling enabled.\n");
RtsFlags.GranFlags.DoPriorityScheduling=rtsTrue;
break;
arg0 = rts_argv[arg]+3;
if ((tmp = strstr(arg0,","))==NULL) {
RtsFlags.GranFlags.SparkPriority = decode(arg0);
- fprintf(stderr,"SparkPriority: %u.\n",RtsFlags.GranFlags.SparkPriority);
+ debugBelch("SparkPriority: %u.\n",RtsFlags.GranFlags.SparkPriority);
} else {
*(tmp++) = '\0';
RtsFlags.GranFlags.SparkPriority = decode(arg0);
RtsFlags.GranFlags.SparkPriority2 = decode(tmp);
- fprintf(stderr,"SparkPriority: %u.\n",
+ debugBelch("SparkPriority: %u.\n",
RtsFlags.GranFlags.SparkPriority);
- fprintf(stderr,"SparkPriority2:%u.\n",
+ debugBelch("SparkPriority2:%u.\n",
RtsFlags.GranFlags.SparkPriority2);
if (RtsFlags.GranFlags.SparkPriority2 <
RtsFlags.GranFlags.SparkPriority) {
- fprintf(stderr,"WARNING: 2nd pri < main pri (%u<%u); 2nd pri has no effect\n",
+ debugBelch("WARNING: 2nd pri < main pri (%u<%u); 2nd pri has no effect\n",
RtsFlags.GranFlags.SparkPriority2,
RtsFlags.GranFlags.SparkPriority);
}
} else {
/* plain pri spark is now invoked with -bX
RtsFlags.GranFlags.DoPrioritySparking = 1;
- fprintf(stderr,"PrioritySparking.\n");
+ debugBelch("PrioritySparking.\n");
*/
}
break;
} else {
RtsFlags.GranFlags.ThunksToPack = 1;
}
- fprintf(stderr,"Thunks To Pack in one packet: %u.\n",
+ debugBelch("Thunks To Pack in one packet: %u.\n",
RtsFlags.GranFlags.ThunksToPack);
break;
case 'e':
RtsFlags.GranFlags.RandomSteal = rtsFalse;
- fprintf(stderr,"Deterministic mode (no random stealing)\n");
+ debugBelch("Deterministic mode (no random stealing)\n");
break;
/* The following class of options contains eXperimental */
} else {
RtsFlags.GranFlags.packBufferSize_internal = GRANSIM_DEFAULT_PACK_BUFFER_SIZE;
}
- fprintf(stderr,"Size of GranSim internal pack buffer: %u.\n",
+ debugBelch("Size of GranSim internal pack buffer: %u.\n",
RtsFlags.GranFlags.packBufferSize_internal);
break;
case '\0':
RtsFlags.GranFlags.DoPrioritySparking = 1;
- fprintf(stderr,"Priority Sparking with Normal Priorities.\n");
+ debugBelch("Priority Sparking with Normal Priorities.\n");
RtsFlags.GranFlags.InversePriorities = rtsFalse;
RtsFlags.GranFlags.RandomPriorities = rtsFalse;
RtsFlags.GranFlags.IgnorePriorities = rtsFalse;
case 'I':
RtsFlags.GranFlags.DoPrioritySparking = 1;
- fprintf(stderr,"Priority Sparking with Inverse Priorities.\n");
+ debugBelch("Priority Sparking with Inverse Priorities.\n");
RtsFlags.GranFlags.InversePriorities++;
break;
case 'R':
RtsFlags.GranFlags.DoPrioritySparking = 1;
- fprintf(stderr,"Priority Sparking with Random Priorities.\n");
+ debugBelch("Priority Sparking with Random Priorities.\n");
RtsFlags.GranFlags.RandomPriorities++;
break;
case 'N':
RtsFlags.GranFlags.DoPrioritySparking = 1;
- fprintf(stderr,"Priority Sparking with No Priorities.\n");
+ debugBelch("Priority Sparking with No Priorities.\n");
RtsFlags.GranFlags.IgnorePriorities++;
break;
case 'Q': /* Set pack buffer size (same as 'Q' in GUM) */
if (rts_argv[arg][4] != '\0') {
RtsFlags.GranFlags.packBufferSize = decode(rts_argv[arg]+4);
- fprintf(stderr,"Pack buffer size: %d\n",
+ debugBelch("Pack buffer size: %d\n",
RtsFlags.GranFlags.packBufferSize);
} else {
- fprintf(stderr, "setupRtsFlags: missing size of PackBuffer (for -Q)\n");
+ debugBelch("setupRtsFlags: missing size of PackBuffer (for -Q)\n");
*error = rtsTrue;
}
break;
break;
if (i==MAX_GRAN_DEBUG_OPTION+1) {
- fprintf(stderr, "Valid GranSim debug options are:\n");
+ debugBelch("Valid GranSim debug options are:\n");
help_GranSim_debug_options(MAX_GRAN_DEBUG_MASK);
bad_option( rts_argv[arg] );
} else { // flag found; now set it
#if 0
case 'e': /* event trace; also -bD1 */
- fprintf(stderr,"DEBUG: event_trace; printing event trace.\n");
+ debugBelch("DEBUG: event_trace; printing event trace.\n");
RtsFlags.GranFlags.Debug.event_trace = rtsTrue;
/* RtsFlags.GranFlags.event_trace=rtsTrue; */
break;
case 'E': /* event statistics; also -bD2 */
- fprintf(stderr,"DEBUG: event_stats; printing event statistics.\n");
+ debugBelch("DEBUG: event_stats; printing event statistics.\n");
RtsFlags.GranFlags.Debug.event_stats = rtsTrue;
/* RtsFlags.GranFlags.Debug |= 0x20; print event statistics */
break;
case 'f': /* thunkStealing; also -bD4 */
- fprintf(stderr,"DEBUG: thunkStealing; printing forwarding of FETCHNODES.\n");
+ debugBelch("DEBUG: thunkStealing; printing forwarding of FETCHNODES.\n");
RtsFlags.GranFlags.Debug.thunkStealing = rtsTrue;
/* RtsFlags.GranFlags.Debug |= 0x2; print fwd messages */
break;
case 'z': /* blockOnFetch; also -bD8 */
- fprintf(stderr,"DEBUG: blockOnFetch; check for blocked on fetch.\n");
+ debugBelch("DEBUG: blockOnFetch; check for blocked on fetch.\n");
RtsFlags.GranFlags.Debug.blockOnFetch = rtsTrue;
/* RtsFlags.GranFlags.Debug |= 0x4; debug non-reschedule-on-fetch */
break;
case 't': /* blockOnFetch_sanity; also -bD16 */
- fprintf(stderr,"DEBUG: blockOnFetch_sanity; check for TSO asleep on fetch.\n");
+ debugBelch("DEBUG: blockOnFetch_sanity; check for TSO asleep on fetch.\n");
RtsFlags.GranFlags.Debug.blockOnFetch_sanity = rtsTrue;
/* RtsFlags.GranFlags.Debug |= 0x10; debug TSO asleep for fetch */
break;
case 'S': /* priSpark; also -bD32 */
- fprintf(stderr,"DEBUG: priSpark; priority sparking.\n");
+ debugBelch("DEBUG: priSpark; priority sparking.\n");
RtsFlags.GranFlags.Debug.priSpark = rtsTrue;
break;
case 's': /* priSched; also -bD64 */
- fprintf(stderr,"DEBUG: priSched; priority scheduling.\n");
+ debugBelch("DEBUG: priSched; priority scheduling.\n");
RtsFlags.GranFlags.Debug.priSched = rtsTrue;
break;
case 'F': /* findWork; also -bD128 */
- fprintf(stderr,"DEBUG: findWork; searching spark-pools (local & remote), thread queues for work.\n");
+ debugBelch("DEBUG: findWork; searching spark-pools (local & remote), thread queues for work.\n");
RtsFlags.GranFlags.Debug.findWork = rtsTrue;
break;
case 'g': /* globalBlock; also -bD256 */
- fprintf(stderr,"DEBUG: globalBlock; blocking on remote closures (FETCHMEs etc in GUM).\n");
+ debugBelch("DEBUG: globalBlock; blocking on remote closures (FETCHMEs etc in GUM).\n");
RtsFlags.GranFlags.Debug.globalBlock = rtsTrue;
break;
case 'G': /* pack; also -bD512 */
- fprintf(stderr,"DEBUG: pack; routines for (un-)packing graph structures.\n");
+ debugBelch("DEBUG: pack; routines for (un-)packing graph structures.\n");
RtsFlags.GranFlags.Debug.pack = rtsTrue;
break;
case 'P': /* packBuffer; also -bD1024 */
- fprintf(stderr,"DEBUG: packBuffer; routines handling pack buffer (GranSim internal!).\n");
+ debugBelch("DEBUG: packBuffer; routines handling pack buffer (GranSim internal!).\n");
RtsFlags.GranFlags.Debug.packBuffer = rtsTrue;
break;
case 'o': /* sortedQ; also -bD2048 */
- fprintf(stderr,"DEBUG: sortedQ; check whether spark/thread queues are sorted.\n");
+ debugBelch("DEBUG: sortedQ; check whether spark/thread queues are sorted.\n");
RtsFlags.GranFlags.Debug.sortedQ = rtsTrue;
break;
case 'r': /* randomSteal; also -bD4096 */
- fprintf(stderr,"DEBUG: randomSteal; stealing sparks/threads from random PEs.\n");
+ debugBelch("DEBUG: randomSteal; stealing sparks/threads from random PEs.\n");
RtsFlags.GranFlags.Debug.randomSteal = rtsTrue;
break;
case 'q': /* checkSparkQ; also -bD8192 */
- fprintf(stderr,"DEBUG: checkSparkQ; check consistency of the spark queues.\n");
+ debugBelch("DEBUG: checkSparkQ; check consistency of the spark queues.\n");
RtsFlags.GranFlags.Debug.checkSparkQ = rtsTrue;
break;
case ':': /* checkLight; also -bD16384 */
- fprintf(stderr,"DEBUG: checkLight; check GranSim-Light setup.\n");
+ debugBelch("DEBUG: checkLight; check GranSim-Light setup.\n");
RtsFlags.GranFlags.Debug.checkLight = rtsTrue;
break;
case 'b': /* bq; also -bD32768 */
- fprintf(stderr,"DEBUG: bq; check blocking queues\n");
+ debugBelch("DEBUG: bq; check blocking queues\n");
RtsFlags.GranFlags.Debug.bq = rtsTrue;
break;
case 'd': /* all options turned on */
- fprintf(stderr,"DEBUG: all options turned on.\n");
+ debugBelch("DEBUG: all options turned on.\n");
set_GranSim_debug_options(MAX_GRAN_DEBUG_MASK);
/* RtsFlags.GranFlags.Debug |= 0x40; */
break;
for (i=0; i<=MAX_GRAN_DEBUG_OPTION; i++)
if ((n>>i)&1) {
- fprintf(stderr, gran_debug_opts_strs[i]);
+ errorBelch(gran_debug_opts_strs[i]);
switch (i) {
case 0: RtsFlags.GranFlags.Debug.event_trace = rtsTrue; break;
case 1: RtsFlags.GranFlags.Debug.event_stats = rtsTrue; break;
for (i=0; i<=MAX_GRAN_DEBUG_OPTION; i++)
if ((n>>i)&1)
- fprintf(stderr, gran_debug_opts_strs[i]);
+ debugBelch(gran_debug_opts_strs[i]);
}
# elif defined(PAR)
{
if (rts_argv[arg][1] != 'q') { /* All GUM options start with -q */
- belch("Warning: GUM option does not start with -q: %s", rts_argv[arg]);
+ errorBelch("Warning: GUM option does not start with -q: %s", rts_argv[arg]);
return;
}
= strtol(rts_argv[arg]+3, (char **) NULL, 10);
if (RtsFlags.ParFlags.maxLocalSparks <= 0) {
- belch("setupRtsFlags: bad value for -e\n");
+ errorBelch("setupRtsFlags: bad value for -e\n");
*error = rtsTrue;
}
}
IF_PAR_DEBUG(verbose,
- belch("-qe<n>: max %d local sparks",
+ errorBelch("-qe<n>: max %d local sparks",
RtsFlags.ParFlags.maxLocalSparks));
break;
RtsFlags.ParFlags.maxThreads
= strtol(rts_argv[arg]+3, (char **) NULL, 10);
} else {
- belch("setupRtsFlags: missing size for -qt\n");
+ errorBelch("missing size for -qt\n");
*error = rtsTrue;
}
IF_PAR_DEBUG(verbose,
- belch("-qt<n>: max %d threads",
+ errorBelch("-qt<n>: max %d threads",
RtsFlags.ParFlags.maxThreads));
break;
RtsFlags.ParFlags.maxFishes = MAX_FISHES;
break;
IF_PAR_DEBUG(verbose,
- belch("-qf<n>: max %d fishes sent out at one time",
+ errorBelch("-qf<n>: max %d fishes sent out at one time",
RtsFlags.ParFlags.maxFishes));
break;
RtsFlags.ParFlags.fishDelay
= strtol(rts_argv[arg]+3, (char **) NULL, 10);
} else {
- belch("setupRtsFlags: missing fish delay time for -qF\n");
+ errorBelch("missing fish delay time for -qF\n");
*error = rtsTrue;
}
IF_PAR_DEBUG(verbose,
- belch("-qF<n>: fish delay time %d us",
+ errorBelch("-qF<n>: fish delay time %d us",
RtsFlags.ParFlags.fishDelay));
break;
case 'O':
RtsFlags.ParFlags.outputDisabled = rtsTrue;
IF_PAR_DEBUG(verbose,
- belch("-qO: output disabled"));
+ errorBelch("-qO: output disabled"));
break;
case 'g': /* -qg<n> ... globalisation scheme */
if (rts_argv[arg][3] != '\0') {
RtsFlags.ParFlags.globalising = decode(rts_argv[arg]+3);
} else {
- belch("setupRtsFlags: missing identifier for globalisation scheme (for -qg)\n");
+ errorBelch("missing identifier for globalisation scheme (for -qg)\n");
*error = rtsTrue;
}
IF_PAR_DEBUG(verbose,
- belch("-qg<n>: globalisation scheme set to %d",
+ debugBelch("-qg<n>: globalisation scheme set to %d",
RtsFlags.ParFlags.globalising));
break;
if (rts_argv[arg][3] != '\0') {
RtsFlags.ParFlags.thunksToPack = decode(rts_argv[arg]+3);
} else {
- belch("setupRtsFlags: missing number of thunks per packet (for -qh)\n");
+ errorBelch("missing number of thunks per packet (for -qh)\n");
*error = rtsTrue;
}
IF_PAR_DEBUG(verbose,
- belch("-qh<n>: thunks per packet set to %d",
+ debugBelch("-qh<n>: thunks per packet set to %d",
RtsFlags.ParFlags.thunksToPack));
break;
# if defined(PAR_TICKY)
RtsFlags.ParFlags.ParStats.Global = rtsTrue;
# else
- fprintf(stderr,"-qPg is only possible for a PAR_TICKY RTS, which this is not");
+ errorBelch("-qPg is only possible for a PAR_TICKY RTS, which this is not");
stg_exit(EXIT_FAILURE);
# endif
break;
default: barf("Unknown option -qP%c", rts_argv[arg][2]);
}
IF_PAR_DEBUG(verbose,
- belch("(-qP) writing to log-file (RtsFlags.ParFlags.ParStats.Full=%s)",
+ debugBelch("(-qP) writing to log-file (RtsFlags.ParFlags.ParStats.Full=%s)",
(RtsFlags.ParFlags.ParStats.Full ? "rtsTrue" : "rtsFalse")));
break;
if (rts_argv[arg][3] != '\0') {
RtsFlags.ParFlags.packBufferSize = decode(rts_argv[arg]+3);
} else {
- belch("setupRtsFlags: missing size of PackBuffer (for -qQ)\n");
+ errorBelch("missing size of PackBuffer (for -qQ)\n");
*error = rtsTrue;
}
IF_PAR_DEBUG(verbose,
- belch("-qQ<n>: pack buffer size set to %d",
+ debugBelch("-qQ<n>: pack buffer size set to %d",
RtsFlags.ParFlags.packBufferSize));
break;
case 'R':
RtsFlags.ParFlags.doFairScheduling = rtsTrue;
IF_PAR_DEBUG(verbose,
- belch("-qR: fair-ish scheduling"));
+ debugBelch("-qR: fair-ish scheduling"));
break;
# if defined(DEBUG)
RtsFlags.ParFlags.wait = 1000;
}
IF_PAR_DEBUG(verbose,
- belch("-qw<n>: length of wait loop after synchr before reduction: %d",
+ debugBelch("-qw<n>: length of wait loop after synchr before reduction: %d",
RtsFlags.ParFlags.wait));
break;
break;
if (i==MAX_PAR_DEBUG_OPTION+1) {
- fprintf(stderr, "Valid GUM debug options are:\n");
+ errorBelch("Valid GUM debug options are:\n");
help_par_debug_options(MAX_PAR_DEBUG_MASK);
bad_option( rts_argv[arg] );
} else { // flag found; now set it
break;
# endif
default:
- belch("Unknown option -q%c (%d opts in total)",
+ errorBelch("Unknown option -q%c (%d opts in total)",
rts_argv[arg][2], *rts_argc);
break;
} /* switch */
for (i=0; i<=MAX_PAR_DEBUG_OPTION; i++)
if ((n>>i)&1) {
- fprintf(stderr, par_debug_opts_strs[i]);
+ debugBelch(par_debug_opts_strs[i]);
switch (i) {
case 0: RtsFlags.ParFlags.Debug.verbose = rtsTrue; break;
case 1: RtsFlags.ParFlags.Debug.bq = rtsTrue; break;
for (i=0; i<=MAX_PAR_DEBUG_OPTION; i++)
if ((n>>i)&1)
- fprintf(stderr, par_debug_opts_strs[i]);
+ debugBelch(par_debug_opts_strs[i]);
}
#endif /* PAR */
//@node Aux fcts, , GranSim specific options
//@subsection Aux fcts
-static FILE * /* return NULL on error */
+static void
+stats_fprintf(FILE *f, char *s, ...)
+{
+ va_list ap;
+ va_start(ap,s);
+ if (f == NULL) {
+ vdebugBelch(s, ap);
+ } else {
+ vfprintf(f, s, ap);
+ }
+ va_end(ap);
+}
+
+static int /* return -1 on error */
open_stats_file (
I_ arg,
int argc, char *argv[],
int rts_argc, char *rts_argv[],
- const char *FILENAME_FMT)
+ const char *FILENAME_FMT,
+ FILE **file_ret)
{
FILE *f = NULL;
- if (strequal(rts_argv[arg]+2, "stderr")) /* use real stderr */
- f = stderr;
- else if (rts_argv[arg][2] != '\0') /* stats file specified */
- f = fopen(rts_argv[arg]+2,"w");
- else {
- char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.<ext> */
- sprintf(stats_filename, FILENAME_FMT, argv[0]);
- f = fopen(stats_filename,"w");
- }
- if (f == NULL) {
- fprintf(stderr, "Can't open stats file %s\n", rts_argv[arg]+2);
+ if (strequal(rts_argv[arg]+2, "stderr")) { /* use debugBelch */
+ f = NULL; /* NULL means use debugBelch */
} else {
+ if (rts_argv[arg][2] != '\0') { /* stats file specified */
+ f = fopen(rts_argv[arg]+2,"w");
+ } else {
+ char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.<ext> */
+ sprintf(stats_filename, FILENAME_FMT, argv[0]);
+ f = fopen(stats_filename,"w");
+ }
+ if (f == NULL) {
+ errorBelch("Can't open stats file %s\n", rts_argv[arg]+2);
+ return -1;
+ }
+ }
+ *file_ret = f;
+
+ {
/* Write argv and rtsv into start of stats file */
- I_ count;
- for(count = 0; count < argc; count++)
- fprintf(f, "%s ", argv[count]);
- fprintf(f, "+RTS ");
+ int count;
+ for(count = 0; count < argc; count++) {
+ stats_fprintf(f, "%s ", argv[count]);
+ }
+ stats_fprintf(f, "+RTS ");
for(count = 0; count < rts_argc; count++)
- fprintf(f, "%s ", rts_argv[count]);
- fprintf(f, "\n");
+ stats_fprintf(f, "%s ", rts_argv[count]);
+ stats_fprintf(f, "\n");
}
-
- return(f);
+ return 0;
}
+
+
static I_
decode(const char *s)
{
static void
bad_option(const char *s)
{
- prog_belch("bad RTS option: %s", s);
+ errorBelch("bad RTS option: %s", s);
stg_exit(EXIT_FAILURE);
}
/* -----------------------------------------------------------------------------
- * $Id: RtsStartup.c,v 1.82 2004/08/21 12:48:00 panne Exp $
+ * $Id: RtsStartup.c,v 1.83 2004/09/03 15:28:42 simonmar Exp $
*
* (c) The GHC Team, 1998-2002
*
#if defined(PAR)
/* NB: this really must be done after processing the RTS flags */
IF_PAR_DEBUG(verbose,
- fprintf(stderr, "==== Synchronising system (%d PEs)\n", nPEs));
+ debugBelch("==== Synchronising system (%d PEs)\n", nPEs));
synchroniseSystem(); // calls initParallelSystem etc
#endif /* PAR */
return;
exit_started=rtsTrue;
- IF_PAR_DEBUG(verbose, fprintf(stderr,"==-- stg_exit %d on [%x]...", n, mytid));
+ IF_PAR_DEBUG(verbose, debugBelch("==-- stg_exit %d on [%x]...", n, mytid));
shutdownParallelSystem(n);
#endif
exit(n);
/* -----------------------------------------------------------------------------
- * $Id: RtsUtils.c,v 1.36 2003/10/21 11:51:15 stolz Exp $
*
- * (c) The GHC Team, 1998-2002
+ * (c) The GHC Team, 1998-2004
*
* General utility functions used in the RTS.
*
#include <stdlib.h>
#include <string.h>
#include <stdarg.h>
+#include <stdio.h>
-/* variable-argument internal error function. */
+/* -----------------------------------------------------------------------------
+ General message generation functions
+
+ All messages should go through here. We can't guarantee that
+ stdout/stderr will be available - e.g. in a Windows program there
+ is no console for generating messages, so they have to either go to
+ to the debug console, or pop up message boxes.
+ -------------------------------------------------------------------------- */
+
+RtsMsgFunction *fatalInternalMsgFn = stdioFatalInternalMsgFn;
+RtsMsgFunction *debugMsgFn = stdioDebugMsgFn;
+RtsMsgFunction *errorMsgFn = stdioErrorMsgFn;
void
barf(char *s, ...)
{
va_list ap;
va_start(ap,s);
+ (*fatalInternalMsgFn)(s,ap);
+ stg_exit(EXIT_INTERNAL_ERROR);
+ va_end(ap);
+}
+
+void
+errorBelch(char *s, ...)
+{
+ va_list ap;
+ va_start(ap,s);
+ (*errorMsgFn)(s,ap);
+ va_end(ap);
+}
+
+void
+debugBelch(char *s, ...)
+{
+ va_list ap;
+ va_start(ap,s);
+ (*debugMsgFn)(s,ap);
+ va_end(ap);
+}
+
+void
+vdebugBelch(char *s, va_list ap)
+{
+ (*debugMsgFn)(s,ap);
+}
+
+/* -----------------------------------------------------------------------------
+ stdio versions of the message functions
+ -------------------------------------------------------------------------- */
+
+void
+stdioFatalInternalMsgFn(char *s, va_list ap)
+{
/* don't fflush(stdout); WORKAROUND bug in Linux glibc */
if (prog_argv != NULL && prog_name != NULL) {
fprintf(stderr, "%s: internal error: ", prog_name);
fprintf(stderr, "\n");
fprintf(stderr, " Please report this as a bug to glasgow-haskell-bugs@haskell.org,\n or http://www.sourceforge.net/projects/ghc/\n");
fflush(stderr);
- stg_exit(EXIT_INTERNAL_ERROR);
- va_end(ap);
}
void
-prog_belch(char *s, ...)
+stdioErrorMsgFn(char *s, va_list ap)
{
- va_list ap;
- va_start(ap,s);
/* don't fflush(stdout); WORKAROUND bug in Linux glibc */
if (prog_argv != NULL && prog_name != NULL) {
fprintf(stderr, "%s: ", prog_name);
}
vfprintf(stderr, s, ap);
fprintf(stderr, "\n");
- va_end(ap);
}
void
-belch(char *s, ...)
+stdioDebugMsgFn(char *s, va_list ap)
{
- va_list ap;
- va_start(ap,s);
/* don't fflush(stdout); WORKAROUND bug in Linux glibc */
vfprintf(stderr, s, ap);
- fprintf(stderr, "\n");
- va_end(ap);
+ fflush(stderr);
}
-/* result-checking malloc wrappers. */
+/* -----------------------------------------------------------------------------
+ Result-checking malloc wrappers.
+ -------------------------------------------------------------------------- */
void *
stgMallocBytes (int n, char *msg)
#ifndef RTSUTILS_H
#define RTSUTILS_H
-/* (Checked) dynamic allocation: */
+#include <stdarg.h>
+
+/* -----------------------------------------------------------------------------
+ * Message generation
+ * -------------------------------------------------------------------------- */
+
+/*
+ * A fatal internal error: this is for errors that probably indicate
+ * bugs in the RTS or compiler. We normally output bug reporting
+ * instructions along with the error message.
+ */
+extern void barf(char *s, ...)
+ GNUC3_ATTRIBUTE(__noreturn__);
+
+/*
+ * An error condition which is caused by and/or can be corrected by
+ * the user.
+ */
+extern void errorBelch(char *s, ...)
+ GNUC3_ATTRIBUTE(format (printf, 1, 2));
+
+/*
+ * A debugging message. Debugging messages are generated either as a
+ * virtue of having DEBUG turned on, or by being explicitly selected
+ * via RTS options (eg. +RTS -Ds).
+ */
+extern void debugBelch(char *s, ...)
+ GNUC3_ATTRIBUTE(format (printf, 1, 2));
+
+/* Version of debugBelch() that takes parameters as a va_list */
+extern void vdebugBelch(char *s, va_list ap);
+
+/* Hooks for redirecting message generation: */
+
+typedef void RtsMsgFunction(char *, va_list);
+
+extern RtsMsgFunction *fatalInternalMsgFn;
+extern RtsMsgFunction *debugMsgFn;
+extern RtsMsgFunction *errorMsgFn;
+
+/* Default stdio implementation of the message hooks: */
+
+extern RtsMsgFunction stdioFatalInternalMsgFn;
+extern RtsMsgFunction stdioDebugMsgFn;
+extern RtsMsgFunction stdioErrorMsgFn;
+
+/* -----------------------------------------------------------------------------
+ * (Checked) dynamic allocation
+ * -------------------------------------------------------------------------- */
+
extern void *stgMallocBytes(int n, char *msg) GNUC3_ATTRIBUTE(__malloc__);
extern void *stgReallocBytes(void *p, int n, char *msg);
extern void *stgCallocBytes(int n, int m, char *msg) GNUC3_ATTRIBUTE(__malloc__);
extern void stgFree(void* p);
-extern void barf(char *s, ...) GNU_ATTRIBUTE(__noreturn__);
-extern void belch(char *s, ...);
-extern void prog_belch(char *s, ...);
+
+/* -----------------------------------------------------------------------------
+ * Misc other utilities
+ * -------------------------------------------------------------------------- */
extern void _stgAssert (char *filename, unsigned int linenum);
nat i, tsos;
StgTSO *tso;
- belch("Checking sanity of all runnable TSOs:");
+ debugBelch("Checking sanity of all runnable TSOs:");
for (i=0, tsos=0; i<RtsFlags.GranFlags.proc; i++) {
for (tso=run_queue_hds[i]; tso!=END_TSO_QUEUE; tso=tso->link) {
- fprintf(stderr, "TSO %p on PE %d ...", tso, i);
+ debugBelch("TSO %p on PE %d ...", tso, i);
checkTSO(tso);
- fprintf(stderr, "OK, ");
+ debugBelch("OK, ");
tsos++;
}
}
- belch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc);
+ debugBelch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc);
}
CurrentTSO, (StgClosure*)NULL, (rtsSpark*)NULL);
IF_DEBUG(gran,
- fprintf(stderr, "GRAN: Init CurrentTSO (in schedule) = %p\n", CurrentTSO);
+ debugBelch("GRAN: Init CurrentTSO (in schedule) = %p\n", CurrentTSO);
G_TSO(CurrentTSO, 5));
if (RtsFlags.GranFlags.Light) {
#if defined(RTS_SUPPORTS_THREADS)
// In the threaded RTS, deadlock detection doesn't work,
// so just exit right away.
- prog_belch("interrupted");
+ errorBelch("interrupted");
releaseCapability(cap);
RELEASE_LOCK(&sched_mutex);
shutdownHaskellAndExit(EXIT_SUCCESS);
if (!RtsFlags.GranFlags.Light)
handleIdlePEs();
- IF_DEBUG(gran, fprintf(stderr, "GRAN: switch by event-type\n"));
+ IF_DEBUG(gran, debugBelch("GRAN: switch by event-type\n"));
/* main event dispatcher in GranSim */
switch (event->evttype) {
/* Should just be continuing execution */
case ContinueThread:
- IF_DEBUG(gran, fprintf(stderr, "GRAN: doing ContinueThread\n"));
+ IF_DEBUG(gran, debugBelch("GRAN: doing ContinueThread\n"));
/* ToDo: check assertion
ASSERT(run_queue_hd != (StgTSO*)NULL &&
run_queue_hd != END_TSO_QUEUE);
/* Ignore ContinueThreads for fetching threads (if synchr comm) */
if (!RtsFlags.GranFlags.DoAsyncFetch &&
procStatus[CurrentProc]==Fetching) {
- belch("ghuH: Spurious ContinueThread while Fetching ignored; TSO %d (%p) [PE %d]",
+ debugBelch("ghuH: Spurious ContinueThread while Fetching ignored; TSO %d (%p) [PE %d]\n",
CurrentTSO->id, CurrentTSO, CurrentProc);
goto next_thread;
}
/* Ignore ContinueThreads for completed threads */
if (CurrentTSO->what_next == ThreadComplete) {
- belch("ghuH: found a ContinueThread event for completed thread %d (%p) [PE %d] (ignoring ContinueThread)",
+ debugBelch("ghuH: found a ContinueThread event for completed thread %d (%p) [PE %d] (ignoring ContinueThread)\n",
CurrentTSO->id, CurrentTSO, CurrentProc);
goto next_thread;
}
/* Ignore ContinueThreads for threads that are being migrated */
if (PROCS(CurrentTSO)==Nowhere) {
- belch("ghuH: trying to run the migrating TSO %d (%p) [PE %d] (ignoring ContinueThread)",
+ debugBelch("ghuH: trying to run the migrating TSO %d (%p) [PE %d] (ignoring ContinueThread)\n",
CurrentTSO->id, CurrentTSO, CurrentProc);
goto next_thread;
}
/* The thread should be at the beginning of the run queue */
if (CurrentTSO!=run_queue_hds[CurrentProc]) {
- belch("ghuH: TSO %d (%p) [PE %d] is not at the start of the run_queue when doing a ContinueThread",
+ debugBelch("ghuH: TSO %d (%p) [PE %d] is not at the start of the run_queue when doing a ContinueThread\n",
CurrentTSO->id, CurrentTSO, CurrentProc);
break; // run the thread anyway
}
/* This point was scheduler_loop in the old RTS */
- IF_DEBUG(gran, belch("GRAN: after main switch"));
+ IF_DEBUG(gran, debugBelch("GRAN: after main switch\n"));
TimeOfLastEvent = CurrentTime[CurrentProc];
TimeOfNextEvent = get_time_of_next_event();
IgnoreEvents=(TimeOfNextEvent==0); // HWL HACK
// CurrentTSO = ThreadQueueHd;
- IF_DEBUG(gran, belch("GRAN: time of next event is: %ld",
+ IF_DEBUG(gran, debugBelch("GRAN: time of next event is: %ld\n",
TimeOfNextEvent));
if (RtsFlags.GranFlags.Light)
EndOfTimeSlice = CurrentTime[CurrentProc]+RtsFlags.GranFlags.time_slice;
IF_DEBUG(gran,
- belch("GRAN: end of time-slice is %#lx", EndOfTimeSlice));
+ debugBelch("GRAN: end of time-slice is %#lx\n", EndOfTimeSlice));
/* in a GranSim setup the TSO stays on the run queue */
t = CurrentTSO;
POP_RUN_QUEUE(t); // take_off_run_queue(t);
IF_DEBUG(gran,
- fprintf(stderr, "GRAN: About to run current thread, which is\n");
+ debugBelch("GRAN: About to run current thread, which is\n");
G_TSO(t,5));
context_switch = 0; // turned on via GranYield, checking events and time slice
if (spark != (rtsSpark) NULL) {
tso = activateSpark(spark); /* turn the spark into a thread */
IF_PAR_DEBUG(schedule,
- belch("==== schedule: Created TSO %d (%p); %d threads active",
+ debugBelch("==== schedule: Created TSO %d (%p); %d threads active\n",
tso->id, tso, advisory_thread_count));
if (tso==END_TSO_QUEUE) { /* failed to activate spark->back to loop */
- belch("==^^ failed to activate spark");
+ debugBelch("==^^ failed to activate spark\n");
goto next_thread;
} /* otherwise fall through & pick-up new tso */
} else {
IF_PAR_DEBUG(verbose,
- belch("==^^ no local sparks (spark pool contains only NFs: %d)",
+ debugBelch("==^^ no local sparks (spark pool contains only NFs: %d)\n",
spark_queue_len(pool)));
goto next_thread;
}
*/
TIME now = msTime() /*CURRENT_TIME*/;
IF_PAR_DEBUG(verbose,
- belch("-- now=%ld", now));
+ debugBelch("-- now=%ld\n", now));
IF_PAR_DEBUG(verbose,
if (outstandingFishes < RtsFlags.ParFlags.maxFishes &&
(last_fish_arrived_at!=0 &&
last_fish_arrived_at+RtsFlags.ParFlags.fishDelay > now)) {
- belch("--$$ delaying FISH until %ld (last fish %ld, delay %ld, now %ld)",
+ debugBelch("--$$ delaying FISH until %ld (last fish %ld, delay %ld, now %ld)\n",
last_fish_arrived_at+RtsFlags.ParFlags.fishDelay,
last_fish_arrived_at,
RtsFlags.ParFlags.fishDelay, now);
pool = &(MainRegTable.rSparks); // generalise to cap = &MainRegTable
IF_DEBUG(scheduler,
- belch("--=^ %d threads, %d sparks on [%#x]",
+ debugBelch("--=^ %d threads, %d sparks on [%#x]\n",
run_queue_len(), spark_queue_len(pool), CURRENT_PROC));
# if 1
RELEASE_LOCK(&sched_mutex);
IF_DEBUG(scheduler, sched_belch("-->> running thread %ld %s ...",
- t->id, whatNext_strs[t->what_next]));
+ (long)t->id, whatNext_strs[t->what_next]));
#ifdef PROFILING
startHeapProfTimer();
ACQUIRE_LOCK(&sched_mutex);
#ifdef RTS_SUPPORTS_THREADS
- IF_DEBUG(scheduler,fprintf(stderr,"sched (task %p): ", osThreadId()););
+ IF_DEBUG(scheduler,debugBelch("sched (task %p): ", osThreadId()););
#elif !defined(GRAN) && !defined(PAR)
- IF_DEBUG(scheduler,fprintf(stderr,"sched: "););
+ IF_DEBUG(scheduler,debugBelch("sched: "););
#endif
#if defined(PAR)
blocks = (nat)BLOCK_ROUND_UP(cap->r.rHpAlloc) / BLOCK_SIZE;
- IF_DEBUG(scheduler,belch("--<< thread %ld (%s) stopped: requesting a large block (size %d)",
- t->id, whatNext_strs[t->what_next], blocks));
+ IF_DEBUG(scheduler,debugBelch("--<< thread %ld (%s) stopped: requesting a large block (size %d)\n",
+ (long)t->id, whatNext_strs[t->what_next], blocks));
// don't do this if it would push us over the
// alloc_blocks_lim limit; we'll GC first.
* maybe set context_switch and wait till they all pile in,
* then have them wait on a GC condition variable.
*/
- IF_DEBUG(scheduler,belch("--<< thread %ld (%s) stopped: HeapOverflow",
- t->id, whatNext_strs[t->what_next]));
+ IF_DEBUG(scheduler,debugBelch("--<< thread %ld (%s) stopped: HeapOverflow\n",
+ (long)t->id, whatNext_strs[t->what_next]));
threadPaused(t);
#if defined(GRAN)
ASSERT(!is_on_queue(t,CurrentProc));
// DumpGranEvent(GR_DESCHEDULE, t);
globalParStats.tot_stackover++;
#endif
- IF_DEBUG(scheduler,belch("--<< thread %ld (%s) stopped, StackOverflow",
- t->id, whatNext_strs[t->what_next]));
+ IF_DEBUG(scheduler,debugBelch("--<< thread %ld (%s) stopped, StackOverflow\n",
+ (long)t->id, whatNext_strs[t->what_next]));
/* just adjust the stack for this thread, then pop it back
* on the run queue.
*/
*/
IF_DEBUG(scheduler,
if (t->what_next != prev_what_next) {
- belch("--<< thread %ld (%s) stopped to switch evaluators",
- t->id, whatNext_strs[t->what_next]);
+ debugBelch("--<< thread %ld (%s) stopped to switch evaluators\n",
+ (long)t->id, whatNext_strs[t->what_next]);
} else {
- belch("--<< thread %ld (%s) stopped, yielding",
- t->id, whatNext_strs[t->what_next]);
+ debugBelch("--<< thread %ld (%s) stopped, yielding\n",
+ (long)t->id, whatNext_strs[t->what_next]);
}
);
IF_DEBUG(sanity,
- //belch("&& Doing sanity check on yielding TSO %ld.", t->id);
+ //debugBelch("&& Doing sanity check on yielding TSO %ld.", t->id);
checkTSO(t));
ASSERT(t->link == END_TSO_QUEUE);
ASSERT(!is_on_queue(t,CurrentProc));
IF_DEBUG(sanity,
- //belch("&& Doing sanity check on all ThreadQueues (and their TSOs).");
+ //debugBelch("&& Doing sanity check on all ThreadQueues (and their TSOs).");
checkThreadQsSanity(rtsTrue));
#endif
ContinueThread,
t, (StgClosure*)NULL, (rtsSpark*)NULL);
IF_GRAN_DEBUG(bq,
- belch("GRAN: eventq and runnableq after adding yielded thread to queue again:");
+ debugBelch("GRAN: eventq and runnableq after adding yielded thread to queue again:\n");
G_EVENTQ(0);
G_CURR_THREADQ(0));
#endif /* GRAN */
case ThreadBlocked:
#if defined(GRAN)
IF_DEBUG(scheduler,
- belch("--<< thread %ld (%p; %s) stopped, blocking on node %p [PE %d] with BQ: ",
+ debugBelch("--<< thread %ld (%p; %s) stopped, blocking on node %p [PE %d] with BQ: \n",
t->id, t, whatNext_strs[t->what_next], t->block_info.closure, (t->block_info.closure==(StgClosure*)NULL ? 99 : where_is(t->block_info.closure)));
if (t->block_info.closure!=(StgClosure*)NULL) print_bq(t->block_info.closure));
*/
#elif defined(PAR)
IF_DEBUG(scheduler,
- belch("--<< thread %ld (%p; %s) stopped, blocking on node %p with BQ: ",
+ debugBelch("--<< thread %ld (%p; %s) stopped, blocking on node %p with BQ: \n",
t->id, t, whatNext_strs[t->what_next], t->block_info.closure));
IF_PAR_DEBUG(bq,
* case it'll be on the relevant queue already.
*/
IF_DEBUG(scheduler,
- fprintf(stderr, "--<< thread %d (%s) stopped: ",
+ debugBelch("--<< thread %d (%s) stopped: ",
t->id, whatNext_strs[t->what_next]);
printThreadBlockage(t);
- fprintf(stderr, "\n"));
- fflush(stderr);
+ debugBelch("\n"));
/* Only for dumping event to log file
ToDo: do I need this in GranSim, too?
/* We also end up here if the thread kills itself with an
* uncaught exception, see Exception.hc.
*/
- IF_DEBUG(scheduler,belch("--++ thread %d (%s) finished",
+ IF_DEBUG(scheduler,debugBelch("--++ thread %d (%s) finished\n",
t->id, whatNext_strs[t->what_next]));
#if defined(GRAN)
endThread(t, CurrentProc); // clean-up the thread
ContinueThread,
t, (StgClosure*)NULL, (rtsSpark*)NULL);
IF_GRAN_DEBUG(bq,
- fprintf(stderr, "GRAN: eventq and runnableq after Garbage collection:\n");
+ debugBelch("GRAN: eventq and runnableq after Garbage collection:\n\n");
G_EVENTQ(0);
G_CURR_THREADQ(0));
#endif /* GRAN */
} /* end of while(1) */
IF_PAR_DEBUG(verbose,
- belch("== Leaving schedule() after having received Finish"));
+ debugBelch("== Leaving schedule() after having received Finish\n"));
}
/* ---------------------------------------------------------------------------
/* check that no more than RtsFlags.ParFlags.maxThreads threads are created */
if (advisory_thread_count >= RtsFlags.ParFlags.maxThreads) {
threadsIgnored++;
- belch("{createThread}Daq ghuH: refusing to create another thread; no more than %d threads allowed (currently %d)",
+ debugBelch("{createThread}Daq ghuH: refusing to create another thread; no more than %d threads allowed (currently %d)\n",
RtsFlags.ParFlags.maxThreads, advisory_thread_count);
return END_TSO_QUEUE;
}
// collect parallel global statistics (currently done together with GC stats)
if (RtsFlags.ParFlags.ParStats.Global &&
RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
- //fprintf(stderr, "Creating thread %d @ %11.2f\n", tso->id, usertime());
+ //debugBelch("Creating thread %d @ %11.2f\n", tso->id, usertime());
globalParStats.tot_threads_created++;
}
#endif
#if defined(GRAN)
IF_GRAN_DEBUG(pri,
- belch("==__ schedule: Created TSO %d (%p);",
+ sched_belch("==__ schedule: Created TSO %d (%p);",
CurrentProc, tso, tso->id));
#elif defined(PAR)
IF_PAR_DEBUG(verbose,
- belch("==__ schedule: Created TSO %d (%p); %d threads active",
- tso->id, tso, advisory_thread_count));
+ sched_belch("==__ schedule: Created TSO %d (%p); %d threads active",
+ (long)tso->id, tso, advisory_thread_count));
#else
IF_DEBUG(scheduler,sched_belch("created thread %ld, stack size = %lx words",
- tso->id, tso->stack_size));
+ (long)tso->id, (long)tso->stack_size));
#endif
return tso;
}
if (RtsFlags.ParFlags.ParStats.Full) {
//ASSERT(run_queue_hd == END_TSO_QUEUE); // I think ...
IF_PAR_DEBUG(verbose,
- belch("==^^ activateSpark: turning spark of closure %p (%s) into a thread",
+ debugBelch("==^^ activateSpark: turning spark of closure %p (%s) into a thread\n",
(StgClosure *)spark, info_type((StgClosure *)spark)));
}
// ToDo: fwd info on local/global spark to thread -- HWL
if (tso->stack_size >= tso->max_stack_size) {
IF_DEBUG(gc,
- belch("@@ threadStackOverflow of TSO %d (%p): stack too large (now %ld; max is %ld)",
- tso->id, tso, tso->stack_size, tso->max_stack_size);
+ debugBelch("@@ threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)\n",
+ (long)tso->id, tso, (long)tso->stack_size, (long)tso->max_stack_size);
/* If we're debugging, just print out the top of the stack */
printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size,
tso->sp+64)));
new_tso_size = round_to_mblocks(new_tso_size); /* Be MBLOCK-friendly */
new_stack_size = new_tso_size - TSO_STRUCT_SIZEW;
- IF_DEBUG(scheduler, fprintf(stderr,"== sched: increasing stack size from %d words to %d.\n", tso->stack_size, new_stack_size));
+ IF_DEBUG(scheduler, debugBelch("== sched: increasing stack size from %d words to %d.\n", tso->stack_size, new_stack_size));
dest = (StgTSO *)allocate(new_tso_size);
TICK_ALLOC_TSO(new_stack_size,0);
dest->mut_link = NULL;
IF_PAR_DEBUG(verbose,
- belch("@@ threadStackOverflow of TSO %d (now at %p): stack size increased to %ld",
+ debugBelch("@@ threadStackOverflow of TSO %d (now at %p): stack size increased to %ld\n",
tso->id, tso, tso->stack_size);
/* If we're debugging, just print out the top of the stack */
printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size,
}
/* the thread-queue-overhead is accounted for in either Resume or UnblockThread */
IF_GRAN_DEBUG(bq,
- fprintf(stderr," %s TSO %d (%p) [PE %d] (block_info.closure=%p) (next=%p) ,",
+ debugBelch(" %s TSO %d (%p) [PE %d] (block_info.closure=%p) (next=%p) ,",
(node_loc==tso_loc ? "Local" : "Global"),
tso->id, tso, CurrentProc, tso->block_info.closure, tso->link));
tso->block_info.closure = NULL;
- IF_DEBUG(scheduler,belch("-- Waking up thread %ld (%p)",
+ IF_DEBUG(scheduler,debugBelch("-- Waking up thread %ld (%p)\n",
tso->id, tso));
}
#elif defined(PAR)
(StgClosure *)bqe);
# endif
}
- IF_PAR_DEBUG(bq, fprintf(stderr, ", %p (%s)", bqe, info_type((StgClosure*)bqe)));
+ IF_PAR_DEBUG(bq, debugBelch(", %p (%s)\n", bqe, info_type((StgClosure*)bqe)));
return next;
}
tso->link = END_TSO_QUEUE;
APPEND_TO_RUN_QUEUE(tso);
THREAD_RUNNABLE();
- IF_DEBUG(scheduler,sched_belch("waking up thread %ld", tso->id));
+ IF_DEBUG(scheduler,sched_belch("waking up thread %ld", (long)tso->id));
return next;
}
#endif
nat len = 0;
IF_GRAN_DEBUG(bq,
- belch("##-_ AwBQ for node %p on PE %d @ %ld by TSO %d (%p): ", \
+ debugBelch("##-_ AwBQ for node %p on PE %d @ %ld by TSO %d (%p): \n", \
node, CurrentProc, CurrentTime[CurrentProc],
CurrentTSO->id, CurrentTSO));
*/
if (CurrentProc!=node_loc) {
IF_GRAN_DEBUG(bq,
- belch("## node %p is on PE %d but CurrentProc is %d (TSO %d); assuming fake fetch and adjusting bitmask (old: %#x)",
+ debugBelch("## node %p is on PE %d but CurrentProc is %d (TSO %d); assuming fake fetch and adjusting bitmask (old: %#x)\n",
node, node_loc, CurrentProc, CurrentTSO->id,
// CurrentTSO, where_is(CurrentTSO),
node->header.gran.procs));
node->header.gran.procs = (node->header.gran.procs) | PE_NUMBER(CurrentProc);
IF_GRAN_DEBUG(bq,
- belch("## new bitmask of node %p is %#x",
+ debugBelch("## new bitmask of node %p is %#x\n",
node, node->header.gran.procs));
if (RtsFlags.GranFlags.GranSimStats.Global) {
globalGranStats.tot_fake_fetches++;
((StgRBH *)node)->mut_link = (StgMutClosure *)((StgRBHSave *)bqe)->payload[1];
IF_GRAN_DEBUG(bq,
- belch("## Filled in RBH_Save for %p (%s) at end of AwBQ",
+ debugBelch("## Filled in RBH_Save for %p (%s) at end of AwBQ\n",
node, info_type(node)));
}
globalGranStats.tot_awbq++; // total no. of bqs awakened
}
IF_GRAN_DEBUG(bq,
- fprintf(stderr,"## BQ Stats of %p: [%d entries] %s\n",
+ debugBelch("## BQ Stats of %p: [%d entries] %s\n",
node, len, (bqe!=END_BQ_QUEUE) ? "RBH" : ""));
}
#elif defined(PAR)
ACQUIRE_LOCK(&sched_mutex);
IF_PAR_DEBUG(verbose,
- belch("##-_ AwBQ for node %p on [%x]: ",
+ debugBelch("##-_ AwBQ for node %p on [%x]: \n",
node, mytid));
#ifdef DIST
//RFP
if(get_itbl(q)->type == CONSTR || q==END_BQ_QUEUE) {
- IF_PAR_DEBUG(verbose, belch("## ... nothing to unblock so lets just return. RFP (BUG?)"));
+ IF_PAR_DEBUG(verbose, debugBelch("## ... nothing to unblock so lets just return. RFP (BUG?)\n"));
return;
}
#endif
}
IF_DEBUG(scheduler,
- sched_belch("raising exception in thread %ld.", tso->id));
+ sched_belch("raising exception in thread %ld.", (long)tso->id));
// Remove it from any blocking queues
unblockThread(tso);
TICK_ALLOC_UP_THK(words+1,0);
IF_DEBUG(scheduler,
- fprintf(stderr, "sched: Updating ");
+ debugBelch("sched: Updating ");
printPtr((P_)((StgUpdateFrame *)frame)->updatee);
- fprintf(stderr, " with ");
+ debugBelch(" with ");
printObj((StgClosure *)ap);
);
detectBlackHoles( void )
{
StgTSO *tso = all_threads;
- StgClosure *frame;
+ StgPtr frame;
StgClosure *blocked_on;
StgRetInfoTable *info;
}
blocked_on = tso->block_info.closure;
- frame = (StgClosure *)tso->sp;
+ frame = tso->sp;
while(1) {
- info = get_ret_itbl(frame);
+ info = get_ret_itbl((StgClosure *)frame);
switch (info->i.type) {
case UPDATE_FRAME:
if (((StgUpdateFrame *)frame)->updatee == blocked_on) {
goto done;
}
- frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
+ frame = (StgPtr)((StgUpdateFrame *)frame + 1);
continue;
case STOP_FRAME:
// normal stack frames; do nothing except advance the pointer
default:
- (StgPtr)frame += stack_frame_sizeW(frame);
+ frame += stack_frame_sizeW((StgClosure *)frame);
}
}
done: ;
{
switch (tso->why_blocked) {
case BlockedOnRead:
- fprintf(stderr,"is blocked on read from fd %d", tso->block_info.fd);
+ debugBelch("is blocked on read from fd %d", tso->block_info.fd);
break;
case BlockedOnWrite:
- fprintf(stderr,"is blocked on write to fd %d", tso->block_info.fd);
+ debugBelch("is blocked on write to fd %d", tso->block_info.fd);
break;
#if defined(mingw32_TARGET_OS)
case BlockedOnDoProc:
- fprintf(stderr,"is blocked on proc (request: %d)", tso->block_info.async_result->reqID);
+ debugBelch("is blocked on proc (request: %d)", tso->block_info.async_result->reqID);
break;
#endif
case BlockedOnDelay:
- fprintf(stderr,"is blocked until %d", tso->block_info.target);
+ debugBelch("is blocked until %d", tso->block_info.target);
break;
case BlockedOnMVar:
- fprintf(stderr,"is blocked on an MVar");
+ debugBelch("is blocked on an MVar");
break;
case BlockedOnException:
- fprintf(stderr,"is blocked on delivering an exception to thread %d",
+ debugBelch("is blocked on delivering an exception to thread %d",
tso->block_info.tso->id);
break;
case BlockedOnBlackHole:
- fprintf(stderr,"is blocked on a black hole");
+ debugBelch("is blocked on a black hole");
break;
case NotBlocked:
- fprintf(stderr,"is not blocked");
+ debugBelch("is not blocked");
break;
#if defined(PAR)
case BlockedOnGA:
- fprintf(stderr,"is blocked on global address; local FM_BQ is %p (%s)",
+ debugBelch("is blocked on global address; local FM_BQ is %p (%s)",
tso->block_info.closure, info_type(tso->block_info.closure));
break;
case BlockedOnGA_NoSend:
- fprintf(stderr,"is blocked on global address (no send); local FM_BQ is %p (%s)",
+ debugBelch("is blocked on global address (no send); local FM_BQ is %p (%s)",
tso->block_info.closure, info_type(tso->block_info.closure));
break;
#endif
case BlockedOnCCall:
- fprintf(stderr,"is blocked on an external call");
+ debugBelch("is blocked on an external call");
break;
case BlockedOnCCall_NoUnblockExc:
- fprintf(stderr,"is blocked on an external call (exceptions were already blocked)");
+ debugBelch("is blocked on an external call (exceptions were already blocked)");
break;
default:
barf("printThreadBlockage: strange tso->why_blocked: %d for TSO %d (%d)",
{
switch (tso->what_next) {
case ThreadKilled:
- fprintf(stderr,"has been killed");
+ debugBelch("has been killed");
break;
case ThreadComplete:
- fprintf(stderr,"has completed");
+ debugBelch("has completed");
break;
default:
printThreadBlockage(tso);
ullong_format_string(TIME_ON_PROC(CurrentProc),
time_string, rtsFalse/*no commas!*/);
- fprintf(stderr, "all threads at [%s]:\n", time_string);
+ debugBelch("all threads at [%s]:\n", time_string);
# elif defined(PAR)
char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN];
ullong_format_string(CURRENT_TIME,
time_string, rtsFalse/*no commas!*/);
- fprintf(stderr,"all threads at [%s]:\n", time_string);
+ debugBelch("all threads at [%s]:\n", time_string);
# else
- fprintf(stderr,"all threads:\n");
+ debugBelch("all threads:\n");
# endif
for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
- fprintf(stderr, "\tthread %d @ %p ", t->id, (void *)t);
+ debugBelch("\tthread %d @ %p ", t->id, (void *)t);
label = lookupThreadLabel(t->id);
- if (label) fprintf(stderr,"[\"%s\"] ",(char *)label);
+ if (label) debugBelch("[\"%s\"] ",(char *)label);
printThreadStatus(t);
- fprintf(stderr,"\n");
+ debugBelch("\n");
}
}
StgTSO *tso;
rtsBool end;
- fprintf(stderr,"## BQ of closure %p (%s): ",
+ debugBelch("## BQ of closure %p (%s): ",
node, info_type(node));
/* should cover all closures that may have a blocking queue */
switch (get_itbl(bqe)->type) {
case TSO:
- fprintf(stderr," TSO %u (%x),",
+ debugBelch(" TSO %u (%x),",
((StgTSO *)bqe)->id, ((StgTSO *)bqe));
break;
case BLOCKED_FETCH:
- fprintf(stderr," BF (node=%p, ga=((%x, %d, %x)),",
+ debugBelch(" BF (node=%p, ga=((%x, %d, %x)),",
((StgBlockedFetch *)bqe)->node,
((StgBlockedFetch *)bqe)->ga.payload.gc.gtid,
((StgBlockedFetch *)bqe)->ga.payload.gc.slot,
((StgBlockedFetch *)bqe)->ga.weight);
break;
case CONSTR:
- fprintf(stderr," %s (IP %p),",
+ debugBelch(" %s (IP %p),",
(get_itbl(bqe) == &stg_RBH_Save_0_info ? "RBH_Save_0" :
get_itbl(bqe) == &stg_RBH_Save_1_info ? "RBH_Save_1" :
get_itbl(bqe) == &stg_RBH_Save_2_info ? "RBH_Save_2" :
break;
}
} /* for */
- fputc('\n', stderr);
+ debugBelch("\n");
}
# elif defined(GRAN)
void
ASSERT(node!=(StgClosure*)NULL); // sanity check
node_loc = where_is(node);
- fprintf(stderr,"## BQ of closure %p (%s) on [PE %d]: ",
+ debugBelch("## BQ of closure %p (%s) on [PE %d]: ",
node, info_type(node), node_loc);
/*
tso_loc = where_is((StgClosure *)bqe);
switch (get_itbl(bqe)->type) {
case TSO:
- fprintf(stderr," TSO %d (%p) on [PE %d],",
+ debugBelch(" TSO %d (%p) on [PE %d],",
((StgTSO *)bqe)->id, (StgTSO *)bqe, tso_loc);
break;
case CONSTR:
- fprintf(stderr," %s (IP %p),",
+ debugBelch(" %s (IP %p),",
(get_itbl(bqe) == &stg_RBH_Save_0_info ? "RBH_Save_0" :
get_itbl(bqe) == &stg_RBH_Save_1_info ? "RBH_Save_1" :
get_itbl(bqe) == &stg_RBH_Save_2_info ? "RBH_Save_2" :
break;
}
} /* for */
- fputc('\n', stderr);
+ debugBelch("\n");
}
#else
/*
tso=tso->link) {
ASSERT(tso!=NULL && tso!=END_TSO_QUEUE); // sanity check
ASSERT(get_itbl(tso)->type == TSO); // guess what, sanity check
- fprintf(stderr," TSO %d (%p),", tso->id, tso);
+ debugBelch(" TSO %d (%p),", tso->id, tso);
}
- fputc('\n', stderr);
+ debugBelch("\n");
}
# endif
va_list ap;
va_start(ap,s);
#ifdef RTS_SUPPORTS_THREADS
- fprintf(stderr, "sched (task %p): ", osThreadId());
+ debugBelch("sched (task %p): ", osThreadId());
#elif defined(PAR)
- fprintf(stderr, "== ");
+ debugBelch("== ");
#else
- fprintf(stderr, "sched: ");
+ debugBelch("sched: ");
#endif
- vfprintf(stderr, s, ap);
- fprintf(stderr, "\n");
- fflush(stderr);
+ vdebugBelch(s, ap);
+ debugBelch("\n");
va_end(ap);
}
#endif
#ifdef DEBUG
-extern void sched_belch(char *s, ...);
+extern void sched_belch(char *s, ...)
+ GNU_ATTRIBUTE(format (printf, 1, 2));
#endif
#endif /* __SCHEDULE_H__ */
/* -----------------------------------------------------------------------------
- * $Id: Select.c,v 1.32 2004/07/15 20:50:40 sof Exp $
+ * $Id: Select.c,v 1.33 2004/09/03 15:28:53 simonmar Exp $
*
* (c) The GHC Team 1995-2002
*
sleeping_queue = tso->link;
tso->why_blocked = NotBlocked;
tso->link = END_TSO_QUEUE;
- IF_DEBUG(scheduler,belch("Waking up sleeping thread %d\n", tso->id));
+ IF_DEBUG(scheduler,debugBelch("Waking up sleeping thread %d\n", tso->id));
PUSH_ON_RUN_QUEUE(tso);
flag = rtsTrue;
}
tv.tv_usec = 0;
IF_DEBUG(scheduler,
- belch("scheduler: checking for threads blocked on I/O");
+ debugBelch("scheduler: checking for threads blocked on I/O");
if (wait) {
- belch(" (waiting)");
+ debugBelch(" (waiting)");
}
- belch("\n");
+ debugBelch("\n");
);
/* loop until we've woken up some threads. This loop is needed
unblock_all = rtsTrue;
break;
} else {
- fprintf(stderr,"%d\n", errno);
- fflush(stderr);
perror("select");
barf("select failed");
}
}
if (ready) {
- IF_DEBUG(scheduler,belch("Waking up blocked thread %d\n", tso->id));
+ IF_DEBUG(scheduler,debugBelch("Waking up blocked thread %d\n", tso->id));
tso->why_blocked = NotBlocked;
tso->link = END_TSO_QUEUE;
PUSH_ON_RUN_QUEUE(tso);
/* -----------------------------------------------------------------------------
- * $Id: Signals.c,v 1.41 2004/08/13 13:10:44 simonmar Exp $
+ * $Id: Signals.c,v 1.42 2004/09/03 15:28:53 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
// stack full?
if (next_pending_handler == &pending_handler_buf[N_PENDING_HANDLERS]) {
- prog_belch("too many pending signals");
+ errorBelch("too many pending signals");
stg_exit(EXIT_FAILURE);
}
sigemptyset(&action.sa_mask);
action.sa_flags = 0;
if (sigaction(SIGINT, &action, &oact) != 0) {
- prog_belch("warning: failed to install SIGINT handler");
+ errorBelch("warning: failed to install SIGINT handler");
}
#if defined(HAVE_SIGINTERRUPT)
sigemptyset(&action.sa_mask);
action.sa_flags = 0;
if (sigaction(SIGCONT, &action, &oact) != 0) {
- prog_belch("warning: failed to install SIGCONT handler");
+ errorBelch("warning: failed to install SIGCONT handler");
}
// install the SIGFPE handler
sigemptyset(&action.sa_mask);
action.sa_flags = 0;
if (sigaction(SIGFPE, &action, &oact) != 0) {
- prog_belch("warning: failed to install SIGFPE handler");
+ errorBelch("warning: failed to install SIGFPE handler");
}
#endif
/* ---------------------------------------------------------------------------
- * $Id: Sparks.c,v 1.7 2003/11/12 17:49:11 sof Exp $
+ * $Id: Sparks.c,v 1.8 2004/09/03 15:28:54 simonmar Exp $
*
* (c) The GHC Team, 2000
*
// collect parallel global statistics (currently done together with GC stats)
if (RtsFlags.ParFlags.ParStats.Global &&
RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
- // fprintf(stderr, "Creating spark for %x @ %11.2f\n", closure, usertime());
+ // debugBelch("Creating spark for %x @ %11.2f\n", closure, usertime());
globalParStats.tot_sparks_created++;
}
#endif
// collect parallel global statistics (currently done together with GC stats)
if (RtsFlags.ParFlags.ParStats.Global &&
RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
- //fprintf(stderr, "Ignoring spark for %x @ %11.2f\n", closure, usertime());
+ //debugBelch("Ignoring spark for %x @ %11.2f\n", closure, usertime());
globalParStats.tot_sparks_ignored++;
}
#endif
#if defined(SMP)
IF_DEBUG(scheduler,
- belch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
+ debugBelch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
n, pruned_sparks, pthread_self()));
#elif defined(PAR)
IF_DEBUG(scheduler,
- belch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
+ debugBelch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
n, pruned_sparks, mytid));
#else
IF_DEBUG(scheduler,
- belch("markSparkQueue: marked %d sparks and pruned %d sparks",
+ debugBelch("markSparkQueue: marked %d sparks and pruned %d sparks",
n, pruned_sparks));
#endif
IF_DEBUG(scheduler,
- belch("markSparkQueue: new spark queue len=%d; (hd=%p; tl=%p)",
+ debugBelch("markSparkQueue: new spark queue len=%d; (hd=%p; tl=%p)",
spark_queue_len(pool), pool->hd, pool->tl));
}
if (!closure_SHOULD_SPARK(node))
{
IF_GRAN_DEBUG(checkSparkQ,
- belch("^^ pruning spark %p (node %p) in gimme_spark",
+ debugBelch("^^ pruning spark %p (node %p) in gimme_spark",
spark, node));
if (RtsFlags.GranFlags.GranSimStats.Sparks)
# if defined(GRAN) && defined(GRAN_CHECK)
/* Should never happen; just for testing
if (spark==pending_sparks_tl) {
- fprintf(stderr,"ReSchedule: Last spark != SparkQueueTl\n");
+ debugBelch("ReSchedule: Last spark != SparkQueueTl\n");
stg_exit(EXIT_FAILURE);
} */
# endif
/* Should never happen; just for testing
if (spark==pending_sparks_tl) {
- fprintf(stderr,"ReSchedule: Last spark != SparkQueueTl\n");
+ debugBelch("ReSchedule: Last spark != SparkQueueTl\n");
stg_exit(EXIT_FAILURE);
break;
} */
spark = spark->next;
IF_GRAN_DEBUG(pri,
- belch("++ Ignoring spark of priority %u (SparkPriority=%u); node=%p; name=%u\n",
+ debugBelch("++ Ignoring spark of priority %u (SparkPriority=%u); node=%p; name=%u\n",
spark->gran_info, RtsFlags.GranFlags.SparkPriority,
spark->node, spark->name);)
}
globalGranStats.tot_low_pri_sparks++;
IF_GRAN_DEBUG(pri,
- belch("++ No high priority spark available; low priority (%u) spark chosen: node=%p; name=%u\n",
+ debugBelch("++ No high priority spark available; low priority (%u) spark chosen: node=%p; name=%u\n",
spark->gran_info,
spark->node, spark->name));
}
if ( RtsFlags.GranFlags.SparkPriority!=0 &&
pri<RtsFlags.GranFlags.SparkPriority ) {
IF_GRAN_DEBUG(pri,
- belch(",, NewSpark: Ignoring spark of priority %u (SparkPriority=%u); node=%#x; name=%u\n",
+ debugBelch(",, NewSpark: Ignoring spark of priority %u (SparkPriority=%u); node=%#x; name=%u\n",
pri, RtsFlags.GranFlags.SparkPriority, node, name));
return ((rtsSpark*)NULL);
}
# ifdef GRAN_CHECK
if (SparksAvail < 0) {
- fprintf(stderr,"disposeSparkQ: SparksAvail<0 after disposing sparkq @ %p\n", &spark);
+ debugBelch("disposeSparkQ: SparksAvail<0 after disposing sparkq @ %p\n", &spark);
print_spark(spark);
}
# endif
}
IF_GRAN_DEBUG(checkSparkQ,
- belch("++ Spark stats after adding spark %p (node %p) to queue on PE %d",
+ debugBelch("++ Spark stats after adding spark %p (node %p) to queue on PE %d",
spark, spark->node, CurrentProc);
print_sparkq_stats());
prev = next, next = next->next)
{}
if ( (prev!=NULL) && (prev!=pending_sparks_tl) )
- fprintf(stderr,"SparkQ inconsistency after adding spark %p: (PE %u) pending_sparks_tl (%p) not end of queue (%p)\n",
+ debugBelch("SparkQ inconsistency after adding spark %p: (PE %u) pending_sparks_tl (%p) not end of queue (%p)\n",
spark,CurrentProc,
pending_sparks_tl, prev);
}
}
}
if (!sorted) {
- fprintf(stderr,"ghuH: SPARKQ on PE %d is not sorted:\n",
+ debugBelch("ghuH: SPARKQ on PE %d is not sorted:\n",
CurrentProc);
print_sparkq(CurrentProc);
}
# if defined(GRAN_CHECK)
if ( RtsFlags.GranFlags.Debug.checkSparkQ )
if ( (prev!=NULL) && (prev!=pending_sparks_tls[proc]) )
- fprintf(stderr,"ERROR in spark_queue_len: (PE %u) pending_sparks_tl (%p) not end of queue (%p)\n",
+ debugBelch("ERROR in spark_queue_len: (PE %u) pending_sparks_tl (%p) not end of queue (%p)\n",
proc, pending_sparks_tls[proc], prev);
# endif
# if defined(GRAN_CHECK)
if ( RtsFlags.GranFlags.Debug.checkSparkQ ) {
- fprintf(stderr,"## |%p:%p| (%p)<-spark=%p->(%p) <-(%p)\n",
+ debugBelch("## |%p:%p| (%p)<-spark=%p->(%p) <-(%p)\n",
pending_sparks_hd, pending_sparks_tl,
spark->prev, spark, spark->next,
(spark->next==NULL ? 0 : spark->next->prev));
# if defined(GRAN_CHECK)
if ( RtsFlags.GranFlags.Debug.checkSparkQ ) {
- fprintf(stderr,"## |%p:%p| (%p)<-spark=%p->(%p) <-(%p); spark=%p will be deleted NOW \n",
+ debugBelch("## |%p:%p| (%p)<-spark=%p->(%p) <-(%p); spark=%p will be deleted NOW \n",
pending_sparks_hd, pending_sparks_tl,
spark->prev, spark, spark->next,
(spark->next==NULL ? 0 : spark->next->prev), spark);
sp->node = (StgClosure *)MarkRoot(sp->node);
}
IF_DEBUG(gc,
- belch("@@ markSparkQueue: spark statistics at start of GC:");
+ debugBelch("@@ markSparkQueue: spark statistics at start of GC:");
print_sparkq_stats());
}
char str[16];
if (spark==NULL) {
- fprintf(stderr,"Spark: NIL\n");
+ debugBelch("Spark: NIL\n");
return;
} else {
sprintf(str,
((spark->node==NULL) ? "______" : "%#6lx"),
stgCast(StgPtr,spark->node));
- fprintf(stderr,"Spark: Node %8s, Name %#6x, Global %5s, Creator %5x, Prev %6p, Next %6p\n",
+ debugBelch("Spark: Node %8s, Name %#6x, Global %5s, Creator %5x, Prev %6p, Next %6p\n",
str, spark->name,
((spark->global)==rtsTrue?"True":"False"), spark->creator,
spark->prev, spark->next);
{
rtsSpark *x = pending_sparks_hds[proc];
- fprintf(stderr,"Spark Queue of PE %d with root at %p:\n", proc, x);
+ debugBelch("Spark Queue of PE %d with root at %p:\n", proc, x);
for (; x!=(rtsSpark*)NULL; x=x->next) {
print_spark(x);
}
{
PEs p;
- fprintf(stderr, "SparkQs: [");
+ debugBelch("SparkQs: [");
for (p=0; p<RtsFlags.GranFlags.proc; p++)
- fprintf(stderr, ", PE %d: %d", p, spark_queue_len(p));
- fprintf(stderr, "\n");
+ debugBelch(", PE %d: %d", p, spark_queue_len(p));
+ debugBelch("\n");
}
#endif
/* -----------------------------------------------------------------------------
- * $Id: Stable.c,v 1.29 2004/08/22 15:50:42 panne Exp $
+ * $Id: Stable.c,v 1.30 2004/09/03 15:28:55 simonmar Exp $
*
* (c) The GHC Team, 1998-2002
*
if (sn != 0) {
ASSERT(stable_ptr_table[sn].addr == p);
- IF_DEBUG(stable,fprintf(stderr,"cached stable name %d at %p\n",sn,p));
+ IF_DEBUG(stable,debugBelch("cached stable name %d at %p\n",sn,p));
return sn;
} else {
sn = stable_ptr_free - stable_ptr_table;
stable_ptr_table[sn].ref = 0;
stable_ptr_table[sn].addr = p;
stable_ptr_table[sn].sn_obj = NULL;
- /* IF_DEBUG(stable,fprintf(stderr,"new stable name %d at
- %p\n",sn,p)); */
+ /* IF_DEBUG(stable,debugBelch("new stable name %d at %p\n",sn,p)); */
/* add the new stable name to the hash table */
insertHashTable(addrToStableHash, (W_)p, (void *)sn);
if (p->sn_obj == NULL) {
// StableName object is dead
freeStableName(p);
- IF_DEBUG(stable, fprintf(stderr,"GC'd Stable name %d\n",
- p - stable_ptr_table));
+ IF_DEBUG(stable, debugBelch("GC'd Stable name %d\n",
+ p - stable_ptr_table));
continue;
} else {
p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
- IF_DEBUG(stable, fprintf(stderr,"Stable name %d still alive at %p, ref %d\n", p - stable_ptr_table, p->addr, p->ref));
+ IF_DEBUG(stable, debugBelch("Stable name %d still alive at %p, ref %d\n", p - stable_ptr_table, p->addr, p->ref));
}
}
}
/* -----------------------------------------------------------------------------
- * $Id: Stats.c,v 1.48 2004/08/13 13:10:45 simonmar Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2004
*
* Statistics and timing-related functions.
*
static void getTimes(void);
static nat pageFaults(void);
+static void statsPrintf( char *s, ... );
+static void statsFlush( void );
+static void statsClose( void );
+
/* elapsedtime() -- The current elapsed time in seconds */
#if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS)
/* We will #ifdef around the fprintf for machines
we *know* are unsupported. (WDP 94/05)
*/
- fprintf(stderr, "NOTE: `getTimes' does nothing!\n");
+ debugBelch("NOTE: `getTimes' does nothing!\n");
return 0.0;
#else /* not stumped */
initStats(void)
{
nat i;
- FILE *sf = RtsFlags.GcFlags.statsFile;
if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
- fprintf(sf, " Alloc Collect Live GC GC TOT TOT Page Flts\n");
- fprintf(sf, " bytes bytes bytes user elap user elap\n");
+ statsPrintf(" Alloc Collect Live GC GC TOT TOT Page Flts\n");
+ statsPrintf(" bytes bytes bytes user elap user elap\n");
}
GC_coll_times =
(TICK_TYPE *)stgMallocBytes(
ticks = sysconf(_SC_CLK_TCK);
if ( ticks == -1 ) {
- fprintf(stderr, "stat_init: bad call to 'sysconf'!\n");
+ debugBelch("stat_init: bad call to 'sysconf'!\n");
stg_exit(EXIT_FAILURE);
}
TicksPerSecond = ticks;
/* We will #ifdef around the fprintf for machines
we *know* are unsupported. (WDP 94/05)
*/
- fprintf(stderr, "NOTE: Guessing `TicksPerSecond = 60'!\n");
+ debugBelch("NOTE: Guessing `TicksPerSecond = 60'!\n");
TicksPerSecond = 60;
#endif
if (bell) {
if (bell > 1) {
- fprintf(stderr, " GC ");
+ debugBelch(" GC ");
rub_bell = 1;
} else {
- fprintf(stderr, "\007");
+ debugBelch("\007");
}
}
void
stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen)
{
- FILE *sf = RtsFlags.GcFlags.statsFile;
-
if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
TICK_TYPE time, etime, gc_time, gc_etime;
gc_time = time - GC_start_time;
gc_etime = etime - GCe_start_time;
- if (RtsFlags.GcFlags.giveStats == VERBOSE_GC_STATS && sf != NULL) {
+ if (RtsFlags.GcFlags.giveStats == VERBOSE_GC_STATS) {
nat faults = pageFaults();
- fprintf(sf, "%9ld %9ld %9ld",
+ statsPrintf("%9ld %9ld %9ld",
alloc*sizeof(W_), collect*sizeof(W_), live*sizeof(W_));
- fprintf(sf, " %5.2f %5.2f %7.2f %7.2f %4ld %4ld (Gen: %2ld)\n",
+ statsPrintf(" %5.2f %5.2f %7.2f %7.2f %4ld %4ld (Gen: %2ld)\n",
TICK_TO_DBL(gc_time),
TICK_TO_DBL(gc_etime),
TICK_TO_DBL(time),
gen);
GC_end_faults = faults;
- fflush(sf);
+ statsFlush();
}
GC_coll_times[gen] += gc_time;
}
if (rub_bell) {
- fprintf(stderr, "\b\b\b \b\b\b");
+ debugBelch("\b\b\b \b\b\b");
rub_bell = 0;
}
}
void
stat_exit(int alloc)
{
- FILE *sf = RtsFlags.GcFlags.statsFile;
-
if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
char temp[BIG_STRING_LEN];
if (MutUserTime < 0) { MutUserTime = 0; }
#endif
- if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS && sf != NULL) {
- fprintf(sf, "%9ld %9.9s %9.9s", (lnat)alloc*sizeof(W_), "", "");
- fprintf(sf, " %5.2f %5.2f\n\n", 0.0, 0.0);
+ if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
+ statsPrintf("%9ld %9.9s %9.9s", (lnat)alloc*sizeof(W_), "", "");
+ statsPrintf(" %5.2f %5.2f\n\n", 0.0, 0.0);
}
- if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS && sf != NULL) {
+ if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS) {
ullong_format_string(GC_tot_alloc*sizeof(W_),
temp, rtsTrue/*commas*/);
- fprintf(sf, "%11s bytes allocated in the heap\n", temp);
+ statsPrintf("%11s bytes allocated in the heap\n", temp);
ullong_format_string(GC_tot_copied*sizeof(W_),
temp, rtsTrue/*commas*/);
- fprintf(sf, "%11s bytes copied during GC\n", temp);
+ statsPrintf("%11s bytes copied during GC\n", temp);
if ( ResidencySamples > 0 ) {
ullong_format_string(MaxResidency*sizeof(W_),
temp, rtsTrue/*commas*/);
- fprintf(sf, "%11s bytes maximum residency (%ld sample(s))\n",
+ statsPrintf("%11s bytes maximum residency (%ld sample(s))\n",
temp, ResidencySamples);
}
- fprintf(sf,"\n");
+ statsPrintf("\n");
/* Print garbage collections in each gen */
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
- fprintf(sf, "%11d collections in generation %d (%6.2fs)\n",
+ statsPrintf("%11d collections in generation %d (%6.2fs)\n",
generations[g].collections, g,
TICK_TO_DBL(GC_coll_times[g]));
}
- fprintf(sf,"\n%11ld Mb total memory in use\n\n",
+ statsPrintf("\n%11ld Mb total memory in use\n\n",
mblocks_allocated * MBLOCK_SIZE / (1024 * 1024));
#ifdef SMP
{
nat i;
for (i = 0; i < RtsFlags.ParFlags.nNodes; i++) {
- fprintf(sf, " Task %2d: MUT time: %6.2fs (%6.2fs elapsed)\n"
+ statsPrintf(" Task %2d: MUT time: %6.2fs (%6.2fs elapsed)\n"
" GC time: %6.2fs (%6.2fs elapsed)\n\n",
i,
TICK_TO_DBL(task_ids[i].mut_time),
}
#endif
- fprintf(sf, " INIT time %6.2fs (%6.2fs elapsed)\n",
+ statsPrintf(" INIT time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime));
- fprintf(sf, " MUT time %6.2fs (%6.2fs elapsed)\n",
+ statsPrintf(" MUT time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime));
- fprintf(sf, " GC time %6.2fs (%6.2fs elapsed)\n",
+ statsPrintf(" GC time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
#ifdef PROFILING
- fprintf(sf, " RP time %6.2fs (%6.2fs elapsed)\n",
+ statsPrintf(" RP time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(RP_tot_time), TICK_TO_DBL(RPe_tot_time));
- fprintf(sf, " PROF time %6.2fs (%6.2fs elapsed)\n",
+ statsPrintf(" PROF time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(HC_tot_time), TICK_TO_DBL(HCe_tot_time));
#endif
- fprintf(sf, " EXIT time %6.2fs (%6.2fs elapsed)\n",
+ statsPrintf(" EXIT time %6.2fs (%6.2fs elapsed)\n",
TICK_TO_DBL(ExitUserTime), TICK_TO_DBL(ExitElapsedTime));
- fprintf(sf, " Total time %6.2fs (%6.2fs elapsed)\n\n",
+ statsPrintf(" Total time %6.2fs (%6.2fs elapsed)\n\n",
TICK_TO_DBL(time), TICK_TO_DBL(etime));
- fprintf(sf, " %%GC time %5.1f%% (%.1f%% elapsed)\n\n",
+ statsPrintf(" %%GC time %5.1f%% (%.1f%% elapsed)\n\n",
TICK_TO_DBL(GC_tot_time)*100/TICK_TO_DBL(time),
TICK_TO_DBL(GCe_tot_time)*100/TICK_TO_DBL(etime));
PROF_VAL(RP_tot_time + HC_tot_time))),
temp, rtsTrue/*commas*/);
- fprintf(sf, " Alloc rate %s bytes per MUT second\n\n", temp);
+ statsPrintf(" Alloc rate %s bytes per MUT second\n\n", temp);
- fprintf(sf, " Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
+ statsPrintf(" Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
TICK_TO_DBL(time - GC_tot_time -
PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100
/ TICK_TO_DBL(time),
/ TICK_TO_DBL(etime));
}
- if (RtsFlags.GcFlags.giveStats == ONELINE_GC_STATS && sf != NULL) {
+ if (RtsFlags.GcFlags.giveStats == ONELINE_GC_STATS) {
/* print the long long separately to avoid bugginess on mingwin (2001-07-02, mingw-0.5) */
- fprintf(sf, "<<ghc: %llu bytes, ", GC_tot_alloc*sizeof(W_));
- fprintf(sf, "%d GCs, %ld/%ld avg/max bytes residency (%ld samples), %luM in use, %.2f INIT (%.2f elapsed), %.2f MUT (%.2f elapsed), %.2f GC (%.2f elapsed) :ghc>>\n",
+ statsPrintf("<<ghc: %llu bytes, ", GC_tot_alloc*sizeof(W_));
+ statsPrintf("%d GCs, %ld/%ld avg/max bytes residency (%ld samples), %luM in use, %.2f INIT (%.2f elapsed), %.2f MUT (%.2f elapsed), %.2f GC (%.2f elapsed) :ghc>>\n",
total_collections,
ResidencySamples == 0 ? 0 :
AvgResidency*sizeof(W_)/ResidencySamples,
TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
}
- fflush(sf);
- if (sf != stderr) {
- fclose(sf);
- }
+ statsFlush();
+ statsClose();
}
}
bdescr *bd;
step *step;
- fprintf(stderr, " Gen Steps Max Mutable Mut-Once Step Blocks Live Large\n Blocks Closures Closures Objects\n");
+ debugBelch(" Gen Steps Max Mutable Mut-Once Step Blocks Live Large\n Blocks Closures Closures Objects\n");
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
for (m = generations[g].mut_list, mut = 0; m != END_MUT_LIST;
for (m = generations[g].mut_once_list, mut_once = 0; m != END_MUT_LIST;
m = m->mut_link)
mut_once++;
- fprintf(stderr, "%8d %8d %8d %9d %9d", g, generations[g].n_steps,
+ debugBelch("%8d %8d %8d %9d %9d", g, generations[g].n_steps,
generations[g].max_blocks, mut, mut_once);
for (s = 0; s < generations[g].n_steps; s++) {
live += (bd->free - bd->start) * sizeof(W_);
}
if (s != 0) {
- fprintf(stderr,"%46s","");
+ debugBelch("%46s","");
}
- fprintf(stderr,"%6d %8d %8d %8d\n", s, step->n_blocks,
+ debugBelch("%6d %8d %8d %8d\n", s, step->n_blocks,
live, lge);
}
}
- fprintf(stderr,"\n");
+ debugBelch("\n");
}
#endif
extern HsInt64 getAllocations( void )
{ return (HsInt64)total_allocated * sizeof(W_); }
+
+/* -----------------------------------------------------------------------------
+ Dumping stuff in the stats file, or via the debug message interface
+ -------------------------------------------------------------------------- */
+
+static void
+statsPrintf( char *s, ... )
+{
+ FILE *sf = RtsFlags.GcFlags.statsFile;
+ va_list ap;
+
+ va_start(ap,s);
+ if (sf == NULL) {
+ vdebugBelch(s,ap);
+ } else {
+ vfprintf(sf, s, ap);
+ }
+ va_end(ap);
+}
+
+static void
+statsFlush( void )
+{
+ FILE *sf = RtsFlags.GcFlags.statsFile;
+ if (sf != NULL) {
+ fflush(sf);
+ }
+}
+
+static void
+statsClose( void )
+{
+ FILE *sf = RtsFlags.GcFlags.statsFile;
+ if (sf != NULL) {
+ fclose(sf);
+ }
+}
/* -----------------------------------------------------------------------------
- * $Id: StgCRun.c,v 1.43 2004/08/13 13:57:08 simonmar Exp $
+ * $Id: StgCRun.c,v 1.44 2004/09/03 15:28:56 simonmar Exp $
*
* (c) The GHC Team, 1998-2003
*
{
while (f) {
if (RtsFlags[0].DebugFlags.interpreter) {
- fprintf(stderr,"Jumping to ");
+ debugBelch("Jumping to ");
printPtr((P_)f); fflush(stdout);
- fprintf(stderr,"\n");
+ debugBelch("\n");
}
f = (StgFunPtr) (f)();
}
/* -----------------------------------------------------------------------------
- * $Id: Storage.c,v 1.84 2004/08/13 13:11:01 simonmar Exp $
*
- * (c) The GHC Team, 1998-1999
+ * (c) The GHC Team, 1998-2004
*
* Storage manager front end
*
if (RtsFlags.GcFlags.maxHeapSize != 0 &&
RtsFlags.GcFlags.minAllocAreaSize >
RtsFlags.GcFlags.maxHeapSize) {
- prog_belch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
+ errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
exit(1);
}
/* The oldest generation has one step and it is compacted. */
if (RtsFlags.GcFlags.compact) {
if (RtsFlags.GcFlags.generations == 1) {
- belch("WARNING: compaction is incompatible with -G1; disabled");
+ errorBelch("WARNING: compaction is incompatible with -G1; disabled");
} else {
oldest_gen->steps[0].is_compacted = 1;
}
#ifdef PAR
/* If we are PAR or DIST then we never forget a CAF */
{ globalAddr *newGA;
- //belch("<##> Globalising CAF %08x %s",caf,info_type(caf));
+ //debugBelch("<##> Globalising CAF %08x %s",caf,info_type(caf));
newGA=makeGlobal(caf,rtsTrue); /*given full weight*/
ASSERT(newGA);
}
}
else if (nursery_blocks < blocks) {
- IF_DEBUG(gc, fprintf(stderr, "Increasing size of nursery to %d blocks\n",
+ IF_DEBUG(gc, debugBelch("Increasing size of nursery to %d blocks\n",
blocks));
g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks);
}
else {
bdescr *next_bd;
- IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n",
+ IF_DEBUG(gc, debugBelch("Decreasing size of nursery to %d blocks\n",
blocks));
bd = g0s0->blocks;
if (total_blocks + free_blocks != mblocks_allocated *
BLOCKS_PER_MBLOCK) {
- fprintf(stderr, "Blocks: %ld live + %ld free = %ld total (%ld around)\n",
+ debugBelch("Blocks: %ld live + %ld free = %ld total (%ld around)\n",
total_blocks, free_blocks, total_blocks + free_blocks,
mblocks_allocated * BLOCKS_PER_MBLOCK);
}
taskTable[taskCount].gc_etime = 0.0;
taskTable[taskCount].elapsedtimestart = stat_getElapsedTime();
- IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Started task: %ld\n",tid););
+ IF_DEBUG(scheduler,debugBelch("scheduler: Started task: %ld\n",tid););
return;
}
/* Wait for all the tasks to terminate */
for (i = 0; i < maxCount; i++) {
- IF_DEBUG(scheduler,fprintf(stderr,"scheduler: waiting for task %ld\n",
+ IF_DEBUG(scheduler,debugBelch("scheduler: waiting for task %ld\n",
taskTable[i].id));
pthread_join(taskTable[i].id, NULL);
}
on thread_ready_cond, don't create a new one.
*/
if ( rts_n_waiting_tasks > 0) {
- IF_DEBUG(scheduler,fprintf(stderr,
+ IF_DEBUG(scheduler,debugBelch(
"scheduler: startTask: %d tasks waiting, not creating new one.\n",
rts_n_waiting_tasks););
// the task will run as soon as a capability is available,
/* If the task limit has been reached, just return. */
if (maxTasks > 0 && taskCount == maxTasks) {
- IF_DEBUG(scheduler,fprintf(stderr,"scheduler: startTask: task limit (%d) reached, not creating new one.\n",maxTasks));
+ IF_DEBUG(scheduler,debugBelch("scheduler: startTask: task limit (%d) reached, not creating new one.\n",maxTasks));
return rtsFalse;
}
}
taskCount++;
- IF_DEBUG(scheduler,fprintf(stderr,"scheduler: startTask: new task %ld (total_count: %d; waiting: %d)\n", tid, taskCount, rts_n_waiting_tasks););
+ IF_DEBUG(scheduler,debugBelch("scheduler: startTask: new task %ld (total_count: %d; waiting: %d)\n", tid, taskCount, rts_n_waiting_tasks););
return rtsTrue;
}
/* -----------------------------------------------------------------------------
- * $Id: Weak.c,v 1.32 2004/08/13 13:11:13 simonmar Exp $
+ * $Id: Weak.c,v 1.33 2004/09/03 15:28:59 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "PosixSource.h"
#define COMPILING_RTS_MAIN
#include "Rts.h"
+#include "RtsUtils.h"
#include "SchedAPI.h"
#include "RtsFlags.h"
#include "Weak.h"
weak_ptr_list = w->link;
if (w->header.info != &stg_DEAD_WEAK_info) {
SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs);
- IF_DEBUG(weak,fprintf(stderr,"Finalising weak pointer at %p -> %p\n", w, w->key));
+ IF_DEBUG(weak,debugBelch("Finalising weak pointer at %p -> %p\n", w, w->key));
if (w->finalizer != &stg_NO_FINALIZER_closure) {
rts_evalLazyIO(w->finalizer,NULL);
rts_unlock();
// No finalizers to run?
if (n == 0) return;
- IF_DEBUG(weak,fprintf(stderr,"weak: batching %d finalizers\n", n));
+ IF_DEBUG(weak,debugBelch("weak: batching %d finalizers\n", n));
arr = (StgMutArrPtrs *)allocate(sizeofW(StgMutArrPtrs) + n);
TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0);
projects / ghc-hetmet.git / commitdiff