--- /dev/null
+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1995
+%
+\section{Runtime-system runtime flags}
+
+Everything to do with RTS runtime flags, including RTS parameters
+that can be set by them, either directly or indirectly.
+
+@rtsFlags.lh@ defines the data structure that holds all of them.
+
+\begin{code}
+#include "rtsdefs.h"
+
+struct RTS_FLAGS RTSflags; /* actually declare the data structure */
+struct ALL_FLAGS AllFlags;
+
+/* some fwd decls */
+static I_ decode(const char *);
+static void bad_option(const char *);
+static FILE * open_stats_file (I_ arg,
+ int argc, char *argv[], int rts_argc, char *rts_argv[],
+ const char *FILENAME_FMT);
+
+/* extern decls */
+long strtol PROTO((const char *, char **, int));
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Initial default values for @RTSFlags@}
+%* *
+%************************************************************************
+
+\begin{code}
+void
+initRtsFlagsDefaults (STG_NO_ARGS)
+{
+ RTSflags.GcFlags.statsFile = NULL;
+ RTSflags.GcFlags.giveStats = NO_GC_STATS;
+
+ RTSflags.GcFlags.stksSize = 0x10002; /* 2^16 = 16Kwords = 64Kbytes */
+ RTSflags.GcFlags.heapSize = 0x100002; /* 2^20 = 1Mwords = 4Mbytes */
+ RTSflags.GcFlags.allocAreaSize = 0x4002; /* 2^14 = 16Kwords = 64Kbytes;
+ plus 2 cache-friendly words */
+ RTSflags.GcFlags.allocAreaSizeGiven = rtsFalse;
+ RTSflags.GcFlags.specifiedOldGenSize= 0; /* means: use all heap available */
+ RTSflags.GcFlags.pcFreeHeap = 3; /* 3% */
+ /* minAllocAreaSize is derived; set in initSM,
+ after we know pcFreeHeap and heapSize */
+
+ RTSflags.GcFlags.force2s = rtsFalse;
+ RTSflags.GcFlags.forceGC = rtsFalse;
+ RTSflags.GcFlags.forcingInterval = 5000000; /* 5MB (or words?) */
+ RTSflags.GcFlags.ringBell = rtsFalse;
+ RTSflags.GcFlags.trace = 0; /* not turned on */
+
+ RTSflags.GcFlags.lazyBlackHoling = rtsTrue;
+ RTSflags.GcFlags.doSelectorsAtGC = rtsTrue;
+ RTSflags.GcFlags.squeezeUpdFrames = rtsTrue;
+
+#if defined(PROFILING) || defined(PAR)
+ RTSflags.CcFlags.doCostCentres = 0;
+ RTSflags.CcFlags.sortBy = SORTCC_TIME;
+
+ /* "ctxtSwitchTicks", "profilerTicks", & "msecsPerTick" are
+ derived info, so they are set after ctxtSwitchTime has been
+ determined.
+ */
+#endif /* PROFILING or PAR */
+
+#ifdef PROFILING
+ RTSflags.ProfFlags.doHeapProfile = rtsFalse;
+#endif /* PROFILING */
+
+#ifdef CONCURRENT
+ RTSflags.ConcFlags.ctxtSwitchTime = CS_MIN_MILLISECS; /* In milliseconds */
+ RTSflags.ConcFlags.maxThreads = 32;
+ RTSflags.ConcFlags.stkChunkSize = 1024;
+ RTSflags.ConcFlags.maxLocalSparks = 500;
+#endif /* CONCURRENT */
+
+#ifdef PAR
+ RTSflags.ParFlags.parallelStats = rtsFalse;
+ RTSflags.ParFlags.granSimStats = rtsFalse;
+ RTSflags.ParFlags.granSimStats_Binary = rtsFalse;
+
+ RTSflags.ParFlags.outputDisabled = rtsFalse;
+
+ RTSflags.ParFlags.packBufferSize = 1024;
+#endif /* PAR */
+
+#ifdef TICKY_TICKY
+ RTSflags.TickyFlags.showTickyStats = rtsFalse;
+ RTSflags.TickyFlags.tickyFile = NULL;
+
+ AllFlags.doUpdEntryCounts = rtsTrue; /*ToDo:move? */
+#endif
+}
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Usage message for runtime-system (RTS) flags}
+%* *
+%************************************************************************
+
+\begin{code}
+static const char *
+usage_text[] = {
+"",
+"Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>",
+"",
+" +RTS Indicates run time system options follow",
+" -RTS Indicates program arguments follow",
+" --RTS Indicates that ALL subsequent arguments will be given to the",
+" program (including any of these RTS flags)",
+"",
+"The following run time system options are available:",
+"",
+" -? -f Prints this message and exits; the program is not executed",
+"",
+" -K<size> Sets the stack size (default 64k) Egs: -K32k -K512k",
+" -H<size> Sets the heap size (default 4M) -H512k -H16M",
+" -s<file> Summary GC statistics (default file: <program>.stat)",
+" -S<file> Detailed GC statistics (with -Sstderr going to stderr)",
+"",
+#if defined(GCap)
+" -M<n>% Sets minimum size of alloc area as % of heap (default 3%)",
+" -A<size> Fixes size of alloc area, overriding any minimum (-A gives 64k)",
+" -G<size> Fixes size of major generation (default is dynamic threshold)",
+" -F2s Forces program compiled for Appel gc to use 2s collection",
+#else
+# if defined(GCgn)
+" -A<size> Specifies size of alloc area (default 64k)",
+" -G<size> Fixes size of major generation (default is available heap)",
+" -F2s Forces program compiled for Gen gc to use 2s collection",
+# else
+" -M<n>% Minimum % of heap which must be available (default 3%)",
+" -A<size> Fixes size of heap area allocated between GCs (-A gives 64k)",
+# endif
+#endif
+" -j<size> Forces major GC at every <size> bytes allocated",
+#if defined(GCdu)
+" -u<percent> Fixes residency threshold at which mode switches (range 0.0..0.95)",
+#endif
+"",
+" -N No black-holing during GC (for use when a signal handler is present)",
+" -Z Don't squeeze out update frames on stack overflow",
+" -B Sound the bell at the start of each (major) garbage collection",
+#if defined(PROFILING) || defined(PAR)
+"",
+" -p<sort> Produce cost centre time profile (output file <program>.prof)",
+" sort: T = time (default), A = alloc, C = cost centre label",
+" -P<sort> Produce serial time profile (output file <program>.time)",
+" and a -p profile with detailed caf/enter/tick/alloc info",
+# if defined(PROFILING)
+"",
+" -h<break-down> Heap residency profile (output file <program>.hp)",
+" break-down: C = cost centre (default), M = module, G = group",
+" D = closure description, Y = type description",
+" T<ints>,<start> = time closure created",
+" ints: no. of interval bands plotted (default 18)",
+" start: seconds after which intervals start (default 0.0)",
+" A subset of closures may be selected by the attached cost centre using:",
+" -c{mod:lab,mod:lab...}, specific module:label cost centre(s)",
+" -m{mod,mod...} all cost centres from the specified modules(s)",
+" -g{grp,grp...} all cost centres from the specified group(s)",
+" Selections can also be made by description, type, kind and age:",
+" -d{des,des...} closures with specified closure descriptions",
+" -y{typ,typ...} closures with specified type descriptions",
+" -k{knd,knd...} closures of the specified kinds",
+" -a<age> closures which survived <age> complete intervals",
+" The selection logic used is summarised as follows:",
+" ([-c] or [-m] or [-g]) and ([-d] or [-y] or [-k]) and [-a]",
+" where an option is true if not specified",
+# endif
+"",
+" -z<tbl><size> set hash table <size> for <tbl> (C, M, G, D or Y)",
+"",
+" -i<secs> Number of seconds in a profiling interval (default 1.0):",
+" heap profile (-h) and/or serial time profile (-P) frequency",
+#endif /* PROFILING or PAR */
+"",
+#if defined(TICKY_TICKY)
+" -r<file> Produce reduction profiling statistics (with -rstderr for stderr)",
+"",
+#endif
+" -T<level> Trace garbage collection execution (debugging)",
+#ifdef CONCURRENT
+"",
+# ifdef PAR
+" -N<n> Use <n> PVMish processors in parallel (default: 2)",
+/* NB: the -N<n> is implemented by the driver!! */
+# endif
+" -C<secs> Context-switch interval in seconds",
+" (0 or no argument means switch as often as possible)",
+" the default is .01 sec; resolution is .01 sec",
+" -e<size> Size of spark pools (default 100)",
+# ifdef PAR
+" -q Enable activity profile (output files in ~/<program>*.gr)",
+" -qb Enable binary activity profile (output file /tmp/<program>.gb)",
+" -Q<size> Set pack-buffer size (default: 1024)",
+# else
+" -q[v] Enable quasi-parallel profile (output file <program>.qp)",
+# endif
+" -t<num> Set maximum number of advisory threads per PE (default 32)",
+" -o<num> Set stack chunk size (default 1024)",
+# ifdef PAR
+" -d Turn on PVM-ish debugging",
+" -O Disable output for performance measurement",
+# endif /* PAR */
+#endif /* CONCURRENT */
+"",
+"Other RTS options may be available for programs compiled a different way.",
+"The GHC User's Guide has full details.",
+"",
+0
+};
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Processing command-line arguments to set @RTSFlags@}
+%* *
+%************************************************************************
+
+\begin{code}
+#define RTS 1
+#define PGM 0
+
+#ifndef atof
+extern double atof();
+/* no proto because some machines use const and some do not */
+#endif
+
+static __inline__ rtsBool
+strequal(const char *a, const char * b)
+{
+ return(strcmp(a, b) == 0);
+}
+
+void
+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);
+
+ /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */
+ /* argv[0] must be PGM argument -- leave in argv */
+
+ total_arg = *argc;
+ arg = 1;
+
+ *argc = 1;
+ *rts_argc = 0;
+
+ for (mode = PGM; arg < total_arg && ! strequal("--RTS", argv[arg]); arg++) {
+ if (strequal("+RTS", argv[arg])) {
+ mode = RTS;
+ }
+ else if (strequal("-RTS", argv[arg])) {
+ mode = PGM;
+ }
+ else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
+ rts_argv[(*rts_argc)++] = argv[arg];
+ }
+ else if (mode == PGM) {
+ argv[(*argc)++] = argv[arg];
+ }
+ else {
+ fflush(stdout);
+ fprintf(stderr, "setupRtsFlags: Too many RTS arguments (max %d)\n",
+ MAX_RTS_ARGS-1);
+ EXIT(EXIT_FAILURE);
+ }
+ }
+ if (arg < total_arg) {
+ /* arg must be --RTS; process remaining program arguments */
+ while (++arg < total_arg) {
+ argv[(*argc)++] = argv[arg];
+ }
+ }
+ argv[*argc] = (char *) 0;
+ rts_argv[*rts_argc] = (char *) 0;
+
+ /* Process RTS (rts_argv) part: mainly to determine statsfile */
+
+ for (arg = 0; arg < *rts_argc; arg++) {
+ if (rts_argv[arg][0] != '-') {
+ fflush(stdout);
+ fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n",
+ rts_argv[arg]);
+ error = rtsTrue;
+
+ } else {
+ switch(rts_argv[arg][1]) {
+
+ /* process: general args, then PROFILING-only ones,
+ then CONCURRENT-only, PARallel-only, GRAN-only,
+ TICKY-only (same order as defined in RtsFlags.lh);
+ within those groups, mostly in case-insensitive
+ alphabetical order.
+ */
+
+#ifdef TICKY_TICKY
+# define TICKY_BUILD_ONLY(x) x
+#else
+# define TICKY_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: ticky-ticky stats\n"); \
+error = rtsTrue;
+#endif
+
+#if (defined(PROFILING) || defined(PAR))
+# define COST_CENTRE_USING_BUILD_ONLY(x) x
+#else
+# define COST_CENTRE_USING_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -prof or -parallel\n"); \
+error = rtsTrue;
+#endif
+
+#ifdef PROFILING
+# define PROFILING_BUILD_ONLY(x)
+#else
+# define PROFILING_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -prof\n"); \
+error = rtsTrue;
+#endif
+
+#ifdef CONCURRENT
+# define CONCURRENT_BUILD_ONLY(x)
+#else
+# define CONCURRENT_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -concurrent\n"); \
+error = rtsTrue;
+#endif
+
+#ifdef PAR
+# define PAR_BUILD_ONLY(x)
+#else
+# define PAR_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -parallel\n"); \
+error = rtsTrue;
+#endif
+
+#ifdef GRAN
+# define GRAN_BUILD_ONLY(x)
+#else
+# define GRAN_BUILD_ONLY(x) \
+fprintf(stderr, "setupRtsFlags: GHC not built for: -gransim\n"); \
+error = rtsTrue;
+#endif
+
+ /* =========== GENERAL ========================== */
+ case '?':
+ case 'f':
+ error = rtsTrue;
+ break;
+
+ case 'A':
+ RTSflags.GcFlags.allocAreaSize
+ = decode(rts_argv[arg]+2) / sizeof(W_);
+ RTSflags.GcFlags.allocAreaSizeGiven = rtsTrue;
+ break;
+
+ case 'B':
+ RTSflags.GcFlags.ringBell = rtsTrue;
+ break;
+
+ case 'F':
+ if (strequal(rts_argv[arg]+2, "2s")) {
+ RTSflags.GcFlags.force2s = rtsTrue;
+ } else {
+ bad_option( rts_argv[arg] );
+ }
+ break;
+
+ case 'G':
+ RTSflags.GcFlags.specifiedOldGenSize
+ = decode(rts_argv[arg]+2) / sizeof(W_);
+ break;
+
+ case 'K':
+ RTSflags.GcFlags.stksSize = decode(rts_argv[arg]+2) / sizeof(W_);
+
+ if (RTSflags.GcFlags.stksSize == 0) bad_option( rts_argv[arg] );
+ break;
+
+ case 'H':
+ RTSflags.GcFlags.heapSize = decode(rts_argv[arg]+2) / sizeof(W_);
+ /* user give size in *bytes* but "heapSize" is in *words* */
+
+ if (RTSflags.GcFlags.heapSize <= 0) bad_option(rts_argv[arg]);
+ break;
+
+ case 'j': /* force GC option */
+ RTSflags.GcFlags.forceGC = rtsTrue;
+ if (rts_argv[arg][2]) {
+ RTSflags.GcFlags.forcingInterval
+ = decode(rts_argv[arg]+2) / sizeof(W_);
+ }
+ break;
+
+ case 'M':
+ RTSflags.GcFlags.pcFreeHeap = atof(rts_argv[arg]+2);
+
+ if (RTSflags.GcFlags.pcFreeHeap < 0 || RTSflags.GcFlags.pcFreeHeap > 100)
+ bad_option( rts_argv[arg] );
+ break;
+
+ case 'N':
+ RTSflags.GcFlags.lazyBlackHoling = rtsFalse;
+ break;
+
+ case 'n':
+ RTSflags.GcFlags.doSelectorsAtGC = rtsFalse;
+ break;
+
+ case 'S': /* NB: no difference at present ! */
+ case 's':
+ RTSflags.GcFlags.giveStats ++; /* will be VERBOSE_GC_STATS */
+#ifdef PAR
+ /* Opening all those files would almost certainly fail... */
+ RTSflags.ParFlags.parallelStats = rtsTrue;
+ RTSflags.GcFlags.statsFile = stderr; /* 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;
+#endif
+ break;
+
+ case 'T':
+ if (rts_argv[arg][2] != '\0')
+ RTSflags.GcFlags.trace
+ = (W_) strtol(rts_argv[arg]+2, (char **)NULL, 0);
+ else
+ RTSflags.GcFlags.trace = 1; /* slightly weird; why, really? */
+ break;
+
+ case 'Z':
+ RTSflags.GcFlags.squeezeUpdFrames = rtsFalse;
+ break;
+
+ /* =========== PROFILING ========================== */
+
+ case 'P': /* detailed cost centre profiling (time/alloc) */
+ COST_CENTRE_USING_BUILD_ONLY(
+ RTSflags.CcFlags.doCostCentres++;
+ )
+ case 'p': /* cost centre profiling (time/alloc) */
+ COST_CENTRE_USING_BUILD_ONLY(
+ { char ch;
+ RTSflags.CcFlags.doCostCentres++;
+
+ for (ch = 2; rts_argv[arg][ch]; ch++) {
+ switch (rts_argv[arg][2]) {
+ case SORTCC_LABEL:
+ case SORTCC_TIME:
+ case SORTCC_ALLOC:
+ RTSflags.CcFlags.sortBy = rts_argv[arg][ch];
+ break;
+ default:
+ fprintf(stderr, "Invalid profiling sort option %s\n", rts_argv[arg]);
+ error = 1;
+ }}}
+ ) break;
+
+ case 'i': /* serial profiling -- initial timer interval */
+ COST_CENTRE_USING_BUILD_ONLY(
+ interval_ticks = (I_) ((atof(rts_argv[arg]+2) * TICK_FREQUENCY));
+ if (interval_ticks <= 0)
+ interval_ticks = 1;
+ ) break;
+
+ case 'h': /* serial heap profile */
+ PROFILING_BUILD_ONLY(
+ switch (rts_argv[arg][2]) {
+ case '\0':
+ case CCchar:
+ RTSflags.ProfFlags.doHeapProfile = HEAP_BY_CC;
+ break;
+ case MODchar:
+ RTSflags.ProfFlags.doHeapProfile = HEAP_BY_MOD;
+ break;
+ case GRPchar:
+ RTSflags.ProfFlags.doHeapProfile = HEAP_BY_GRP;
+ break;
+ case DESCRchar:
+ RTSflags.ProfFlags.doHeapProfile = HEAP_BY_DESCR;
+ break;
+ case TYPEchar:
+ RTSflags.ProfFlags.doHeapProfile = HEAP_BY_TYPE;
+ break;
+ case TIMEchar:
+ RTSflags.ProfFlags.doHeapProfile = HEAP_BY_TIME;
+ if (rts_argv[arg][3]) {
+ char *start_str = strchr(rts_argv[arg]+3, ',');
+ I_ intervals;
+ if (start_str) *start_str = '\0';
+
+ if ((intervals = decode(rts_argv[arg]+3)) != 0) {
+ time_intervals = (hash_t) intervals;
+ /* ToDo: and what if it *is* zero intervals??? */
+ }
+ if (start_str) {
+ earlier_ticks = (I_)((atof(start_str + 1) * TICK_FREQUENCY));
+ }
+ }
+ break;
+ default:
+ fprintf(stderr, "Invalid heap profile option: %s\n",
+ rts_argv[arg]);
+ error = 1;
+ }
+ ) break;
+
+ case 'z': /* size of index tables */
+ PROFILING_BUILD_ONLY(
+ switch (rts_argv[arg][2]) {
+ case CCchar:
+ max_cc_no = (hash_t) decode(rts_argv[arg]+3);
+ if (max_cc_no == 0) {
+ fprintf(stderr, "Bad number of cost centres %s\n", rts_argv[arg]);
+ error = 1;
+ }
+ break;
+ case MODchar:
+ max_mod_no = (hash_t) decode(rts_argv[arg]+3);
+ if (max_mod_no == 0) {
+ fprintf(stderr, "Bad number of modules %s\n", rts_argv[arg]);
+ error = 1;
+ }
+ break;
+ case GRPchar:
+ max_grp_no = (hash_t) decode(rts_argv[arg]+3);
+ if (max_grp_no == 0) {
+ fprintf(stderr, "Bad number of groups %s\n", rts_argv[arg]);
+ error = 1;
+ }
+ break;
+ case DESCRchar:
+ max_descr_no = (hash_t) decode(rts_argv[arg]+3);
+ if (max_descr_no == 0) {
+ fprintf(stderr, "Bad number of closure descriptions %s\n", rts_argv[arg]);
+ error = 1;
+ }
+ break;
+ case TYPEchar:
+ max_type_no = (hash_t) decode(rts_argv[arg]+3);
+ if (max_type_no == 0) {
+ fprintf(stderr, "Bad number of type descriptions %s\n", rts_argv[arg]);
+ error = 1;
+ }
+ break;
+ default:
+ fprintf(stderr, "Invalid index table size option: %s\n",
+ rts_argv[arg]);
+ error = 1;
+ }
+ ) break;
+
+ case 'c': /* cost centre label select */
+ case 'm': /* cost centre module select */
+ case 'g': /* cost centre group select */
+ case 'd': /* closure descr select */
+ case 'y': /* closure type select */
+ case 'k': /* closure kind select */
+ PROFILING_BUILD_ONLY(
+
+ left = strchr(rts_argv[arg], '{');
+ right = strrchr(rts_argv[arg], '}');
+ if (! left || ! right ||
+ strrchr(rts_argv[arg], '{') != left ||
+ strchr(rts_argv[arg], '}') != right) {
+ fprintf(stderr, "Invalid heap profiling selection bracketing\n %s\n", rts_argv[arg]);
+ error = 1;
+ } else {
+ *right = '\0';
+ switch (rts_argv[arg][1]) {
+ case 'c': /* cost centre label select */
+ select_cc = left + 1;
+ break;
+ case 'm': /* cost centre module select */
+ select_mod = left + 1;
+ break;
+ case 'g': /* cost centre group select */
+ select_grp = left + 1;
+ break;
+ case 'd': /* closure descr select */
+ select_descr = left + 1;
+ break;
+ case 't': /* closure type select */
+ select_type = left + 1;
+ break;
+ case 'k': /* closure kind select */
+ select_kind = left + 1;
+ break;
+ }
+ }
+ ) break;
+
+ /* =========== CONCURRENT ========================= */
+ case 'C': /* context switch interval */
+ CONCURRENT_BUILD_ONLY (
+ if (rts_argv[arg][2] == '\0')
+ RTSflags.ConcFlags.ctxtSwitchTime = 0;
+ else {
+ I_ cst; /* tmp */
+
+ /* Convert to milliseconds */
+ cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
+ cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS;
+ if (cst < CS_MIN_MILLISECS)
+ cst = CS_MIN_MILLISECS;
+
+ RTSflags.ConcFlags.ctxtSwitchTime = cst;
+ }
+ ) break;
+
+ case 't':
+ CONCURRENT_BUILD_ONLY(
+ if (rts_argv[arg][2] != '\0') {
+ RTSflags.ConcFlags.maxThreads
+ = strtol(rts_argv[arg]+2, (char **) NULL, 10);
+ } else {
+ fprintf(stderr, "setupRtsFlags: missing size for -t\n");
+ error = rtsTrue;
+ }
+ ) break;
+
+ case 'o':
+ CONCURRENT_BUILD_ONLY (
+ if (rts_argv[arg][2] != '\0') {
+ I_ size = decode(rts_argv[arg]+2);
+
+ if (size < MIN_STKO_CHUNK_SIZE)
+ size = MIN_STKO_CHUNK_SIZE;
+
+ RTSflags.ConcFlags.stkChunkSize = size;
+ } else {
+ fprintf(stderr, "setupRtsFlags: missing size for -o\n");
+ error = rtsTrue;
+ }
+ ) break;
+
+ /* =========== PARALLEL =========================== */
+ case 'e':
+ CONCURRENT_BUILD_ONLY(
+ if (rts_argv[arg][2] != '\0') { /* otherwise, stick w/ the default */
+
+ RTSflags.ConcFlags.maxLocalSparks
+ = strtol(rts_argv[arg]+2, (char **) NULL, 10);
+
+ if (RTSflags.ConcFlags.maxLocalSparks <= 0) {
+ fprintf(stderr, "setupRtsFlags: bad value for -e\n");
+ error = rtsTrue;
+ }
+ }
+ ) break;
+
+ case 'O':
+ PAR_BUILD_ONLY(
+ RTSflags.ParFlags.outputDisabled = rtsTrue;
+ ) break;
+
+ case 'q': /* activity profile option */
+ PAR_BUILD_ONLY(
+ if (rts_argv[arg][2] == 'b')
+ RTSflags.ParFlags.granSimStats_Binary = rtsTrue;
+ else
+ RTSflags.ParFlags.granSimStats = rtsTrue;
+ ) break;
+
+#if 0 /* or??? */
+ case 'q': /* quasi-parallel profile option */
+ GRAN_BUILD_ONLY (
+ if (rts_argv[arg][2] == 'v')
+ do_qp_prof = 2;
+ else
+ do_qp_prof++;
+ ) break;
+#endif /* 0??? */
+
+ case 'Q': /* Set pack buffer size */
+ PAR_BUILD_ONLY(
+ if (rts_argv[arg][2] != '\0') {
+ RTSflags.ParFlags.packBufferSize = decode(rts_argv[arg]+2);
+ } else {
+ fprintf(stderr, "setupRtsFlags: missing size of PackBuffer (for -Q)\n");
+ error = rtsTrue;
+ }
+ ) break;
+
+ /* =========== GRAN =============================== */
+
+ case 'b':
+ GRAN_BUILD_ONLY(
+ process_gran_option();
+ ) break;
+
+ /* =========== TICKY ============================== */
+
+ case 'r': /* Basic profiling stats */
+ 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;
+ ) break;
+
+ /* =========== OH DEAR ============================ */
+ default:
+ fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n",rts_argv[arg]);
+ error = rtsTrue;
+ break;
+ }
+ }
+ }
+ if (error) {
+ const char **p;
+
+ fflush(stdout);
+ for (p = usage_text; *p; p++)
+ fprintf(stderr, "%s\n", *p);
+ EXIT(EXIT_FAILURE);
+ }
+
+}
+
+#ifdef GRAN
+static void
+process_gran_option()
+{
+ if (rts_argv[arg][2] != '\0') {
+
+ /* Should we emulate hbcpp */
+ if(strequal((rts_argv[arg]+2),"roken")) {
+ ++DoAlwaysCreateThreads;
+ strcpy(rts_argv[arg]+2,"oring");
+ }
+
+ /* or a ridiculously idealised simulator */
+ if(strequal((rts_argv[arg]+2),"oring")) {
+ gran_latency = gran_fetchtime = gran_additional_latency =
+ gran_gunblocktime = gran_lunblocktime
+ = gran_threadcreatetime = gran_threadqueuetime
+ = gran_threadscheduletime = gran_threaddescheduletime
+ = gran_threadcontextswitchtime
+ = 0;
+
+ gran_mpacktime = gran_munpacktime = 0;
+
+ gran_arith_cost = gran_float_cost = gran_load_cost
+ = gran_store_cost = gran_branch_cost = 0;
+
+ gran_heapalloc_cost = 1;
+
+ /* ++DoFairSchedule; */
+ ++DoStealThreadsFirst;
+ ++DoThreadMigration;
+ RTSflags.ParFlags.granSimStats = rtsTrue;
+ }
+
+ /* or a ridiculously idealised simulator */
+ if(strequal((rts_argv[arg]+2),"onzo")) {
+ gran_latency = gran_fetchtime = gran_additional_latency =
+ gran_gunblocktime = gran_lunblocktime
+ = gran_threadcreatetime = gran_threadqueuetime
+ = gran_threadscheduletime = gran_threaddescheduletime
+ = gran_threadcontextswitchtime
+ = 0;
+
+ gran_mpacktime = gran_munpacktime = 0;
+
+ /* Keep default values for these
+ gran_arith_cost = gran_float_cost = gran_load_cost
+ = gran_store_cost = gran_branch_cost = 0;
+ */
+
+ gran_heapalloc_cost = 1;
+
+ /* ++DoFairSchedule; */ /* -b-R */
+ /* ++DoStealThreadsFirst; */ /* -b-T */
+ ++DoReScheduleOnFetch; /* -bZ */
+ ++DoThreadMigration; /* -bM */
+ RTSflags.ParFlags.granSimStats = rtsTrue; /* -bP */
+# if defined(GRAN_CHECK) && defined(GRAN)
+ debug = 0x20; /* print event statistics */
+# endif
+ }
+
+ /* Communication and task creation cost parameters */
+ else switch(rts_argv[arg][2]) {
+ case 'l':
+ if (rts_argv[arg][3] != '\0')
+ {
+ gran_gunblocktime = gran_latency = decode(rts_argv[arg]+3);
+ gran_fetchtime = 2* gran_latency;
+ }
+ else
+ gran_latency = LATENCY;
+ break;
+
+ case 'a':
+ if (rts_argv[arg][3] != '\0')
+ gran_additional_latency = decode(rts_argv[arg]+3);
+ else
+ gran_additional_latency = ADDITIONAL_LATENCY;
+ break;
+
+ case 'm':
+ if (rts_argv[arg][3] != '\0')
+ gran_mpacktime = decode(rts_argv[arg]+3);
+ else
+ gran_mpacktime = MSGPACKTIME;
+ break;
+
+ case 'x':
+ if (rts_argv[arg][3] != '\0')
+ gran_mtidytime = decode(rts_argv[arg]+3);
+ else
+ gran_mtidytime = 0;
+ break;
+
+ case 'r':
+ if (rts_argv[arg][3] != '\0')
+ gran_munpacktime = decode(rts_argv[arg]+3);
+ else
+ gran_munpacktime = MSGUNPACKTIME;
+ break;
+
+ case 'f':
+ if (rts_argv[arg][3] != '\0')
+ gran_fetchtime = decode(rts_argv[arg]+3);
+ else
+ gran_fetchtime = FETCHTIME;
+ break;
+
+ case 'n':
+ if (rts_argv[arg][3] != '\0')
+ gran_gunblocktime = decode(rts_argv[arg]+3);
+ else
+ gran_gunblocktime = GLOBALUNBLOCKTIME;
+ break;
+
+ case 'u':
+ if (rts_argv[arg][3] != '\0')
+ gran_lunblocktime = decode(rts_argv[arg]+3);
+ else
+ gran_lunblocktime = LOCALUNBLOCKTIME;
+ break;
+
+ /* Thread-related metrics */
+ case 't':
+ if (rts_argv[arg][3] != '\0')
+ gran_threadcreatetime = decode(rts_argv[arg]+3);
+ else
+ gran_threadcreatetime = THREADCREATETIME;
+ break;
+
+ case 'q':
+ if (rts_argv[arg][3] != '\0')
+ gran_threadqueuetime = decode(rts_argv[arg]+3);
+ else
+ gran_threadqueuetime = THREADQUEUETIME;
+ break;
+
+ case 'c':
+ if (rts_argv[arg][3] != '\0')
+ gran_threadscheduletime = decode(rts_argv[arg]+3);
+ else
+ gran_threadscheduletime = THREADSCHEDULETIME;
+
+ gran_threadcontextswitchtime = gran_threadscheduletime
+ + gran_threaddescheduletime;
+ break;
+
+ case 'd':
+ if (rts_argv[arg][3] != '\0')
+ gran_threaddescheduletime = decode(rts_argv[arg]+3);
+ else
+ gran_threaddescheduletime = THREADDESCHEDULETIME;
+
+ gran_threadcontextswitchtime = gran_threadscheduletime
+ + gran_threaddescheduletime;
+ break;
+
+ /* Instruction Cost Metrics */
+ case 'A':
+ if (rts_argv[arg][3] != '\0')
+ gran_arith_cost = decode(rts_argv[arg]+3);
+ else
+ gran_arith_cost = ARITH_COST;
+ break;
+
+ case 'F':
+ if (rts_argv[arg][3] != '\0')
+ gran_float_cost = decode(rts_argv[arg]+3);
+ else
+ gran_float_cost = FLOAT_COST;
+ break;
+
+ case 'B':
+ if (rts_argv[arg][3] != '\0')
+ gran_branch_cost = decode(rts_argv[arg]+3);
+ else
+ gran_branch_cost = BRANCH_COST;
+ break;
+
+ case 'L':
+ if (rts_argv[arg][3] != '\0')
+ gran_load_cost = decode(rts_argv[arg]+3);
+ else
+ gran_load_cost = LOAD_COST;
+ break;
+
+ case 'S':
+ if (rts_argv[arg][3] != '\0')
+ gran_store_cost = decode(rts_argv[arg]+3);
+ else
+ gran_store_cost = STORE_COST;
+ break;
+
+ case 'H':
+ if (rts_argv[arg][3] != '\0')
+ gran_heapalloc_cost = decode(rts_argv[arg]+3);
+ else
+ gran_heapalloc_cost = 0;
+ break;
+
+ case 'y':
+ if (rts_argv[arg][3] != '\0')
+ FetchStrategy = decode(rts_argv[arg]+3);
+ else
+ FetchStrategy = 4; /* default: fetch everything */
+ break;
+
+ /* General Parameters */
+ case 'p':
+ if (rts_argv[arg][3] != '\0')
+ {
+ max_proc = decode(rts_argv[arg]+3);
+ if(max_proc > MAX_PROC || max_proc < 1)
+ {
+ fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n", MAX_PROC);
+ error = rtsTrue;
+ }
+ }
+ else
+ max_proc = MAX_PROC;
+ break;
+
+ case 'C':
+ ++DoAlwaysCreateThreads;
+ ++DoThreadMigration;
+ break;
+
+ case 'G':
+ ++DoGUMMFetching;
+ break;
+
+ case 'M':
+ ++DoThreadMigration;
+ break;
+
+ case 'R':
+ ++DoFairSchedule;
+ break;
+
+ case 'T':
+ ++DoStealThreadsFirst;
+ ++DoThreadMigration;
+ break;
+
+ case 'Z':
+ ++DoReScheduleOnFetch;
+ break;
+
+ case 'z':
+ ++SimplifiedFetch;
+ break;
+
+ case 'N':
+ ++PreferSparksOfLocalNodes;
+ break;
+
+ case 'b':
+ RTSflags.ParFlags.granSimStats_Binary = rtsTrue;
+ break;
+
+ case 'P':
+ RTSflags.ParFlags.granSimStats = rtsTrue;
+ break;
+
+ case 's':
+ ++do_sp_profile;
+ break;
+
+ case '-':
+ switch(rts_argv[arg][3]) {
+
+ case 'C':
+ DoAlwaysCreateThreads=0;
+ DoThreadMigration=0;
+ break;
+
+ case 'G':
+ DoGUMMFetching=0;
+ break;
+
+ case 'M':
+ DoThreadMigration=0;
+ break;
+
+ case 'R':
+ DoFairSchedule=0;
+ break;
+
+ case 'T':
+ DoStealThreadsFirst=0;
+ DoThreadMigration=0;
+ break;
+
+ case 'Z':
+ DoReScheduleOnFetch=0;
+ break;
+
+ case 'N':
+ PreferSparksOfLocalNodes=0;
+ break;
+
+ case 'P':
+ RTSflags.ParFlags.granSimStats = rtsFalse;
+ no_gr_profile=1;
+ break;
+
+ case 's':
+ do_sp_profile=0;
+ break;
+
+ case 'b':
+ RTSflags.ParFlags.granSimStats_Binary = rtsFalse;
+ break;
+
+ default:
+ bad_option( rts_argv[arg] );
+ break;
+ }
+ break;
+
+# if defined(GRAN_CHECK) && defined(GRAN)
+ case 'D':
+ switch(rts_argv[arg][3]) {
+ case 'e': /* event trace */
+ fprintf(stderr,"Printing event trace.\n");
+ ++event_trace;
+ break;
+
+ case 'f':
+ fprintf(stderr,"Printing forwarding of FETCHNODES.\n");
+ debug |= 0x2; /* print fwd messages */
+ break;
+
+ case 'z':
+ fprintf(stderr,"Check for blocked on fetch.\n");
+ debug |= 0x4; /* debug non-reschedule-on-fetch */
+ break;
+
+ case 't':
+ fprintf(stderr,"Check for TSO asleep on fetch.\n");
+ debug |= 0x10; /* debug TSO asleep for fetch */
+ break;
+
+ case 'E':
+ fprintf(stderr,"Printing event statistics.\n");
+ debug |= 0x20; /* print event statistics */
+ break;
+
+ case 'F':
+ fprintf(stderr,"Prohibiting forward.\n");
+ NoForward = 1; /* prohibit forwarding */
+ break;
+
+ case 'm':
+ fprintf(stderr,"Printing fetch misses.\n");
+ PrintFetchMisses = 1; /* prohibit forwarding */
+ break;
+
+ case 'd':
+ fprintf(stderr,"Debug mode.\n");
+ debug |= 0x40;
+ break;
+
+ case 'D':
+ fprintf(stderr,"Severe debug mode.\n");
+ debug |= 0x80;
+ break;
+
+ case '\0':
+ debug = 1;
+ break;
+
+ default:
+ bad_option( rts_argv[arg] );
+ break;
+ }
+ break;
+# endif
+ default:
+ bad_option( rts_argv[arg] );
+ break;
+ }
+ }
+ do_gr_sim++;
+ RTSflags.ConcFlags.ctxtSwitchTime = 0;
+}
+#endif /* GRAN */
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Profiling RTS Arguments}
+%* *
+%************************************************************************
+
+\begin{code}
+I_ MaxResidency = 0; /* in words; for stats only */
+I_ ResidencySamples = 0; /* for stats only */
+
+void
+initSM(void)
+{
+ RTSflags.GcFlags.minAllocAreaSize
+ = (I_) (RTSflags.GcFlags.heapSize * RTSflags.GcFlags.pcFreeHeap / 100);
+ /*
+ This needs to be here, in case the user changed some of these
+ values with a "hook".
+ */
+}
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Utility bits}
+%* *
+%************************************************************************
+
+\begin{code}
+static FILE * /* return NULL on error */
+open_stats_file (
+ I_ arg,
+ int argc, char *argv[],
+ int rts_argc, char *rts_argv[],
+ const char *FILENAME_FMT)
+{
+ FILE *f = NULL;
+
+ if (strequal(rts_argv[arg]+2, "stderr")) /* use real stderr */
+ f = stderr;
+ else if (rts_argv[arg][2] != '\0') /* stats file specified */
+ f = fopen(rts_argv[arg]+2,"w");
+ else {
+ char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.<ext> */
+ sprintf(stats_filename, FILENAME_FMT, argv[0]);
+ f = fopen(stats_filename,"w");
+ }
+ if (f == NULL) {
+ fprintf(stderr, "Can't open stats file %s\n", rts_argv[arg]+2);
+ } else {
+ /* 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 ");
+ for(count = 0; count < rts_argc; count++)
+ fprintf(f, "%s ", rts_argv[count]);
+ fprintf(f, "\n");
+ }
+
+ return(f);
+}
+
+static I_
+decode(const char *s)
+{
+ I_ c;
+ StgDouble m;
+
+ if (!*s)
+ return 0;
+
+ m = atof(s);
+ c = s[strlen(s)-1];
+
+ if (c == 'g' || c == 'G')
+ m *= 1000*1000*1000; /* UNchecked! */
+ else if (c == 'm' || c == 'M')
+ m *= 1000*1000; /* We do not use powers of 2 (1024) */
+ else if (c == 'k' || c == 'K') /* to avoid possible bad effects on */
+ m *= 1000; /* a direct-mapped cache. */
+ else if (c == 'w' || c == 'W')
+ m *= sizeof(W_);
+
+ return (I_)m;
+}
+
+static void
+bad_option(const char *s)
+{
+ fflush(stdout);
+ fprintf(stderr, "initSM: Bad RTS option: %s\n", s);
+ EXIT(EXIT_FAILURE);
+}
+\end{code}
projects / ghc-hetmet.git / blobdiff