From 34533246b5686e1948e6a014a6e2dc72befe94c7 Mon Sep 17 00:00:00 2001 From: panne Date: Tue, 29 Jun 1999 13:06:45 +0000 Subject: [PATCH] [project @ 1999-06-29 13:04:38 by panne] Made the compilation of the RTS almost warning-free and improved the output of some "barf"s in the garbage collector . This is part of my epic crusade against "scavenge_mut_list: strange object?"... :-( --- ghc/rts/GC.c | 24 ++++++++++++++---------- ghc/rts/Printer.c | 8 +++++--- ghc/rts/Printer.h | 7 ++++--- ghc/rts/Profiling.c | 4 +++- ghc/rts/RtsStartup.c | 4 +++- ghc/rts/hooks/OutOfHeap.c | 3 ++- 6 files changed, 31 insertions(+), 19 deletions(-) diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c index f97eeff..b32274f 100644 --- a/ghc/rts/GC.c +++ b/ghc/rts/GC.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: GC.c,v 1.59 1999/05/11 16:47:53 keithw Exp $ + * $Id: GC.c,v 1.60 1999/06/29 13:04:38 panne Exp $ * * (c) The GHC Team 1998-1999 * @@ -840,7 +840,7 @@ cleanup_weak_ptr_list ( StgWeak **list ) StgClosure * isAlive(StgClosure *p) { - StgInfoTable *info; + const StgInfoTable *info; while (1) { @@ -1130,6 +1130,9 @@ loop: } step = bd->step->to; } +#ifdef DEBUG + else step = NULL; /* make sure copy() will crash if HEAP_ALLOCED is wrong */ +#endif /* make sure the info pointer is into text space */ ASSERT(q && (LOOKS_LIKE_GHC_INFO(GET_INFO(q)) @@ -1281,7 +1284,8 @@ loop: break; default: - barf("evacuate: THUNK_SELECTOR: strange selectee"); + barf("evacuate: THUNK_SELECTOR: strange selectee %d", + (int)(selectee_info->type)); } } return copy(q,THUNK_SELECTOR_sizeW(),step); @@ -1436,7 +1440,7 @@ loop: return q; default: - barf("evacuate: strange closure type"); + barf("evacuate: strange closure type %d", (int)(info->type)); } barf("evacuate"); @@ -1486,7 +1490,7 @@ relocate_TSO(StgTSO *src, StgTSO *dest) break; default: - barf("relocate_TSO"); + barf("relocate_TSO %d", (int)(get_itbl(su)->type)); } break; } @@ -1881,7 +1885,7 @@ scavenge(step *step) static rtsBool scavenge_one(StgClosure *p) { - StgInfoTable *info; + const StgInfoTable *info; rtsBool no_luck; ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p)) @@ -1979,7 +1983,7 @@ scavenge_one(StgClosure *p) static void scavenge_mut_once_list(generation *gen) { - StgInfoTable *info; + const StgInfoTable *info; StgMutClosure *p, *next, *new_list; p = gen->mut_once_list; @@ -2099,7 +2103,7 @@ scavenge_mut_once_list(generation *gen) default: /* shouldn't have anything else on the mutables list */ - barf("scavenge_mut_once_list: strange object?"); + barf("scavenge_mut_once_list: strange object? %d", (int)(info->type)); } } @@ -2110,7 +2114,7 @@ scavenge_mut_once_list(generation *gen) static void scavenge_mutable_list(generation *gen) { - StgInfoTable *info; + const StgInfoTable *info; StgMutClosure *p, *next; p = gen->saved_mut_list; @@ -2217,7 +2221,7 @@ scavenge_mutable_list(generation *gen) default: /* shouldn't have anything else on the mutables list */ - barf("scavenge_mut_list: strange object?"); + barf("scavenge_mut_list: strange object? %d", (int)(info->type)); } } } diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index 34f87e8..3fe0313 100644 --- a/ghc/rts/Printer.c +++ b/ghc/rts/Printer.c @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- - * $Id: Printer.c,v 1.13 1999/05/11 16:47:54 keithw Exp $ + * $Id: Printer.c,v 1.14 1999/06/29 13:04:39 panne Exp $ * * Copyright (c) 1994-1999. * @@ -9,6 +9,7 @@ * ---------------------------------------------------------------------------*/ #include "Rts.h" +#include "Printer.h" #ifdef DEBUG @@ -17,8 +18,6 @@ #include "Bytecodes.h" /* for InstrPtr */ #include "Disassembler.h" -#include "Printer.h" - /* -------------------------------------------------------------------------- * local function decls * ------------------------------------------------------------------------*/ @@ -54,7 +53,9 @@ char* lookupHugsItblName ( void* v ) void printPtr( StgPtr p ) { +#ifdef INTERPRETER char* str; +#endif const char *raw; if (lookupGHCName( p, &raw )) { printZcoded(raw); @@ -734,6 +735,7 @@ static rtsBool isReal( flagword flags, const char *name ) return rtsFalse; } #else + (void)flags; /* keep gcc -Wall happy */ if (*name == '\0' || (name[0] == 'g' && name[1] == 'c' && name[2] == 'c') || (name[0] == 'c' && name[1] == 'c' && name[2] == '.')) { diff --git a/ghc/rts/Printer.h b/ghc/rts/Printer.h index bb92b6b..b44847e 100644 --- a/ghc/rts/Printer.h +++ b/ghc/rts/Printer.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Printer.h,v 1.3 1999/02/05 16:02:47 simonm Exp $ + * $Id: Printer.h,v 1.4 1999/06/29 13:04:40 panne Exp $ * * (c) The GHC Team, 1998-1999 * @@ -9,6 +9,8 @@ extern void printPtr ( StgPtr p ); extern void printObj ( StgClosure *obj ); + +#ifdef DEBUG extern void printClosure ( StgClosure *obj ); extern StgStackPtr printStackObj ( StgStackPtr sp ); extern void printStackChunk ( StgStackPtr sp, StgStackPtr spLim ); @@ -20,5 +22,4 @@ extern void printTSO ( StgTSO *tso ); extern void DEBUG_LoadSymbols( char *name ); extern rtsBool lookupGHCName( StgPtr addr, const char **result ); - - +#endif diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c index 2dc0b61..56260b1 100644 --- a/ghc/rts/Profiling.c +++ b/ghc/rts/Profiling.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Profiling.c,v 1.6 1999/04/23 09:47:32 simonm Exp $ + * $Id: Profiling.c,v 1.7 1999/06/29 13:04:40 panne Exp $ * * (c) The GHC Team, 1998-1999 * @@ -503,7 +503,9 @@ report_ccs_profiling( void ) { nat count; char temp[128]; /* sigh: magic constant */ +#ifdef NOT_YET rtsBool do_groups = rtsFalse; +#endif if (!RtsFlags.CcFlags.doCostCentres) return; diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c index fd9d671..e6583fa 100644 --- a/ghc/rts/RtsStartup.c +++ b/ghc/rts/RtsStartup.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: RtsStartup.c,v 1.13 1999/05/21 14:28:32 sof Exp $ + * $Id: RtsStartup.c,v 1.14 1999/06/29 13:04:40 panne Exp $ * * (c) The GHC Team, 1998-1999 * @@ -40,7 +40,9 @@ static int rts_has_started_up = 0; void startupHaskell(int argc, char *argv[]) { +#ifdef ENABLE_WIN32_DLL_SUPPORT int i; +#endif /* To avoid repeated initialisations of the RTS */ if (rts_has_started_up) diff --git a/ghc/rts/hooks/OutOfHeap.c b/ghc/rts/hooks/OutOfHeap.c index 39be01f..b09dbd1 100644 --- a/ghc/rts/hooks/OutOfHeap.c +++ b/ghc/rts/hooks/OutOfHeap.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: OutOfHeap.c,v 1.2 1998/12/02 13:29:14 simonm Exp $ + * $Id: OutOfHeap.c,v 1.3 1999/06/29 13:06:45 panne Exp $ * * User-overridable RTS hooks. * @@ -12,6 +12,7 @@ OutOfHeapHook (lnat request_size, lnat heap_size) /* both sizes in bytes */ { /* fprintf(stderr, "Heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse `+RTS -H' to increase the total heap size.\n", */ + (void)request_size; /* keep gcc -Wall happy */ fprintf(stderr, "Heap exhausted;\nCurrent maximum heap size is %lu bytes;\nuse `+RTS -M' to increase it.\n", heap_size); } -- 1.7.10.4