ghc/runtime/main/main.lc

   1 %/****************************************************************
   2 %*                                                              *
   3 %*      This is where everything starts                         *
   4 %*                                                              *
   5 %****************************************************************/
   6
   7 \begin{code}
   8 #if defined(USE_COST_CENTRES) || defined(GUM) || defined(CONCURRENT)
   9 #define NON_POSIX_SOURCE /* time things on Solaris -- sigh */
  10 #endif
  11
  12 #include "rtsdefs.h"
  13 #include <setjmp.h>
  14
  15 #if defined(STDC_HEADERS) || defined(HAVE_STRING_H)
  16 # include <string.h>
  17 /* An ANSI string.h and pre-ANSI memory.h might conflict.  */
  18 # if !defined(STDC_HEADERS) && defined(HAVE_MEMORY_H)
  19 #  include <memory.h>
  20 # endif /* not STDC_HEADERS and HAVE_MEMORY_H */
  21 # define index strchr
  22 # define rindex strrchr
  23 # define bcopy(s, d, n) memcpy ((d), (s), (n))
  24 # define bcmp(s1, s2, n) memcmp ((s1), (s2), (n))
  25 # define bzero(s, n) memset ((s), 0, (n))
  26 #else /* not STDC_HEADERS and not HAVE_STRING_H */
  27 # include <strings.h>
  28 /* memory.h and strings.h conflict on some systems.  */
  29 #endif /* not STDC_HEADERS and not HAVE_STRING_H */
  30
  31 #if defined(USE_COST_CENTRES) || defined(GUM)
  32 /* need some "time" things */
  33
  34 /* ToDo: This is a mess! Improve ? */
  35
  36 # ifdef HAVE_SYS_TYPES_H
  37 #  include <sys/types.h>
  38 # endif
  39
  40 # ifdef HAVE_SYS_TIMES_H
  41 #  include <sys/times.h>
  42 # endif
  43
  44 # ifdef HAVE_SYS_TIME_H
  45 #  include <sys/time.h>
  46 # endif
  47 #endif /* USE_COST_CENTRES || GUM */
  48
  49 #ifndef PAR
  50 STGRegisterTable MainRegTable;
  51 #endif
  52
  53 /* fwd decls */
  54 void setupRtsFlags PROTO((int *argc, char *argv[], I_ *rtsc, char *rtsv[]));
  55 void shutdownHaskell(STG_NO_ARGS);
  56
  57 EXTFUN(startStgWorld);
  58 extern void PrintRednCountInfo(STG_NO_ARGS);
  59 extern void checkAStack(STG_NO_ARGS);
  60
  61 /* a real nasty Global Variable */
  62 /* moved to main/TopClosure(13)?.lc -- *one* of them will get linked in
  63 P_ TopClosure = Main_mainPrimIO_closure;
  64  */
  65
  66 /* structure to carry around info about the storage manager */
  67 smInfo StorageMgrInfo;
  68
  69 FILE *main_statsfile = NULL;
  70 #if defined(DO_REDN_COUNTING)
  71 FILE *tickyfile = NULL;
  72 #endif
  73 #if defined(SM_DO_BH_UPDATE)
  74 I_ noBlackHoles = 0;
  75 #endif
  76 I_ doSanityChks = 0;
  77 I_ showRednCountStats = 0;
  78 I_ traceUpdates = 0;
  79 extern I_ squeeze_upd_frames;
  80
  81 #ifdef PAR
  82 extern I_       OkToGC, buckets, average_stats();
  83 extern rtsBool  TraceSparks, OutputDisabled, DelaySparks,
  84                 DeferGlobalUpdates, ParallelStats;
  85
  86 extern void RunParallelSystem PROTO((P_));
  87 extern void initParallelSystem(STG_NO_ARGS);
  88 extern void SynchroniseSystem(STG_NO_ARGS);
  89
  90 extern void SetTrace PROTO((W_ address, I_ level/*?*/));
  91 #endif
  92
  93 #if defined(GRAN_CHECK) && defined(GRAN)
  94 extern W_ debug;
  95 extern W_ event_trace ;
  96 extern W_ event_trace_all ;
  97 #endif
  98
  99 extern void *stgAllocForGMP   PROTO((size_t));
 100 extern void *stgReallocForGMP PROTO ((void *, size_t, size_t));
 101 extern void  stgDeallocForGMP PROTO ((void *, size_t));
 102
 103 #if defined (DO_SPAT_PROFILING) && sparc_TARGET_ARCH
 104     /* NOTE: I, WDP, do not use this in my SPAT profiling */
 105 W_ KHHP, KHHPLIM, KHSPA, KHSPB;
 106 #endif
 107
 108 /* NeXTs can't just reach out and touch "end", to use in
 109    distinguishing things in static vs dynamic (malloc'd) memory.
 110 */
 111 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
 112 void *get_end_result;
 113 #endif
 114
 115 I_    prog_argc;
 116 char  **prog_argv;
 117 I_    rts_argc;
 118 char *rts_argv[MAX_RTS_ARGS];
 119
 120 #ifndef PAR
 121 jmp_buf restart_main;       /* For restarting after a signal */
 122 #endif
 123
 124 #if defined(PVM)
 125 unsigned nPEs = 0, nIMUs = 0;
 126 #endif
 127
 128 #if defined(GUM)
 129 int nPEs = 0;
 130 #endif
 131
 132 int /* return type of "main" is defined by the C standard */
 133 main(argc, argv)
 134     int argc;
 135     char *argv[];
 136 {
 137 \end{code}
 138
 139 The very first thing we do is grab the start time...just in case we're
 140 collecting timing statistics.
 141
 142 \begin{code}
 143
 144     start_time();
 145
 146 \end{code}
 147
 148 The parallel system needs to be initialised and synchronised before
 149 the program is run.  This is done {\em before} heap allocation, so we
 150 can grab all remaining heap without needing to consider the System
 151 Manager's requirements.
 152
 153 \begin{code}
 154 #ifdef PAR
 155     /*
 156      * Grab the number of PEs out of the argument vector, and eliminate it
 157      * from further argument processing
 158      */
 159     nPEs = atoi(argv[1]);
 160     argv[1] = argv[0];
 161     argv++;
 162     argc--;
 163
 164 /*    fprintf(stderr, "I'm alive, nPEs = %d \n", nPEs);    */
 165     SynchroniseSystem();
 166 #endif
 167
 168 #if defined(USE_COST_CENTRES) || defined(GUM)
 169     /* setup string indicating time of run -- only used for profiling */
 170     (void) time_str();
 171 #endif
 172
 173 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
 174     get_end_result = get_end();
 175 #endif
 176
 177     /*
 178        divide the command-line args between pgm and RTS;
 179        figure out what statsfile to use (if any);
 180        [if so, write the whole cmd-line into it]
 181
 182        This is unlikely to work well in parallel!  KH.
 183     */
 184     setupRtsFlags(&argc, argv, &rts_argc, rts_argv);
 185     prog_argc = argc;
 186     prog_argv = argv;
 187
 188 #if defined(PAR)
 189    /* Initialise the parallel system -- before initHeap! */
 190    initParallelSystem();
 191 #endif  /* PAR */
 192
 193 #if defined(LIFE_PROFILE)
 194     if (life_profile_init(rts_argv, prog_argv) != 0) {
 195         fflush(stdout);
 196         fprintf(stderr, "life_profile_init failed!\n");
 197         EXIT(EXIT_FAILURE);
 198     }
 199 #endif
 200
 201 #if defined(USE_COST_CENTRES) || defined(GUM)
 202     if (init_cc_profiling(rts_argc, rts_argv, prog_argv) != 0) {
 203         fflush(stdout);
 204         fprintf(stderr, "init_cc_profiling failed!\n");
 205         EXIT(EXIT_FAILURE);
 206     }
 207 #endif
 208
 209 #if defined(CONCURRENT) && defined(GRAN)
 210     if (!no_gr_profile)
 211       if (init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv) != 0) {
 212           fprintf(stderr, "init_gr_simulation failed!\n"); EXIT(EXIT_FAILURE);
 213       }
 214 #endif
 215
 216 #ifdef PAR
 217     if (do_gr_profile)
 218         init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv);
 219 #endif
 220
 221     /*
 222        initialize the storage manager
 223     */
 224     if ( initSM(rts_argc, rts_argv, main_statsfile) != 0) {
 225         fflush(stdout);
 226         fprintf(stderr, "initSM failed!\n");
 227         EXIT(EXIT_FAILURE);
 228     }
 229
 230 #ifndef PAR
 231     if ( initStacks( &StorageMgrInfo ) != 0) {
 232         fflush(stdout);
 233         fprintf(stderr, "initStacks failed!\n");
 234         EXIT(EXIT_FAILURE);
 235     }
 236 #endif
 237
 238     if ( initHeap( &StorageMgrInfo ) != 0) {
 239         fflush(stdout);
 240         fprintf(stderr, "initHeap failed!\n"); EXIT(EXIT_FAILURE);
 241     }
 242
 243 #if defined(CONCURRENT) && !defined(GRAN)
 244     if (!initThreadPools(MaxLocalSparks)) {
 245         fflush(stdout);
 246         fprintf(stderr, "initThreadPools failed!\n");
 247         EXIT(EXIT_FAILURE);
 248     }
 249 #endif
 250
 251 #if defined(USE_COST_CENTRES) || defined(GUM)
 252     /* call cost centre registering routine (after heap allocated) */
 253     cc_register();
 254 #endif
 255
 256 /* Information needed by runtime trace analysers -- don't even ask what it does! */
 257   /* NOTE: I, WDP, do not use this in my SPAT profiling */
 258 #if defined (DO_SPAT_PROFILING) && sparc_TARGET_ARCH
 259    KHHPLIM = (W_) StorageMgrInfo.hplim;
 260    KHHP =    (W_) StorageMgrInfo.hp;
 261    KHSPA =   (W_) SAVE_SpA,
 262    KHSPB =   (W_) SAVE_SpB;
 263
 264 /*  fprintf(stderr,"Hp = %lx, HpLim = %lx, SpA = %lx, SpB = %lx\n",KHHP,KHHPLIM,KHSPA,KHSPB); */
 265
 266 /* NOT ME:
 267   __asm__("sethi %%hi(_KHHP),%%o0\n\tld [%%o0+%%lo(_KHHP)],%%g0" : : : "%%o0");
 268   __asm__("sethi %%hi(_KHHPLIM),%%o0\n\tld [%%o0+%%lo(_KHHPLIM)],%%g0" : : : "%%o0");
 269   __asm__("sethi %%hi(_KHSPA),%%o0\n\tld [%%o0+%%lo(_KHSPA)],%%g0" : : : "%%o0");
 270   __asm__("sethi %%hi(_KHSPB),%%o0\n\tld [%%o0+%%lo(_KHSPB)],%%g0" : : : "%%o0");
 271 */
 272 #endif
 273
 274 #if defined(DO_REDN_COUNTING)
 275     max_SpA = MAIN_SpA; /* initial high-water marks */
 276     max_SpB = MAIN_SpB;
 277 #endif
 278
 279     /* Tell GNU multi-precision pkg about our custom alloc functions */
 280     mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
 281
 282     /* Record initialization times */
 283     end_init();
 284
 285 #if defined(USE_COST_CENTRES) || defined(CONCURRENT)
 286     /*
 287      * Both the context-switcher and the cost-center profiler use
 288      * a virtual timer.
 289      */
 290     if (install_vtalrm_handler()) {
 291         fflush(stdout);
 292         fprintf(stderr, "Can't install VTALRM handler.\n");
 293         EXIT(EXIT_FAILURE);
 294     }
 295 #if (defined(CONCURRENT) && defined(USE_COST_CENTRES)) || defined(GUM)
 296     if (time_profiling) {
 297         if (contextSwitchTime % (1000/TICK_FREQUENCY) == 0)
 298             tick_millisecs = TICK_MILLISECS;
 299         else
 300             tick_millisecs = CS_MIN_MILLISECS;
 301
 302         contextSwitchTicks = contextSwitchTime / tick_millisecs;
 303         profilerTicks = TICK_MILLISECS / tick_millisecs;
 304     } else
 305         tick_millisecs = contextSwitchTime;
 306 #endif
 307
 308 #ifndef CONCURRENT
 309     START_TIME_PROFILER;
 310 #endif
 311
 312 #endif  /* USE_COST_CENTRES || CONCURRENT */
 313
 314 #ifndef PAR
 315     setjmp(restart_main);
 316     initUserSignals();
 317 #endif
 318
 319 #ifdef CONCURRENT
 320 # if defined(GRAN)                                                 /* HWL */
 321     /* RunnableThreadsHd etc. are init in ScheduleThreads */
 322     /*
 323      * I'm not sure about this.  Note that this code is for re-initializing
 324      * things when a longjmp to restart_main occurs.  --JSM
 325      */
 326
 327 # else                                                             /* !GRAN */
 328     AvailableStack = AvailableTSO = Nil_closure;
 329     RunnableThreadsHd = RunnableThreadsTl = Nil_closure;
 330     WaitingThreadsHd = WaitingThreadsTl = Nil_closure;
 331     PendingSparksHd[REQUIRED_POOL] =
 332       PendingSparksTl[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL];
 333     PendingSparksHd[ADVISORY_POOL] =
 334       PendingSparksTl[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL];
 335 # endif
 336
 337     CurrentTSO = Nil_closure;
 338
 339 # ifdef PAR
 340     RunParallelSystem(TopClosure);
 341 # else
 342     STKO_LINK(MainStkO) = Nil_closure;
 343     ScheduleThreads(TopClosure);
 344 # endif /* PAR */
 345
 346 #else   /* not threaded (sequential) */
 347
 348 # if defined(__STG_TAILJUMPS__)
 349     miniInterpret((StgFunPtr)startStgWorld);
 350 # else
 351     if (doSanityChks)
 352         miniInterpret_debug((StgFunPtr)startStgWorld, checkAStack);
 353     else
 354         miniInterpret((StgFunPtr)startStgWorld);
 355 # endif /* not tail-jumping */
 356 #endif /* !CONCURRENT */
 357
 358     shutdownHaskell();
 359     return(EXIT_SUCCESS);    /* don't use EXIT! :-) */
 360 }
 361 \end{code}
 362
 363 It should be possible to call @shutdownHaskell@ whenever you want to
 364 shut a Haskell program down in an orderly way.
 365
 366 Note that some of this code probably depends on the integrity of
 367 various internal data structures so this should not be called in
 368 response to detecting a catastrophic error.
 369
 370 \begin{code}
 371 void
 372 shutdownHaskell(STG_NO_ARGS)
 373 {
 374     STOP_TIME_PROFILER;
 375
 376     if (exitSM(&StorageMgrInfo) != 0) {
 377         fflush(stdout);
 378         fprintf(stderr, "exitSM failed!\n");
 379         EXIT(EXIT_FAILURE);
 380     }
 381 #if defined(LIFE_PROFILE)
 382     {
 383         extern P_ hp_start;     /* from the SM -- Hack! */
 384         life_profile_finish(StorageMgrInfo.hp - hp_start, prog_argv);
 385     }
 386 #endif
 387
 388 #if defined(USE_COST_CENTRES)
 389     heap_profile_finish();
 390 #endif
 391 #if defined(USE_COST_CENTRES) || defined(GUM)
 392     report_cc_profiling(1 /* final */ );
 393 #endif
 394
 395 #if defined(DO_REDN_COUNTING)
 396     if (showRednCountStats) {
 397         PrintRednCountInfo();
 398     }
 399 #endif
 400
 401 #if defined(GRAN_CHECK) && defined(GRAN)
 402     if (PrintFetchMisses)
 403       fprintf(stderr,"Number of fetch misses: %d\n",fetch_misses);
 404
 405 # if defined(COUNT)
 406     fprintf(stderr,"COUNT statistics:\n");
 407     fprintf(stderr,"  Total number of updates: %u\n",nUPDs);
 408     fprintf(stderr,"  Needed to awaken BQ: %u with avg BQ len of: %f\n",
 409             nUPDs_BQ,(float)BQ_lens/(float)nUPDs_BQ);
 410     fprintf(stderr,"  Number of PAPs: %u\n",nPAPs);
 411 # endif
 412
 413     if (!no_gr_profile)
 414       end_gr_simulation();
 415 #endif
 416
 417     fflush(stdout);
 418     /* This fflush is important, because: if "main" just returns,
 419        then we will end up in pre-supplied exit code that will close
 420        streams and flush buffers.  In particular we have seen: it
 421        will close fd 0 (stdin), then flush fd 1 (stdout), then <who
 422        cares>...
 423
 424        But if you're playing with sockets, that "close fd 0" might
 425        suggest to the daemon that all is over, only to be presented
 426        with more stuff on "fd 1" at the flush.
 427
 428        The fflush avoids this sad possibility.
 429     */
 430 }
 431 \end{code}
 432
 433 %/****************************************************************
 434 %*                                                              *
 435 %*          Getting default settings for RTS parameters         *
 436 %*                                                              *
 437 %* +RTS indicates following arguments destined for RTS          *
 438 %* -RTS indicates following arguments destined for program      *
 439 %*                                                              *
 440 %****************************************************************/
 441 \begin{code}
 442
 443 char *flagtext[] = {
 444 "",
 445 "Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>",
 446 "",
 447 "   +RTS    Indicates run time system options follow",
 448 "   -RTS    Indicates program arguments follow",
 449 "  --RTS    Indicates that ALL subsequent arguments will be given to the",
 450 "           program (including any of these RTS flags)",
 451 "",
 452 "The following run time system options are available:",
 453 "",
 454 "  -? -f    Prints this message and exits; the program is not executed",
 455 "",
 456 "  -K<size> Sets the stack size (default 64k)    Egs: -K32k   -K512k",
 457 "  -H<size> Sets the heap size  (default 4M)          -H512k  -H16M",
 458 "  -s<file> Summary GC statistics   (default file: <program>.stat)",
 459 "  -S<file> Detailed GC statistics  (with -Sstderr going to stderr)",
 460 "",
 461 #if defined(GCap)
 462 "  -M<n>%   Sets minimum size of alloc area as % of heap (default 3%)",
 463 "  -A<size> Fixes size of alloc area, overriding any minimum (-A gives 64k)",
 464 "  -G<size> Fixes size of major generation (default is dynamic threshold)",
 465 "  -F2s     Forces program compiled for Appel gc to use 2s collection",
 466 #else
 467 # if defined(GCgn)
 468 "  -A<size> Specifies size of alloc area (default 64k)",
 469 "  -G<size> Fixes size of major generation (default is available heap)",
 470 "  -F2s     Forces program compiled for Gen gc to use 2s collection",
 471 # else
 472 "  -M<n>%   Minimum % of heap which must be available (default 3%)",
 473 "  -A<size> Fixes size of heap area allocated between GCs (-A gives 64k)",
 474 # endif
 475 #endif
 476 #if defined(FORCE_GC)
 477 "  -j<size>  Forces major GC at every <size> bytes allocated",
 478 #endif /* FORCE_GC */
 479 #if defined(GCdu)
 480 "  -u<percent> Fixes residency threshold at which mode switches (range 0.0..0.95)",
 481 #endif
 482 "",
 483 #if defined(SM_DO_BH_UPDATE)
 484 "  -N       No black-holing (for use when a signal handler is present)",
 485 #endif
 486 "  -Z       Don't squeeze out update frames on stack overflow",
 487 "  -B       Sound the bell at the start of each (major) garbage collection",
 488 #if defined(USE_COST_CENTRES) || defined(GUM)
 489 "",
 490 "  -p<sort> Produce cost centre time profile  (output file <program>.prof)",
 491 "             sort: T = time (default), A = alloc, C = cost centre label",
 492 "  -P<sort> Produce serial time profile (output file <program>.time)",
 493 "             and a -p profile with detailed caf/enter/tick/alloc info",
 494 #if defined(USE_COST_CENTRES)
 495 "",
 496 "  -h<break-down> Heap residency profile      (output file <program>.hp)",
 497 "     break-down: C = cost centre (default), M = module, G = group",
 498 "                 D = closure description, Y = type description",
 499 "                 T<ints>,<start> = time closure created",
 500 "                    ints:  no. of interval bands plotted (default 18)",
 501 "                    start: seconds after which intervals start (default 0.0)",
 502 "  A subset of closures may be selected by the attached cost centre using:",
 503 "    -c{mod:lab,mod:lab...}, specific module:label cost centre(s)",
 504 "    -m{mod,mod...} all cost centres from the specified modules(s)",
 505 "    -g{grp,grp...} all cost centres from the specified group(s)",
 506 "  Selections can also be made by description, type, kind and age:",
 507 "    -d{des,des...} closures with specified closure descriptions",
 508 "    -y{typ,typ...} closures with specified type descriptions",
 509 "    -k{knd,knd...} closures of the specified kinds",
 510 "    -a<age>        closures which survived <age> complete intervals",
 511 "  The selection logic used is summarised as follows:",
 512 "    ([-c] or [-m] or [-g]) and ([-d] or [-y] or [-k]) and [-a]",
 513 "    where an option is true if not specified",
 514 #endif
 515 "",
 516 "  -z<tbl><size>  set hash table <size> for <tbl> (C, M, G, D or Y)",
 517 "",
 518 "  -i<secs> Number of seconds in a profiling interval (default 1.0):",
 519 "           heap profile (-h) and/or serial time profile (-P) frequency",
 520 #endif /* USE_COST_CENTRES */
 521 #if defined(LIFE_PROFILE)
 522 "",
 523 "  -l<res>  Produce liftime and update profile (output file <program>.life)",
 524 "              res: the age resolution in bytes allocated   (default 10,000)",
 525 #endif /* LIFE_PROFILE */
 526 "",
 527 #if defined(DO_REDN_COUNTING)
 528 "  -r<file>  Produce reduction profiling statistics (with -rstderr for stderr)",
 529 "",
 530 #endif
 531 "  -I        Use debugging miniInterpret with stack and heap sanity-checking.",
 532 "  -T<level> Trace garbage collection execution (debugging)",
 533 #ifdef CONCURRENT
 534 "",
 535 # ifdef PAR
 536 "  -N<n>     Use <n> PVMish processors in parallel (default: 2)",
 537 /* NB: the -N<n> is implemented by the driver!! */
 538 # endif
 539 "  -C<secs>  Context-switch interval in seconds",
 540 "                (0 or no argument means switch as often as possible)",
 541 "                the default is .01 sec; resolution is .01 sec",
 542 "  -e<size>        Size of spark pools (default 100)",
 543 # ifdef PAR
 544 "  -q        Enable activity profile (output files in ~/<program>*.gr)",
 545 "  -qb       Enable binary activity profile (output file /tmp/<program>.gb)",
 546 #else
 547 "  -q[v]     Enable quasi-parallel profile (output file <program>.qp)",
 548 # endif
 549 "  -t<num>   Set maximum number of advisory threads per PE (default 32)",
 550 "  -o<num>   Set stack chunk size (default 1024)",
 551 # ifdef PAR
 552 "  -d        Turn on PVM-ish debugging",
 553 "  -O        Disable output for performance measurement",
 554 # endif /* PAR */
 555 #endif /* CONCURRENT */
 556 "",
 557 "Other RTS options may be available for programs compiled a different way.",
 558 "The GHC User's Guide has full details.",
 559 "",
 560 0
 561 };
 562
 563 #define RTS 1
 564 #define PGM 0
 565
 566 #ifndef atof
 567 extern double atof();
 568 /* no proto because some machines use const and some do not */
 569 #endif
 570
 571 void
 572 setupRtsFlags(argc, argv, rts_argc, rts_argv)
 573 int *argc;
 574 I_ *rts_argc;
 575 char *argv[], *rts_argv[];
 576 {
 577     I_ error = 0;
 578     I_ mode;
 579     I_ arg, total_arg;
 580     char *last_slash;
 581
 582     /* Remove directory from argv[0] -- default files in current directory */
 583
 584     if ((last_slash = (char *) rindex(argv[0], '/')) != NULL)
 585         strcpy(argv[0], last_slash+1);
 586
 587     /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */
 588     /*   argv[0] must be PGM argument -- leave in argv                 */
 589
 590     total_arg = *argc;
 591     arg = 1;
 592
 593     *argc = 1;
 594     *rts_argc = 0;
 595
 596     for (mode = PGM; arg < total_arg && strcmp("--RTS", argv[arg]) != 0; arg++) {
 597         if (strcmp("+RTS", argv[arg]) == 0) {
 598             mode = RTS;
 599         }
 600         else if (strcmp("-RTS", argv[arg]) == 0) {
 601             mode = PGM;
 602         }
 603         else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
 604             rts_argv[(*rts_argc)++] = argv[arg];
 605         }
 606         else if (mode == PGM) {
 607             argv[(*argc)++] = argv[arg];
 608         }
 609         else {
 610             fflush(stdout);
 611             fprintf(stderr, "setupRtsFlags: Too many RTS arguments (max %d)\n",
 612                     MAX_RTS_ARGS-1);
 613             EXIT(EXIT_FAILURE);
 614         }
 615     }
 616     if (arg < total_arg) {
 617         /* arg must be --RTS; process remaining program arguments */
 618         while (++arg < total_arg) {
 619             argv[(*argc)++] = argv[arg];
 620         }
 621     }
 622     argv[*argc] = (char *) 0;
 623     rts_argv[*rts_argc] = (char *) 0;
 624
 625     /* Process RTS (rts_argv) part: mainly to determine statsfile */
 626
 627     for (arg = 0; arg < *rts_argc; arg++) {
 628         if (rts_argv[arg][0] == '-') {
 629             switch(rts_argv[arg][1]) {
 630               case '?':
 631               case 'f':
 632                 error = 1;
 633                 break;
 634
 635               case 'Z': /* Don't squeeze out update frames */
 636                     squeeze_upd_frames = 0;
 637                 break;
 638
 639 #if defined(SM_DO_BH_UPDATE)
 640               case 'N':
 641                 noBlackHoles++;
 642                 break;
 643 #endif
 644
 645               case 'I':
 646                 doSanityChks++;
 647 #if defined(__STG_TAILJUMPS__)
 648                 /* Blech -- too many errors if run in parallel -- KH */
 649                 fprintf(stderr, "setupRtsFlags: Using Tail Jumps: Sanity checks not possible: %s\n", rts_argv[arg]);
 650                 error = 1;
 651 #endif
 652                 break;
 653
 654               case 'U':
 655                 traceUpdates++;
 656 #if ! defined(DO_RUNTIME_TRACE_UPDATES)
 657                 fprintf(stderr, "setupRtsFlags: Update Tracing not compiled in: %s\n", rts_argv[arg]);
 658                 error = 1;
 659 #endif
 660                 break;
 661
 662               case 'r': /* Basic profiling stats */
 663                 showRednCountStats++;
 664 #if ! defined(DO_REDN_COUNTING)
 665                 fprintf(stderr, "setupRtsFlags: Reduction counting not compiled in: %s\n", rts_argv[arg]);
 666                 error = 1;
 667
 668 #else /* ticky-ticky! */
 669                 if (strcmp(rts_argv[arg]+2, "stderr") == 0) /* use real stderr */
 670                     tickyfile = stderr;
 671                 else if (rts_argv[arg][2] != '\0')          /* ticky file specified */
 672                     tickyfile = fopen(rts_argv[arg]+2,"w");
 673                 else {
 674                     char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.ticky */
 675                     sprintf(stats_filename, TICKY_FILENAME_FMT, argv[0]);
 676                     tickyfile = fopen(stats_filename,"w");
 677                 }
 678                 if (tickyfile == NULL) {
 679                     fprintf(stderr, "Can't open tickyfile %s (default %0.24s.ticky)\n",
 680                                 rts_argv[arg]+2, argv[0]);
 681                     error = 1;
 682                 } else {
 683                     /* Write argv and rtsv into start of ticky file */
 684                     I_ count;
 685                     for(count = 0; count < *argc; count++)
 686                         fprintf(tickyfile, "%s ", argv[count]);
 687                     fprintf(tickyfile, "+RTS ");
 688                     for(count = 0; count < *rts_argc; count++)
 689                         fprintf(tickyfile, "%s ", rts_argv[count]);
 690                     fprintf(tickyfile, "\n");
 691                 }
 692 #endif /* ticky-ticky! */
 693                 break;
 694
 695               case 's': /* Also used by GC -- open file here */
 696               case 'S':
 697 #ifdef PAR
 698                 /* Opening all those files would almost certainly fail... */
 699                 ParallelStats = rtsTrue;
 700                 main_statsfile = stderr; /* temporary; ToDo: rm */
 701 #else
 702                 if (strcmp(rts_argv[arg]+2, "stderr") == 0)       /* use real stderr */
 703                     main_statsfile = stderr;
 704                 else if (rts_argv[arg][2] != '\0')                /* stats file specified */
 705                     main_statsfile = fopen(rts_argv[arg]+2,"w");
 706                 else {
 707                     char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.stat */
 708                     sprintf(stats_filename, STAT_FILENAME_FMT, argv[0]);
 709                     main_statsfile = fopen(stats_filename,"w");
 710                 }
 711                 if (main_statsfile == NULL) {
 712                     fprintf(stderr, "Can't open statsfile %s (default %0.24s.stat)\n", rts_argv[arg]+2, argv[0]);
 713                     error = 1;
 714                 } else {
 715                     /* Write argv and rtsv into start of stats file */
 716                     I_ count;
 717                     for(count = 0; count < *argc; count++)
 718                         fprintf(main_statsfile, "%s ", argv[count]);
 719                     fprintf(main_statsfile, "+RTS ");
 720                     for(count = 0; count < *rts_argc; count++)
 721                         fprintf(main_statsfile, "%s ", rts_argv[count]);
 722                     fprintf(main_statsfile, "\n");
 723                 }
 724 #endif
 725                 break;
 726
 727               case 'P': /* detailed cost centre profiling (time/alloc) */
 728               case 'p': /* cost centre profiling (time/alloc) */
 729               case 'i': /* serial profiling -- initial timer interval */
 730 #if ! (defined(USE_COST_CENTRES) || defined(GUM))
 731                 fprintf(stderr, "setupRtsFlags: Not built for cost centre profiling: %s\n", rts_argv[arg]);
 732                 error = 1;
 733 #endif /* ! (USE_COST_CENTRES || GUM) */
 734                 break;
 735               case 'h': /* serial heap profile */
 736               case 'z': /* size of index tables */
 737               case 'c': /* cost centre label select */
 738               case 'm': /* cost centre module select */
 739               case 'g': /* cost centre group select */
 740               case 'd': /* closure descr select */
 741               case 'y': /* closure type select */
 742               case 'k': /* closure kind select */
 743               case 'a': /* closure age select */
 744 #if ! defined(USE_COST_CENTRES)
 745                 fprintf(stderr, "setupRtsFlags: Not built for cost centre profiling: %s\n", rts_argv[arg]);
 746                 error = 1;
 747 #endif /* ! USE_COST_CENTRES */
 748                 break;
 749
 750               case 'j': /* force GC option */
 751 #if defined(FORCE_GC)
 752                 force_GC++;
 753                 if (rts_argv[arg][2]) {
 754                     GCInterval = decode(rts_argv[arg]+2) / sizeof(W_);
 755                 }
 756 #else  /* ! FORCE_GC */
 757                 fprintf(stderr, "setupRtsFlags: Not built for forcing GC: %s\n", rts_argv[arg]);
 758                 error = 1;
 759 #endif /* ! FORCE_GC */
 760                 break;
 761
 762               case 'l': /* life profile option */
 763 #if defined(LIFE_PROFILE)
 764                 do_life_prof++;
 765                 if (rts_argv[arg][2]) {
 766                     LifeInterval = decode(rts_argv[arg]+2) / sizeof(W_);
 767                 }
 768 #else  /* ! LIFE_PROFILE */
 769                 fprintf(stderr, "setupRtsFlags: Not built for lifetime profiling: %s\n", rts_argv[arg]);
 770                 error = 1;
 771 #endif /* ! LIFE_PROFILE */
 772                 break;
 773
 774               /* Flags for the threaded RTS */
 775
 776 #ifdef CONCURRENT
 777               case 'C': /* context switch interval */
 778                 if (rts_argv[arg][2] != '\0') {
 779                     /* Convert to milliseconds */
 780                     contextSwitchTime = (I_) ((atof(rts_argv[arg]+2) * 1000));
 781                     contextSwitchTime = (contextSwitchTime / CS_MIN_MILLISECS)
 782                                         * CS_MIN_MILLISECS;
 783                     if (contextSwitchTime < CS_MIN_MILLISECS)
 784                         contextSwitchTime = CS_MIN_MILLISECS;
 785                 } else
 786                     contextSwitchTime = 0;
 787                 break;
 788 #if !defined(GRAN)
 789               case 'e':
 790                 if (rts_argv[arg][2] != '\0') {
 791                     MaxLocalSparks = strtol(rts_argv[arg]+2, (char **) NULL, 10);
 792                     if (MaxLocalSparks <= 0) {
 793                         fprintf(stderr, "setupRtsFlags: bad value for -e\n");
 794                         error = 1;
 795                     }
 796                 } else
 797                     MaxLocalSparks = DEFAULT_MAX_LOCAL_SPARKS;
 798                 break;
 799 #endif
 800 #ifdef PAR
 801               case 'q': /* activity profile option */
 802                 if (rts_argv[arg][2] == 'b')
 803                     do_gr_binary++;
 804                 else
 805                     do_gr_profile++;
 806                 break;
 807 #else
 808               case 'q': /* quasi-parallel profile option */
 809                 if (rts_argv[arg][2] == 'v')
 810                     do_qp_prof = 2;
 811                 else
 812                     do_qp_prof++;
 813                 break;
 814 #endif
 815               case 't':
 816                 if (rts_argv[arg][2] != '\0') {
 817                     MaxThreads = strtol(rts_argv[arg]+2, (char **) NULL, 10);
 818                 } else {
 819                     fprintf(stderr, "setupRtsFlags: missing size for -t\n");
 820                     error = 1;
 821                 }
 822                 break;
 823
 824               case 'o':
 825                 if (rts_argv[arg][2] != '\0') {
 826                     StkOChunkSize = decode(rts_argv[arg]+2);
 827                     if (StkOChunkSize < MIN_STKO_CHUNK_SIZE)
 828                         StkOChunkSize = MIN_STKO_CHUNK_SIZE;
 829                 } else {
 830                     fprintf(stderr, "setupRtsFlags: missing size for -o\n");
 831                     error = 1;
 832                 }
 833                 break;
 834
 835 # ifdef PAR
 836               case 'O':
 837                 OutputDisabled = rtsTrue;
 838                 break;
 839
 840 # else  /* PAR */
 841
 842 #  if !defined(GRAN)
 843               case 'b': /* will fall through to disaster */
 844 #  else
 845               case 'b':
 846                 if (rts_argv[arg][2] != '\0') {
 847
 848                   /* Should we emulate hbcpp */
 849                   if(strcmp((rts_argv[arg]+2),"roken")==0) {
 850                     ++DoAlwaysCreateThreads;
 851                     strcpy(rts_argv[arg]+2,"oring");
 852                   }
 853
 854                   /* or a ridiculously idealised simulator */
 855                   if(strcmp((rts_argv[arg]+2),"oring")==0) {
 856                     gran_latency = gran_fetchtime = gran_additional_latency =
 857                       gran_gunblocktime = gran_lunblocktime
 858                         = gran_threadcreatetime = gran_threadqueuetime
 859                           = gran_threadscheduletime = gran_threaddescheduletime
 860                             = gran_threadcontextswitchtime
 861                               = 0;
 862
 863                     gran_mpacktime = gran_munpacktime = 0;
 864
 865                     gran_arith_cost = gran_float_cost = gran_load_cost
 866                       = gran_store_cost = gran_branch_cost = 0;
 867
 868                     gran_heapalloc_cost = 1;
 869
 870                     /* ++DoFairSchedule; */
 871                     ++DoStealThreadsFirst;
 872                     ++DoThreadMigration;
 873                     ++do_gr_profile;
 874                   }
 875
 876                   /* or a ridiculously idealised simulator */
 877                   if(strcmp((rts_argv[arg]+2),"onzo")==0) {
 878                     gran_latency = gran_fetchtime = gran_additional_latency =
 879                       gran_gunblocktime = gran_lunblocktime
 880                         = gran_threadcreatetime = gran_threadqueuetime
 881                           = gran_threadscheduletime = gran_threaddescheduletime
 882                             = gran_threadcontextswitchtime
 883                               = 0;
 884
 885                     gran_mpacktime = gran_munpacktime = 0;
 886
 887                     /* Keep default values for these
 888                     gran_arith_cost = gran_float_cost = gran_load_cost
 889                       = gran_store_cost = gran_branch_cost = 0;
 890                       */
 891
 892                     gran_heapalloc_cost = 1;
 893
 894                     /* ++DoFairSchedule; */       /* -b-R */
 895                     /* ++DoStealThreadsFirst; */  /* -b-T */
 896                     ++DoReScheduleOnFetch;        /* -bZ */
 897                     ++DoThreadMigration;          /* -bM */
 898                     ++do_gr_profile;              /* -bP */
 899 #   if defined(GRAN_CHECK) && defined(GRAN)
 900                     debug = 0x20;       /* print event statistics   */
 901 #   endif
 902                   }
 903
 904                   /* Communication and task creation cost parameters */
 905                   else switch(rts_argv[arg][2]) {
 906                     case 'l':
 907                       if (rts_argv[arg][3] != '\0')
 908                         {
 909                           gran_gunblocktime = gran_latency = decode(rts_argv[arg]+3);
 910                           gran_fetchtime = 2* gran_latency;
 911                         }
 912                       else
 913                         gran_latency = LATENCY;
 914                       break;
 915
 916                     case 'a':
 917                       if (rts_argv[arg][3] != '\0')
 918                         gran_additional_latency = decode(rts_argv[arg]+3);
 919                       else
 920                         gran_additional_latency = ADDITIONAL_LATENCY;
 921                       break;
 922
 923                     case 'm':
 924                       if (rts_argv[arg][3] != '\0')
 925                         gran_mpacktime = decode(rts_argv[arg]+3);
 926                       else
 927                         gran_mpacktime = MSGPACKTIME;
 928                       break;
 929
 930                     case 'x':
 931                       if (rts_argv[arg][3] != '\0')
 932                         gran_mtidytime = decode(rts_argv[arg]+3);
 933                       else
 934                         gran_mtidytime = 0;
 935                       break;
 936
 937                     case 'r':
 938                       if (rts_argv[arg][3] != '\0')
 939                         gran_munpacktime = decode(rts_argv[arg]+3);
 940                       else
 941                         gran_munpacktime = MSGUNPACKTIME;
 942                       break;
 943
 944                     case 'f':
 945                       if (rts_argv[arg][3] != '\0')
 946                         gran_fetchtime = decode(rts_argv[arg]+3);
 947                       else
 948                         gran_fetchtime = FETCHTIME;
 949                       break;
 950
 951                     case 'n':
 952                       if (rts_argv[arg][3] != '\0')
 953                         gran_gunblocktime = decode(rts_argv[arg]+3);
 954                       else
 955                         gran_gunblocktime = GLOBALUNBLOCKTIME;
 956                       break;
 957
 958                     case 'u':
 959                       if (rts_argv[arg][3] != '\0')
 960                         gran_lunblocktime = decode(rts_argv[arg]+3);
 961                       else
 962                         gran_lunblocktime = LOCALUNBLOCKTIME;
 963                       break;
 964
 965                     /* Thread-related metrics */
 966                     case 't':
 967                       if (rts_argv[arg][3] != '\0')
 968                         gran_threadcreatetime = decode(rts_argv[arg]+3);
 969                       else
 970                         gran_threadcreatetime = THREADCREATETIME;
 971                       break;
 972
 973                     case 'q':
 974                       if (rts_argv[arg][3] != '\0')
 975                         gran_threadqueuetime = decode(rts_argv[arg]+3);
 976                       else
 977                         gran_threadqueuetime = THREADQUEUETIME;
 978                       break;
 979
 980                     case 'c':
 981                       if (rts_argv[arg][3] != '\0')
 982                         gran_threadscheduletime = decode(rts_argv[arg]+3);
 983                       else
 984                         gran_threadscheduletime = THREADSCHEDULETIME;
 985
 986                       gran_threadcontextswitchtime = gran_threadscheduletime
 987                                                    + gran_threaddescheduletime;
 988                       break;
 989
 990                     case 'd':
 991                       if (rts_argv[arg][3] != '\0')
 992                         gran_threaddescheduletime = decode(rts_argv[arg]+3);
 993                       else
 994                         gran_threaddescheduletime = THREADDESCHEDULETIME;
 995
 996                       gran_threadcontextswitchtime = gran_threadscheduletime
 997                                                    + gran_threaddescheduletime;
 998                       break;
 999
1000                     /* Instruction Cost Metrics */
1001                     case 'A':
1002                       if (rts_argv[arg][3] != '\0')
1003                         gran_arith_cost = decode(rts_argv[arg]+3);
1004                       else
1005                         gran_arith_cost = ARITH_COST;
1006                       break;
1007
1008                     case 'F':
1009                       if (rts_argv[arg][3] != '\0')
1010                         gran_float_cost = decode(rts_argv[arg]+3);
1011                       else
1012                         gran_float_cost = FLOAT_COST;
1013                       break;
1014
1015                     case 'B':
1016                       if (rts_argv[arg][3] != '\0')
1017                         gran_branch_cost = decode(rts_argv[arg]+3);
1018                       else
1019                         gran_branch_cost = BRANCH_COST;
1020                       break;
1021
1022                     case 'L':
1023                       if (rts_argv[arg][3] != '\0')
1024                         gran_load_cost = decode(rts_argv[arg]+3);
1025                       else
1026                         gran_load_cost = LOAD_COST;
1027                       break;
1028
1029                     case 'S':
1030                       if (rts_argv[arg][3] != '\0')
1031                         gran_store_cost = decode(rts_argv[arg]+3);
1032                       else
1033                         gran_store_cost = STORE_COST;
1034                       break;
1035
1036                     case 'H':
1037                       if (rts_argv[arg][3] != '\0')
1038                         gran_heapalloc_cost = decode(rts_argv[arg]+3);
1039                       else
1040                         gran_heapalloc_cost = 0;
1041                       break;
1042
1043                     case 'y':
1044                       if (rts_argv[arg][3] != '\0')
1045                         FetchStrategy = decode(rts_argv[arg]+3);
1046                       else
1047                         FetchStrategy = 4; /* default: fetch everything */
1048                       break;
1049
1050                     /* General Parameters */
1051                     case 'p':
1052                       if (rts_argv[arg][3] != '\0')
1053                         {
1054                           max_proc = decode(rts_argv[arg]+3);
1055                           if(max_proc > MAX_PROC || max_proc < 1)
1056                             {
1057                               fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n", MAX_PROC);
1058                               error = 1;
1059                             }
1060                         }
1061                       else
1062                         max_proc = MAX_PROC;
1063                       break;
1064
1065                     case 'C':
1066                       ++DoAlwaysCreateThreads;
1067                       ++DoThreadMigration;
1068                       break;
1069
1070                     case 'G':
1071                       ++DoGUMMFetching;
1072                       break;
1073
1074                     case 'M':
1075                       ++DoThreadMigration;
1076                       break;
1077
1078                     case 'R':
1079                       ++DoFairSchedule;
1080                       break;
1081
1082                     case 'T':
1083                       ++DoStealThreadsFirst;
1084                       ++DoThreadMigration;
1085                       break;
1086
1087                     case 'Z':
1088                       ++DoReScheduleOnFetch;
1089                       break;
1090
1091                     case 'z':
1092                       ++SimplifiedFetch;
1093                       break;
1094
1095                     case 'N':
1096                       ++PreferSparksOfLocalNodes;
1097                       break;
1098
1099                     case 'b':
1100                       ++do_gr_binary;
1101                       break;
1102
1103                     case 'P':
1104                       ++do_gr_profile;
1105                       break;
1106
1107                     case 's':
1108                       ++do_sp_profile;
1109                       break;
1110
1111                     case '-':
1112                       switch(rts_argv[arg][3]) {
1113
1114                        case 'C':
1115                          DoAlwaysCreateThreads=0;
1116                          DoThreadMigration=0;
1117                          break;
1118
1119                        case 'G':
1120                          DoGUMMFetching=0;
1121                          break;
1122
1123                        case 'M':
1124                          DoThreadMigration=0;
1125                          break;
1126
1127                         case 'R':
1128                          DoFairSchedule=0;
1129                          break;
1130
1131                        case 'T':
1132                          DoStealThreadsFirst=0;
1133                          DoThreadMigration=0;
1134                          break;
1135
1136                        case 'Z':
1137                          DoReScheduleOnFetch=0;
1138                          break;
1139
1140                        case 'N':
1141                          PreferSparksOfLocalNodes=0;
1142                          break;
1143
1144                        case 'P':
1145                          do_gr_profile=0;
1146                          no_gr_profile=1;
1147                          break;
1148
1149                        case 's':
1150                          do_sp_profile=0;
1151                          break;
1152
1153                        case 'b':
1154                          do_gr_binary=0;
1155                          break;
1156
1157                        default:
1158                          badoption( rts_argv[arg] );
1159                          break;
1160                        }
1161                       break;
1162
1163 #   if defined(GRAN_CHECK) && defined(GRAN)
1164                     case 'D':
1165                       switch(rts_argv[arg][3]) {
1166                           case 'e':       /* event trace */
1167                             fprintf(stderr,"Printing event trace.\n");
1168                             ++event_trace;
1169                             break;
1170
1171                           case 'f':
1172                             fprintf(stderr,"Printing forwarding of FETCHNODES.\n");
1173                             debug |= 0x2; /* print fwd messages */
1174                             break;
1175
1176                           case 'z':
1177                             fprintf(stderr,"Check for blocked on fetch.\n");
1178                             debug |= 0x4; /* debug non-reschedule-on-fetch */
1179                             break;
1180
1181                           case 't':
1182                             fprintf(stderr,"Check for TSO asleep on fetch.\n");
1183                             debug |= 0x10; /* debug TSO asleep for fetch  */
1184                             break;
1185
1186                           case 'E':
1187                             fprintf(stderr,"Printing event statistics.\n");
1188                             debug |= 0x20; /* print event statistics   */
1189                             break;
1190
1191                           case 'F':
1192                             fprintf(stderr,"Prohibiting forward.\n");
1193                             NoForward = 1; /* prohibit forwarding   */
1194                             break;
1195
1196                           case 'm':
1197                             fprintf(stderr,"Printing fetch misses.\n");
1198                             PrintFetchMisses = 1; /* prohibit forwarding   */
1199                             break;
1200
1201                           case 'd':
1202                             fprintf(stderr,"Debug mode.\n");
1203                             debug |= 0x40;
1204                             break;
1205
1206                           case 'D':
1207                             fprintf(stderr,"Severe debug mode.\n");
1208                             debug |= 0x80;
1209                             break;
1210
1211                           case '\0':
1212                             debug = 1;
1213                             break;
1214
1215                           default:
1216                             badoption( rts_argv[arg] );
1217                             break;
1218                           }
1219                       break;
1220 #   endif
1221                     default:
1222                       badoption( rts_argv[arg] );
1223                       break;
1224                     }
1225                 }
1226                 do_gr_sim++;
1227                 contextSwitchTime = 0;
1228                 break;
1229 #  endif
1230               case 'J':
1231               case 'Q':
1232               case 'D':
1233               case 'R':
1234               case 'L':
1235               case 'O':
1236                 fprintf(stderr, "setupRtsFlags: Not built for parallel execution: %s\n", rts_argv[arg]);
1237                 error = 1;
1238 # endif /* PAR */
1239 #else   /* CONCURRENT */
1240               case 't':
1241                 fprintf(stderr, "setupRtsFlags: Not built for threaded execution: %s\n", rts_argv[arg]);
1242                 error = 1;
1243
1244 #endif  /* CONCURRENT */
1245               case 'H': /* SM options -- ignore */
1246               case 'A':
1247               case 'G':
1248               case 'F':
1249               case 'K':
1250               case 'M':
1251               case 'B':
1252               case 'T':
1253 #ifdef GCdu
1254               case 'u': /* set dual mode threshold */
1255 #endif
1256                 break;
1257
1258               default: /* Unknown option ! */
1259                 fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n", rts_argv[arg]);
1260                 error = 1;
1261                 break;
1262             }
1263           }
1264         else {
1265             fflush(stdout);
1266             fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n",
1267                     rts_argv[arg]);
1268             error = 1;
1269         }
1270     }
1271     if (error == 1) {
1272         char  **p;
1273         fflush(stdout);
1274         for (p = flagtext; *p; p++)
1275             fprintf(stderr, "%s\n", *p);
1276         EXIT(EXIT_FAILURE);
1277     }
1278 }
1279 \end{code}
1280
1281 Sets up and returns a string indicating the date/time of the run.
1282 Successive calls simply return the same string again. Initially
1283 called by @main.lc@ to initialise the string at the start of the run.
1284 Only used for profiling.
1285
1286 \begin{code}
1287 #if defined(USE_COST_CENTRES) || defined(CONCURRENT)
1288 # include <time.h>
1289
1290 char *
1291 time_str(STG_NO_ARGS)
1292 {
1293     static time_t now = 0;
1294     static char nowstr[26];
1295
1296     if (now == 0) {
1297         time(&now);
1298         strcpy(nowstr, ctime(&now));
1299         strcpy(nowstr+16,nowstr+19);
1300         nowstr[21] = '\0';
1301     }
1302     return nowstr;
1303 }
1304 #endif /* profiling */
1305 \end{code}
1306
1307 ToDo: Will this work under threads?
1308
1309 \begin{code}
1310 StgStablePtr errorHandler = -1;
1311
1312 StgInt getErrorHandler()
1313 {
1314   return (StgInt) errorHandler;
1315 }
1316
1317 #ifndef PAR
1318
1319 void raiseError( handler )
1320 StgStablePtr handler;
1321 {
1322   if (handler == -1) {
1323     shutdownHaskell();
1324   } else {
1325     TopClosure = deRefStablePointer( handler );
1326     longjmp(restart_main,1);
1327   }
1328 }
1329 \end{code}
1330
1331 \begin{code}
1332 StgInt
1333 catchError( newErrorHandler )
1334 StgStablePtr newErrorHandler;
1335 {
1336   StgStablePtr oldErrorHandler = errorHandler;
1337   errorHandler = newErrorHandler;
1338   return oldErrorHandler;
1339 }
1340
1341 #endif
1342 \end{code}
1343
1344 If we have installed an error handler, we might want to
1345 indicate that we have successfully recovered from an error by
1346 decrementing the counter.
1347
1348 \begin{code}
1349 void
1350 decrementErrorCount()
1351 {
1352   ErrorIO_call_count-=1;
1353 }
1354
1355 \end{code}