From 95ca6bff6fc9918203173b442192d9298ef9757a Mon Sep 17 00:00:00 2001 From: simonmar Date: Fri, 3 Sep 2004 15:28:59 +0000 Subject: [PATCH] [project @ 2004-09-03 15:28:18 by simonmar] Cleanup: all (well, most) messages from the RTS now go through the functions in RtsUtils: barf(), debugBelch() and errorBelch(). The latter two were previously called belch() and prog_belch() respectively. See the comments for the right usage of these message functions. One reason for doing this is so that we can avoid spurious uses of stdout/stderr by Haskell apps on platforms where we shouldn't be using them (eg. non-console apps on Windows). --- ghc/rts/Adjustor.c | 10 +- ghc/rts/BlockAlloc.c | 6 +- ghc/rts/Disassembler.c | 150 ++++++++++++----------- ghc/rts/FrontPanel.c | 4 +- ghc/rts/GC.c | 62 +++++----- ghc/rts/GCCompact.c | 20 ++-- ghc/rts/Interpreter.c | 54 ++++----- ghc/rts/Itimer.c | 6 +- ghc/rts/Linker.c | 293 ++++++++++++++++++++++----------------------- ghc/rts/MBlock.c | 22 ++-- ghc/rts/Main.c | 12 +- ghc/rts/OSThreads.c | 4 +- ghc/rts/OSThreads.h | 4 +- ghc/rts/Printer.c | 234 ++++++++++++++++++------------------ ghc/rts/ProfHeap.c | 14 +-- ghc/rts/Profiling.c | 37 ++++-- ghc/rts/Profiling.h | 6 + ghc/rts/Proftimer.c | 4 +- ghc/rts/RetainerProfile.c | 106 ++++++++-------- ghc/rts/RetainerSet.c | 8 +- ghc/rts/RetainerSet.h | 4 +- ghc/rts/RtsAPI.c | 8 +- ghc/rts/RtsFlags.c | 262 ++++++++++++++++++++++------------------ ghc/rts/RtsStartup.c | 6 +- ghc/rts/RtsUtils.c | 71 ++++++++--- ghc/rts/RtsUtils.h | 58 ++++++++- ghc/rts/Sanity.c | 8 +- ghc/rts/Schedule.c | 216 +++++++++++++++++---------------- ghc/rts/Schedule.h | 3 +- ghc/rts/Select.c | 14 +-- ghc/rts/Signals.c | 10 +- ghc/rts/Sparks.c | 54 ++++----- ghc/rts/Stable.c | 13 +- ghc/rts/Stats.c | 137 +++++++++++++-------- ghc/rts/StgCRun.c | 6 +- ghc/rts/Storage.c | 15 ++- ghc/rts/Task.c | 10 +- ghc/rts/Weak.c | 7 +- 38 files changed, 1056 insertions(+), 902 deletions(-) diff --git a/ghc/rts/Adjustor.c b/ghc/rts/Adjustor.c index 44fbcf2..3b93989 100644 --- a/ghc/rts/Adjustor.c +++ b/ghc/rts/Adjustor.c @@ -501,7 +501,7 @@ freeHaskellFunctionPtr(void* ptr) #if defined(i386_TARGET_ARCH) if ( *(unsigned char*)ptr != 0x68 && *(unsigned char*)ptr != 0x58 ) { - prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); + errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); return; } @@ -513,7 +513,7 @@ freeHaskellFunctionPtr(void* ptr) } #elif defined(sparc_TARGET_ARCH) if ( *(unsigned long*)ptr != 0x9C23A008UL ) { - prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); + errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); return; } @@ -521,7 +521,7 @@ freeHaskellFunctionPtr(void* ptr) freeStablePtr(*((StgStablePtr*)((unsigned long*)ptr + 11))); #elif defined(alpha_TARGET_ARCH) if ( *(StgWord64*)ptr != 0xa77b0018a61b0010L ) { - prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); + errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); return; } @@ -529,7 +529,7 @@ freeHaskellFunctionPtr(void* ptr) freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10))); #elif defined(powerpc_TARGET_ARCH) if ( *(StgWord*)ptr != 0x7d0a4378 ) { - prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); + errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); return; } freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 4*12))); @@ -538,7 +538,7 @@ freeHaskellFunctionPtr(void* ptr) StgWord64 *code = (StgWord64 *)(fdesc+1); if (fdesc->ip != (StgWord64)code) { - prog_belch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); + errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr); return; } freeStablePtr((StgStablePtr)code[16]); diff --git a/ghc/rts/BlockAlloc.c b/ghc/rts/BlockAlloc.c index 63da2a2..034b621 100644 --- a/ghc/rts/BlockAlloc.c +++ b/ghc/rts/BlockAlloc.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: BlockAlloc.c,v 1.17 2003/11/12 17:49:05 sof Exp $ + * $Id: BlockAlloc.c,v 1.18 2004/09/03 15:28:19 simonmar Exp $ * * (c) The GHC Team 1998-2000 * @@ -325,8 +325,8 @@ checkFreeListSanity(void) for (bd = free_list; bd != NULL; bd = bd->link) { IF_DEBUG(block_alloc, - fprintf(stderr,"group at 0x%x, length %d blocks\n", - (nat)bd->start, bd->blocks)); + debugBelch("group at 0x%x, length %d blocks\n", + (nat)bd->start, bd->blocks)); ASSERT(bd->blocks > 0); checkWellFormedGroup(bd); if (bd->link != NULL) { diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c index 41b66f1..b084a29 100644 --- a/ghc/rts/Disassembler.c +++ b/ghc/rts/Disassembler.c @@ -4,8 +4,8 @@ * 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 @@ -23,8 +23,6 @@ #include "Disassembler.h" #include "Interpreter.h" -#include - /* -------------------------------------------------------------------------- * Disassembler * ------------------------------------------------------------------------*/ @@ -47,188 +45,188 @@ disInstr ( StgBCO *bco, int pc ) 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: @@ -251,32 +249,32 @@ void disassemble( StgBCO *bco ) 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); } diff --git a/ghc/rts/FrontPanel.c b/ghc/rts/FrontPanel.c index 85faeeb..92ed071 100644 --- a/ghc/rts/FrontPanel.c +++ b/ghc/rts/FrontPanel.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: FrontPanel.c,v 1.9 2004/08/13 13:09:49 simonmar Exp $ + * $Id: FrontPanel.c,v 1.10 2004/09/03 15:28:20 simonmar Exp $ * * (c) The GHC Team 2000 * @@ -102,7 +102,7 @@ configure_event( GtkWidget *widget, GdkEventConfigure *event STG_UNUSED, widget->allocation.width, widget->allocation.height); - fprintf(stderr, "configure!\n"); + debugBelch("configure!\n"); updateFrontPanel(); return TRUE; } diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index adb36cc..9d25926 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.168 2004/08/13 13:09:49 simonmar Exp $ + * $Id: GC.c,v 1.169 2004/09/03 15:28:20 simonmar Exp $ * * (c) The GHC Team 1998-2003 * @@ -307,7 +307,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) #endif #if defined(DEBUG) && defined(GRAN) - IF_DEBUG(gc, belch("@@ Starting garbage collection at %ld (%lx)\n", + IF_DEBUG(gc, debugBelch("@@ Starting garbage collection at %ld (%lx)\n", Now, Now)); #endif @@ -440,7 +440,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) stp->bitmap = bitmap_bdescr; bitmap = bitmap_bdescr->start; - IF_DEBUG(gc, belch("bitmap_size: %d, bitmap: %p", + IF_DEBUG(gc, debugBelch("bitmap_size: %d, bitmap: %p", bitmap_size, bitmap);); // don't forget to fill it with zeros! @@ -851,10 +851,10 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) oldest_gen->steps[0].n_blocks > (RtsFlags.GcFlags.compactThreshold * max) / 100))) { oldest_gen->steps[0].is_compacted = 1; -// fprintf(stderr,"compaction: on\n", live); +// debugBelch("compaction: on\n", live); } else { oldest_gen->steps[0].is_compacted = 0; -// fprintf(stderr,"compaction: off\n", live); +// debugBelch("compaction: off\n", live); } // if we're going to go over the maximum heap size, reduce the @@ -886,7 +886,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) } #if 0 - fprintf(stderr,"live: %d, min_alloc: %d, size : %d, max = %d\n", live, + debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live, min_alloc, size, max); #endif @@ -968,7 +968,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc ) int pc_free; adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks); - IF_DEBUG(gc, belch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks)); + IF_DEBUG(gc, debugBelch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks)); pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize; if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ { heapOverflow(); @@ -1196,7 +1196,7 @@ traverse_weak_ptr_list(void) w->link = weak_ptr_list; weak_ptr_list = w; flag = rtsTrue; - IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p", + IF_DEBUG(weak, debugBelch("Weak pointer still alive at %p -> %p", w, w->key)); continue; } @@ -1958,7 +1958,7 @@ loop: //ToDo: derive size etc from reverted IP //to = copy(q,size,stp); IF_DEBUG(gc, - belch("@@ evacuate: RBH %p (%s) to %p (%s)", + debugBelch("@@ evacuate: RBH %p (%s) to %p (%s)", q, info_type(q), to, info_type(to))); return to; } @@ -1967,7 +1967,7 @@ loop: ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE); to = copy(q,sizeofW(StgBlockedFetch),stp); IF_DEBUG(gc, - belch("@@ evacuate: %p (%s) to %p (%s)", + debugBelch("@@ evacuate: %p (%s) to %p (%s)", q, info_type(q), to, info_type(to))); return to; @@ -1978,7 +1978,7 @@ loop: ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); to = copy(q,sizeofW(StgFetchMe),stp); IF_DEBUG(gc, - belch("@@ evacuate: %p (%s) to %p (%s)", + debugBelch("@@ evacuate: %p (%s) to %p (%s)", q, info_type(q), to, info_type(to))); return to; @@ -1986,7 +1986,7 @@ loop: ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE); to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp); IF_DEBUG(gc, - belch("@@ evacuate: %p (%s) to %p (%s)", + debugBelch("@@ evacuate: %p (%s) to %p (%s)", q, info_type(q), to, info_type(to))); return to; #endif @@ -2750,7 +2750,7 @@ scavenge(step *stp) recordMutable((StgMutClosure *)to); failed_to_evac = rtsFalse; // mutable anyhow. IF_DEBUG(gc, - belch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", + debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", p, info_type(p), (StgClosure *)rbh->blocking_queue)); // ToDo: use size of reverted closure here! p += BLACKHOLE_sizeW(); @@ -2771,7 +2771,7 @@ scavenge(step *stp) recordMutable((StgMutClosure *)bf); } IF_DEBUG(gc, - belch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", + debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", bf, info_type((StgClosure *)bf), bf->node, info_type(bf->node))); p += sizeofW(StgBlockedFetch); @@ -2795,7 +2795,7 @@ scavenge(step *stp) recordMutable((StgMutClosure *)fmbq); } IF_DEBUG(gc, - belch("@@ scavenge: %p (%s) exciting, isn't it", + debugBelch("@@ scavenge: %p (%s) exciting, isn't it", p, info_type((StgClosure *)p))); p += sizeofW(StgFetchMeBlockingQueue); break; @@ -3059,7 +3059,7 @@ linear_scan: recordMutable((StgMutClosure *)rbh); failed_to_evac = rtsFalse; // mutable anyhow. IF_DEBUG(gc, - belch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", + debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)", p, info_type(p), (StgClosure *)rbh->blocking_queue)); break; } @@ -3078,7 +3078,7 @@ linear_scan: recordMutable((StgMutClosure *)bf); } IF_DEBUG(gc, - belch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", + debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it", bf, info_type((StgClosure *)bf), bf->node, info_type(bf->node))); break; @@ -3100,7 +3100,7 @@ linear_scan: recordMutable((StgMutClosure *)fmbq); } IF_DEBUG(gc, - belch("@@ scavenge: %p (%s) exciting, isn't it", + debugBelch("@@ scavenge: %p (%s) exciting, isn't it", p, info_type((StgClosure *)p))); break; } @@ -3123,7 +3123,7 @@ linear_scan: // start a new linear scan if the mark stack overflowed at some point if (mark_stack_overflowed && oldgen_scan_bd == NULL) { - IF_DEBUG(gc, belch("scavenge_mark_stack: starting linear scan")); + IF_DEBUG(gc, debugBelch("scavenge_mark_stack: starting linear scan")); mark_stack_overflowed = rtsFalse; oldgen_scan_bd = oldest_gen->steps[0].blocks; oldgen_scan = oldgen_scan_bd->start; @@ -3367,7 +3367,7 @@ scavenge_mut_once_list(generation *gen) } else { size = gen->steps[0].scan - start; } - belch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_)); + debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_)); } #endif @@ -3743,7 +3743,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end) StgWord bitmap; nat size; - //IF_DEBUG(sanity, belch(" scavenging stack between %p and %p", p, stack_end)); + //IF_DEBUG(sanity, debugBelch(" scavenging stack between %p and %p", p, stack_end)); /* * Each time around this loop, we are looking at a chunk of stack @@ -3987,7 +3987,7 @@ gcCAFs(void) ASSERT(info->type == IND_STATIC); if (STATIC_LINK(info,p) == NULL) { - IF_DEBUG(gccafs, belch("CAF gc'd at 0x%04lx", (long)p)); + IF_DEBUG(gccafs, debugBelch("CAF gc'd at 0x%04lx", (long)p)); // black hole it SET_INFO(p,&stg_BLACKHOLE_info); p = STATIC_LINK2(info,p); @@ -4001,7 +4001,7 @@ gcCAFs(void) } - // belch("%d CAFs live", i); + // debugBelch("%d CAFs live", i); } #endif @@ -4048,7 +4048,7 @@ threadLazyBlackHole(StgTSO *tso) if (bh->header.info != &stg_BLACKHOLE_BQ_info && bh->header.info != &stg_CAF_BLACKHOLE_info) { #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) - belch("Unexpected lazy BHing required at 0x%04x",(int)bh); + debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh); #endif #ifdef PROFILING // @LDV profiling @@ -4175,7 +4175,7 @@ threadSqueezeStack(StgTSO *tso) bh->header.info != &stg_BLACKHOLE_BQ_info && bh->header.info != &stg_CAF_BLACKHOLE_info) { #if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG) - belch("Unexpected lazy BHing required at 0x%04x",(int)bh); + debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh); #endif #ifdef DEBUG /* zero out the slop so that the sanity checker can tell @@ -4310,12 +4310,12 @@ printMutOnceList(generation *gen) p = gen->mut_once_list; next = p->mut_link; - fprintf(stderr, "@@ Mut once list %p: ", gen->mut_once_list); + debugBelch("@@ Mut once list %p: ", gen->mut_once_list); for (; p != END_MUT_LIST; p = next, next = p->mut_link) { - fprintf(stderr, "%p (%s), ", + debugBelch("%p (%s), ", p, info_type((StgClosure *)p)); } - fputc('\n', stderr); + debugBelch("\n"); } void @@ -4326,12 +4326,12 @@ printMutableList(generation *gen) p = gen->mut_list; next = p->mut_link; - fprintf(stderr, "@@ Mutable list %p: ", gen->mut_list); + debugBelch("@@ Mutable list %p: ", gen->mut_list); for (; p != END_MUT_LIST; p = next, next = p->mut_link) { - fprintf(stderr, "%p (%s), ", + debugBelch("%p (%s), ", p, info_type((StgClosure *)p)); } - fputc('\n', stderr); + debugBelch("\n"); } STATIC_INLINE rtsBool diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c index 8f61d73..2dd59cc 100644 --- a/ghc/rts/GCCompact.c +++ b/ghc/rts/GCCompact.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GCCompact.c,v 1.19 2004/08/13 13:09:56 simonmar Exp $ + * $Id: GCCompact.c,v 1.20 2004/09/03 15:28:26 simonmar Exp $ * * (c) The GHC Team 2001 * @@ -72,15 +72,15 @@ thread( StgPtr p ) STATIC_INLINE void unthread( StgPtr p, StgPtr free ) { - StgPtr q = (StgPtr)*p, r; + StgWord q = *p, r; - while (((StgWord)q & 1) != 0) { - (StgWord)q -= 1; // unset the low bit again - r = (StgPtr)*q; - *q = (StgWord)free; + while ((q & 1) != 0) { + q -= 1; // unset the low bit again + r = *((StgPtr)q); + *((StgPtr)q) = (StgWord)free; q = r; } - *p = (StgWord)q; + *p = q; } STATIC_INLINE StgInfoTable * @@ -880,12 +880,12 @@ compact( void (*get_roots)(evac_fn) ) for (g = 0; g < RtsFlags.GcFlags.generations; g++) { for (s = 0; s < generations[g].n_steps; s++) { stp = &generations[g].steps[s]; - IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d\n", stp->gen->no, stp->no);); + IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no);); update_fwd(stp->to_blocks); update_fwd_large(stp->scavenged_large_objects); if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) { - IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no);); + IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no);); update_fwd_compact(stp->blocks); } } @@ -895,7 +895,7 @@ compact( void (*get_roots)(evac_fn) ) stp = &oldest_gen->steps[0]; if (stp->blocks != NULL) { blocks = update_bkwd_compact(stp); - IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", + IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", stp->gen->no, stp->no, stp->n_blocks, blocks);); stp->n_blocks = blocks; diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c index cd7ab13..5a13428 100644 --- a/ghc/rts/Interpreter.c +++ b/ghc/rts/Interpreter.c @@ -111,22 +111,22 @@ void interp_startup ( void ) void interp_shutdown ( void ) { int i, j, k, o_max, i_max, j_max; - fprintf(stderr, "%d constrs entered -> (%d BCO, %d UPD, %d ??? )\n", + debugBelch("%d constrs entered -> (%d BCO, %d UPD, %d ??? )\n", it_retto_BCO + it_retto_UPDATE + it_retto_other, it_retto_BCO, it_retto_UPDATE, it_retto_other ); - fprintf(stderr, "%d total entries, %d unknown entries \n", + debugBelch("%d total entries, %d unknown entries \n", it_total_entries, it_total_unknown_entries); for (i = 0; i < N_CLOSURE_TYPES; i++) { if (it_unknown_entries[i] == 0) continue; - fprintf(stderr, " type %2d: unknown entries (%4.1f%%) == %d\n", + debugBelch(" type %2d: unknown entries (%4.1f%%) == %d\n", i, 100.0 * ((double)it_unknown_entries[i]) / ((double)it_total_unknown_entries), it_unknown_entries[i]); } - fprintf(stderr, "%d insns, %d slides, %d BCO_entries\n", + debugBelch("%d insns, %d slides, %d BCO_entries\n", it_insns, it_slides, it_BCO_entries); for (i = 0; i < 27; i++) - fprintf(stderr, "opcode %2d got %d\n", i, it_ofreq[i] ); + debugBelch("opcode %2d got %d\n", i, it_ofreq[i] ); for (k = 1; k < 20; k++) { o_max = 0; @@ -140,7 +140,7 @@ void interp_shutdown ( void ) } } - fprintf ( stderr, "%d: count (%4.1f%%) %6d is %d then %d\n", + debugBelch("%d: count (%4.1f%%) %6d is %d then %d\n", k, ((double)o_max) * 100.0 / ((double)it_insns), o_max, i_max, j_max ); it_oofreq[i_max][j_max] = 0; @@ -228,14 +228,14 @@ eval_obj: INTERP_TICK(it_total_evals); IF_DEBUG(interpreter, - fprintf(stderr, + debugBelch( "\n---------------------------------------------------------------\n"); - fprintf(stderr,"Evaluating: "); printObj(obj); - fprintf(stderr,"Sp = %p\n", Sp); - fprintf(stderr, "\n" ); + debugBelch("Evaluating: "); printObj(obj); + debugBelch("Sp = %p\n", Sp); + debugBelch("\n" ); printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size); - fprintf(stderr, "\n\n"); + debugBelch("\n\n"); ); IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size)); @@ -327,7 +327,7 @@ eval_obj: { // Can't handle this object; yield to scheduler IF_DEBUG(interpreter, - fprintf(stderr, "evaluating unknown closure -- yielding to sched\n"); + debugBelch("evaluating unknown closure -- yielding to sched\n"); printObj(obj); ); Sp -= 2; @@ -344,13 +344,13 @@ do_return: ASSERT(closure_HNF(obj)); IF_DEBUG(interpreter, - fprintf(stderr, + debugBelch( "\n---------------------------------------------------------------\n"); - fprintf(stderr,"Returning: "); printObj(obj); - fprintf(stderr,"Sp = %p\n", Sp); - fprintf(stderr, "\n" ); + debugBelch("Returning: "); printObj(obj); + debugBelch("Sp = %p\n", Sp); + debugBelch("\n" ); printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size); - fprintf(stderr, "\n\n"); + debugBelch("\n\n"); ); IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size)); @@ -422,7 +422,7 @@ do_return: // Can't handle this return address; yield to scheduler INTERP_TICK(it_retto_other); IF_DEBUG(interpreter, - fprintf(stderr, "returning to unknown frame -- yielding to sched\n"); + debugBelch("returning to unknown frame -- yielding to sched\n"); printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size); ); Sp -= 2; @@ -485,7 +485,7 @@ do_return_unboxed: // Can't handle this return address; yield to scheduler INTERP_TICK(it_retto_other); IF_DEBUG(interpreter, - fprintf(stderr, "returning to unknown frame -- yielding to sched\n"); + debugBelch("returning to unknown frame -- yielding to sched\n"); printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size); ); RETURN_TO_SCHEDULER(ThreadRunGHC, ThreadYielding); @@ -729,18 +729,18 @@ run_BCO: ASSERT(bciPtr <= instrs[0]); IF_DEBUG(interpreter, //if (do_print_stack) { - //fprintf(stderr, "\n-- BEGIN stack\n"); + //debugBelch("\n-- BEGIN stack\n"); //printStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); - //fprintf(stderr, "-- END stack\n\n"); + //debugBelch("-- END stack\n\n"); //} - fprintf(stderr,"Sp = %p pc = %d ", Sp, bciPtr); + debugBelch("Sp = %p pc = %d ", Sp, bciPtr); disInstr(bco,bciPtr); if (0) { int i; - fprintf(stderr,"\n"); + debugBelch("\n"); for (i = 8; i >= 0; i--) { - fprintf(stderr, "%d %p\n", i, (StgPtr)(*(Sp+i))); + debugBelch("%d %p\n", i, (StgPtr)(*(Sp+i))); } - fprintf(stderr,"\n"); + debugBelch("\n"); } //if (do_print_stack) checkStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu); ); @@ -962,7 +962,7 @@ run_BCO: ap->payload[i] = (StgClosure*)Sp[i+1]; Sp += n_payload+1; IF_DEBUG(interpreter, - fprintf(stderr,"\tBuilt "); + debugBelch("\tBuilt "); printObj((StgClosure*)ap); ); goto nextInsn; @@ -997,7 +997,7 @@ run_BCO: Sp --; Sp[0] = (W_)con; IF_DEBUG(interpreter, - fprintf(stderr,"\tBuilt "); + debugBelch("\tBuilt "); printObj((StgClosure*)con); ); goto nextInsn; diff --git a/ghc/rts/Itimer.c b/ghc/rts/Itimer.c index 2f769d3..7ba7051 100644 --- a/ghc/rts/Itimer.c +++ b/ghc/rts/Itimer.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Itimer.c,v 1.36 2003/12/22 16:27:10 simonmar Exp $ + * $Id: Itimer.c,v 1.37 2004/09/03 15:28:29 simonmar Exp $ * * (c) The GHC Team, 1995-1999 * @@ -92,7 +92,7 @@ int startTicker(nat ms, TickProc handle_tick) { # ifndef HAVE_SETITIMER - /* fprintf(stderr, "No virtual timer on this system\n"); */ + /* debugBelch("No virtual timer on this system\n"); */ return -1; # else struct itimerval it; @@ -112,7 +112,7 @@ int stopTicker() { # ifndef HAVE_SETITIMER - /* fprintf(stderr, "No virtual timer on this system\n"); */ + /* debugBelch("No virtual timer on this system\n"); */ return -1; # else struct itimerval it; diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index 24f5d09..d6024ac 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -666,7 +666,7 @@ static void ghciInsertStrHashTable ( char* obj_name, 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" @@ -803,7 +803,7 @@ addDLL( char *dll_name ) 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) { @@ -880,7 +880,7 @@ lookupSymbol( char *lbl ) 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 @@ -889,13 +889,13 @@ lookupSymbol( char *lbl ) */ 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; } } @@ -947,7 +947,7 @@ void ghci_enquire ( char* addr ) 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); @@ -956,10 +956,10 @@ void ghci_enquire ( char* addr ) 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); } } } @@ -990,7 +990,7 @@ loadObj( char *path ) 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 */ @@ -1004,7 +1004,7 @@ loadObj( char *path ) } } 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" @@ -1209,7 +1209,7 @@ unloadObj( char *path ) } } - belch("unloadObj: can't find `%s' to unload", path); + errorBelch("unloadObj: can't find `%s' to unload", path); return 0; } @@ -1222,7 +1222,7 @@ static void addProddableBlock ( ObjectCode* oc, void* start, int size ) { 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; @@ -1258,7 +1258,7 @@ static void addSection ( ObjectCode* oc, SectionKind kind, 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 ); */ } @@ -1420,12 +1420,12 @@ printName ( UChar* name, UChar* strtab ) { 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] ); } } } @@ -1532,7 +1532,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) 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)) @@ -1546,36 +1546,36 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) + 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 @@ -1585,44 +1585,34 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) 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" @@ -1662,7 +1652,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) 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 ); @@ -1670,35 +1660,35 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) 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" @@ -1715,7 +1705,7 @@ ocVerifyImage_PEi386 ( ObjectCode* oc ) i++; } - fprintf ( stderr, "\n" ); + debugBelch("\n" ); return 1; } @@ -1761,7 +1751,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) "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. */ @@ -1776,7 +1766,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) 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 @@ -1808,7 +1798,7 @@ ocGetNames_PEi386 ( ObjectCode* oc ) && 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; } @@ -1862,26 +1852,26 @@ ocGetNames_PEi386 ( ObjectCode* oc ) 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" @@ -1923,7 +1913,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) /* 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*) ( @@ -1967,7 +1957,8 @@ ocResolve_PEi386 ( ObjectCode* oc ) 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; @@ -1995,20 +1986,20 @@ ocResolve_PEi386 ( ObjectCode* oc ) 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)) @@ -2026,7 +2017,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) (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: } @@ -2051,7 +2042,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) *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; } @@ -2059,7 +2050,7 @@ ocResolve_PEi386 ( ObjectCode* oc ) } } - IF_DEBUG(linker, belch("completed %s", oc->fileName)); + IF_DEBUG(linker, debugBelch("completed %s", oc->fileName)); return 1; } @@ -2328,44 +2319,44 @@ ocVerifyImage_ELF ( ObjectCode* oc ) 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 )); @@ -2374,36 +2365,36 @@ ocVerifyImage_ELF ( ObjectCode* oc ) 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++) { @@ -2414,65 +2405,65 @@ ocVerifyImage_ELF ( ObjectCode* oc ) 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; } @@ -2494,7 +2485,7 @@ ocGetNames_ELF ( ObjectCode* oc ) ASSERT(symhash != NULL); if (!strtab) { - belch("%s: no strtab", oc->fileName); + errorBelch("%s: no strtab", oc->fileName); return 0; } @@ -2540,7 +2531,7 @@ ocGetNames_ELF ( ObjectCode* oc ) "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); */ } @@ -2576,7 +2567,7 @@ ocGetNames_ELF ( ObjectCode* oc ) 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, @@ -2601,7 +2592,7 @@ ocGetNames_ELF ( ObjectCode* oc ) 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); } */ @@ -2616,7 +2607,7 @@ ocGetNames_ELF ( ObjectCode* oc ) 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; } @@ -2635,10 +2626,10 @@ ocGetNames_ELF ( ObjectCode* oc ) } } 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), @@ -2672,7 +2663,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, 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++) { @@ -2686,10 +2677,10 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, 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)]; @@ -2709,13 +2700,13 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, 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 ); @@ -2727,7 +2718,7 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, 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; } @@ -2753,7 +2744,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, 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++) { @@ -2775,11 +2766,11 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, 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)]; @@ -2808,17 +2799,17 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, /* 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 ); */ @@ -2892,7 +2883,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, 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; } @@ -2919,7 +2910,7 @@ ocResolve_ELF ( ObjectCode* oc ) 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; } @@ -3150,7 +3141,7 @@ static int resolveImports( 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); @@ -3381,7 +3372,7 @@ static int relocateSection( unsigned long symbolAddress = (unsigned long) (lookupSymbol(nm)); if(!symbolAddress) { - belch("\nunknown symbol `%s'", nm); + errorBelch("\nunknown symbol `%s'", nm); return 0; } diff --git a/ghc/rts/MBlock.c b/ghc/rts/MBlock.c index d0ead3f..5867c1b 100644 --- a/ghc/rts/MBlock.c +++ b/ghc/rts/MBlock.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: MBlock.c,v 1.50 2003/10/31 16:21:27 sof Exp $ + * $Id: MBlock.c,v 1.51 2004/09/03 15:28:33 simonmar Exp $ * * (c) The GHC Team 1998-1999 * @@ -133,7 +133,7 @@ my_mmap (void *addr, lnat size) (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) { // If we request more than 3Gig, then we get EINVAL // instead of ENOMEM (at least on Linux). - prog_belch("out of memory (requested %d bytes)", size); + errorBelch("out of memory (requested %d bytes)", size); stg_exit(EXIT_FAILURE); } else { barf("getMBlock: mmap: %s", strerror(errno)); @@ -205,7 +205,7 @@ getMBlocks(nat n) if (((W_)ret & MBLOCK_MASK) != 0) { // misaligned block! #if 0 // defined(DEBUG) - belch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request); + errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request); #endif // unmap this block... @@ -221,7 +221,7 @@ getMBlocks(nat n) // ToDo: check that we haven't already grabbed the memory at next_request next_request = ret + size; - IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret)); + IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at %p\n",n,ret)); // fill in the table for (i = 0; i < n; i++) { @@ -291,19 +291,19 @@ getMBlocks(nat n) , PAGE_READWRITE ); if ( base_non_committed == 0 ) { - fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError()); + errorBelch("getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError()); ret=(void*)-1; } else { end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool; /* The returned pointer is not aligned on a mega-block boundary. Make it. */ base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE; # if 0 - fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n", - (unsigned)base_mblocks - (unsigned)base_non_committed); + debugBelch("getMBlocks: Dropping %d bytes off of 256M chunk\n", + (unsigned)base_mblocks - (unsigned)base_non_committed); # endif if ( ((char*)base_mblocks + size) > end_non_committed ) { - fprintf(stderr, "getMBlocks: oops, committed too small a region to start with."); + debugBelch("getMBlocks: oops, committed too small a region to start with."); ret=(void*)-1; } else { next_request = base_mblocks; @@ -314,7 +314,7 @@ getMBlocks(nat n) if ( ret != (void*)-1 ) { ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE); if (ret == NULL) { - fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError()); + debugBelch("getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError()); ret=(void*)-1; } } @@ -327,7 +327,7 @@ getMBlocks(nat n) barf("getMBlocks: unknown memory allocation failure on Win32."); } - IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret)); + IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at 0x%x\n",n,(nat)ret)); next_request = (char*)next_request + size; mblocks_allocated += n; @@ -356,7 +356,7 @@ freeMBlock(void* p, nat n) if (rc == FALSE) { # ifdef DEBUG - fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError()); + debugBelch("freeMBlocks: VirtualFree failed with: %d\n", GetLastError()); # endif } diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c index 114b3fc..cceb607 100644 --- a/ghc/rts/Main.c +++ b/ghc/rts/Main.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Main.c,v 1.41 2004/08/13 13:10:10 simonmar Exp $ + * $Id: Main.c,v 1.42 2004/09/03 15:28:34 simonmar Exp $ * * (c) The GHC Team 1998-2000 * @@ -78,14 +78,14 @@ int main(int argc, char *argv[]) if (IAmMainThread == rtsTrue) { IF_PAR_DEBUG(verbose, - fprintf(stderr, "==== [%x] Main Thread Started ...\n", mytid)); + debugBelch("==== [%x] Main Thread Started ...\n", mytid)); /* ToDo: Dump event for the main thread */ status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL); } else { /* Just to show we're alive */ IF_PAR_DEBUG(verbose, - fprintf(stderr, "== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n", + debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n", mytid)); /* all non-main threads enter the scheduler without work */ @@ -110,11 +110,11 @@ int main(int argc, char *argv[]) /* check the status of the entire Haskell computation */ switch (status) { case Killed: - prog_belch("main thread exited (uncaught exception)"); + errorBelch("main thread exited (uncaught exception)"); exit_status = EXIT_KILLED; break; case Interrupted: - prog_belch("interrupted"); + errorBelch("interrupted"); exit_status = EXIT_INTERRUPTED; break; case Success: @@ -122,7 +122,7 @@ int main(int argc, char *argv[]) break; #if defined(PAR) case NoStatus: - prog_belch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml..."); + errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml..."); exit_status = EXIT_KILLED; break; #endif diff --git a/ghc/rts/OSThreads.c b/ghc/rts/OSThreads.c index ca8fd6d..7ed6fd8 100644 --- a/ghc/rts/OSThreads.c +++ b/ghc/rts/OSThreads.c @@ -144,7 +144,7 @@ initCondition( Condition* pCond ) NULL); /* unnamed => process-local. */ if ( h == NULL ) { - belch("initCondition: unable to create"); + errorBelch("initCondition: unable to create"); } *pCond = h; return; @@ -154,7 +154,7 @@ void closeCondition( Condition* pCond ) { if ( CloseHandle(*pCond) == 0 ) { - belch("closeCondition: failed to close"); + errorBelch("closeCondition: failed to close"); } return; } diff --git a/ghc/rts/OSThreads.h b/ghc/rts/OSThreads.h index a65e002..0ba6fb9 100644 --- a/ghc/rts/OSThreads.h +++ b/ghc/rts/OSThreads.h @@ -21,8 +21,8 @@ typedef pthread_t OSThreadId; #define INIT_COND_VAR PTHREAD_COND_INITIALIZER #ifdef LOCK_DEBUG -#define ACQUIRE_LOCK(mutex) fprintf(stderr, "ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); fflush(stderr); pthread_mutex_lock(mutex) -#define RELEASE_LOCK(mutex) fprintf(stderr, "RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); fflush(stderr); pthread_mutex_unlock(mutex) +#define ACQUIRE_LOCK(mutex) debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); pthread_mutex_lock(mutex) +#define RELEASE_LOCK(mutex) debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); pthread_mutex_unlock(mutex) #else #define ACQUIRE_LOCK(mutex) pthread_mutex_lock(mutex) #define RELEASE_LOCK(mutex) pthread_mutex_unlock(mutex) diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index e1c0b4d..7074a43 100644 --- a/ghc/rts/Printer.c +++ b/ghc/rts/Printer.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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. * @@ -10,12 +10,10 @@ #include "PosixSource.h" #include "Rts.h" #include "Printer.h" - -#include +#include "RtsUtils.h" #ifdef DEBUG -#include "RtsUtils.h" #include "RtsFlags.h" #include "MBlock.h" #include "Storage.h" @@ -62,23 +60,23 @@ void printPtr( StgPtr p ) 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 } @@ -90,13 +88,13 @@ printStdObjPayload( StgClosure *obj ) 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 @@ -130,21 +128,21 @@ printClosure( StgClosure *obj ) */ 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; } @@ -152,10 +150,10 @@ printClosure( StgClosure *obj ) 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; @@ -174,7 +172,7 @@ printClosure( StgClosure *obj ) case THUNK_SELECTOR: printStdObjHdr(obj, "THUNK_SELECTOR"); - fprintf(stderr, ", %p)\n", ((StgSelector *)obj)->selectee); + debugBelch(", %p)\n", ((StgSelector *)obj)->selectee); break; case BCO: @@ -185,12 +183,12 @@ printClosure( StgClosure *obj ) { 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; } @@ -198,13 +196,13 @@ printClosure( StgClosure *obj ) { 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; } @@ -212,43 +210,43 @@ printClosure( StgClosure *obj ) { 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. @@ -264,79 +262,79 @@ printClosure( StgClosure *obj ) 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 { @@ -344,12 +342,12 @@ printClosure( StgClosure *obj ) 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 @@ -357,63 +355,63 @@ printClosure( StgClosure *obj ) 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 @@ -421,23 +419,23 @@ printClosure( StgClosure *obj ) #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; @@ -454,31 +452,31 @@ void printGraph( StgClosure *obj ) 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; @@ -495,12 +493,12 @@ printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size ) 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]); } } } @@ -516,12 +514,12 @@ printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap, StgWord bitmap = large_bitmap->bitmap[bmp]; j = 0; for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) { - 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]); } } } @@ -555,7 +553,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) 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, @@ -564,13 +562,13 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) 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++; } @@ -579,7 +577,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) 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)); @@ -590,7 +588,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) 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; @@ -609,7 +607,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) 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, @@ -631,7 +629,7 @@ printStackChunk( StgPtr sp, StgPtr spBottom ) } default: - fprintf(stderr, "unknown object %d\n", info->type); + debugBelch("unknown object %d\n", info->type); barf("printStackChunk"); } } @@ -940,10 +938,10 @@ static void printZcoded( const char *raw ) 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; } } @@ -1012,7 +1010,7 @@ extern void DEBUG_LoadSymbols( char *name ) } #if 0 if (storage_needed == 0) { - belch("no storage needed"); + debugBelch("no storage needed"); } #endif symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols"); @@ -1026,14 +1024,14 @@ extern void DEBUG_LoadSymbols( char *name ) 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) ); @@ -1092,7 +1090,7 @@ findPtr(P_ p, int follow) while (!LOOKS_LIKE_INFO_PTR(*r) || (P_)*r == NULL) { r--; } - fprintf(stderr, "%p = ", r); + debugBelch("%p = ", r); printClosure((StgClosure *)r); arr[i++] = r; } else { @@ -1104,7 +1102,7 @@ findPtr(P_ p, int follow) } } if (follow && i == 1) { - fprintf(stderr, "-->\n"); + debugBelch("-->\n"); findPtr(arr[0], 1); } } @@ -1112,11 +1110,11 @@ findPtr(P_ p, int follow) #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 */ diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c index 49b3813..dab6057 100644 --- a/ghc/rts/ProfHeap.c +++ b/ghc/rts/ProfHeap.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: ProfHeap.c,v 1.53 2004/08/13 13:10:25 simonmar Exp $ + * $Id: ProfHeap.c,v 1.54 2004/09/03 15:28:35 simonmar Exp $ * * (c) The GHC Team, 1998-2003 * @@ -332,7 +332,7 @@ nextEra( void ) era++; if (era == max_era) { - prog_belch("maximum number of censuses reached; use +RTS -i to reduce"); + errorBelch("maximum number of censuses reached; use +RTS -i to reduce"); stg_exit(EXIT_FAILURE); } @@ -368,7 +368,7 @@ void initProfiling2( void ) /* open the log file */ if ((hp_file = fopen(hp_filename, "w")) == NULL) { - 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; @@ -406,7 +406,7 @@ initHeapProfiling(void) #ifdef PROFILING if (doingLDVProfiling() && doingRetainerProfiling()) { - prog_belch("cannot mix -hb and -hr"); + errorBelch("cannot mix -hb and -hr"); stg_exit(1); } #endif @@ -567,7 +567,7 @@ rtsBool 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; @@ -696,8 +696,8 @@ aggregateCensusInfo( void ) // 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; diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c index ea00fae..b236429 100644 --- a/ghc/rts/Profiling.c +++ b/ghc/rts/Profiling.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -266,7 +266,7 @@ initProfilingLogFile(void) /* 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., .prof/hp. @@ -297,7 +297,7 @@ initProfilingLogFile(void) /* 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; @@ -355,9 +355,9 @@ PushCostCentre ( CostCentreStack *ccs, CostCentre *cc ) #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 @@ -417,11 +417,11 @@ AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 ) { 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 @@ -917,4 +917,19 @@ fprintCCS( FILE *f, CostCentreStack *ccs ) 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 */ diff --git a/ghc/rts/Profiling.h b/ghc/rts/Profiling.h index b503fa6..7ed7bdc 100644 --- a/ghc/rts/Profiling.h +++ b/ghc/rts/Profiling.h @@ -6,6 +6,8 @@ * * ---------------------------------------------------------------------------*/ +#include + #if defined(PROFILING) || defined(DEBUG) void initProfiling1 ( void ); void initProfiling2 ( void ); @@ -26,4 +28,8 @@ extern lnat RTS_VAR(total_prof_ticks); extern void fprintCCS( FILE *f, CostCentreStack *ccs ); +#ifdef DEBUG +extern void debugCCS( CostCentreStack *ccs ); +#endif + #endif diff --git a/ghc/rts/Proftimer.c b/ghc/rts/Proftimer.c index dc36df9..da8c7b8 100644 --- a/ghc/rts/Proftimer.c +++ b/ghc/rts/Proftimer.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -11,8 +11,6 @@ #include "PosixSource.h" -#include - #include "Rts.h" #include "Profiling.h" #include "Timer.h" diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c index 1ff0027..e45f875 100644 --- a/ghc/rts/RetainerProfile.c +++ b/ghc/rts/RetainerProfile.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -17,8 +17,6 @@ #define INLINE inline #endif -#include - #include "Rts.h" #include "RtsUtils.h" #include "RetainerProfile.h" @@ -439,7 +437,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) 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); @@ -632,7 +630,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) 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. @@ -661,7 +659,7 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) stackSize++; if (stackSize > maxStackSize) maxStackSize = stackSize; // ASSERT(stackSize >= 0); - // fprintf(stderr, "stackSize = %d\n", stackSize); + // debugBelch("stackSize = %d\n", stackSize); #endif } @@ -684,7 +682,7 @@ popOffReal(void) 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); @@ -699,7 +697,7 @@ popOffReal(void) if (stackSize > maxStackSize) maxStackSize = stackSize; /* ASSERT(stackSize >= 0); - fprintf(stderr, "stackSize = %d\n", stackSize); + debugBelch("stackSize = %d\n", stackSize); */ #endif return; @@ -720,7 +718,7 @@ popOffReal(void) if (stackSize > maxStackSize) maxStackSize = stackSize; /* ASSERT(stackSize >= 0); - fprintf(stderr, "stackSize = %d\n", stackSize); + debugBelch("stackSize = %d\n", stackSize); */ #endif } @@ -728,7 +726,7 @@ popOffReal(void) 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); @@ -742,7 +740,7 @@ popOff(void) { if (stackSize > maxStackSize) maxStackSize = stackSize; /* ASSERT(stackSize >= 0); - fprintf(stderr, "stackSize = %d\n", stackSize); + debugBelch("stackSize = %d\n", stackSize); */ #endif return; @@ -773,7 +771,7 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) 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 { @@ -1293,7 +1291,7 @@ retainStack( StgClosure *c, retainer c_child_r, 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 || @@ -1409,7 +1407,7 @@ retainStack( StgClosure *c, retainer c_child_r, // 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 @@ -1495,7 +1493,7 @@ retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 ) #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) @@ -1505,18 +1503,18 @@ retainClosure( StgClosure *c0, StgClosure *cp0, retainer 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, @@ -1558,13 +1556,13 @@ inner_loop: 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; @@ -1912,7 +1910,7 @@ resetStaticObjectForRetainerProfiling( void ) } } #ifdef DEBUG_RETAINER - // fprintf(stderr, "count in scavenged_static_objects = %d\n", count); + // debugBelch("count in scavenged_static_objects = %d\n", count); #endif } @@ -1934,25 +1932,25 @@ retainerProfile(void) #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); @@ -1960,7 +1958,7 @@ retainerProfile(void) /* #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); @@ -1983,7 +1981,7 @@ retainerProfile(void) 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++) @@ -2005,13 +2003,13 @@ retainerProfile(void) 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 @@ -2022,22 +2020,22 @@ retainerProfile(void) 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); @@ -2083,17 +2081,17 @@ sanityCheckHeapClosure( StgClosure *c ) 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); @@ -2282,12 +2280,12 @@ checkHeapSanityForRetainerProfiling( void ) 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++) { @@ -2300,14 +2298,14 @@ checkHeapSanityForRetainerProfiling( void ) */ 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); } } } @@ -2331,7 +2329,7 @@ findPointer(StgPtr p) 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; } } @@ -2343,7 +2341,7 @@ findPointer(StgPtr p) 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; } } @@ -2364,14 +2362,14 @@ belongToHeap(StgPtr p) 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; } } diff --git a/ghc/rts/RetainerSet.c b/ghc/rts/RetainerSet.c index 45b74b0..2990a38 100644 --- a/ghc/rts/RetainerSet.c +++ b/ghc/rts/RetainerSet.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -148,7 +148,7 @@ addElement(retainer r, RetainerSet *rs) StgWord hk; // Hash Key #ifdef DEBUG_RETAINER - // fprintf(stderr, "addElement(%p, %p) = ", r, rs); + // debugBelch("addElement(%p, %p) = ", r, rs); #endif ASSERT(rs != NULL); @@ -188,7 +188,7 @@ addElement(retainer r, RetainerSet *rs) 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; @@ -211,7 +211,7 @@ addElement(retainer r, RetainerSet *rs) hashTable[hash(hk)] = nrs; #ifdef DEBUG_RETAINER - // fprintf(stderr, "%p\n", nrs); + // debugBelch("%p\n", nrs); #endif return nrs; } diff --git a/ghc/rts/RetainerSet.h b/ghc/rts/RetainerSet.h index 5b6a5b2..c42d6ad 100644 --- a/ghc/rts/RetainerSet.h +++ b/ghc/rts/RetainerSet.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -11,6 +11,8 @@ #ifndef RETAINERSET_H #define RETAINERSET_H +#include + #ifdef PROFILING /* diff --git a/ghc/rts/RtsAPI.c b/ghc/rts/RtsAPI.c index d79da3d..c91253b 100644 --- a/ghc/rts/RtsAPI.c +++ b/ghc/rts/RtsAPI.c @@ -1,5 +1,5 @@ /* ---------------------------------------------------------------------------- - * $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 * @@ -479,13 +479,13 @@ rts_checkSchedStatus ( char* site, SchedulerStatus rc ) 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); } } diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c index cf8d2c5..d79136b 100644 --- a/ghc/rts/RtsFlags.c +++ b/ghc/rts/RtsFlags.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 @@ -115,12 +115,13 @@ static char par_debug_opts_flags[] = { 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); @@ -577,7 +578,7 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[]) 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 { @@ -595,7 +596,7 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[]) # 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 @@ -603,7 +604,7 @@ error = rtsTrue; # 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 @@ -611,7 +612,7 @@ error = rtsTrue; # 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 @@ -619,7 +620,7 @@ error = rtsTrue; # 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 @@ -627,7 +628,7 @@ error = rtsTrue; # 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 @@ -635,7 +636,7 @@ error = rtsTrue; # 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 @@ -643,7 +644,7 @@ error = rtsTrue; # 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 @@ -816,13 +817,15 @@ error = rtsTrue; #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; @@ -870,7 +873,7 @@ error = rtsTrue; 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 @@ -939,7 +942,7 @@ error = rtsTrue; } if (RtsFlags.ProfFlags.doHeapProfile != 0) { - prog_belch("multiple heap profile options"); + errorBelch("multiple heap profile options"); error = rtsTrue; break; } @@ -974,7 +977,7 @@ error = rtsTrue; break; default: - prog_belch("invalid heap profile option: %s",rts_argv[arg]); + errorBelch("invalid heap profile option: %s",rts_argv[arg]); error = rtsTrue; } ) @@ -1023,7 +1026,7 @@ 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; } } @@ -1036,7 +1039,7 @@ 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; } } @@ -1060,11 +1063,14 @@ 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 =================== */ @@ -1072,7 +1078,7 @@ error = rtsTrue; 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; @@ -1091,7 +1097,7 @@ error = rtsTrue; /* 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; } @@ -1099,7 +1105,7 @@ error = rtsTrue; /* =========== OH DEAR ============================ */ default: - prog_belch("unknown RTS option: %s",rts_argv[arg]); + errorBelch("unknown RTS option: %s",rts_argv[arg]); error = rtsTrue; break; } @@ -1110,7 +1116,7 @@ error = rtsTrue; fflush(stdout); for (p = usage_text; *p; p++) - belch("%s", *p); + errorBelch("%s", *p); stg_exit(EXIT_FAILURE); } } @@ -1123,7 +1129,7 @@ error = rtsTrue; 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 = @@ -1383,7 +1389,7 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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; @@ -1392,7 +1398,7 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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; @@ -1406,7 +1412,7 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) } 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; } @@ -1436,22 +1442,22 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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; @@ -1512,18 +1518,18 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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); } @@ -1531,7 +1537,7 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) } else { /* plain pri spark is now invoked with -bX RtsFlags.GranFlags.DoPrioritySparking = 1; - fprintf(stderr,"PrioritySparking.\n"); + debugBelch("PrioritySparking.\n"); */ } break; @@ -1542,13 +1548,13 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) } 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 */ @@ -1562,7 +1568,7 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) } 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; @@ -1571,7 +1577,7 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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; @@ -1579,19 +1585,19 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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; @@ -1679,10 +1685,10 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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; @@ -1699,7 +1705,7 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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 @@ -1710,92 +1716,92 @@ process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) #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; @@ -1824,7 +1830,7 @@ set_GranSim_debug_options(nat n) { 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; @@ -1856,7 +1862,7 @@ help_GranSim_debug_options(nat n) { 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) @@ -1866,7 +1872,7 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) { 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; } @@ -1878,12 +1884,12 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) = 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: max %d local sparks", + errorBelch("-qe: max %d local sparks", RtsFlags.ParFlags.maxLocalSparks)); break; @@ -1892,11 +1898,11 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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: max %d threads", + errorBelch("-qt: max %d threads", RtsFlags.ParFlags.maxThreads)); break; @@ -1907,7 +1913,7 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) RtsFlags.ParFlags.maxFishes = MAX_FISHES; break; IF_PAR_DEBUG(verbose, - belch("-qf: max %d fishes sent out at one time", + errorBelch("-qf: max %d fishes sent out at one time", RtsFlags.ParFlags.maxFishes)); break; @@ -1916,29 +1922,29 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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: fish delay time %d us", + errorBelch("-qF: 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 ... 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: globalisation scheme set to %d", + debugBelch("-qg: globalisation scheme set to %d", RtsFlags.ParFlags.globalising)); break; @@ -1946,11 +1952,11 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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: thunks per packet set to %d", + debugBelch("-qh: thunks per packet set to %d", RtsFlags.ParFlags.thunksToPack)); break; @@ -1975,14 +1981,14 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) # 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; @@ -1990,18 +1996,18 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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: pack buffer size set to %d", + debugBelch("-qQ: 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) @@ -2013,7 +2019,7 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) RtsFlags.ParFlags.wait = 1000; } IF_PAR_DEBUG(verbose, - belch("-qw: length of wait loop after synchr before reduction: %d", + debugBelch("-qw: length of wait loop after synchr before reduction: %d", RtsFlags.ParFlags.wait)); break; @@ -2029,7 +2035,7 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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 @@ -2039,7 +2045,7 @@ process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error) 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 */ @@ -2055,7 +2061,7 @@ set_par_debug_options(nat n) { 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; @@ -2086,7 +2092,7 @@ help_par_debug_options(nat n) { 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 */ @@ -2094,40 +2100,62 @@ help_par_debug_options(nat n) { //@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 . */ - 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 . */ + 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) { @@ -2155,6 +2183,6 @@ 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); } diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c index 89fb4a4..4e6a68c 100644 --- a/ghc/rts/RtsStartup.c +++ b/ghc/rts/RtsStartup.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -143,7 +143,7 @@ hs_init(int *argc, char **argv[]) #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 */ @@ -461,7 +461,7 @@ stg_exit(int n) 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); diff --git a/ghc/rts/RtsUtils.c b/ghc/rts/RtsUtils.c index 6ff4f72..99bea75 100644 --- a/ghc/rts/RtsUtils.c +++ b/ghc/rts/RtsUtils.c @@ -1,7 +1,6 @@ /* ----------------------------------------------------------------------------- - * $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. * @@ -33,14 +32,62 @@ #include #include #include +#include -/* 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); @@ -51,36 +98,30 @@ barf(char *s, ...) 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) diff --git a/ghc/rts/RtsUtils.h b/ghc/rts/RtsUtils.h index efa178a..6f7111f 100644 --- a/ghc/rts/RtsUtils.h +++ b/ghc/rts/RtsUtils.h @@ -9,15 +9,65 @@ #ifndef RTSUTILS_H #define RTSUTILS_H -/* (Checked) dynamic allocation: */ +#include + +/* ----------------------------------------------------------------------------- + * 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); diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index 82d6add..d4c3dca 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -644,18 +644,18 @@ checkTSOsSanity(void) { nat i, tsos; StgTSO *tso; - belch("Checking sanity of all runnable TSOs:"); + debugBelch("Checking sanity of all runnable TSOs:"); for (i=0, tsos=0; ilink) { - 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); } diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c index 71c3ec9..9e2a5d0 100644 --- a/ghc/rts/Schedule.c +++ b/ghc/rts/Schedule.c @@ -371,7 +371,7 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, 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) { @@ -428,7 +428,7 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, #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); @@ -561,13 +561,13 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, 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); @@ -575,25 +575,25 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, /* 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 } @@ -650,14 +650,14 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, /* 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) @@ -666,7 +666,7 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, 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; @@ -674,7 +674,7 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, 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 @@ -710,16 +710,16 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, 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; } @@ -740,12 +740,12 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, */ 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); @@ -791,7 +791,7 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS, 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 @@ -887,7 +887,7 @@ run_thread: 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(); @@ -937,9 +937,9 @@ run_thread: 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) @@ -967,8 +967,8 @@ run_thread: 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. @@ -1027,8 +1027,8 @@ run_thread: * 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)); @@ -1059,8 +1059,8 @@ run_thread: // 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. */ @@ -1105,16 +1105,16 @@ run_thread: */ 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); @@ -1131,7 +1131,7 @@ run_thread: 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 @@ -1154,7 +1154,7 @@ run_thread: 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 */ @@ -1163,7 +1163,7 @@ run_thread: 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)); @@ -1183,7 +1183,7 @@ run_thread: */ #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, @@ -1203,11 +1203,10 @@ run_thread: * 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? @@ -1226,7 +1225,7 @@ run_thread: /* 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 @@ -1346,7 +1345,7 @@ run_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 */ @@ -1366,7 +1365,7 @@ run_thread: } /* end of while(1) */ IF_PAR_DEBUG(verbose, - belch("== Leaving schedule() after having received Finish")); + debugBelch("== Leaving schedule() after having received Finish\n")); } /* --------------------------------------------------------------------------- @@ -1703,7 +1702,7 @@ createThread(nat size) /* 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; } @@ -1836,22 +1835,22 @@ createThread(nat size) // 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; } @@ -1900,7 +1899,7 @@ activateSpark (rtsSpark spark) 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 @@ -2268,8 +2267,8 @@ threadStackOverflow(StgTSO *tso) 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))); @@ -2289,7 +2288,7 @@ threadStackOverflow(StgTSO *tso) 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); @@ -2318,7 +2317,7 @@ threadStackOverflow(StgTSO *tso) 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, @@ -2407,11 +2406,11 @@ unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node) } /* 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) @@ -2456,7 +2455,7 @@ unblockOneLocked(StgBlockingQueueElement *bqe, StgClosure *node) (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; } @@ -2473,7 +2472,7 @@ unblockOneLocked(StgTSO *tso) 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 @@ -2507,7 +2506,7 @@ awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node) 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)); @@ -2524,13 +2523,13 @@ awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node) */ 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++; @@ -2565,7 +2564,7 @@ awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node) ((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))); } @@ -2577,7 +2576,7 @@ awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *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) @@ -2589,12 +2588,12 @@ awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node) 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 @@ -3006,7 +3005,7 @@ raiseAsync(StgTSO *tso, StgClosure *exception) } 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); @@ -3121,9 +3120,9 @@ raiseAsync(StgTSO *tso, StgClosure *exception) 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); ); @@ -3291,7 +3290,7 @@ static void detectBlackHoles( void ) { StgTSO *tso = all_threads; - StgClosure *frame; + StgPtr frame; StgClosure *blocked_on; StgRetInfoTable *info; @@ -3307,10 +3306,10 @@ detectBlackHoles( void ) } 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) { @@ -3323,7 +3322,7 @@ detectBlackHoles( void ) goto done; } - frame = (StgClosure *) ((StgUpdateFrame *)frame + 1); + frame = (StgPtr)((StgUpdateFrame *)frame + 1); continue; case STOP_FRAME: @@ -3331,7 +3330,7 @@ detectBlackHoles( void ) // normal stack frames; do nothing except advance the pointer default: - (StgPtr)frame += stack_frame_sizeW(frame); + frame += stack_frame_sizeW((StgClosure *)frame); } } done: ; @@ -3350,47 +3349,47 @@ printThreadBlockage(StgTSO *tso) { 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)", @@ -3404,10 +3403,10 @@ printThreadStatus(StgTSO *tso) { 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); @@ -3425,23 +3424,23 @@ printAllThreads(void) 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"); } } @@ -3458,7 +3457,7 @@ print_bq (StgClosure *node) 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 */ @@ -3498,18 +3497,18 @@ print_bqe (StgBlockingQueueElement *bqe) 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" : @@ -3521,7 +3520,7 @@ print_bqe (StgBlockingQueueElement *bqe) break; } } /* for */ - fputc('\n', stderr); + debugBelch("\n"); } # elif defined(GRAN) void @@ -3539,7 +3538,7 @@ print_bq (StgClosure *node) 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); /* @@ -3559,11 +3558,11 @@ print_bq (StgClosure *node) 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" : @@ -3575,7 +3574,7 @@ print_bq (StgClosure *node) break; } } /* for */ - fputc('\n', stderr); + debugBelch("\n"); } #else /* @@ -3592,9 +3591,9 @@ print_bq (StgClosure *node) 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 @@ -3620,15 +3619,14 @@ sched_belch(char *s, ...) 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); } diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h index 588ddc5..d097a39 100644 --- a/ghc/rts/Schedule.h +++ b/ghc/rts/Schedule.h @@ -315,7 +315,8 @@ startSchedulerTaskIfNecessary(void); #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__ */ diff --git a/ghc/rts/Select.c b/ghc/rts/Select.c index 223bdd6..a604bcd 100644 --- a/ghc/rts/Select.c +++ b/ghc/rts/Select.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -68,7 +68,7 @@ wakeUpSleepingThreads(nat ticks) 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; } @@ -105,11 +105,11 @@ awaitEvent(rtsBool wait) 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 @@ -220,8 +220,6 @@ awaitEvent(rtsBool wait) unblock_all = rtsTrue; break; } else { - fprintf(stderr,"%d\n", errno); - fflush(stderr); perror("select"); barf("select failed"); } @@ -299,7 +297,7 @@ awaitEvent(rtsBool wait) } 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); diff --git a/ghc/rts/Signals.c b/ghc/rts/Signals.c index 4d76b11..3d287d6 100644 --- a/ghc/rts/Signals.c +++ b/ghc/rts/Signals.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -168,7 +168,7 @@ generic_handler(int sig) // 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); } @@ -436,7 +436,7 @@ initDefaultHandlers() 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) @@ -448,7 +448,7 @@ initDefaultHandlers() 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 @@ -466,7 +466,7 @@ initDefaultHandlers() 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 diff --git a/ghc/rts/Sparks.c b/ghc/rts/Sparks.c index 21dbdc9..9571d7a 100644 --- a/ghc/rts/Sparks.c +++ b/ghc/rts/Sparks.c @@ -1,5 +1,5 @@ /* --------------------------------------------------------------------------- - * $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 * @@ -137,7 +137,7 @@ add_to_spark_queue( StgClosure *closure, StgSparkPool *pool ) // 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 @@ -147,7 +147,7 @@ add_to_spark_queue( StgClosure *closure, StgSparkPool *pool ) // 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 @@ -240,20 +240,20 @@ markSparkQueue( void ) #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)); } @@ -322,7 +322,7 @@ findLocalSpark (rtsEvent *event, rtsBool *found_res, rtsSparkQ *spark_res) 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) @@ -362,7 +362,7 @@ findLocalSpark (rtsEvent *event, rtsBool *found_res, rtsSparkQ *spark_res) # 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 @@ -400,7 +400,7 @@ findLocalSpark (rtsEvent *event, rtsBool *found_res, rtsSparkQ *spark_res) /* 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; } */ @@ -408,7 +408,7 @@ findLocalSpark (rtsEvent *event, rtsBool *found_res, rtsSparkQ *spark_res) 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);) } @@ -471,7 +471,7 @@ activateSpark (rtsEvent *event, rtsSparkQ spark) 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)); } @@ -549,7 +549,7 @@ nat name, gran_info, size_info, par_info, local; if ( RtsFlags.GranFlags.SparkPriority!=0 && prinode, CurrentProc); print_sparkq_stats()); @@ -677,7 +677,7 @@ rtsSpark *spark; 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); } @@ -703,7 +703,7 @@ rtsSpark *spark; } } 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); } @@ -730,7 +730,7 @@ PEs proc; # 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 @@ -756,7 +756,7 @@ rtsBool dispose_too; # 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)); @@ -781,7 +781,7 @@ rtsBool dispose_too; # 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); @@ -811,7 +811,7 @@ markSparkQueue(void) 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()); } @@ -823,14 +823,14 @@ rtsSpark *spark; 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); @@ -845,7 +845,7 @@ PEs proc; { 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); } @@ -860,10 +860,10 @@ print_sparkq_stats(void) { PEs p; - fprintf(stderr, "SparkQs: ["); + debugBelch("SparkQs: ["); for (p=0; psn_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)); } } } diff --git a/ghc/rts/Stats.c b/ghc/rts/Stats.c index 4920b4b..35d1c9f 100644 --- a/ghc/rts/Stats.c +++ b/ghc/rts/Stats.c @@ -1,7 +1,6 @@ /* ----------------------------------------------------------------------------- - * $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. * @@ -122,6 +121,10 @@ static TICK_TYPE *GC_coll_times; 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) @@ -198,7 +201,7 @@ getTimes(void) /* 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 */ @@ -275,11 +278,10 @@ void 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( @@ -306,7 +308,7 @@ stat_startInit(void) 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; @@ -322,7 +324,7 @@ stat_startInit(void) /* 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 @@ -408,10 +410,10 @@ stat_startGC(void) if (bell) { if (bell > 1) { - fprintf(stderr, " GC "); + debugBelch(" GC "); rub_bell = 1; } else { - fprintf(stderr, "\007"); + debugBelch("\007"); } } @@ -439,8 +441,6 @@ stat_startGC(void) 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; @@ -450,12 +450,12 @@ stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen) 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), @@ -465,7 +465,7 @@ stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen) gen); GC_end_faults = faults; - fflush(sf); + statsFlush(); } GC_coll_times[gen] += gc_time; @@ -500,7 +500,7 @@ stat_endGC(lnat alloc, lnat collect, lnat live, lnat copied, lnat gen) } if (rub_bell) { - fprintf(stderr, "\b\b\b \b\b\b"); + debugBelch("\b\b\b \b\b\b"); rub_bell = 0; } } @@ -620,8 +620,6 @@ long int stat_getElapsedTime () void stat_exit(int alloc) { - FILE *sf = RtsFlags.GcFlags.statsFile; - if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) { char temp[BIG_STRING_LEN]; @@ -657,43 +655,43 @@ stat_exit(int alloc) 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), @@ -704,23 +702,23 @@ stat_exit(int alloc) } #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)); @@ -733,9 +731,9 @@ stat_exit(int alloc) 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), @@ -744,10 +742,10 @@ stat_exit(int alloc) / 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, "<>\n", + statsPrintf("<>\n", total_collections, ResidencySamples == 0 ? 0 : AvgResidency*sizeof(W_)/ResidencySamples, @@ -759,10 +757,8 @@ stat_exit(int alloc) TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time)); } - fflush(sf); - if (sf != stderr) { - fclose(sf); - } + statsFlush(); + statsClose(); } } @@ -780,7 +776,7 @@ statDescribeGens(void) 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; @@ -789,7 +785,7 @@ statDescribeGens(void) 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++) { @@ -806,13 +802,13 @@ statDescribeGens(void) 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 @@ -823,3 +819,40 @@ statDescribeGens(void) 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); + } +} diff --git a/ghc/rts/StgCRun.c b/ghc/rts/StgCRun.c index d593db0..79104e7 100644 --- a/ghc/rts/StgCRun.c +++ b/ghc/rts/StgCRun.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -87,9 +87,9 @@ StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg STG_UNUSED) { 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)(); } diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c index 367530f..770b43a 100644 --- a/ghc/rts/Storage.c +++ b/ghc/rts/Storage.c @@ -1,7 +1,6 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -88,7 +87,7 @@ initStorage( void ) 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); } @@ -177,7 +176,7 @@ initStorage( void ) /* 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; } @@ -279,7 +278,7 @@ newCAF(StgClosure* caf) #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); } @@ -418,7 +417,7 @@ resizeNursery ( nat blocks ) } 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); } @@ -426,7 +425,7 @@ resizeNursery ( nat 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; @@ -832,7 +831,7 @@ memInventory(void) 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); } diff --git a/ghc/rts/Task.c b/ghc/rts/Task.c index 94705d5..ad05208 100644 --- a/ghc/rts/Task.c +++ b/ghc/rts/Task.c @@ -91,7 +91,7 @@ startTask ( void (*taskStart)(void) ) 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; } @@ -113,7 +113,7 @@ stopTaskManager () /* 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); } @@ -166,7 +166,7 @@ startTask ( void (*taskStart)(void) ) 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, @@ -176,7 +176,7 @@ startTask ( void (*taskStart)(void) ) /* 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; } @@ -187,7 +187,7 @@ startTask ( void (*taskStart)(void) ) } 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; } diff --git a/ghc/rts/Weak.c b/ghc/rts/Weak.c index ccb9eb2..afc8bae 100644 --- a/ghc/rts/Weak.c +++ b/ghc/rts/Weak.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -10,6 +10,7 @@ #include "PosixSource.h" #define COMPILING_RTS_MAIN #include "Rts.h" +#include "RtsUtils.h" #include "SchedAPI.h" #include "RtsFlags.h" #include "Weak.h" @@ -40,7 +41,7 @@ finalizeWeakPointersNow(void) 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(); @@ -101,7 +102,7 @@ scheduleFinalizers(StgWeak *list) // 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); -- 1.7.10.4