ghc/runtime/main/RtsFlags.lc

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
   3 %
   4 \section{Runtime-system runtime flags}
   5
   6 Everything to do with RTS runtime flags, including RTS parameters
   7 that can be set by them, either directly or indirectly.
   8
   9 @rtsFlags.lh@ defines the data structure that holds all of them.
  10
  11 \begin{code}
  12 #include "rtsdefs.h"
  13
  14 struct RTS_FLAGS RTSflags; /* actually declare the data structure */
  15 struct ALL_FLAGS AllFlags;
  16
  17 /* some fwd decls */
  18 static I_     decode(const char *);
  19 static void   bad_option(const char *);
  20 static FILE * open_stats_file (I_ arg,
  21                 int argc, char *argv[], int rts_argc, char *rts_argv[],
  22                 const char *FILENAME_FMT);
  23
  24 /* extern decls */
  25 long strtol  PROTO((const char *, char **, int));
  26 \end{code}
  27
  28 %************************************************************************
  29 %*                                                                      *
  30 \subsection{Initial default values for @RTSFlags@}
  31 %*                                                                      *
  32 %************************************************************************
  33
  34 \begin{code}
  35 void
  36 initRtsFlagsDefaults (STG_NO_ARGS)
  37 {
  38     RTSflags.GcFlags.statsFile          = NULL;
  39     RTSflags.GcFlags.giveStats          = NO_GC_STATS;
  40
  41     RTSflags.GcFlags.stksSize           = 0x10002;  /* 2^16 = 16Kwords = 64Kbytes */
  42     RTSflags.GcFlags.heapSize           = 0x100002; /* 2^20 =  1Mwords =  4Mbytes  */
  43     RTSflags.GcFlags.allocAreaSize      = 0x4002;   /* 2^14 = 16Kwords = 64Kbytes;
  44                                                        plus 2 cache-friendly words */
  45     RTSflags.GcFlags.allocAreaSizeGiven = rtsFalse;
  46     RTSflags.GcFlags.specifiedOldGenSize= 0;    /* means: use all heap available */
  47     RTSflags.GcFlags.pcFreeHeap         = 3;    /* 3% */
  48     /* minAllocAreaSize is derived; set in initSM,
  49        after we know pcFreeHeap and heapSize */
  50
  51     RTSflags.GcFlags.force2s            = rtsFalse;
  52     RTSflags.GcFlags.forceGC            = rtsFalse;
  53     RTSflags.GcFlags.forcingInterval    = 5000000; /* 5MB (or words?) */
  54     RTSflags.GcFlags.ringBell           = rtsFalse;
  55     RTSflags.GcFlags.trace              = 0; /* not turned on */
  56
  57     RTSflags.GcFlags.lazyBlackHoling    = rtsTrue;
  58     RTSflags.GcFlags.doSelectorsAtGC    = rtsTrue;
  59     RTSflags.GcFlags.squeezeUpdFrames   = rtsTrue;
  60
  61 #if defined(PROFILING) || defined(PAR)
  62     RTSflags.CcFlags.doCostCentres      = 0;
  63     RTSflags.CcFlags.sortBy             = SORTCC_TIME;
  64
  65     /* "ctxtSwitchTicks", "profilerTicks", & "msecsPerTick" are
  66         derived info, so they are set after ctxtSwitchTime has been
  67         determined.
  68     */
  69 #endif /* PROFILING or PAR */
  70
  71 #ifdef PROFILING
  72     RTSflags.ProfFlags.doHeapProfile    = rtsFalse;
  73 #endif /* PROFILING */
  74
  75 #ifdef CONCURRENT
  76     RTSflags.ConcFlags.ctxtSwitchTime   = CS_MIN_MILLISECS;  /* In milliseconds */
  77     RTSflags.ConcFlags.maxThreads       = 32;
  78     RTSflags.ConcFlags.stkChunkSize     = 1024;
  79     RTSflags.ConcFlags.maxLocalSparks   = 500;
  80 #endif /* CONCURRENT */
  81
  82 #ifdef PAR
  83     RTSflags.ParFlags.parallelStats     = rtsFalse;
  84     RTSflags.ParFlags.granSimStats      = rtsFalse;
  85     RTSflags.ParFlags.granSimStats_Binary = rtsFalse;
  86
  87     RTSflags.ParFlags.outputDisabled    = rtsFalse;
  88
  89     RTSflags.ParFlags.packBufferSize    = 1024;
  90 #endif /* PAR */
  91
  92 #ifdef TICKY_TICKY
  93     RTSflags.TickyFlags.showTickyStats  = rtsFalse;
  94     RTSflags.TickyFlags.tickyFile       = NULL;
  95
  96     AllFlags.doUpdEntryCounts           = rtsTrue; /*ToDo:move? */
  97 #endif
  98 }
  99 \end{code}
 100
 101 %************************************************************************
 102 %*                                                                      *
 103 \subsection{Usage message for runtime-system (RTS) flags}
 104 %*                                                                      *
 105 %************************************************************************
 106
 107 \begin{code}
 108 static const char *
 109 usage_text[] = {
 110 "",
 111 "Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>",
 112 "",
 113 "   +RTS    Indicates run time system options follow",
 114 "   -RTS    Indicates program arguments follow",
 115 "  --RTS    Indicates that ALL subsequent arguments will be given to the",
 116 "           program (including any of these RTS flags)",
 117 "",
 118 "The following run time system options are available:",
 119 "",
 120 "  -? -f    Prints this message and exits; the program is not executed",
 121 "",
 122 "  -K<size> Sets the stack size (default 64k)    Egs: -K32k   -K512k",
 123 "  -H<size> Sets the heap size  (default 4M)          -H512k  -H16M",
 124 "  -s<file> Summary GC statistics   (default file: <program>.stat)",
 125 "  -S<file> Detailed GC statistics  (with -Sstderr going to stderr)",
 126 "",
 127 #if defined(GCap)
 128 "  -M<n>%   Sets minimum size of alloc area as % of heap (default 3%)",
 129 "  -A<size> Fixes size of alloc area, overriding any minimum (-A gives 64k)",
 130 "  -G<size> Fixes size of major generation (default is dynamic threshold)",
 131 "  -F2s     Forces program compiled for Appel gc to use 2s collection",
 132 #else
 133 # if defined(GCgn)
 134 "  -A<size> Specifies size of alloc area (default 64k)",
 135 "  -G<size> Fixes size of major generation (default is available heap)",
 136 "  -F2s     Forces program compiled for Gen gc to use 2s collection",
 137 # else
 138 "  -M<n>%   Minimum % of heap which must be available (default 3%)",
 139 "  -A<size> Fixes size of heap area allocated between GCs (-A gives 64k)",
 140 # endif
 141 #endif
 142 "  -j<size> Forces major GC at every <size> bytes allocated",
 143 #if defined(GCdu)
 144 "  -u<percent> Fixes residency threshold at which mode switches (range 0.0..0.95)",
 145 #endif
 146 "",
 147 "  -N       No black-holing during GC (for use when a signal handler is present)",
 148 "  -Z       Don't squeeze out update frames on stack overflow",
 149 "  -B       Sound the bell at the start of each (major) garbage collection",
 150 #if defined(PROFILING) || defined(PAR)
 151 "",
 152 "  -p<sort> Produce cost centre time profile  (output file <program>.prof)",
 153 "             sort: T = time (default), A = alloc, C = cost centre label",
 154 "  -P<sort> Produce serial time profile (output file <program>.time)",
 155 "             and a -p profile with detailed caf/enter/tick/alloc info",
 156 # if defined(PROFILING)
 157 "",
 158 "  -h<break-down> Heap residency profile      (output file <program>.hp)",
 159 "     break-down: C = cost centre (default), M = module, G = group",
 160 "                 D = closure description, Y = type description",
 161 "                 T<ints>,<start> = time closure created",
 162 "                    ints:  no. of interval bands plotted (default 18)",
 163 "                    start: seconds after which intervals start (default 0.0)",
 164 "  A subset of closures may be selected by the attached cost centre using:",
 165 "    -c{mod:lab,mod:lab...}, specific module:label cost centre(s)",
 166 "    -m{mod,mod...} all cost centres from the specified modules(s)",
 167 "    -g{grp,grp...} all cost centres from the specified group(s)",
 168 "  Selections can also be made by description, type, kind and age:",
 169 "    -d{des,des...} closures with specified closure descriptions",
 170 "    -y{typ,typ...} closures with specified type descriptions",
 171 "    -k{knd,knd...} closures of the specified kinds",
 172 "    -a<age>        closures which survived <age> complete intervals",
 173 "  The selection logic used is summarised as follows:",
 174 "    ([-c] or [-m] or [-g]) and ([-d] or [-y] or [-k]) and [-a]",
 175 "    where an option is true if not specified",
 176 # endif
 177 "",
 178 "  -z<tbl><size>  set hash table <size> for <tbl> (C, M, G, D or Y)",
 179 "",
 180 "  -i<secs> Number of seconds in a profiling interval (default 1.0):",
 181 "           heap profile (-h) and/or serial time profile (-P) frequency",
 182 #endif /* PROFILING or PAR */
 183 "",
 184 #if defined(TICKY_TICKY)
 185 "  -r<file>  Produce reduction profiling statistics (with -rstderr for stderr)",
 186 "",
 187 #endif
 188 "  -T<level> Trace garbage collection execution (debugging)",
 189 #ifdef CONCURRENT
 190 "",
 191 # ifdef PAR
 192 "  -N<n>     Use <n> PVMish processors in parallel (default: 2)",
 193 /* NB: the -N<n> is implemented by the driver!! */
 194 # endif
 195 "  -C<secs>  Context-switch interval in seconds",
 196 "                (0 or no argument means switch as often as possible)",
 197 "                the default is .01 sec; resolution is .01 sec",
 198 "  -e<size>        Size of spark pools (default 100)",
 199 # ifdef PAR
 200 "  -q        Enable activity profile (output files in ~/<program>*.gr)",
 201 "  -qb       Enable binary activity profile (output file /tmp/<program>.gb)",
 202 "  -Q<size>  Set pack-buffer size (default: 1024)",
 203 # else
 204 "  -q[v]     Enable quasi-parallel profile (output file <program>.qp)",
 205 # endif
 206 "  -t<num>   Set maximum number of advisory threads per PE (default 32)",
 207 "  -o<num>   Set stack chunk size (default 1024)",
 208 # ifdef PAR
 209 "  -d        Turn on PVM-ish debugging",
 210 "  -O        Disable output for performance measurement",
 211 # endif /* PAR */
 212 #endif /* CONCURRENT */
 213 "",
 214 "Other RTS options may be available for programs compiled a different way.",
 215 "The GHC User's Guide has full details.",
 216 "",
 217 0
 218 };
 219 \end{code}
 220
 221 %************************************************************************
 222 %*                                                                      *
 223 \subsection{Processing command-line arguments to set @RTSFlags@}
 224 %*                                                                      *
 225 %************************************************************************
 226
 227 \begin{code}
 228 #define RTS 1
 229 #define PGM 0
 230
 231 #ifndef atof
 232 extern double atof();
 233 /* no proto because some machines use const and some do not */
 234 #endif
 235
 236 static __inline__ rtsBool
 237 strequal(const char *a, const char * b)
 238 {
 239     return(strcmp(a, b) == 0);
 240 }
 241
 242 void
 243 setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
 244 {
 245     rtsBool error = rtsFalse;
 246     I_ mode;
 247     I_ arg, total_arg;
 248     char *last_slash;
 249
 250     /* Remove directory from argv[0] -- default files in current directory */
 251
 252     if ((last_slash = (char *) strrchr(argv[0], '/')) != NULL)
 253         strcpy(argv[0], last_slash+1);
 254
 255     /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */
 256     /*   argv[0] must be PGM argument -- leave in argv                 */
 257
 258     total_arg = *argc;
 259     arg = 1;
 260
 261     *argc = 1;
 262     *rts_argc = 0;
 263
 264     for (mode = PGM; arg < total_arg && ! strequal("--RTS", argv[arg]); arg++) {
 265         if (strequal("+RTS", argv[arg])) {
 266             mode = RTS;
 267         }
 268         else if (strequal("-RTS", argv[arg])) {
 269             mode = PGM;
 270         }
 271         else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
 272             rts_argv[(*rts_argc)++] = argv[arg];
 273         }
 274         else if (mode == PGM) {
 275             argv[(*argc)++] = argv[arg];
 276         }
 277         else {
 278             fflush(stdout);
 279             fprintf(stderr, "setupRtsFlags: Too many RTS arguments (max %d)\n",
 280                     MAX_RTS_ARGS-1);
 281             EXIT(EXIT_FAILURE);
 282         }
 283     }
 284     if (arg < total_arg) {
 285         /* arg must be --RTS; process remaining program arguments */
 286         while (++arg < total_arg) {
 287             argv[(*argc)++] = argv[arg];
 288         }
 289     }
 290     argv[*argc] = (char *) 0;
 291     rts_argv[*rts_argc] = (char *) 0;
 292
 293     /* Process RTS (rts_argv) part: mainly to determine statsfile */
 294
 295     for (arg = 0; arg < *rts_argc; arg++) {
 296         if (rts_argv[arg][0] != '-') {
 297             fflush(stdout);
 298             fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n",
 299                     rts_argv[arg]);
 300             error = rtsTrue;
 301
 302         } else {
 303             switch(rts_argv[arg][1]) {
 304
 305               /* process: general args, then PROFILING-only ones,
 306                  then CONCURRENT-only, PARallel-only, GRAN-only,
 307                  TICKY-only (same order as defined in RtsFlags.lh);
 308                  within those groups, mostly in case-insensitive
 309                  alphabetical order.
 310               */
 311
 312 #ifdef TICKY_TICKY
 313 # define TICKY_BUILD_ONLY(x) x
 314 #else
 315 # define TICKY_BUILD_ONLY(x) \
 316 fprintf(stderr, "setupRtsFlags: GHC not built for: ticky-ticky stats\n"); \
 317 error = rtsTrue;
 318 #endif
 319
 320 #if (defined(PROFILING) || defined(PAR))
 321 # define COST_CENTRE_USING_BUILD_ONLY(x) x
 322 #else
 323 # define COST_CENTRE_USING_BUILD_ONLY(x) \
 324 fprintf(stderr, "setupRtsFlags: GHC not built for: -prof or -parallel\n"); \
 325 error = rtsTrue;
 326 #endif
 327
 328 #ifdef PROFILING
 329 # define PROFILING_BUILD_ONLY(x)
 330 #else
 331 # define PROFILING_BUILD_ONLY(x) \
 332 fprintf(stderr, "setupRtsFlags: GHC not built for: -prof\n"); \
 333 error = rtsTrue;
 334 #endif
 335
 336 #ifdef CONCURRENT
 337 # define CONCURRENT_BUILD_ONLY(x)
 338 #else
 339 # define CONCURRENT_BUILD_ONLY(x) \
 340 fprintf(stderr, "setupRtsFlags: GHC not built for: -concurrent\n"); \
 341 error = rtsTrue;
 342 #endif
 343
 344 #ifdef PAR
 345 # define PAR_BUILD_ONLY(x)
 346 #else
 347 # define PAR_BUILD_ONLY(x) \
 348 fprintf(stderr, "setupRtsFlags: GHC not built for: -parallel\n"); \
 349 error = rtsTrue;
 350 #endif
 351
 352 #ifdef GRAN
 353 # define GRAN_BUILD_ONLY(x)
 354 #else
 355 # define GRAN_BUILD_ONLY(x) \
 356 fprintf(stderr, "setupRtsFlags: GHC not built for: -gransim\n"); \
 357 error = rtsTrue;
 358 #endif
 359
 360               /* =========== GENERAL ========================== */
 361               case '?':
 362               case 'f':
 363                 error = rtsTrue;
 364                 break;
 365
 366               case 'A':
 367                 RTSflags.GcFlags.allocAreaSize
 368                   = decode(rts_argv[arg]+2) / sizeof(W_);
 369                 RTSflags.GcFlags.allocAreaSizeGiven = rtsTrue;
 370                 break;
 371
 372               case 'B':
 373                 RTSflags.GcFlags.ringBell = rtsTrue;
 374                 break;
 375
 376               case 'F':
 377                 if (strequal(rts_argv[arg]+2, "2s")) {
 378                     RTSflags.GcFlags.force2s = rtsTrue;
 379                 } else {
 380                     bad_option( rts_argv[arg] );
 381                 }
 382                 break;
 383
 384               case 'G':
 385                 RTSflags.GcFlags.specifiedOldGenSize
 386                   = decode(rts_argv[arg]+2) / sizeof(W_);
 387                 break;
 388
 389               case 'K':
 390                 RTSflags.GcFlags.stksSize = decode(rts_argv[arg]+2) / sizeof(W_);
 391
 392                 if (RTSflags.GcFlags.stksSize == 0) bad_option( rts_argv[arg] );
 393                 break;
 394
 395               case 'H':
 396                 RTSflags.GcFlags.heapSize = decode(rts_argv[arg]+2) / sizeof(W_);
 397                 /* user give size in *bytes* but "heapSize" is in *words* */
 398
 399                 if (RTSflags.GcFlags.heapSize <= 0) bad_option(rts_argv[arg]);
 400                 break;
 401
 402               case 'j': /* force GC option */
 403                 RTSflags.GcFlags.forceGC = rtsTrue;
 404                 if (rts_argv[arg][2]) {
 405                     RTSflags.GcFlags.forcingInterval
 406                         = decode(rts_argv[arg]+2) / sizeof(W_);
 407                 }
 408                 break;
 409
 410               case 'M':
 411                 RTSflags.GcFlags.pcFreeHeap = atof(rts_argv[arg]+2);
 412
 413                 if (RTSflags.GcFlags.pcFreeHeap < 0 || RTSflags.GcFlags.pcFreeHeap > 100)
 414                     bad_option( rts_argv[arg] );
 415                 break;
 416
 417               case 'N':
 418                 RTSflags.GcFlags.lazyBlackHoling = rtsFalse;
 419                 break;
 420
 421               case 'n':
 422                 RTSflags.GcFlags.doSelectorsAtGC = rtsFalse;
 423                 break;
 424
 425               case 'S': /* NB: no difference at present ! */
 426               case 's':
 427                 RTSflags.GcFlags.giveStats ++; /* will be VERBOSE_GC_STATS */
 428 #ifdef PAR
 429                 /* Opening all those files would almost certainly fail... */
 430                 RTSflags.ParFlags.parallelStats = rtsTrue;
 431                 RTSflags.GcFlags.statsFile = stderr; /* temporary; ToDo: rm */
 432 #else
 433                 RTSflags.GcFlags.statsFile
 434                   = open_stats_file(arg, *argc, argv,
 435                         *rts_argc, rts_argv, STAT_FILENAME_FMT);
 436
 437                 if (RTSflags.GcFlags.statsFile == NULL) error = rtsTrue;
 438 #endif
 439                 break;
 440
 441               case 'T':
 442                 if (rts_argv[arg][2] != '\0')
 443                     RTSflags.GcFlags.trace
 444                       = (W_) strtol(rts_argv[arg]+2, (char **)NULL, 0);
 445                 else
 446                     RTSflags.GcFlags.trace = 1; /* slightly weird; why, really? */
 447                 break;
 448
 449               case 'Z':
 450                 RTSflags.GcFlags.squeezeUpdFrames = rtsFalse;
 451                 break;
 452
 453               /* =========== PROFILING ========================== */
 454
 455               case 'P': /* detailed cost centre profiling (time/alloc) */
 456                 COST_CENTRE_USING_BUILD_ONLY(
 457                 RTSflags.CcFlags.doCostCentres++;
 458                 )
 459               case 'p': /* cost centre profiling (time/alloc) */
 460                 COST_CENTRE_USING_BUILD_ONLY(
 461                 RTSflags.CcFlags.doCostCentres++;
 462
 463                 switch (rts_argv[arg][2]) {
 464                   case SORTCC_LABEL:
 465                   case SORTCC_TIME:
 466                   case SORTCC_ALLOC:
 467                         RTSflags.CcFlags.sortBy = rts_argv[arg][2];
 468                     break;
 469                   default:
 470                     fprintf(stderr, "Invalid profiling sort option %s\n", rts_argv[arg]);
 471                     error = 1;
 472                 }
 473                 ) break;
 474
 475               case 'i': /* serial profiling -- initial timer interval */
 476                 COST_CENTRE_USING_BUILD_ONLY(
 477                 interval_ticks = (I_) ((atof(rts_argv[arg]+2) * TICK_FREQUENCY));
 478                 if (interval_ticks <= 0)
 479                     interval_ticks = 1;
 480                 ) break;
 481
 482               case 'h': /* serial heap profile */
 483                 PROFILING_BUILD_ONLY(
 484                 switch (rts_argv[arg][2]) {
 485                   case '\0':
 486                   case CCchar:
 487                     RTSflags.ProfFlags.doHeapProfile = HEAP_BY_CC;
 488                     break;
 489                   case MODchar:
 490                     RTSflags.ProfFlags.doHeapProfile = HEAP_BY_MOD;
 491                     break;
 492                   case GRPchar:
 493                     RTSflags.ProfFlags.doHeapProfile = HEAP_BY_GRP;
 494                     break;
 495                   case DESCRchar:
 496                     RTSflags.ProfFlags.doHeapProfile = HEAP_BY_DESCR;
 497                     break;
 498                   case TYPEchar:
 499                     RTSflags.ProfFlags.doHeapProfile = HEAP_BY_TYPE;
 500                     break;
 501                   case TIMEchar:
 502                     RTSflags.ProfFlags.doHeapProfile = HEAP_BY_TIME;
 503                     if (rts_argv[arg][3]) {
 504                         char *start_str = strchr(rts_argv[arg]+3, ',');
 505                         I_ intervals;
 506                         if (start_str) *start_str = '\0';
 507
 508                         if ((intervals = decode(rts_argv[arg]+3)) != 0) {
 509                             time_intervals = (hash_t) intervals;
 510                             /* ToDo: and what if it *is* zero intervals??? */
 511                         }
 512                         if (start_str) {
 513                             earlier_ticks = (I_)((atof(start_str + 1) * TICK_FREQUENCY));
 514                         }
 515                     }
 516                     break;
 517                   default:
 518                     fprintf(stderr, "Invalid heap profile option: %s\n",
 519                             rts_argv[arg]);
 520                     error = 1;
 521                 }
 522                 ) break;
 523
 524               case 'z': /* size of index tables */
 525                 PROFILING_BUILD_ONLY(
 526                 switch (rts_argv[arg][2]) {
 527                   case CCchar:
 528                     max_cc_no = (hash_t) decode(rts_argv[arg]+3);
 529                     if (max_cc_no == 0) {
 530                         fprintf(stderr, "Bad number of cost centres %s\n", rts_argv[arg]);
 531                         error = 1;
 532                     }
 533                     break;
 534                   case MODchar:
 535                     max_mod_no = (hash_t) decode(rts_argv[arg]+3);
 536                     if (max_mod_no == 0) {
 537                         fprintf(stderr, "Bad number of modules %s\n", rts_argv[arg]);
 538                         error = 1;
 539                     }
 540                     break;
 541                   case GRPchar:
 542                     max_grp_no = (hash_t) decode(rts_argv[arg]+3);
 543                     if (max_grp_no == 0) {
 544                         fprintf(stderr, "Bad number of groups %s\n", rts_argv[arg]);
 545                         error = 1;
 546                     }
 547                     break;
 548                   case DESCRchar:
 549                     max_descr_no = (hash_t) decode(rts_argv[arg]+3);
 550                     if (max_descr_no == 0) {
 551                         fprintf(stderr, "Bad number of closure descriptions %s\n", rts_argv[arg]);
 552                         error = 1;
 553                     }
 554                     break;
 555                   case TYPEchar:
 556                     max_type_no = (hash_t) decode(rts_argv[arg]+3);
 557                     if (max_type_no == 0) {
 558                         fprintf(stderr, "Bad number of type descriptions %s\n", rts_argv[arg]);
 559                         error = 1;
 560                     }
 561                     break;
 562                   default:
 563                     fprintf(stderr, "Invalid index table size option: %s\n",
 564                             rts_argv[arg]);
 565                     error = 1;
 566                 }
 567                 ) break;
 568
 569               case 'c': /* cost centre label select */
 570               case 'm': /* cost centre module select */
 571               case 'g': /* cost centre group select */
 572               case 'd': /* closure descr select */
 573               case 'y': /* closure type select */
 574               case 'k': /* closure kind select */
 575                 PROFILING_BUILD_ONLY(
 576
 577                 left  = strchr(rts_argv[arg], '{');
 578                 right = strrchr(rts_argv[arg], '}');
 579                 if (! left || ! right ||
 580                         strrchr(rts_argv[arg], '{') != left ||
 581                          strchr(rts_argv[arg], '}') != right) {
 582                     fprintf(stderr, "Invalid heap profiling selection bracketing\n   %s\n", rts_argv[arg]);
 583                     error = 1;
 584                 } else {
 585                     *right = '\0';
 586                     switch (rts_argv[arg][1]) {
 587                       case 'c': /* cost centre label select */
 588                         select_cc = left + 1;
 589                         break;
 590                       case 'm': /* cost centre module select */
 591                         select_mod = left + 1;
 592                         break;
 593                       case 'g': /* cost centre group select */
 594                         select_grp = left + 1;
 595                         break;
 596                       case 'd': /* closure descr select */
 597                         select_descr = left + 1;
 598                         break;
 599                       case 't': /* closure type select */
 600                         select_type = left + 1;
 601                         break;
 602                       case 'k': /* closure kind select */
 603                         select_kind = left + 1;
 604                         break;
 605                 }
 606                 }
 607                 ) break;
 608
 609               /* =========== CONCURRENT ========================= */
 610               case 'C': /* context switch interval */
 611                 CONCURRENT_BUILD_ONLY (
 612                 if (rts_argv[arg][2] == '\0')
 613                     RTSflags.ConcFlags.ctxtSwitchTime = 0;
 614                 else {
 615                     I_ cst; /* tmp */
 616
 617                     /* Convert to milliseconds */
 618                     cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
 619                     cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS;
 620                     if (cst < CS_MIN_MILLISECS)
 621                         cst = CS_MIN_MILLISECS;
 622
 623                     RTSflags.ConcFlags.ctxtSwitchTime = cst;
 624                 }
 625                 ) break;
 626
 627               case 't':
 628                 CONCURRENT_BUILD_ONLY(
 629                 if (rts_argv[arg][2] != '\0') {
 630                     RTSflags.ConcFlags.maxThreads
 631                       = strtol(rts_argv[arg]+2, (char **) NULL, 10);
 632                 } else {
 633                     fprintf(stderr, "setupRtsFlags: missing size for -t\n");
 634                     error = rtsTrue;
 635                 }
 636                 ) break;
 637
 638               case 'o':
 639                 CONCURRENT_BUILD_ONLY (
 640                 if (rts_argv[arg][2] != '\0') {
 641                     I_ size = decode(rts_argv[arg]+2);
 642
 643                     if (size < MIN_STKO_CHUNK_SIZE)
 644                         size = MIN_STKO_CHUNK_SIZE;
 645
 646                     RTSflags.ConcFlags.stkChunkSize = size;
 647                 } else {
 648                     fprintf(stderr, "setupRtsFlags: missing size for -o\n");
 649                     error = rtsTrue;
 650                 }
 651                 ) break;
 652
 653               /* =========== PARALLEL =========================== */
 654               case 'e':
 655                 CONCURRENT_BUILD_ONLY(
 656                 if (rts_argv[arg][2] != '\0') { /* otherwise, stick w/ the default */
 657
 658                     RTSflags.ConcFlags.maxLocalSparks
 659                       = strtol(rts_argv[arg]+2, (char **) NULL, 10);
 660
 661                     if (RTSflags.ConcFlags.maxLocalSparks <= 0) {
 662                         fprintf(stderr, "setupRtsFlags: bad value for -e\n");
 663                         error = rtsTrue;
 664                     }
 665                 }
 666                 ) break;
 667
 668               case 'O':
 669                 PAR_BUILD_ONLY(
 670                 RTSflags.ParFlags.outputDisabled = rtsTrue;
 671                 ) break;
 672
 673               case 'q': /* activity profile option */
 674                 PAR_BUILD_ONLY(
 675                 if (rts_argv[arg][2] == 'b')
 676                     RTSflags.ParFlags.granSimStats_Binary = rtsTrue;
 677                 else
 678                     RTSflags.ParFlags.granSimStats = rtsTrue;
 679                 ) break;
 680
 681 #if 0 /* or??? */
 682               case 'q': /* quasi-parallel profile option */
 683                 GRAN_BUILD_ONLY (
 684                 if (rts_argv[arg][2] == 'v')
 685                     do_qp_prof = 2;
 686                 else
 687                     do_qp_prof++;
 688                 ) break;
 689 #endif /* 0??? */
 690
 691               case 'Q': /* Set pack buffer size */
 692                 PAR_BUILD_ONLY(
 693                 if (rts_argv[arg][2] != '\0') {
 694                     RTSflags.ParFlags.packBufferSize = decode(rts_argv[arg]+2);
 695                 } else {
 696                     fprintf(stderr, "setupRtsFlags: missing size of PackBuffer (for -Q)\n");
 697                     error = rtsTrue;
 698                 }
 699                 ) break;
 700
 701               /* =========== GRAN =============================== */
 702
 703               case 'b':
 704                 GRAN_BUILD_ONLY(
 705                 process_gran_option();
 706                 ) break;
 707
 708               /* =========== TICKY ============================== */
 709
 710               case 'r': /* Basic profiling stats */
 711                 TICKY_BUILD_ONLY(
 712
 713                 RTSflags.TickyFlags.showTickyStats = rtsTrue;
 714                 RTSflags.TickyFlags.tickyFile
 715                   = open_stats_file(arg, *argc, argv,
 716                         *rts_argc, rts_argv, TICKY_FILENAME_FMT);
 717
 718                 if (RTSflags.TickyFlags.tickyFile == NULL) error = rtsTrue;
 719                 ) break;
 720
 721               /* =========== OH DEAR ============================ */
 722               default:
 723                 fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n",rts_argv[arg]);
 724                 error = rtsTrue;
 725                 break;
 726             }
 727         }
 728     }
 729     if (error) {
 730         const char **p;
 731
 732         fflush(stdout);
 733         for (p = usage_text; *p; p++)
 734             fprintf(stderr, "%s\n", *p);
 735         EXIT(EXIT_FAILURE);
 736     }
 737
 738 }
 739
 740 #ifdef GRAN
 741 static void
 742 process_gran_option()
 743 {
 744     if (rts_argv[arg][2] != '\0') {
 745
 746       /* Should we emulate hbcpp */
 747       if(strequal((rts_argv[arg]+2),"roken")) {
 748         ++DoAlwaysCreateThreads;
 749         strcpy(rts_argv[arg]+2,"oring");
 750       }
 751
 752       /* or a ridiculously idealised simulator */
 753       if(strequal((rts_argv[arg]+2),"oring")) {
 754         gran_latency = gran_fetchtime = gran_additional_latency =
 755           gran_gunblocktime = gran_lunblocktime
 756             = gran_threadcreatetime = gran_threadqueuetime
 757               = gran_threadscheduletime = gran_threaddescheduletime
 758                 = gran_threadcontextswitchtime
 759                   = 0;
 760
 761         gran_mpacktime = gran_munpacktime = 0;
 762
 763         gran_arith_cost = gran_float_cost = gran_load_cost
 764           = gran_store_cost = gran_branch_cost = 0;
 765
 766         gran_heapalloc_cost = 1;
 767
 768         /* ++DoFairSchedule; */
 769         ++DoStealThreadsFirst;
 770         ++DoThreadMigration;
 771         RTSflags.ParFlags.granSimStats = rtsTrue;
 772       }
 773
 774       /* or a ridiculously idealised simulator */
 775       if(strequal((rts_argv[arg]+2),"onzo")) {
 776         gran_latency = gran_fetchtime = gran_additional_latency =
 777           gran_gunblocktime = gran_lunblocktime
 778             = gran_threadcreatetime = gran_threadqueuetime
 779               = gran_threadscheduletime = gran_threaddescheduletime
 780                 = gran_threadcontextswitchtime
 781                   = 0;
 782
 783         gran_mpacktime = gran_munpacktime = 0;
 784
 785         /* Keep default values for these
 786         gran_arith_cost = gran_float_cost = gran_load_cost
 787           = gran_store_cost = gran_branch_cost = 0;
 788           */
 789
 790         gran_heapalloc_cost = 1;
 791
 792         /* ++DoFairSchedule; */       /* -b-R */
 793         /* ++DoStealThreadsFirst; */  /* -b-T */
 794         ++DoReScheduleOnFetch;        /* -bZ */
 795         ++DoThreadMigration;          /* -bM */
 796         RTSflags.ParFlags.granSimStats = rtsTrue; /* -bP */
 797 #   if defined(GRAN_CHECK) && defined(GRAN)
 798         debug = 0x20;       /* print event statistics   */
 799 #   endif
 800       }
 801
 802       /* Communication and task creation cost parameters */
 803       else switch(rts_argv[arg][2]) {
 804         case 'l':
 805           if (rts_argv[arg][3] != '\0')
 806             {
 807               gran_gunblocktime = gran_latency = decode(rts_argv[arg]+3);
 808               gran_fetchtime = 2* gran_latency;
 809             }
 810           else
 811             gran_latency = LATENCY;
 812           break;
 813
 814         case 'a':
 815           if (rts_argv[arg][3] != '\0')
 816             gran_additional_latency = decode(rts_argv[arg]+3);
 817           else
 818             gran_additional_latency = ADDITIONAL_LATENCY;
 819           break;
 820
 821         case 'm':
 822           if (rts_argv[arg][3] != '\0')
 823             gran_mpacktime = decode(rts_argv[arg]+3);
 824           else
 825             gran_mpacktime = MSGPACKTIME;
 826           break;
 827
 828         case 'x':
 829           if (rts_argv[arg][3] != '\0')
 830             gran_mtidytime = decode(rts_argv[arg]+3);
 831           else
 832             gran_mtidytime = 0;
 833           break;
 834
 835         case 'r':
 836           if (rts_argv[arg][3] != '\0')
 837             gran_munpacktime = decode(rts_argv[arg]+3);
 838           else
 839             gran_munpacktime = MSGUNPACKTIME;
 840           break;
 841
 842         case 'f':
 843           if (rts_argv[arg][3] != '\0')
 844             gran_fetchtime = decode(rts_argv[arg]+3);
 845           else
 846             gran_fetchtime = FETCHTIME;
 847           break;
 848
 849         case 'n':
 850           if (rts_argv[arg][3] != '\0')
 851             gran_gunblocktime = decode(rts_argv[arg]+3);
 852           else
 853             gran_gunblocktime = GLOBALUNBLOCKTIME;
 854           break;
 855
 856         case 'u':
 857           if (rts_argv[arg][3] != '\0')
 858             gran_lunblocktime = decode(rts_argv[arg]+3);
 859           else
 860             gran_lunblocktime = LOCALUNBLOCKTIME;
 861           break;
 862
 863         /* Thread-related metrics */
 864         case 't':
 865           if (rts_argv[arg][3] != '\0')
 866             gran_threadcreatetime = decode(rts_argv[arg]+3);
 867           else
 868             gran_threadcreatetime = THREADCREATETIME;
 869           break;
 870
 871         case 'q':
 872           if (rts_argv[arg][3] != '\0')
 873             gran_threadqueuetime = decode(rts_argv[arg]+3);
 874           else
 875             gran_threadqueuetime = THREADQUEUETIME;
 876           break;
 877
 878         case 'c':
 879           if (rts_argv[arg][3] != '\0')
 880             gran_threadscheduletime = decode(rts_argv[arg]+3);
 881           else
 882             gran_threadscheduletime = THREADSCHEDULETIME;
 883
 884           gran_threadcontextswitchtime = gran_threadscheduletime
 885                                        + gran_threaddescheduletime;
 886           break;
 887
 888         case 'd':
 889           if (rts_argv[arg][3] != '\0')
 890             gran_threaddescheduletime = decode(rts_argv[arg]+3);
 891           else
 892             gran_threaddescheduletime = THREADDESCHEDULETIME;
 893
 894           gran_threadcontextswitchtime = gran_threadscheduletime
 895                                        + gran_threaddescheduletime;
 896           break;
 897
 898         /* Instruction Cost Metrics */
 899         case 'A':
 900           if (rts_argv[arg][3] != '\0')
 901             gran_arith_cost = decode(rts_argv[arg]+3);
 902           else
 903             gran_arith_cost = ARITH_COST;
 904           break;
 905
 906         case 'F':
 907           if (rts_argv[arg][3] != '\0')
 908             gran_float_cost = decode(rts_argv[arg]+3);
 909           else
 910             gran_float_cost = FLOAT_COST;
 911           break;
 912
 913         case 'B':
 914           if (rts_argv[arg][3] != '\0')
 915             gran_branch_cost = decode(rts_argv[arg]+3);
 916           else
 917             gran_branch_cost = BRANCH_COST;
 918           break;
 919
 920         case 'L':
 921           if (rts_argv[arg][3] != '\0')
 922             gran_load_cost = decode(rts_argv[arg]+3);
 923           else
 924             gran_load_cost = LOAD_COST;
 925           break;
 926
 927         case 'S':
 928           if (rts_argv[arg][3] != '\0')
 929             gran_store_cost = decode(rts_argv[arg]+3);
 930           else
 931             gran_store_cost = STORE_COST;
 932           break;
 933
 934         case 'H':
 935           if (rts_argv[arg][3] != '\0')
 936             gran_heapalloc_cost = decode(rts_argv[arg]+3);
 937           else
 938             gran_heapalloc_cost = 0;
 939           break;
 940
 941         case 'y':
 942           if (rts_argv[arg][3] != '\0')
 943             FetchStrategy = decode(rts_argv[arg]+3);
 944           else
 945             FetchStrategy = 4; /* default: fetch everything */
 946           break;
 947
 948         /* General Parameters */
 949         case 'p':
 950           if (rts_argv[arg][3] != '\0')
 951             {
 952               max_proc = decode(rts_argv[arg]+3);
 953               if(max_proc > MAX_PROC || max_proc < 1)
 954                 {
 955                   fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n", MAX_PROC);
 956                   error = rtsTrue;
 957                 }
 958             }
 959           else
 960             max_proc = MAX_PROC;
 961           break;
 962
 963         case 'C':
 964           ++DoAlwaysCreateThreads;
 965           ++DoThreadMigration;
 966           break;
 967
 968         case 'G':
 969           ++DoGUMMFetching;
 970           break;
 971
 972         case 'M':
 973           ++DoThreadMigration;
 974           break;
 975
 976         case 'R':
 977           ++DoFairSchedule;
 978           break;
 979
 980         case 'T':
 981           ++DoStealThreadsFirst;
 982           ++DoThreadMigration;
 983           break;
 984
 985         case 'Z':
 986           ++DoReScheduleOnFetch;
 987           break;
 988
 989         case 'z':
 990           ++SimplifiedFetch;
 991           break;
 992
 993         case 'N':
 994           ++PreferSparksOfLocalNodes;
 995           break;
 996
 997         case 'b':
 998           RTSflags.ParFlags.granSimStats_Binary = rtsTrue;
 999           break;
1000
1001         case 'P':
1002           RTSflags.ParFlags.granSimStats = rtsTrue;
1003           break;
1004
1005         case 's':
1006           ++do_sp_profile;
1007           break;
1008
1009         case '-':
1010           switch(rts_argv[arg][3]) {
1011
1012            case 'C':
1013              DoAlwaysCreateThreads=0;
1014              DoThreadMigration=0;
1015              break;
1016
1017            case 'G':
1018              DoGUMMFetching=0;
1019              break;
1020
1021            case 'M':
1022              DoThreadMigration=0;
1023              break;
1024
1025             case 'R':
1026              DoFairSchedule=0;
1027              break;
1028
1029            case 'T':
1030              DoStealThreadsFirst=0;
1031              DoThreadMigration=0;
1032              break;
1033
1034            case 'Z':
1035              DoReScheduleOnFetch=0;
1036              break;
1037
1038            case 'N':
1039              PreferSparksOfLocalNodes=0;
1040              break;
1041
1042            case 'P':
1043              RTSflags.ParFlags.granSimStats = rtsFalse;
1044              no_gr_profile=1;
1045              break;
1046
1047            case 's':
1048              do_sp_profile=0;
1049              break;
1050
1051            case 'b':
1052              RTSflags.ParFlags.granSimStats_Binary = rtsFalse;
1053              break;
1054
1055            default:
1056              bad_option( rts_argv[arg] );
1057              break;
1058            }
1059           break;
1060
1061 #   if defined(GRAN_CHECK) && defined(GRAN)
1062         case 'D':
1063           switch(rts_argv[arg][3]) {
1064               case 'e':       /* event trace */
1065                 fprintf(stderr,"Printing event trace.\n");
1066                 ++event_trace;
1067                 break;
1068
1069               case 'f':
1070                 fprintf(stderr,"Printing forwarding of FETCHNODES.\n");
1071                 debug |= 0x2; /* print fwd messages */
1072                 break;
1073
1074               case 'z':
1075                 fprintf(stderr,"Check for blocked on fetch.\n");
1076                 debug |= 0x4; /* debug non-reschedule-on-fetch */
1077                 break;
1078
1079               case 't':
1080                 fprintf(stderr,"Check for TSO asleep on fetch.\n");
1081                 debug |= 0x10; /* debug TSO asleep for fetch  */
1082                 break;
1083
1084               case 'E':
1085                 fprintf(stderr,"Printing event statistics.\n");
1086                 debug |= 0x20; /* print event statistics   */
1087                 break;
1088
1089               case 'F':
1090                 fprintf(stderr,"Prohibiting forward.\n");
1091                 NoForward = 1; /* prohibit forwarding   */
1092                 break;
1093
1094               case 'm':
1095                 fprintf(stderr,"Printing fetch misses.\n");
1096                 PrintFetchMisses = 1; /* prohibit forwarding   */
1097                 break;
1098
1099               case 'd':
1100                 fprintf(stderr,"Debug mode.\n");
1101                 debug |= 0x40;
1102                 break;
1103
1104               case 'D':
1105                 fprintf(stderr,"Severe debug mode.\n");
1106                 debug |= 0x80;
1107                 break;
1108
1109               case '\0':
1110                 debug = 1;
1111                 break;
1112
1113               default:
1114                 bad_option( rts_argv[arg] );
1115                 break;
1116               }
1117           break;
1118 #   endif
1119         default:
1120           bad_option( rts_argv[arg] );
1121           break;
1122         }
1123     }
1124     do_gr_sim++;
1125     RTSflags.ConcFlags.ctxtSwitchTime = 0;
1126 }
1127 #endif /* GRAN */
1128 \end{code}
1129
1130 %************************************************************************
1131 %*                                                                      *
1132 \subsection{Profiling RTS Arguments}
1133 %*                                                                      *
1134 %************************************************************************
1135
1136 \begin{code}
1137 I_ MaxResidency = 0;     /* in words; for stats only */
1138 I_ ResidencySamples = 0; /* for stats only */
1139
1140 void
1141 initSM(void)
1142 {
1143     RTSflags.GcFlags.minAllocAreaSize
1144       = (I_) (RTSflags.GcFlags.heapSize * RTSflags.GcFlags.pcFreeHeap / 100);
1145     /*
1146         This needs to be here, in case the user changed some of these
1147         values with a "hook".
1148     */
1149 }
1150 \end{code}
1151
1152 %************************************************************************
1153 %*                                                                      *
1154 \subsection{Utility bits}
1155 %*                                                                      *
1156 %************************************************************************
1157
1158 \begin{code}
1159 static FILE *           /* return NULL on error */
1160 open_stats_file (
1161     I_ arg,
1162     int argc, char *argv[],
1163     int rts_argc, char *rts_argv[],
1164     const char *FILENAME_FMT)
1165 {
1166     FILE *f = NULL;
1167
1168     if (strequal(rts_argv[arg]+2, "stderr")) /* use real stderr */
1169         f = stderr;
1170     else if (rts_argv[arg][2] != '\0')      /* stats file specified */
1171         f = fopen(rts_argv[arg]+2,"w");
1172     else {
1173         char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.<ext> */
1174         sprintf(stats_filename, FILENAME_FMT, argv[0]);
1175         f = fopen(stats_filename,"w");
1176     }
1177     if (f == NULL) {
1178         fprintf(stderr, "Can't open stats file %s\n", rts_argv[arg]+2);
1179     } else {
1180         /* Write argv and rtsv into start of stats file */
1181         I_ count;
1182         for(count = 0; count < argc; count++)
1183             fprintf(f, "%s ", argv[count]);
1184         fprintf(f, "+RTS ");
1185         for(count = 0; count < rts_argc; count++)
1186             fprintf(f, "%s ", rts_argv[count]);
1187         fprintf(f, "\n");
1188     }
1189
1190     return(f);
1191 }
1192
1193 static I_
1194 decode(const char *s)
1195 {
1196     I_ c;
1197     StgDouble m;
1198
1199     if (!*s)
1200         return 0;
1201
1202     m = atof(s);
1203     c = s[strlen(s)-1];
1204
1205     if (c == 'g' || c == 'G')
1206         m *= 1000*1000*1000;    /* UNchecked! */
1207     else if (c == 'm' || c == 'M')
1208         m *= 1000*1000;                 /* We do not use powers of 2 (1024) */
1209     else if (c == 'k' || c == 'K')      /* to avoid possible bad effects on */
1210         m *= 1000;                      /* a direct-mapped cache.           */
1211     else if (c == 'w' || c == 'W')
1212         m *= sizeof(W_);
1213
1214     return (I_)m;
1215 }
1216
1217 static void
1218 bad_option(const char *s)
1219 {
1220   fflush(stdout);
1221   fprintf(stderr, "initSM: Bad RTS option: %s\n", s);
1222   EXIT(EXIT_FAILURE);
1223 }
1224 \end{code}