1 %/****************************************************************
3 %* This is where everything starts *
5 %****************************************************************/
8 #if defined(USE_COST_CENTRES) || defined(GUM) || defined(CONCURRENT)
9 #define NON_POSIX_SOURCE /* time things on Solaris -- sigh */
15 #if defined(STDC_HEADERS) || defined(HAVE_STRING_H)
17 /* An ANSI string.h and pre-ANSI memory.h might conflict. */
18 # if !defined(STDC_HEADERS) && defined(HAVE_MEMORY_H)
20 # endif /* not STDC_HEADERS and HAVE_MEMORY_H */
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 */
28 /* memory.h and strings.h conflict on some systems. */
29 #endif /* not STDC_HEADERS and not HAVE_STRING_H */
31 #if defined(USE_COST_CENTRES) || defined(GUM)
32 /* need some "time" things */
34 /* ToDo: This is a mess! Improve ? */
36 # ifdef HAVE_SYS_TYPES_H
37 # include <sys/types.h>
40 # ifdef HAVE_SYS_TIMES_H
41 # include <sys/times.h>
44 # ifdef HAVE_SYS_TIME_H
45 # include <sys/time.h>
47 #endif /* USE_COST_CENTRES || GUM */
50 STGRegisterTable MainRegTable;
54 void setupRtsFlags PROTO((int *argc, char *argv[], I_ *rtsc, char *rtsv[]));
55 void shutdownHaskell(STG_NO_ARGS);
57 EXTFUN(startStgWorld);
58 extern void PrintRednCountInfo(STG_NO_ARGS);
59 extern void checkAStack(STG_NO_ARGS);
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;
66 /* structure to carry around info about the storage manager */
67 smInfo StorageMgrInfo;
69 FILE *main_statsfile = NULL;
70 #if defined(DO_REDN_COUNTING)
71 FILE *tickyfile = NULL;
73 #if defined(SM_DO_BH_UPDATE)
77 I_ showRednCountStats = 0;
79 extern I_ squeeze_upd_frames;
82 extern I_ OkToGC, buckets, average_stats();
83 extern rtsBool TraceSparks, OutputDisabled, DelaySparks,
84 DeferGlobalUpdates, ParallelStats;
86 extern void RunParallelSystem PROTO((P_));
87 extern void initParallelSystem(STG_NO_ARGS);
88 extern void SynchroniseSystem(STG_NO_ARGS);
90 extern void SetTrace PROTO((W_ address, I_ level/*?*/));
93 #if defined(GRAN_CHECK) && defined(GRAN)
95 extern W_ event_trace ;
96 extern W_ event_trace_all ;
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));
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;
108 /* NeXTs can't just reach out and touch "end", to use in
109 distinguishing things in static vs dynamic (malloc'd) memory.
111 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
112 void *get_end_result;
118 char *rts_argv[MAX_RTS_ARGS];
121 jmp_buf restart_main; /* For restarting after a signal */
125 unsigned nPEs = 0, nIMUs = 0;
132 int /* return type of "main" is defined by the C standard */
139 The very first thing we do is grab the start time...just in case we're
140 collecting timing statistics.
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.
156 * Grab the number of PEs out of the argument vector, and eliminate it
157 * from further argument processing
159 nPEs = atoi(argv[1]);
164 /* fprintf(stderr, "I'm alive, nPEs = %d \n", nPEs); */
168 #if defined(USE_COST_CENTRES) || defined(GUM)
169 /* setup string indicating time of run -- only used for profiling */
173 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
174 get_end_result = get_end();
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]
182 This is unlikely to work well in parallel! KH.
184 setupRtsFlags(&argc, argv, &rts_argc, rts_argv);
189 /* Initialise the parallel system -- before initHeap! */
190 initParallelSystem();
193 #if defined(LIFE_PROFILE)
194 if (life_profile_init(rts_argv, prog_argv) != 0) {
196 fprintf(stderr, "life_profile_init failed!\n");
201 #if defined(USE_COST_CENTRES) || defined(GUM)
202 if (init_cc_profiling(rts_argc, rts_argv, prog_argv) != 0) {
204 fprintf(stderr, "init_cc_profiling failed!\n");
209 #if defined(CONCURRENT) && defined(GRAN)
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);
218 init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv);
222 initialize the storage manager
224 if ( initSM(rts_argc, rts_argv, main_statsfile) != 0) {
226 fprintf(stderr, "initSM failed!\n");
231 if ( initStacks( &StorageMgrInfo ) != 0) {
233 fprintf(stderr, "initStacks failed!\n");
238 if ( initHeap( &StorageMgrInfo ) != 0) {
240 fprintf(stderr, "initHeap failed!\n"); EXIT(EXIT_FAILURE);
243 #if defined(CONCURRENT) && !defined(GRAN)
244 if (!initThreadPools(MaxLocalSparks)) {
246 fprintf(stderr, "initThreadPools failed!\n");
251 #if defined(USE_COST_CENTRES) || defined(GUM)
252 /* call cost centre registering routine (after heap allocated) */
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;
264 /* fprintf(stderr,"Hp = %lx, HpLim = %lx, SpA = %lx, SpB = %lx\n",KHHP,KHHPLIM,KHSPA,KHSPB); */
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");
274 #if defined(DO_REDN_COUNTING)
275 max_SpA = MAIN_SpA; /* initial high-water marks */
279 /* Tell GNU multi-precision pkg about our custom alloc functions */
280 mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
282 /* Record initialization times */
285 #if defined(USE_COST_CENTRES) || defined(CONCURRENT)
287 * Both the context-switcher and the cost-center profiler use
290 if (install_vtalrm_handler()) {
292 fprintf(stderr, "Can't install VTALRM handler.\n");
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;
300 tick_millisecs = CS_MIN_MILLISECS;
302 contextSwitchTicks = contextSwitchTime / tick_millisecs;
303 profilerTicks = TICK_MILLISECS / tick_millisecs;
305 tick_millisecs = contextSwitchTime;
312 #endif /* USE_COST_CENTRES || CONCURRENT */
315 setjmp(restart_main);
320 # if defined(GRAN) /* HWL */
321 /* RunnableThreadsHd etc. are init in ScheduleThreads */
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
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];
337 CurrentTSO = Nil_closure;
340 RunParallelSystem(TopClosure);
342 STKO_LINK(MainStkO) = Nil_closure;
343 ScheduleThreads(TopClosure);
346 #else /* not threaded (sequential) */
348 # if defined(__STG_TAILJUMPS__)
349 miniInterpret((StgFunPtr)startStgWorld);
352 miniInterpret_debug((StgFunPtr)startStgWorld, checkAStack);
354 miniInterpret((StgFunPtr)startStgWorld);
355 # endif /* not tail-jumping */
356 #endif /* !CONCURRENT */
359 return(EXIT_SUCCESS); /* don't use EXIT! :-) */
363 It should be possible to call @shutdownHaskell@ whenever you want to
364 shut a Haskell program down in an orderly way.
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.
372 shutdownHaskell(STG_NO_ARGS)
376 if (exitSM(&StorageMgrInfo) != 0) {
378 fprintf(stderr, "exitSM failed!\n");
381 #if defined(LIFE_PROFILE)
383 extern P_ hp_start; /* from the SM -- Hack! */
384 life_profile_finish(StorageMgrInfo.hp - hp_start, prog_argv);
388 #if defined(USE_COST_CENTRES)
389 heap_profile_finish();
391 #if defined(USE_COST_CENTRES) || defined(GUM)
392 report_cc_profiling(1 /* final */ );
395 #if defined(DO_REDN_COUNTING)
396 if (showRednCountStats) {
397 PrintRednCountInfo();
401 #if defined(GRAN_CHECK) && defined(GRAN)
402 if (PrintFetchMisses)
403 fprintf(stderr,"Number of fetch misses: %d\n",fetch_misses);
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);
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
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.
428 The fflush avoids this sad possibility.
433 %/****************************************************************
435 %* Getting default settings for RTS parameters *
437 %* +RTS indicates following arguments destined for RTS *
438 %* -RTS indicates following arguments destined for program *
440 %****************************************************************/
445 "Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>",
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)",
452 "The following run time system options are available:",
454 " -? -f Prints this message and exits; the program is not executed",
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)",
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",
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",
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)",
476 #if defined(FORCE_GC)
477 " -j<size> Forces major GC at every <size> bytes allocated",
478 #endif /* FORCE_GC */
480 " -u<percent> Fixes residency threshold at which mode switches (range 0.0..0.95)",
483 #if defined(SM_DO_BH_UPDATE)
484 " -N No black-holing (for use when a signal handler is present)",
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)
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)
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",
516 " -z<tbl><size> set hash table <size> for <tbl> (C, M, G, D or Y)",
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)
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 */
527 #if defined(DO_REDN_COUNTING)
528 " -r<file> Produce reduction profiling statistics (with -rstderr for stderr)",
531 " -I Use debugging miniInterpret with stack and heap sanity-checking.",
532 " -T<level> Trace garbage collection execution (debugging)",
536 " -N<n> Use <n> PVMish processors in parallel (default: 2)",
537 /* NB: the -N<n> is implemented by the driver!! */
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)",
544 " -q Enable activity profile (output files in ~/<program>*.gr)",
545 " -qb Enable binary activity profile (output file /tmp/<program>.gb)",
547 " -q[v] Enable quasi-parallel profile (output file <program>.qp)",
549 " -t<num> Set maximum number of advisory threads per PE (default 32)",
550 " -o<num> Set stack chunk size (default 1024)",
552 " -d Turn on PVM-ish debugging",
553 " -O Disable output for performance measurement",
555 #endif /* CONCURRENT */
557 "Other RTS options may be available for programs compiled a different way.",
558 "The GHC User's Guide has full details.",
567 extern double atof();
568 /* no proto because some machines use const and some do not */
572 setupRtsFlags(argc, argv, rts_argc, rts_argv)
575 char *argv[], *rts_argv[];
582 /* Remove directory from argv[0] -- default files in current directory */
584 if ((last_slash = (char *) rindex(argv[0], '/')) != NULL)
585 strcpy(argv[0], last_slash+1);
587 /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */
588 /* argv[0] must be PGM argument -- leave in argv */
596 for (mode = PGM; arg < total_arg && strcmp("--RTS", argv[arg]) != 0; arg++) {
597 if (strcmp("+RTS", argv[arg]) == 0) {
600 else if (strcmp("-RTS", argv[arg]) == 0) {
603 else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
604 rts_argv[(*rts_argc)++] = argv[arg];
606 else if (mode == PGM) {
607 argv[(*argc)++] = argv[arg];
611 fprintf(stderr, "setupRtsFlags: Too many RTS arguments (max %d)\n",
616 if (arg < total_arg) {
617 /* arg must be --RTS; process remaining program arguments */
618 while (++arg < total_arg) {
619 argv[(*argc)++] = argv[arg];
622 argv[*argc] = (char *) 0;
623 rts_argv[*rts_argc] = (char *) 0;
625 /* Process RTS (rts_argv) part: mainly to determine statsfile */
627 for (arg = 0; arg < *rts_argc; arg++) {
628 if (rts_argv[arg][0] == '-') {
629 switch(rts_argv[arg][1]) {
635 case 'Z': /* Don't squeeze out update frames */
636 squeeze_upd_frames = 0;
639 #if defined(SM_DO_BH_UPDATE)
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]);
656 #if ! defined(DO_RUNTIME_TRACE_UPDATES)
657 fprintf(stderr, "setupRtsFlags: Update Tracing not compiled in: %s\n", rts_argv[arg]);
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]);
668 #else /* ticky-ticky! */
669 if (strcmp(rts_argv[arg]+2, "stderr") == 0) /* use real stderr */
671 else if (rts_argv[arg][2] != '\0') /* ticky file specified */
672 tickyfile = fopen(rts_argv[arg]+2,"w");
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");
678 if (tickyfile == NULL) {
679 fprintf(stderr, "Can't open tickyfile %s (default %0.24s.ticky)\n",
680 rts_argv[arg]+2, argv[0]);
683 /* Write argv and rtsv into start of ticky file */
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");
692 #endif /* ticky-ticky! */
695 case 's': /* Also used by GC -- open file here */
698 /* Opening all those files would almost certainly fail... */
699 ParallelStats = rtsTrue;
700 main_statsfile = stderr; /* temporary; ToDo: rm */
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");
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");
711 if (main_statsfile == NULL) {
712 fprintf(stderr, "Can't open statsfile %s (default %0.24s.stat)\n", rts_argv[arg]+2, argv[0]);
715 /* Write argv and rtsv into start of stats file */
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");
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]);
733 #endif /* ! (USE_COST_CENTRES || GUM) */
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]);
747 #endif /* ! USE_COST_CENTRES */
750 case 'j': /* force GC option */
751 #if defined(FORCE_GC)
753 if (rts_argv[arg][2]) {
754 GCInterval = decode(rts_argv[arg]+2) / sizeof(W_);
756 #else /* ! FORCE_GC */
757 fprintf(stderr, "setupRtsFlags: Not built for forcing GC: %s\n", rts_argv[arg]);
759 #endif /* ! FORCE_GC */
762 case 'l': /* life profile option */
763 #if defined(LIFE_PROFILE)
765 if (rts_argv[arg][2]) {
766 LifeInterval = decode(rts_argv[arg]+2) / sizeof(W_);
768 #else /* ! LIFE_PROFILE */
769 fprintf(stderr, "setupRtsFlags: Not built for lifetime profiling: %s\n", rts_argv[arg]);
771 #endif /* ! LIFE_PROFILE */
774 /* Flags for the threaded RTS */
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)
783 if (contextSwitchTime < CS_MIN_MILLISECS)
784 contextSwitchTime = CS_MIN_MILLISECS;
786 contextSwitchTime = 0;
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");
797 MaxLocalSparks = DEFAULT_MAX_LOCAL_SPARKS;
801 case 'q': /* activity profile option */
802 if (rts_argv[arg][2] == 'b')
808 case 'q': /* quasi-parallel profile option */
809 if (rts_argv[arg][2] == 'v')
816 if (rts_argv[arg][2] != '\0') {
817 MaxThreads = strtol(rts_argv[arg]+2, (char **) NULL, 10);
819 fprintf(stderr, "setupRtsFlags: missing size for -t\n");
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;
830 fprintf(stderr, "setupRtsFlags: missing size for -o\n");
837 OutputDisabled = rtsTrue;
843 case 'b': /* will fall through to disaster */
846 if (rts_argv[arg][2] != '\0') {
848 /* Should we emulate hbcpp */
849 if(strcmp((rts_argv[arg]+2),"roken")==0) {
850 ++DoAlwaysCreateThreads;
851 strcpy(rts_argv[arg]+2,"oring");
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
863 gran_mpacktime = gran_munpacktime = 0;
865 gran_arith_cost = gran_float_cost = gran_load_cost
866 = gran_store_cost = gran_branch_cost = 0;
868 gran_heapalloc_cost = 1;
870 /* ++DoFairSchedule; */
871 ++DoStealThreadsFirst;
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
885 gran_mpacktime = gran_munpacktime = 0;
887 /* Keep default values for these
888 gran_arith_cost = gran_float_cost = gran_load_cost
889 = gran_store_cost = gran_branch_cost = 0;
892 gran_heapalloc_cost = 1;
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 */
904 /* Communication and task creation cost parameters */
905 else switch(rts_argv[arg][2]) {
907 if (rts_argv[arg][3] != '\0')
909 gran_gunblocktime = gran_latency = decode(rts_argv[arg]+3);
910 gran_fetchtime = 2* gran_latency;
913 gran_latency = LATENCY;
917 if (rts_argv[arg][3] != '\0')
918 gran_additional_latency = decode(rts_argv[arg]+3);
920 gran_additional_latency = ADDITIONAL_LATENCY;
924 if (rts_argv[arg][3] != '\0')
925 gran_mpacktime = decode(rts_argv[arg]+3);
927 gran_mpacktime = MSGPACKTIME;
931 if (rts_argv[arg][3] != '\0')
932 gran_mtidytime = decode(rts_argv[arg]+3);
938 if (rts_argv[arg][3] != '\0')
939 gran_munpacktime = decode(rts_argv[arg]+3);
941 gran_munpacktime = MSGUNPACKTIME;
945 if (rts_argv[arg][3] != '\0')
946 gran_fetchtime = decode(rts_argv[arg]+3);
948 gran_fetchtime = FETCHTIME;
952 if (rts_argv[arg][3] != '\0')
953 gran_gunblocktime = decode(rts_argv[arg]+3);
955 gran_gunblocktime = GLOBALUNBLOCKTIME;
959 if (rts_argv[arg][3] != '\0')
960 gran_lunblocktime = decode(rts_argv[arg]+3);
962 gran_lunblocktime = LOCALUNBLOCKTIME;
965 /* Thread-related metrics */
967 if (rts_argv[arg][3] != '\0')
968 gran_threadcreatetime = decode(rts_argv[arg]+3);
970 gran_threadcreatetime = THREADCREATETIME;
974 if (rts_argv[arg][3] != '\0')
975 gran_threadqueuetime = decode(rts_argv[arg]+3);
977 gran_threadqueuetime = THREADQUEUETIME;
981 if (rts_argv[arg][3] != '\0')
982 gran_threadscheduletime = decode(rts_argv[arg]+3);
984 gran_threadscheduletime = THREADSCHEDULETIME;
986 gran_threadcontextswitchtime = gran_threadscheduletime
987 + gran_threaddescheduletime;
991 if (rts_argv[arg][3] != '\0')
992 gran_threaddescheduletime = decode(rts_argv[arg]+3);
994 gran_threaddescheduletime = THREADDESCHEDULETIME;
996 gran_threadcontextswitchtime = gran_threadscheduletime
997 + gran_threaddescheduletime;
1000 /* Instruction Cost Metrics */
1002 if (rts_argv[arg][3] != '\0')
1003 gran_arith_cost = decode(rts_argv[arg]+3);
1005 gran_arith_cost = ARITH_COST;
1009 if (rts_argv[arg][3] != '\0')
1010 gran_float_cost = decode(rts_argv[arg]+3);
1012 gran_float_cost = FLOAT_COST;
1016 if (rts_argv[arg][3] != '\0')
1017 gran_branch_cost = decode(rts_argv[arg]+3);
1019 gran_branch_cost = BRANCH_COST;
1023 if (rts_argv[arg][3] != '\0')
1024 gran_load_cost = decode(rts_argv[arg]+3);
1026 gran_load_cost = LOAD_COST;
1030 if (rts_argv[arg][3] != '\0')
1031 gran_store_cost = decode(rts_argv[arg]+3);
1033 gran_store_cost = STORE_COST;
1037 if (rts_argv[arg][3] != '\0')
1038 gran_heapalloc_cost = decode(rts_argv[arg]+3);
1040 gran_heapalloc_cost = 0;
1044 if (rts_argv[arg][3] != '\0')
1045 FetchStrategy = decode(rts_argv[arg]+3);
1047 FetchStrategy = 4; /* default: fetch everything */
1050 /* General Parameters */
1052 if (rts_argv[arg][3] != '\0')
1054 max_proc = decode(rts_argv[arg]+3);
1055 if(max_proc > MAX_PROC || max_proc < 1)
1057 fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n", MAX_PROC);
1062 max_proc = MAX_PROC;
1066 ++DoAlwaysCreateThreads;
1067 ++DoThreadMigration;
1075 ++DoThreadMigration;
1083 ++DoStealThreadsFirst;
1084 ++DoThreadMigration;
1088 ++DoReScheduleOnFetch;
1096 ++PreferSparksOfLocalNodes;
1112 switch(rts_argv[arg][3]) {
1115 DoAlwaysCreateThreads=0;
1116 DoThreadMigration=0;
1124 DoThreadMigration=0;
1132 DoStealThreadsFirst=0;
1133 DoThreadMigration=0;
1137 DoReScheduleOnFetch=0;
1141 PreferSparksOfLocalNodes=0;
1158 badoption( rts_argv[arg] );
1163 # if defined(GRAN_CHECK) && defined(GRAN)
1165 switch(rts_argv[arg][3]) {
1166 case 'e': /* event trace */
1167 fprintf(stderr,"Printing event trace.\n");
1172 fprintf(stderr,"Printing forwarding of FETCHNODES.\n");
1173 debug |= 0x2; /* print fwd messages */
1177 fprintf(stderr,"Check for blocked on fetch.\n");
1178 debug |= 0x4; /* debug non-reschedule-on-fetch */
1182 fprintf(stderr,"Check for TSO asleep on fetch.\n");
1183 debug |= 0x10; /* debug TSO asleep for fetch */
1187 fprintf(stderr,"Printing event statistics.\n");
1188 debug |= 0x20; /* print event statistics */
1192 fprintf(stderr,"Prohibiting forward.\n");
1193 NoForward = 1; /* prohibit forwarding */
1197 fprintf(stderr,"Printing fetch misses.\n");
1198 PrintFetchMisses = 1; /* prohibit forwarding */
1202 fprintf(stderr,"Debug mode.\n");
1207 fprintf(stderr,"Severe debug mode.\n");
1216 badoption( rts_argv[arg] );
1222 badoption( rts_argv[arg] );
1227 contextSwitchTime = 0;
1236 fprintf(stderr, "setupRtsFlags: Not built for parallel execution: %s\n", rts_argv[arg]);
1239 #else /* CONCURRENT */
1241 fprintf(stderr, "setupRtsFlags: Not built for threaded execution: %s\n", rts_argv[arg]);
1244 #endif /* CONCURRENT */
1245 case 'H': /* SM options -- ignore */
1254 case 'u': /* set dual mode threshold */
1258 default: /* Unknown option ! */
1259 fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n", rts_argv[arg]);
1266 fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n",
1274 for (p = flagtext; *p; p++)
1275 fprintf(stderr, "%s\n", *p);
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.
1287 #if defined(USE_COST_CENTRES) || defined(CONCURRENT)
1291 time_str(STG_NO_ARGS)
1293 static time_t now = 0;
1294 static char nowstr[26];
1298 strcpy(nowstr, ctime(&now));
1299 strcpy(nowstr+16,nowstr+19);
1304 #endif /* profiling */
1307 ToDo: Will this work under threads?
1310 StgStablePtr errorHandler = -1;
1312 StgInt getErrorHandler()
1314 return (StgInt) errorHandler;
1319 void raiseError( handler )
1320 StgStablePtr handler;
1322 if (handler == -1) {
1325 TopClosure = deRefStablePointer( handler );
1326 longjmp(restart_main,1);
1333 catchError( newErrorHandler )
1334 StgStablePtr newErrorHandler;
1336 StgStablePtr oldErrorHandler = errorHandler;
1337 errorHandler = newErrorHandler;
1338 return oldErrorHandler;
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.
1350 decrementErrorCount()
1352 ErrorIO_call_count-=1;