1615934b1973a54d32e09a1c5db80d4615125f3b
[ghc-hetmet.git] / ghc / rts / RtsFlags.c
1 /* -----------------------------------------------------------------------------
2  * $Id: RtsFlags.c,v 1.15 1999/08/25 16:11:50 simonmar Exp $
3  *
4  * (c) The AQUA Project, Glasgow University, 1994-1997
5  * (c) The GHC Team, 1998-1999
6  *
7  * Functions for parsing the argument list.
8  *
9  * ---------------------------------------------------------------------------*/
10
11 #include "Rts.h"
12 #include "RtsFlags.h"
13 #include "RtsUtils.h"
14 #include "BlockAlloc.h"
15 #include "ProfRts.h"
16
17 #if HAVE_STDLIB_H
18 #include <stdlib.h>
19 #endif
20
21 #ifdef HAVE_STRING_H
22 #include <string.h>
23 #endif
24
25 extern struct RTS_FLAGS RtsFlags;
26
27 /*
28  * Split argument lists
29  */
30 int     prog_argc; /* an "int" so as to match normal "argc" */
31 char  **prog_argv = NULL;
32 int     rts_argc;  /* ditto */
33 char   *rts_argv[MAX_RTS_ARGS];
34
35 /*
36  * constants, used later 
37  */
38 #define RTS 1
39 #define PGM 0
40
41 /* -----------------------------------------------------------------------------
42    Static function decls
43    -------------------------------------------------------------------------- */
44
45 static FILE *           /* return NULL on error */
46 open_stats_file (
47     I_ arg,
48     int argc, char *argv[],
49     int rts_argc, char *rts_argv[],
50     const char *FILENAME_FMT);
51
52 static I_ decode(const char *s);
53 static void bad_option(const char *s);
54
55 /* -----------------------------------------------------------------------------
56  * Command-line option parsing routines.
57  * ---------------------------------------------------------------------------*/
58
59 void initRtsFlagsDefaults(void)
60 {
61     RtsFlags.GcFlags.statsFile          = NULL;
62     RtsFlags.GcFlags.giveStats          = NO_GC_STATS;
63
64     RtsFlags.GcFlags.maxStkSize         = (1024 * 1024) / sizeof(W_);
65     RtsFlags.GcFlags.initialStkSize     = 1024 / sizeof(W_);
66
67     RtsFlags.GcFlags.minAllocAreaSize   = (256 * 1024)        / BLOCK_SIZE;
68     RtsFlags.GcFlags.minOldGenSize      = (1024 * 1024)       / BLOCK_SIZE;
69     RtsFlags.GcFlags.maxHeapSize        = (64  * 1024 * 1024) / BLOCK_SIZE;
70     RtsFlags.GcFlags.heapSizeSuggestion = 0;    /* none */
71     RtsFlags.GcFlags.pcFreeHeap         = 3;    /* 3% */
72     RtsFlags.GcFlags.oldGenFactor       = 2;
73     RtsFlags.GcFlags.generations        = 2;
74     RtsFlags.GcFlags.steps              = 2;
75
76     RtsFlags.GcFlags.forceGC            = rtsFalse;
77     RtsFlags.GcFlags.forcingInterval    = 5000000; /* 5MB (or words?) */
78     RtsFlags.GcFlags.ringBell           = rtsFalse;
79
80     RtsFlags.GcFlags.squeezeUpdFrames   = rtsTrue;
81
82 #if defined(PROFILING) || defined(PAR)
83     RtsFlags.CcFlags.doCostCentres      = 0;
84     RtsFlags.CcFlags.sortBy             = SORTCC_TIME;
85 #endif /* PROFILING or PAR */
86
87 #ifdef PROFILING
88     RtsFlags.ProfFlags.doHeapProfile = rtsFalse;
89
90     RtsFlags.ProfFlags.ccSelector    = NULL;
91     RtsFlags.ProfFlags.modSelector   = NULL;
92     RtsFlags.ProfFlags.grpSelector   = NULL;
93     RtsFlags.ProfFlags.descrSelector = NULL;
94     RtsFlags.ProfFlags.typeSelector  = NULL;
95     RtsFlags.ProfFlags.kindSelector  = NULL;
96 #elif defined(DEBUG)
97     RtsFlags.ProfFlags.doHeapProfile = rtsFalse;
98 #endif
99
100     RtsFlags.ConcFlags.ctxtSwitchTime   = CS_MIN_MILLISECS;  /* In milliseconds */
101 #ifdef PAR
102     RtsFlags.ParFlags.parallelStats     = rtsFalse;
103     RtsFlags.ParFlags.granSimStats      = rtsFalse;
104     RtsFlags.ParFlags.granSimStats_Binary = rtsFalse;
105
106     RtsFlags.ParFlags.outputDisabled    = rtsFalse;
107
108     RtsFlags.ParFlags.packBufferSize    = 1024;
109     RtsFlags.ParFlags.maxLocalSparks    = 4096;
110 #endif /* PAR */
111
112 #ifdef GRAN
113     RtsFlags.GranFlags.granSimStats     = rtsFalse;
114     RtsFlags.GranFlags.granSimStats_suppressed  = rtsFalse;
115     RtsFlags.GranFlags.granSimStats_Binary = rtsFalse;
116     RtsFlags.GranFlags.granSimStats_Sparks = rtsFalse;
117     RtsFlags.GranFlags.granSimStats_Heap = rtsFalse;
118     RtsFlags.GranFlags.labelling        = rtsFalse;
119     RtsFlags.GranFlags.packBufferSize   = 1024;
120     RtsFlags.GranFlags.packBufferSize_internal = GRANSIM_DEFAULT_PACK_BUFFER_SIZE;
121
122     RtsFlags.GranFlags.proc  = MAX_PROC;
123     RtsFlags.GranFlags.max_fishes = MAX_FISHES;
124     RtsFlags.GranFlags.time_slice = GRAN_TIME_SLICE;
125     RtsFlags.GranFlags.Light = rtsFalse;
126
127     RtsFlags.GranFlags.gran_latency =             LATENCY;          
128     RtsFlags.GranFlags.gran_additional_latency =  ADDITIONAL_LATENCY; 
129     RtsFlags.GranFlags.gran_fetchtime =           FETCHTIME; 
130     RtsFlags.GranFlags.gran_lunblocktime =        LOCALUNBLOCKTIME; 
131     RtsFlags.GranFlags.gran_gunblocktime =        GLOBALUNBLOCKTIME;
132     RtsFlags.GranFlags.gran_mpacktime =           MSGPACKTIME;      
133     RtsFlags.GranFlags.gran_munpacktime =         MSGUNPACKTIME;
134     RtsFlags.GranFlags.gran_mtidytime =           MSGTIDYTIME;
135
136     RtsFlags.GranFlags.gran_threadcreatetime =         THREADCREATETIME;
137     RtsFlags.GranFlags.gran_threadqueuetime =          THREADQUEUETIME;
138     RtsFlags.GranFlags.gran_threaddescheduletime =     THREADDESCHEDULETIME;
139     RtsFlags.GranFlags.gran_threadscheduletime =       THREADSCHEDULETIME;
140     RtsFlags.GranFlags.gran_threadcontextswitchtime =  THREADCONTEXTSWITCHTIME;
141
142     RtsFlags.GranFlags.gran_arith_cost =         ARITH_COST;       
143     RtsFlags.GranFlags.gran_branch_cost =        BRANCH_COST; 
144     RtsFlags.GranFlags.gran_load_cost =          LOAD_COST;        
145     RtsFlags.GranFlags.gran_store_cost =         STORE_COST; 
146     RtsFlags.GranFlags.gran_float_cost =         FLOAT_COST;       
147
148     RtsFlags.GranFlags.gran_heapalloc_cost =     HEAPALLOC_COST;
149
150     RtsFlags.GranFlags.gran_pri_spark_overhead = PRI_SPARK_OVERHEAD;        
151     RtsFlags.GranFlags.gran_pri_sched_overhead = PRI_SCHED_OVERHEAD;        
152
153     RtsFlags.GranFlags.DoFairSchedule = rtsFalse;             
154     RtsFlags.GranFlags.DoReScheduleOnFetch = rtsFalse;        
155     RtsFlags.GranFlags.DoStealThreadsFirst = rtsFalse;        
156     RtsFlags.GranFlags.SimplifiedFetch = rtsFalse;            
157     RtsFlags.GranFlags.DoAlwaysCreateThreads = rtsFalse;      
158     RtsFlags.GranFlags.DoGUMMFetching = rtsFalse;             
159     RtsFlags.GranFlags.DoThreadMigration = rtsFalse;          
160     RtsFlags.GranFlags.FetchStrategy = 2;                     
161     RtsFlags.GranFlags.PreferSparksOfLocalNodes = rtsFalse;   
162     RtsFlags.GranFlags.DoPrioritySparking = rtsFalse;         
163     RtsFlags.GranFlags.DoPriorityScheduling = rtsFalse;       
164     RtsFlags.GranFlags.SparkPriority = 0;
165     RtsFlags.GranFlags.SparkPriority2 = 0; 
166     RtsFlags.GranFlags.RandomPriorities = rtsFalse;           
167     RtsFlags.GranFlags.InversePriorities = rtsFalse;          
168     RtsFlags.GranFlags.IgnorePriorities = rtsFalse;           
169     RtsFlags.GranFlags.ThunksToPack = 0;                      
170     RtsFlags.GranFlags.RandomSteal = rtsTrue;
171     RtsFlags.GranFlags.NoForward = rtsFalse;
172     RtsFlags.GranFlags.PrintFetchMisses = rtsFalse;
173
174     RtsFlags.GranFlags.debug = 0x0;
175     RtsFlags.GranFlags.event_trace = rtsFalse;
176     RtsFlags.GranFlags.event_trace_all = rtsFalse;
177 #endif
178
179 #ifdef TICKY_TICKY
180     RtsFlags.TickyFlags.showTickyStats   = rtsFalse;
181     RtsFlags.TickyFlags.tickyFile        = NULL;
182 #endif
183 }
184
185 static const char *
186 usage_text[] = {
187 "",
188 "Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>",
189 "",
190 "   +RTS    Indicates run time system options follow",
191 "   -RTS    Indicates program arguments follow",
192 "  --RTS    Indicates that ALL subsequent arguments will be given to the",
193 "           program (including any of these RTS flags)",
194 "",
195 "The following run time system options are available:",
196 "",
197 "  -? -f    Prints this message and exits; the program is not executed",
198 "",
199 "  -K<size> Sets the maximum stack size (default 1M)  Egs: -K32k   -K512k",
200 "  -k<size> Sets the initial thread stack size (default 1k)  Egs: -K4k   -K2m",
201 "",
202 "  -A<size> Sets the minimum allocation area size (default 256k) Egs: -A1m -A10k",
203 "  -M<size> Sets the maximum heap size (default 64M)  Egs: -M256k -M1G",
204 "  -H<size> Sets the minimum heap size (default 0M)   Egs: -H24m  -H1G",
205 "  -m<n>%   Minimum % of heap which must be available (default 3%)",
206 "  -G<n>    Number of generations (default: 2)",
207 "  -T<n>    Number of steps in younger generations (default: 2)",
208 "  -s<file> Summary GC statistics   (default file: <program>.stat)",
209 "  -S<file> Detailed GC statistics  (with -Sstderr going to stderr)",
210 "",
211 "",
212 "  -Z       Don't squeeze out update frames on stack overflow",
213 "  -B       Sound the bell at the start of each garbage collection",
214 #if defined(PROFILING) || defined(PAR)
215 "",
216 "  -p<sort> Produce cost centre time profile  (output file <program>.prof)",
217 "             sort: T = time (default), A = alloc, C = cost centre label",
218 "  -P<sort> Produce serial time profile (output file <program>.time)",
219 "             and a -p profile with detailed tick/alloc info",
220 # if defined(PROFILING)
221 "",
222 "  -h<break-down> Heap residency profile      (output file <program>.hp)",
223 "     break-down: C = cost centre (default), M = module, G = group",
224 "                 D = closure description, Y = type description",
225 "                 T<ints>,<start> = time closure created",
226 "                    ints:  no. of interval bands plotted (default 18)",
227 "                    start: seconds after which intervals start (default 0.0)",
228 "  A subset of closures may be selected by the attached cost centre using:",
229 "    -c{mod:lab,mod:lab...}, specific module:label cost centre(s)",
230 "    -m{mod,mod...} all cost centres from the specified modules(s)",
231 "    -g{grp,grp...} all cost centres from the specified group(s)",
232 "  Selections can also be made by description, type, kind and age:",
233 "    -d{des,des...} closures with specified closure descriptions",
234 "    -y{typ,typ...} closures with specified type descriptions",
235 "    -k{knd,knd...} closures of the specified kinds",
236 "    -a<age>        closures which survived <age> complete intervals",
237 "  The selection logic used is summarised as follows:",
238 "    ([-c] or [-m] or [-g]) and ([-d] or [-y] or [-k]) and [-a]",
239 "    where an option is true if not specified",
240 # endif
241 "",
242 "  -z<tbl><size>  set hash table <size> for <tbl> (C, M, G, D or Y)",
243 "",
244 "  -i<secs> Number of seconds in a profiling interval (default 1.0):",
245 "           heap profile (-h) and/or serial time profile (-P) frequency",
246 #endif /* PROFILING or PAR */
247 #if !defined(PROFILING) && defined(DEBUG)
248 "",
249 "  -h<break-down> Debugging Heap residency profile",
250 "                 (output file <program>.hp)",
251 "     break-down: L = closure label (default)",
252 "                 T = closure type (constructor, thunk etc.)",
253 #endif
254 "",
255 #if defined(TICKY_TICKY)
256 "  -r<file>  Produce reduction profiling statistics (with -rstderr for stderr)",
257 "",
258 #endif
259 # ifdef PAR
260 "  -N<n>     Use <n> PVMish processors in parallel (default: 2)",
261 /* NB: the -N<n> is implemented by the driver!! */
262 # endif
263 "  -C<secs>  Context-switch interval in seconds",
264 "                (0 or no argument means switch as often as possible)",
265 "                the default is .01 sec; resolution is .01 sec",
266 # ifdef PAR
267 "  -q        Enable activity profile (output files in ~/<program>*.gr)",
268 "  -qb       Enable binary activity profile (output file /tmp/<program>.gb)",
269 "  -Q<size>  Set pack-buffer size (default: 1024)",
270 # endif
271 # ifdef PAR
272 "  -d        Turn on PVM-ish debugging",
273 "  -O        Disable output for performance measurement",
274 # endif /* PAR */
275 # ifdef GRAN  /* ToDo: fill in decent Docu here */
276 "  -b...     All GranSim options start with -b; see GranSim User's Guide for details",
277 # endif
278 "",
279 "Other RTS options may be available for programs compiled a different way.",
280 "The GHC User's Guide has full details.",
281 "",
282 0
283 };
284
285 static __inline__ rtsBool
286 strequal(const char *a, const char * b)
287 {
288     return(strcmp(a, b) == 0);
289 }
290
291 void
292 setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
293 {
294     rtsBool error = rtsFalse;
295     I_ mode;
296     I_ arg, total_arg;
297     char *last_slash;
298
299     /* Remove directory from argv[0] -- default files in current directory */
300
301     if ((last_slash = (char *) strrchr(argv[0], '/')) != NULL)
302         strcpy(argv[0], last_slash+1);
303
304     /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */
305     /*   argv[0] must be PGM argument -- leave in argv                 */
306
307     total_arg = *argc;
308     arg = 1;
309
310     *argc = 1;
311     *rts_argc = 0;
312
313     for (mode = PGM; arg < total_arg && ! strequal("--RTS", argv[arg]); arg++) {
314         if (strequal("+RTS", argv[arg])) {
315             mode = RTS;
316         }
317         else if (strequal("-RTS", argv[arg])) {
318             mode = PGM;
319         }
320         else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
321             rts_argv[(*rts_argc)++] = argv[arg];
322         }
323         else if (mode == PGM) {
324             argv[(*argc)++] = argv[arg];
325         }
326         else {
327           barf("too many RTS arguments (max %d)", MAX_RTS_ARGS-1);
328         }
329     }
330     if (arg < total_arg) {
331         /* arg must be --RTS; process remaining program arguments */
332         while (++arg < total_arg) {
333             argv[(*argc)++] = argv[arg];
334         }
335     }
336     argv[*argc] = (char *) 0;
337     rts_argv[*rts_argc] = (char *) 0;
338
339     /* Process RTS (rts_argv) part: mainly to determine statsfile */
340
341     for (arg = 0; arg < *rts_argc; arg++) {
342         if (rts_argv[arg][0] != '-') {
343             fflush(stdout);
344             fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n",
345                     rts_argv[arg]);
346             error = rtsTrue;
347
348         } else {
349             switch(rts_argv[arg][1]) {
350
351               /* process: general args, then PROFILING-only ones,
352                  then CONCURRENT-only, PARallel-only, GRAN-only,
353                  TICKY-only (same order as defined in RtsFlags.lh);
354                  within those groups, mostly in case-insensitive
355                  alphabetical order.
356               */
357
358 #ifdef TICKY_TICKY
359 # define TICKY_BUILD_ONLY(x) x
360 #else
361 # define TICKY_BUILD_ONLY(x) \
362 fprintf(stderr, "setupRtsFlags: GHC not built for: ticky-ticky stats\n"); \
363 error = rtsTrue;
364 #endif
365
366 #if defined(PROFILING) 
367 # define COST_CENTRE_USING_BUILD_ONLY(x) x
368 #else
369 # define COST_CENTRE_USING_BUILD_ONLY(x) \
370 fprintf(stderr, "setupRtsFlags: GHC not built for: -prof or -parallel\n"); \
371 error = rtsTrue;
372 #endif
373
374 #ifdef PROFILING
375 # define PROFILING_BUILD_ONLY(x)   x
376 #else
377 # define PROFILING_BUILD_ONLY(x) \
378 fprintf(stderr, "setupRtsFlags: GHC not built for: -prof\n"); \
379 error = rtsTrue;
380 #endif
381
382 #ifdef PAR
383 # define PAR_BUILD_ONLY(x)      x
384 #else
385 # define PAR_BUILD_ONLY(x) \
386 fprintf(stderr, "setupRtsFlags: GHC not built for: -parallel\n"); \
387 error = rtsTrue;
388 #endif
389
390 #ifdef GRAN
391 # define GRAN_BUILD_ONLY(x)     x
392 #else
393 # define GRAN_BUILD_ONLY(x) \
394 fprintf(stderr, "setupRtsFlags: GHC not built for: -gransim\n"); \
395 error = rtsTrue;
396 #endif
397
398               /* =========== GENERAL ========================== */
399               case '?':
400               case 'f':
401                 error = rtsTrue;
402                 break;
403
404               case 'A':
405                 RtsFlags.GcFlags.minAllocAreaSize
406                   = decode(rts_argv[arg]+2) / BLOCK_SIZE;
407                 if (RtsFlags.GcFlags.minAllocAreaSize <= 0) {
408                   bad_option(rts_argv[arg]);
409                 }
410                 break;
411
412               case 'B':
413                 RtsFlags.GcFlags.ringBell = rtsTrue;
414                 break;
415
416               case 'F':
417                 RtsFlags.GcFlags.oldGenFactor = atof(rts_argv[arg]+2);
418               
419                 if (RtsFlags.GcFlags.oldGenFactor < 0)
420                   bad_option( rts_argv[arg] );
421                 break;
422               
423 #ifdef DEBUG
424               case 'D':
425                 /* hack warning: interpret the flags as a binary number */
426                 { 
427                    I_ n = decode(rts_argv[arg]+2);
428                    if (n     &1) RtsFlags.DebugFlags.scheduler   = rtsTrue;
429                    if ((n>>1)&1) RtsFlags.DebugFlags.evaluator   = rtsTrue;
430                    if ((n>>2)&1) RtsFlags.DebugFlags.codegen     = rtsTrue;
431                    if ((n>>3)&1) RtsFlags.DebugFlags.weak        = rtsTrue;
432                    if ((n>>4)&1) RtsFlags.DebugFlags.gccafs      = rtsTrue;
433                    if ((n>>5)&1) RtsFlags.DebugFlags.gc          = rtsTrue;
434                    if ((n>>6)&1) RtsFlags.DebugFlags.block_alloc = rtsTrue;
435                    if ((n>>7)&1) RtsFlags.DebugFlags.sanity      = rtsTrue;
436                    if ((n>>8)&1) RtsFlags.DebugFlags.stable      = rtsTrue;
437                    if ((n>>9)&1) RtsFlags.DebugFlags.prof        = rtsTrue;
438                 }
439                 break;
440 #endif
441
442               case 'K':
443                 RtsFlags.GcFlags.maxStkSize = 
444                   decode(rts_argv[arg]+2) / sizeof(W_);
445
446                 if (RtsFlags.GcFlags.maxStkSize == 0) 
447                   bad_option( rts_argv[arg] );
448                 break;
449
450               case 'k':
451                 RtsFlags.GcFlags.initialStkSize = 
452                   decode(rts_argv[arg]+2) / sizeof(W_);
453
454                 if (RtsFlags.GcFlags.initialStkSize == 0) 
455                   bad_option( rts_argv[arg] );
456                 break;
457
458               case 'M':
459                 RtsFlags.GcFlags.maxHeapSize = 
460                   decode(rts_argv[arg]+2) / BLOCK_SIZE;
461                 /* user give size in *bytes* but "maxHeapSize" is in *blocks* */
462
463                 if (RtsFlags.GcFlags.maxHeapSize <= 0) {
464                   bad_option(rts_argv[arg]);
465                 }
466                 break;
467
468               case 'm':
469                 RtsFlags.GcFlags.pcFreeHeap = atof(rts_argv[arg]+2);
470
471                 if (RtsFlags.GcFlags.pcFreeHeap < 0 || 
472                     RtsFlags.GcFlags.pcFreeHeap > 100)
473                   bad_option( rts_argv[arg] );
474                 break;
475
476               case 'G':
477                 RtsFlags.GcFlags.generations = decode(rts_argv[arg]+2);
478                 if (RtsFlags.GcFlags.generations < 1) {
479                   bad_option(rts_argv[arg]);
480                 }
481                 break;
482
483               case 'T':
484                 RtsFlags.GcFlags.steps = decode(rts_argv[arg]+2);
485                 if (RtsFlags.GcFlags.steps < 1) {
486                   bad_option(rts_argv[arg]);
487                 }
488                 break;
489
490               case 'H':
491                 RtsFlags.GcFlags.heapSizeSuggestion = 
492                   decode(rts_argv[arg]+2) / BLOCK_SIZE;
493
494                 if (RtsFlags.GcFlags.heapSizeSuggestion <= 0) {
495                   bad_option(rts_argv[arg]);
496                 }
497                 break;
498
499               case 'j': /* force GC option */
500                 RtsFlags.GcFlags.forceGC = rtsTrue;
501                 if (rts_argv[arg][2]) {
502                     RtsFlags.GcFlags.forcingInterval
503                         = decode(rts_argv[arg]+2) / sizeof(W_);
504                 }
505                 break;
506
507               case 'S':
508                 RtsFlags.GcFlags.giveStats ++;
509
510               case 's':
511                 RtsFlags.GcFlags.giveStats ++;
512 #ifdef PAR
513                 /* Opening all those files would almost certainly fail... */
514                 RtsFlags.ParFlags.parallelStats = rtsTrue;
515                 RtsFlags.GcFlags.statsFile = stderr; /* temporary; ToDo: rm */
516 #else
517                 RtsFlags.GcFlags.statsFile
518                   = open_stats_file(arg, *argc, argv,
519                         *rts_argc, rts_argv, STAT_FILENAME_FMT);
520
521                 if (RtsFlags.GcFlags.statsFile == NULL) error = rtsTrue;
522 #endif
523                 break;
524
525               case 'Z':
526                 RtsFlags.GcFlags.squeezeUpdFrames = rtsFalse;
527                 break;
528
529               /* =========== PROFILING ========================== */
530
531               case 'P': /* detailed cost centre profiling (time/alloc) */
532                 COST_CENTRE_USING_BUILD_ONLY(
533                 RtsFlags.CcFlags.doCostCentres++;
534                 )
535               case 'p': /* cost centre profiling (time/alloc) */
536                 COST_CENTRE_USING_BUILD_ONLY(
537                 RtsFlags.CcFlags.doCostCentres++;
538
539                 switch (rts_argv[arg][2]) {
540                   case SORTCC_LABEL:
541                   case SORTCC_TIME:
542                   case SORTCC_ALLOC:
543                         RtsFlags.CcFlags.sortBy = rts_argv[arg][2];
544                     break;
545                   default:
546                         RtsFlags.CcFlags.sortBy = SORTCC_TIME;
547                     break;
548                 }
549                 ) break;
550
551               case 'i': /* serial profiling -- initial timer interval */
552                 COST_CENTRE_USING_BUILD_ONLY(
553                 interval_ticks = (I_) ((atof(rts_argv[arg]+2) * TICK_FREQUENCY));
554                 if (interval_ticks <= 0)
555                     interval_ticks = 1;
556                 ) break;
557
558               case 'h': /* serial heap profile */
559 #if !defined(PROFILING) && defined(DEBUG)
560                 switch (rts_argv[arg][2]) {
561                   case '\0':
562                   case 'L':
563                     RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_INFOPTR;
564                     break;
565                   case 'T':
566                     RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE;
567                     break;
568                   default:
569                     fprintf(stderr, "Invalid heap profile option: %s\n",
570                             rts_argv[arg]);
571                     error = rtsTrue;
572                 }
573 #else
574                 PROFILING_BUILD_ONLY(
575                 switch (rts_argv[arg][2]) {
576                   case '\0':
577                   case CCchar:
578                     RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CC;
579                     break;
580                   case MODchar:
581                     RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_MOD;
582                     break;
583                   case GRPchar:
584                     RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_GRP;
585                     break;
586                   case DESCRchar:
587                     RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_DESCR;
588                     break;
589                   case TYPEchar:
590                     RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_TYPE;
591                     break;
592                   case TIMEchar:
593                     RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_TIME;
594                     if (rts_argv[arg][3]) {
595                         char *start_str = strchr(rts_argv[arg]+3, ',');
596                         I_ intervals;
597                         if (start_str) *start_str = '\0';
598
599                         if ((intervals = decode(rts_argv[arg]+3)) != 0) {
600                             time_intervals = (hash_t) intervals;
601                             /* ToDo: and what if it *is* zero intervals??? */
602                         }
603                         if (start_str) {
604                             earlier_ticks = (I_)((atof(start_str + 1) * TICK_FREQUENCY));
605                         }
606                     }
607                     break;
608                   default:
609                     fprintf(stderr, "Invalid heap profile option: %s\n",
610                             rts_argv[arg]);
611                     error = rtsTrue;
612                 }
613                 ) 
614 #endif
615                 break;
616
617               case 'z': /* size of index tables */
618                 PROFILING_BUILD_ONLY(
619                 switch (rts_argv[arg][2]) {
620                   case CCchar:
621                     max_cc_no = (hash_t) decode(rts_argv[arg]+3);
622                     if (max_cc_no == 0) {
623                         fprintf(stderr, "Bad number of cost centres %s\n", rts_argv[arg]);
624                         error = rtsTrue;
625                     }
626                     break;
627                   case MODchar:
628                     max_mod_no = (hash_t) decode(rts_argv[arg]+3);
629                     if (max_mod_no == 0) {
630                         fprintf(stderr, "Bad number of modules %s\n", rts_argv[arg]);
631                         error = rtsTrue;
632                     }
633                     break;
634                   case GRPchar:
635                     max_grp_no = (hash_t) decode(rts_argv[arg]+3);
636                     if (max_grp_no == 0) {
637                         fprintf(stderr, "Bad number of groups %s\n", rts_argv[arg]);
638                         error = rtsTrue;
639                     }
640                     break;
641                   case DESCRchar:
642                     max_descr_no = (hash_t) decode(rts_argv[arg]+3);
643                     if (max_descr_no == 0) {
644                         fprintf(stderr, "Bad number of closure descriptions %s\n", rts_argv[arg]);
645                         error = rtsTrue;
646                     }
647                     break;
648                   case TYPEchar:
649                     max_type_no = (hash_t) decode(rts_argv[arg]+3);
650                     if (max_type_no == 0) {
651                         fprintf(stderr, "Bad number of type descriptions %s\n", rts_argv[arg]);
652                         error = rtsTrue;
653                     }
654                     break;
655                   default:
656                     fprintf(stderr, "Invalid index table size option: %s\n",
657                             rts_argv[arg]);
658                     error = rtsTrue;
659                 }
660                 ) break;
661
662               case 'c': /* cost centre label select */
663               case 'g': /* cost centre group select */
664               case 'd': /* closure descr select */
665               case 'y': /* closure type select */
666                 PROFILING_BUILD_ONLY(
667                 {char *left  = strchr(rts_argv[arg], '{');
668                  char *right = strrchr(rts_argv[arg], '}');
669
670                 if (! left || ! right ||
671                         strrchr(rts_argv[arg], '{') != left ||
672                          strchr(rts_argv[arg], '}') != right) {
673                     fprintf(stderr, "Invalid heap profiling selection bracketing\n   %s\n", rts_argv[arg]);
674                     error = rtsTrue;
675                 } else {
676                     *right = '\0';
677                     switch (rts_argv[arg][1]) {
678                       case 'c': /* cost centre label select */
679                         RtsFlags.ProfFlags.ccSelector = left + 1;
680                         break;
681                       case 'm': /* cost centre module select */
682                         RtsFlags.ProfFlags.modSelector = left + 1;
683                         break;
684                       case 'g': /* cost centre group select */
685                         RtsFlags.ProfFlags.grpSelector = left + 1;
686                         break;
687                       case 'd': /* closure descr select */
688                         RtsFlags.ProfFlags.descrSelector = left + 1;
689                         break;
690                       case 'y': /* closure type select */
691                         RtsFlags.ProfFlags.typeSelector = left + 1;
692                         break;
693                       case 'k': /* closure kind select */
694                         RtsFlags.ProfFlags.kindSelector = left + 1;
695                         break;
696                     }
697                 }}
698                 ) break;
699
700               /* =========== CONCURRENT ========================= */
701               case 'C': /* context switch interval */
702                 if (rts_argv[arg][2] == '\0')
703                     RtsFlags.ConcFlags.ctxtSwitchTime = 0;
704                 else {
705                     I_ cst; /* tmp */
706
707                     /* Convert to milliseconds */
708                     cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
709                     cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS;
710                     if (cst < CS_MIN_MILLISECS)
711                         cst = CS_MIN_MILLISECS;
712
713                     RtsFlags.ConcFlags.ctxtSwitchTime = cst;
714                 }
715                 break;
716
717               /* =========== PARALLEL =========================== */
718               case 'e':
719                 PAR_BUILD_ONLY(
720                 if (rts_argv[arg][2] != '\0') { /* otherwise, stick w/ the default */
721
722                     RtsFlags.ParFlags.maxLocalSparks
723                       = strtol(rts_argv[arg]+2, (char **) NULL, 10);
724
725                     if (RtsFlags.ParFlags.maxLocalSparks <= 0) {
726                         fprintf(stderr, "setupRtsFlags: bad value for -e\n");
727                         error = rtsTrue;
728                     }
729                 }
730                 ) break;
731
732               case 'O':
733                 PAR_BUILD_ONLY(
734                 RtsFlags.ParFlags.outputDisabled = rtsTrue;
735                 ) break;
736
737               case 'q': /* activity profile option */
738                 PAR_BUILD_ONLY(
739                 if (rts_argv[arg][2] == 'b')
740                     RtsFlags.ParFlags.granSimStats_Binary = rtsTrue;
741                 else
742                     RtsFlags.ParFlags.granSimStats = rtsTrue;
743                 ) break;
744
745 #if 0 /* or??? */
746               case 'q': /* quasi-parallel profile option */
747                 GRAN_BUILD_ONLY (
748                 if (rts_argv[arg][2] == 'v')
749                     do_qp_prof = 2;
750                 else
751                     do_qp_prof++;
752                 ) break;
753 #endif /* 0??? */
754
755               case 'Q': /* Set pack buffer size */
756                 PAR_BUILD_ONLY(
757                 if (rts_argv[arg][2] != '\0') {
758                     RtsFlags.ParFlags.packBufferSize = decode(rts_argv[arg]+2);
759                 } else {
760                     fprintf(stderr, "setupRtsFlags: missing size of PackBuffer (for -Q)\n");
761                     error = rtsTrue;
762                 }
763                 ) break;
764
765               /* =========== GRAN =============================== */
766
767               case 'b':
768                 GRAN_BUILD_ONLY(
769                 process_gran_option(arg, rts_argc, rts_argv, &error);
770                 ) break;
771
772               /* =========== TICKY ============================== */
773
774               case 'r': /* Basic profiling stats */
775                 TICKY_BUILD_ONLY(
776
777                 RtsFlags.TickyFlags.showTickyStats = rtsTrue;
778                 RtsFlags.TickyFlags.tickyFile
779                   = open_stats_file(arg, *argc, argv,
780                         *rts_argc, rts_argv, TICKY_FILENAME_FMT);
781
782                 if (RtsFlags.TickyFlags.tickyFile == NULL) error = rtsTrue;
783                 ) break;
784
785               /* =========== OH DEAR ============================ */
786               default:
787                 fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n",rts_argv[arg]);
788                 error = rtsTrue;
789                 break;
790             }
791         }
792     }
793     if (error) {
794         const char **p;
795
796         fflush(stdout);
797         for (p = usage_text; *p; p++)
798             fprintf(stderr, "%s\n", *p);
799         stg_exit(EXIT_FAILURE);
800     }
801
802 }
803
804 static FILE *           /* return NULL on error */
805 open_stats_file (
806     I_ arg,
807     int argc, char *argv[],
808     int rts_argc, char *rts_argv[],
809     const char *FILENAME_FMT)
810 {
811     FILE *f = NULL;
812
813     if (strequal(rts_argv[arg]+2, "stderr")) /* use real stderr */
814         f = stderr;
815     else if (rts_argv[arg][2] != '\0')      /* stats file specified */
816         f = fopen(rts_argv[arg]+2,"w");
817     else {
818         char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.<ext> */
819         sprintf(stats_filename, FILENAME_FMT, argv[0]);
820         f = fopen(stats_filename,"w");
821     }
822     if (f == NULL) {
823         fprintf(stderr, "Can't open stats file %s\n", rts_argv[arg]+2);
824     } else {
825         /* Write argv and rtsv into start of stats file */
826         I_ count;
827         for(count = 0; count < argc; count++)
828             fprintf(f, "%s ", argv[count]);
829         fprintf(f, "+RTS ");
830         for(count = 0; count < rts_argc; count++)
831             fprintf(f, "%s ", rts_argv[count]);
832         fprintf(f, "\n");
833     }
834
835     return(f);
836 }
837
838 static I_
839 decode(const char *s)
840 {
841     I_ c;
842     StgDouble m;
843
844     if (!*s)
845         return 0;
846
847     m = atof(s);
848     c = s[strlen(s)-1];
849
850     if (c == 'g' || c == 'G')
851         m *= 1000*1000*1000;    /* UNchecked! */
852     else if (c == 'm' || c == 'M')
853         m *= 1000*1000;                 /* We do not use powers of 2 (1024) */
854     else if (c == 'k' || c == 'K')      /* to avoid possible bad effects on */
855         m *= 1000;                      /* a direct-mapped cache.           */ 
856     else if (c == 'w' || c == 'W')
857         m *= sizeof(W_);
858
859     return (I_)m;
860 }
861
862 static void
863 bad_option(const char *s)
864 {
865   fflush(stdout);
866   fprintf(stderr, "initSM: Bad RTS option: %s\n", s);
867   stg_exit(EXIT_FAILURE);
868 }