X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FRtsFlags.c;h=f24912fe46777204542aa97fffd178161f443680;hb=3eacdc7faf0d0e87a7201253f9f12c1fb4db7249;hp=789d73de8c7e47265537b502da5bed903463cc5b;hpb=5d0ccfe99f2b3daebff76d6edf65f7484d1cf801;p=ghc-hetmet.git diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c index 789d73d..f24912f 100644 --- a/ghc/rts/RtsFlags.c +++ b/ghc/rts/RtsFlags.c @@ -1,5 +1,5 @@ + /* ----------------------------------------------------------------------------- - * $Id: RtsFlags.c,v 1.65 2003/01/28 16:23:53 simonmar Exp $ * * (c) The AQUA Project, Glasgow University, 1994-1997 * (c) The GHC Team, 1998-1999 @@ -26,13 +26,9 @@ #include "RtsFlags.h" #include "RtsUtils.h" #include "BlockAlloc.h" -#include "Itimer.h" /* CS_MIN_MILLISECS */ +#include "Timer.h" /* CS_MIN_MILLISECS */ #include "Profiling.h" -#if defined(PROFILING) -#include "Itimer.h" -#endif - #ifdef HAVE_CTYPE_H #include #endif @@ -40,13 +36,15 @@ #include #include -extern struct RTS_FLAGS RtsFlags; +// Flag Structure +RTS_FLAGS RtsFlags; /* * Split argument lists */ -int prog_argc = 0; /* an "int" so as to match normal "argc" */ +int prog_argc = 0; /* an "int" so as to match normal "argc" */ char **prog_argv = NULL; +char *prog_name = NULL; /* 'basename' of prog_argv[0] */ int rts_argc = 0; /* ditto */ char *rts_argv[MAX_RTS_ARGS]; @@ -59,25 +57,9 @@ char *rts_argv[MAX_RTS_ARGS]; #define RTS 1 #define PGM 0 -char *debug_opts_prefix[] = { - "_-", /* scheduler */ - "_.", /* interpreter */ - "_,", /* codegen */ - "_;", /* weak */ - "_~", /* gccafs */ - "_@", /* gc */ - "_#", /* block */ - "_&", /* sanity */ - "_:", /* stable */ - "_!", /* prof */ - "_=", /* gran */ - "_=" /* par */ - "_*" /* linker */ -}; - #if defined(GRAN) -char *gran_debug_opts_strs[] = { +static char *gran_debug_opts_strs[] = { "DEBUG (-bDe, -bD1): event_trace; printing event trace.\n", "DEBUG (-bDE, -bD2): event_stats; printing event statistics.\n", "DEBUG (-bDb, -bD4): bq; check blocking queues\n", @@ -96,32 +78,13 @@ char *gran_debug_opts_strs[] = { }; /* one character codes for the available debug options */ -char gran_debug_opts_flags[] = { +static char gran_debug_opts_flags[] = { 'e', 'E', 'b', 'G', 'q', 'f', 'r', 'F', 'u', 'S', ':', 'o', 'z', 'P', 't' }; -/* prefix strings printed with the debug messages of the corresponding type */ -char *gran_debug_opts_prefix[] = { - "", /* event_trace */ - "", /* event_stats */ - "##", /* bq */ - "**", /* pack */ - "^^", /* checkSparkQ */ - "==", /* thunkStealing */ - "^^", /* randomSteal */ - "+-", /* findWork */ - "", /* unused */ - "++", /* pri */ - "::", /* checkLight */ - "##", /* sortedQ */ - "", /* blockOnFetch */ - "", /* packBuffer */ - "" /* blockOnFetch_sanity */ -}; - #elif defined(PAR) -char *par_debug_opts_strs[] = { +static char *par_debug_opts_strs[] = { "DEBUG (-qDv, -qD1): verbose; be generally verbose with parallel related stuff.\n", "DEBUG (-qDq, -qD2): bq; print blocking queues.\n", "DEBUG (-qDs, -qD4): schedule; scheduling of parallel threads.\n", @@ -139,27 +102,10 @@ char *par_debug_opts_strs[] = { }; /* one character codes for the available debug options */ -char par_debug_opts_flags[] = { +static char par_debug_opts_flags[] = { 'v', 'q', 's', 'e', 'r', 'w', 'F', 'f', 'l', 'o', 'p', 'z' }; -/* prefix strings printed with the debug messages of the corresponding type */ -char *par_debug_opts_prefix[] = { - " ", /* verbose */ - "##", /* bq */ - "--", /* schedule */ - "!!", /* free */ - "[]", /* resume */ - ";;", /* weight */ - "%%", /* fetch */ - //",,", /* ack */ - "$$", /* fish */ - "", /* tables */ - "**", /* packet */ - "**" /* pack */ - ":(" /* paranoia */ -}; - #endif /* PAR */ //@node Static function decls, Command-line option parsing routines, Constants @@ -169,12 +115,13 @@ char *par_debug_opts_prefix[] = { 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); @@ -202,10 +149,10 @@ void initRtsFlagsDefaults(void) RtsFlags.GcFlags.statsFile = NULL; RtsFlags.GcFlags.giveStats = NO_GC_STATS; - RtsFlags.GcFlags.maxStkSize = (1024 * 1024) / sizeof(W_); + RtsFlags.GcFlags.maxStkSize = (8 * 1024 * 1024) / sizeof(W_); RtsFlags.GcFlags.initialStkSize = 1024 / sizeof(W_); - RtsFlags.GcFlags.minAllocAreaSize = (256 * 1024) / BLOCK_SIZE; + RtsFlags.GcFlags.minAllocAreaSize = (512 * 1024) / BLOCK_SIZE; RtsFlags.GcFlags.minOldGenSize = (1024 * 1024) / BLOCK_SIZE; RtsFlags.GcFlags.maxHeapSize = 0; /* off by default */ RtsFlags.GcFlags.heapSizeSuggestion = 0; /* none */ @@ -226,6 +173,7 @@ void initRtsFlagsDefaults(void) #ifdef RTS_GTK_FRONTPANEL RtsFlags.GcFlags.frontpanel = rtsFalse; #endif + RtsFlags.GcFlags.idleGCDelayTicks = 300 / TICK_MILLISECS; /* ticks */ #ifdef DEBUG RtsFlags.DebugFlags.scheduler = rtsFalse; @@ -237,10 +185,12 @@ void initRtsFlagsDefaults(void) RtsFlags.DebugFlags.block_alloc = rtsFalse; RtsFlags.DebugFlags.sanity = rtsFalse; RtsFlags.DebugFlags.stable = rtsFalse; + RtsFlags.DebugFlags.stm = rtsFalse; RtsFlags.DebugFlags.prof = rtsFalse; RtsFlags.DebugFlags.gran = rtsFalse; RtsFlags.DebugFlags.par = rtsFalse; RtsFlags.DebugFlags.linker = rtsFalse; + RtsFlags.DebugFlags.squeeze = rtsFalse; #endif #if defined(PROFILING) || defined(PAR) @@ -267,7 +217,7 @@ void initRtsFlagsDefaults(void) RtsFlags.ConcFlags.ctxtSwitchTime = CS_MIN_MILLISECS; /* In milliseconds */ -#ifdef SMP +#ifdef THREADED_RTS RtsFlags.ParFlags.nNodes = 1; #endif @@ -294,13 +244,13 @@ void initRtsFlagsDefaults(void) RtsFlags.ParFlags.fishDelay = FISH_DELAY; #endif -#if defined(PAR) || defined(SMP) +#if defined(PAR) || defined(THREADED_RTS) RtsFlags.ParFlags.maxLocalSparks = 4096; -#endif /* PAR || SMP */ +#endif /* PAR || THREADED_RTS */ #if defined(GRAN) /* ToDo: check defaults for GranSim and GUM */ - RtsFlags.GcFlags.maxStkSize = (1024 * 1024) / sizeof(W_); + RtsFlags.GcFlags.maxStkSize = (8 * 1024 * 1024) / sizeof(W_); RtsFlags.GcFlags.initialStkSize = 1024 / sizeof(W_); RtsFlags.GranFlags.maxThreads = 65536; // refers to mandatory threads @@ -386,8 +336,8 @@ usage_text[] = { "", " -? Prints this message and exits; the program is not executed", "", -" -K Sets the maximum stack size (default 1M) Egs: -K32k -K512k", -" -k Sets the initial thread stack size (default 1k) Egs: -K4k -K2m", +" -K Sets the maximum stack size (default 8M) Egs: -K32k -K512k", +" -k Sets the initial thread stack size (default 1k) Egs: -k4k -k2m", "", " -A Sets the minimum allocation area size (default 256k) Egs: -A1m -A10k", " -M Sets the maximum heap size (default unlimited) Egs: -M256k -M1G", @@ -398,6 +348,9 @@ usage_text[] = { " -c Auto-enable compaction of the oldest generation when live data is", " at least % of the maximum heap size set with -M (default: 30%)", " -c Enable compaction for all major collections", +#if defined(THREADED_RTS) +" -I Perform full GC after idle time (default: 0.3, 0 == off)", +#endif "", " -t One-line GC statistics (default file: .stat)", " -s Summary GC statistics (with -Sstderr going to stderr)", @@ -478,12 +431,14 @@ usage_text[] = { " -Dr DEBUG: gran", " -DP DEBUG: par", " -Dl DEBUG: linker", +" -Dm DEBUG: stm", +" -Dz DEBUG: stack squezing", "", -#endif // DEBUG -#if defined(SMP) +#endif /* DEBUG */ +#if defined(THREADED_RTS) " -N Use OS threads (default: 1)", #endif -#if defined(SMP) || defined(PAR) +#if defined(THREADED_RTS) || defined(PAR) " -e Size of spark pools (default 100)", #endif #if defined(PAR) @@ -493,7 +448,7 @@ usage_text[] = { " -qd Turn on PVM-ish debugging", " -qO Disable output for performance measurement", #endif -#if defined(SMP) || defined(PAR) +#if defined(THREADED_RTS) || defined(PAR) " -e Maximum number of outstanding local sparks (default: 4096)", #endif #if defined(PAR) @@ -512,7 +467,7 @@ usage_text[] = { 0 }; -static __inline__ rtsBool +STATIC_INLINE rtsBool strequal(const char *a, const char * b) { return(strcmp(a, b) == 0); @@ -532,7 +487,7 @@ splitRtsFlags(char *s, int *rts_argc, char *rts_argv[]) if (c1 == c2) { break; } if (*rts_argc < MAX_RTS_ARGS-1) { - s = malloc(c2-c1+1); + s = stgMallocBytes(c2-c1+1, "RtsFlags.c:splitRtsFlags()"); strncpy(s, c1, c2-c1); s[c2-c1] = '\0'; rts_argv[(*rts_argc)++] = s; @@ -550,13 +505,8 @@ setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[]) rtsBool error = rtsFalse; I_ mode; I_ arg, total_arg; - char *last_slash; - - /* Remove directory from argv[0] -- default files in current directory */ - - if ((last_slash = (char *) strrchr(argv[0], '/')) != NULL) - strcpy(argv[0], last_slash+1); + setProgName (argv); total_arg = *argc; arg = 1; @@ -623,7 +573,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 { @@ -641,7 +591,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("GHC not built for: ticky-ticky stats"); \ +errorBelch("not built for: ticky-ticky stats"); \ error = rtsTrue; #endif @@ -649,7 +599,7 @@ error = rtsTrue; # define COST_CENTRE_USING_BUILD_ONLY(x) x #else # define COST_CENTRE_USING_BUILD_ONLY(x) \ -prog_belch("GHC not built for: -prof or -parallel"); \ +errorBelch("not built for: -prof or -parallel"); \ error = rtsTrue; #endif @@ -657,31 +607,31 @@ error = rtsTrue; # define PROFILING_BUILD_ONLY(x) x #else # define PROFILING_BUILD_ONLY(x) \ -prog_belch("GHC not built for: -prof"); \ +errorBelch("not built for: -prof"); \ error = rtsTrue; #endif -#ifdef SMP -# define SMP_BUILD_ONLY(x) x +#ifdef PAR +# define PAR_BUILD_ONLY(x) x #else -# define SMP_BUILD_ONLY(x) \ -prog_belch("GHC not built for: -smp"); \ +# define PAR_BUILD_ONLY(x) \ +errorBelch("not built for: -parallel"); \ error = rtsTrue; #endif -#ifdef PAR -# define PAR_BUILD_ONLY(x) x +#ifdef THREADED_RTS +# define THREADED_BUILD_ONLY(x) x #else -# define PAR_BUILD_ONLY(x) \ -prog_belch("GHC not built for: -parallel"); \ +# define THREADED_BUILD_ONLY(x) \ +errorBelch("not built for: -smp"); \ error = rtsTrue; #endif -#if defined(SMP) || defined(PAR) -# define PAR_OR_SMP_BUILD_ONLY(x) x +#if defined(THREADED_RTS) || defined(PAR) +# define PAR_OR_THREADED_BUILD_ONLY(x) x #else -# define PAR_OR_SMP_BUILD_ONLY(x) \ -prog_belch("GHC not built for: -parallel or -smp"); \ +# define PAR_OR_THREADED_BUILD_ONLY(x) \ +errorBelch("not built for: -parallel or -smp"); \ error = rtsTrue; #endif @@ -689,7 +639,7 @@ error = rtsTrue; # define GRAN_BUILD_ONLY(x) x #else # define GRAN_BUILD_ONLY(x) \ -prog_belch("GHC not built for: -gransim"); \ +errorBelch("not built for: -gransim"); \ error = rtsTrue; #endif @@ -775,6 +725,12 @@ error = rtsTrue; case 'a': RtsFlags.DebugFlags.apply = rtsTrue; break; + case 'm': + RtsFlags.DebugFlags.stm = rtsTrue; + break; + case 'z': + RtsFlags.DebugFlags.squeeze = rtsTrue; + break; default: bad_option( rts_argv[arg] ); } @@ -846,6 +802,23 @@ error = rtsTrue; break; #endif + case 'I': /* idle GC delay */ + if (rts_argv[arg][2] == '\0') { + /* use default */ + } else { + I_ cst; /* tmp */ + + /* Convert to ticks */ + cst = (I_) ((atof(rts_argv[arg]+2) * 1000)); + if (cst > 0 && cst < TICK_MILLISECS) { + cst = TICK_MILLISECS; + } else { + cst = cst / TICK_MILLISECS; + } + RtsFlags.GcFlags.idleGCDelayTicks = cst; + } + break; + case 'S': RtsFlags.GcFlags.giveStats = VERBOSE_GC_STATS; goto stats; @@ -862,13 +835,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; @@ -916,7 +891,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 @@ -985,7 +960,7 @@ error = rtsTrue; } if (RtsFlags.ProfFlags.doHeapProfile != 0) { - prog_belch("multiple heap profile options"); + errorBelch("multiple heap profile options"); error = rtsTrue; break; } @@ -1020,11 +995,11 @@ 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; } ) -#endif // PROFILING +#endif /* PROFILING */ break; #if defined(PROFILING) @@ -1062,14 +1037,14 @@ error = rtsTrue; } break; -#ifdef SMP +#ifdef THREADED_RTS case 'N': - SMP_BUILD_ONLY( + THREADED_BUILD_ONLY( if (rts_argv[arg][2] != '\0') { 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; } } @@ -1077,12 +1052,12 @@ error = rtsTrue; #endif /* =========== PARALLEL =========================== */ case 'e': - PAR_OR_SMP_BUILD_ONLY( + PAR_OR_THREADED_BUILD_ONLY( if (rts_argv[arg][2] != '\0') { 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; } } @@ -1106,11 +1081,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 =================== */ @@ -1118,7 +1096,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; @@ -1137,7 +1115,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; } @@ -1145,7 +1123,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; } @@ -1156,7 +1134,7 @@ error = rtsTrue; fflush(stdout); for (p = usage_text; *p; p++) - belch("%s", *p); + errorBelch("%s", *p); stg_exit(EXIT_FAILURE); } } @@ -1169,7 +1147,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 = @@ -1429,7 +1407,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; @@ -1438,7 +1416,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; @@ -1452,7 +1430,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; } @@ -1482,22 +1460,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; @@ -1558,18 +1536,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); } @@ -1577,7 +1555,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; @@ -1588,13 +1566,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 */ @@ -1608,7 +1586,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; @@ -1617,7 +1595,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; @@ -1625,19 +1603,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; @@ -1725,10 +1703,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; @@ -1745,7 +1723,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 @@ -1756,92 +1734,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; @@ -1870,7 +1848,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; @@ -1902,7 +1880,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) @@ -1912,7 +1890,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; } @@ -1924,12 +1902,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; @@ -1938,11 +1916,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; @@ -1953,7 +1931,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; @@ -1962,29 +1940,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; @@ -1992,11 +1970,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; @@ -2021,14 +1999,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; @@ -2036,18 +2014,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) @@ -2059,7 +2037,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; @@ -2075,7 +2053,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 @@ -2085,7 +2063,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 */ @@ -2101,7 +2079,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; @@ -2132,7 +2110,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 */ @@ -2140,40 +2118,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) { @@ -2201,6 +2201,56 @@ 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); } + +/* ----------------------------------------------------------------------------- + Getting/Setting the program's arguments. + + These are used by System.Environment, and parts of the RTS. + -------------------------------------------------------------------------- */ + +void +setProgName(char *argv[]) +{ + /* Remove directory from argv[0] -- default files in current directory */ +#if !defined(mingw32_HOST_OS) + char *last_slash; + if ( (last_slash = (char *) strrchr(argv[0], '/')) != NULL ) { + prog_name = last_slash+1; + } else { + prog_name = argv[0]; + } +#else + char* last_slash = argv[0] + (strlen(argv[0]) - 1); + while ( last_slash > argv[0] ) { + if ( *last_slash == '/' || *last_slash == '\\' ) { + prog_name = last_slash+1; + return; + } + last_slash--; + } + prog_name = argv[0]; +#endif +} + +void +getProgArgv(int *argc, char **argv[]) +{ + if (argc) { *argc = prog_argc; } + if (argv) { *argv = prog_argv; } +} + +void +setProgArgv(int argc, char *argv[]) +{ + /* Usually this is done by startupHaskell, so we don't need to call this. + However, sometimes Hugs wants to change the arguments which Haskell + getArgs >>= ... will be fed. So you can do that by calling here + _after_ calling startupHaskell. + */ + prog_argc = argc; + prog_argv = argv; + setProgName(prog_argv); +}