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