%****************************************************************/
\begin{code}
-#if defined(USE_COST_CENTRES) || defined(GUM) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(PAR) || defined(CONCURRENT)
#define NON_POSIX_SOURCE /* time things on Solaris -- sigh */
#endif
# if !defined(STDC_HEADERS) && defined(HAVE_MEMORY_H)
# include <memory.h>
# endif /* not STDC_HEADERS and HAVE_MEMORY_H */
-# define index strchr
-# define rindex strrchr
-# define bcopy(s, d, n) memcpy ((d), (s), (n))
-# define bcmp(s1, s2, n) memcmp ((s1), (s2), (n))
-# define bzero(s, n) memset ((s), 0, (n))
+
#else /* not STDC_HEADERS and not HAVE_STRING_H */
# include <strings.h>
/* memory.h and strings.h conflict on some systems. */
#endif /* not STDC_HEADERS and not HAVE_STRING_H */
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
/* need some "time" things */
/* ToDo: This is a mess! Improve ? */
# ifdef HAVE_SYS_TIME_H
# include <sys/time.h>
# endif
-#endif /* USE_COST_CENTRES || GUM */
+#endif /* PROFILING || PAR */
#ifndef PAR
STGRegisterTable MainRegTable;
#endif
/* fwd decls */
-void setupRtsFlags PROTO((int *argc, char *argv[], I_ *rtsc, char *rtsv[]));
void shutdownHaskell(STG_NO_ARGS);
EXTFUN(startStgWorld);
-extern void PrintRednCountInfo(STG_NO_ARGS);
+extern void PrintTickyInfo(STG_NO_ARGS);
extern void checkAStack(STG_NO_ARGS);
/* a real nasty Global Variable */
/* structure to carry around info about the storage manager */
smInfo StorageMgrInfo;
-FILE *main_statsfile = NULL;
-#if defined(DO_REDN_COUNTING)
-FILE *tickyfile = NULL;
-#endif
-#if defined(SM_DO_BH_UPDATE)
-I_ noBlackHoles = 0;
-#endif
-I_ doSanityChks = 0;
-I_ showRednCountStats = 0;
-I_ traceUpdates = 0;
-extern I_ squeeze_upd_frames;
-
#ifdef PAR
-extern I_ OkToGC, buckets, average_stats();
-extern rtsBool TraceSparks, OutputDisabled, DelaySparks,
- DeferGlobalUpdates, ParallelStats;
+extern I_ OkToGC, buckets;
+extern rtsBool TraceSparks, DelaySparks,
+ DeferGlobalUpdates;
extern void RunParallelSystem PROTO((P_));
extern void initParallelSystem(STG_NO_ARGS);
extern void *stgReallocForGMP PROTO ((void *, size_t, size_t));
extern void stgDeallocForGMP PROTO ((void *, size_t));
-#if defined (DO_SPAT_PROFILING) && sparc_TARGET_ARCH
- /* NOTE: I, WDP, do not use this in my SPAT profiling */
-W_ KHHP, KHHPLIM, KHSPA, KHSPB;
-#endif
-
/* NeXTs can't just reach out and touch "end", to use in
distinguishing things in static vs dynamic (malloc'd) memory.
*/
void *get_end_result;
#endif
-I_ prog_argc;
+int prog_argc; /* an "int" so as to match normal "argc" */
char **prog_argv;
-I_ rts_argc;
+int rts_argc; /* ditto */
char *rts_argv[MAX_RTS_ARGS];
#ifndef PAR
unsigned nPEs = 0, nIMUs = 0;
#endif
-#if defined(GUM)
+#if defined(PAR)
int nPEs = 0;
#endif
int /* return type of "main" is defined by the C standard */
-main(argc, argv)
- int argc;
- char *argv[];
+main(int argc, char *argv[])
{
\end{code}
collecting timing statistics.
\begin{code}
-
start_time();
-
\end{code}
The parallel system needs to be initialised and synchronised before
\begin{code}
#ifdef PAR
/*
- * Grab the number of PEs out of the argument vector, and eliminate it
- * from further argument processing
+ * Grab the number of PEs out of the argument vector, and
+ * eliminate it from further argument processing.
*/
nPEs = atoi(argv[1]);
argv[1] = argv[0];
argv++;
argc--;
-/* fprintf(stderr, "I'm alive, nPEs = %d \n", nPEs); */
SynchroniseSystem();
#endif
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
/* setup string indicating time of run -- only used for profiling */
(void) time_str();
#endif
#endif
/*
- divide the command-line args between pgm and RTS;
- figure out what statsfile to use (if any);
- [if so, write the whole cmd-line into it]
+ divide the command-line args between pgm and RTS; figure out
+ what statsfile to use (if any); [if so, write the whole
+ cmd-line into it]
This is unlikely to work well in parallel! KH.
*/
+ initRtsFlagsDefaults();
+ defaultsHook(); /* the one supplied does nothing;
+ the user may have supplied a more interesting one.
+ */
+
setupRtsFlags(&argc, argv, &rts_argc, rts_argv);
prog_argc = argc;
prog_argv = argv;
initParallelSystem();
#endif /* PAR */
-#if defined(LIFE_PROFILE)
- if (life_profile_init(rts_argv, prog_argv) != 0) {
- fflush(stdout);
- fprintf(stderr, "life_profile_init failed!\n");
- EXIT(EXIT_FAILURE);
- }
-#endif
-
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
if (init_cc_profiling(rts_argc, rts_argv, prog_argv) != 0) {
fflush(stdout);
fprintf(stderr, "init_cc_profiling failed!\n");
#endif
#ifdef PAR
- if (do_gr_profile)
+ if (RTSflags.ParFlags.granSimStats)
init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv);
#endif
- /*
- initialize the storage manager
- */
- if ( initSM(rts_argc, rts_argv, main_statsfile) != 0) {
- fflush(stdout);
- fprintf(stderr, "initSM failed!\n");
- EXIT(EXIT_FAILURE);
- }
+ /* initialize the storage manager */
+ initSM();
#ifndef PAR
- if ( initStacks( &StorageMgrInfo ) != 0) {
+ if (! initStacks( &StorageMgrInfo )) {
fflush(stdout);
fprintf(stderr, "initStacks failed!\n");
EXIT(EXIT_FAILURE);
}
#endif
- if ( initHeap( &StorageMgrInfo ) != 0) {
+ if (! initHeap( &StorageMgrInfo )) {
fflush(stdout);
- fprintf(stderr, "initHeap failed!\n"); EXIT(EXIT_FAILURE);
+ fprintf(stderr, "initHeap failed!\n");
+ EXIT(EXIT_FAILURE);
}
#if defined(CONCURRENT) && !defined(GRAN)
- if (!initThreadPools(MaxLocalSparks)) {
+ if (!initThreadPools()) {
fflush(stdout);
fprintf(stderr, "initThreadPools failed!\n");
EXIT(EXIT_FAILURE);
}
#endif
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
/* call cost centre registering routine (after heap allocated) */
cc_register();
#endif
-/* Information needed by runtime trace analysers -- don't even ask what it does! */
- /* NOTE: I, WDP, do not use this in my SPAT profiling */
-#if defined (DO_SPAT_PROFILING) && sparc_TARGET_ARCH
- KHHPLIM = (W_) StorageMgrInfo.hplim;
- KHHP = (W_) StorageMgrInfo.hp;
- KHSPA = (W_) SAVE_SpA,
- KHSPB = (W_) SAVE_SpB;
-
-/* fprintf(stderr,"Hp = %lx, HpLim = %lx, SpA = %lx, SpB = %lx\n",KHHP,KHHPLIM,KHSPA,KHSPB); */
-
-/* NOT ME:
- __asm__("sethi %%hi(_KHHP),%%o0\n\tld [%%o0+%%lo(_KHHP)],%%g0" : : : "%%o0");
- __asm__("sethi %%hi(_KHHPLIM),%%o0\n\tld [%%o0+%%lo(_KHHPLIM)],%%g0" : : : "%%o0");
- __asm__("sethi %%hi(_KHSPA),%%o0\n\tld [%%o0+%%lo(_KHSPA)],%%g0" : : : "%%o0");
- __asm__("sethi %%hi(_KHSPB),%%o0\n\tld [%%o0+%%lo(_KHSPB)],%%g0" : : : "%%o0");
-*/
-#endif
-
-#if defined(DO_REDN_COUNTING)
+#if defined(TICKY_TICKY)
max_SpA = MAIN_SpA; /* initial high-water marks */
max_SpB = MAIN_SpB;
#endif
/* Record initialization times */
end_init();
-#if defined(USE_COST_CENTRES) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(CONCURRENT)
/*
* Both the context-switcher and the cost-center profiler use
* a virtual timer.
fprintf(stderr, "Can't install VTALRM handler.\n");
EXIT(EXIT_FAILURE);
}
-#if (defined(CONCURRENT) && defined(USE_COST_CENTRES)) || defined(GUM)
- if (time_profiling) {
- if (contextSwitchTime % (1000/TICK_FREQUENCY) == 0)
- tick_millisecs = TICK_MILLISECS;
+#if (defined(CONCURRENT) && defined(PROFILING)) || defined(PAR)
+ if (! time_profiling)
+ RTSflags.CcFlags.msecsPerTick = RTSflags.ConcFlags.ctxtSwitchTime;
+ else {
+ if (RTSflags.ConcFlags.ctxtSwitchTime % (1000/TICK_FREQUENCY) == 0)
+ RTSflags.CcFlags.msecsPerTick = TICK_MILLISECS;
else
- tick_millisecs = CS_MIN_MILLISECS;
+ RTSflags.CcFlags.msecsPerTick = CS_MIN_MILLISECS;
- contextSwitchTicks = contextSwitchTime / tick_millisecs;
- profilerTicks = TICK_MILLISECS / tick_millisecs;
- } else
- tick_millisecs = contextSwitchTime;
+ RTSflags.CcFlags.ctxtSwitchTicks = RTSflags.ConcFlags.ctxtSwitchTime / RTSflags.CcFlags.msecsPerTick;
+ RTSflags.CcFlags.profilerTicks = TICK_MILLISECS / RTSflags.CcFlags.msecsPerTick;
+ }
#endif
#ifndef CONCURRENT
START_TIME_PROFILER;
#endif
-#endif /* USE_COST_CENTRES || CONCURRENT */
+#endif /* PROFILING || CONCURRENT */
#ifndef PAR
setjmp(restart_main);
#else /* not threaded (sequential) */
-# if defined(__STG_TAILJUMPS__)
miniInterpret((StgFunPtr)startStgWorld);
-# else
- if (doSanityChks)
- miniInterpret_debug((StgFunPtr)startStgWorld, checkAStack);
- else
- miniInterpret((StgFunPtr)startStgWorld);
-# endif /* not tail-jumping */
+
#endif /* !CONCURRENT */
shutdownHaskell();
{
STOP_TIME_PROFILER;
- if (exitSM(&StorageMgrInfo) != 0) {
+ if (! exitSM(&StorageMgrInfo)) {
fflush(stdout);
fprintf(stderr, "exitSM failed!\n");
EXIT(EXIT_FAILURE);
}
-#if defined(LIFE_PROFILE)
- {
- extern P_ hp_start; /* from the SM -- Hack! */
- life_profile_finish(StorageMgrInfo.hp - hp_start, prog_argv);
- }
-#endif
-#if defined(USE_COST_CENTRES)
+#if defined(PROFILING)
heap_profile_finish();
#endif
-#if defined(USE_COST_CENTRES) || defined(GUM)
+#if defined(PROFILING) || defined(PAR)
report_cc_profiling(1 /* final */ );
#endif
-#if defined(DO_REDN_COUNTING)
- if (showRednCountStats) {
- PrintRednCountInfo();
- }
+#if defined(TICKY_TICKY)
+ if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
#endif
#if defined(GRAN_CHECK) && defined(GRAN)
}
\end{code}
-%/****************************************************************
-%* *
-%* Getting default settings for RTS parameters *
-%* *
-%* +RTS indicates following arguments destined for RTS *
-%* -RTS indicates following arguments destined for program *
-%* *
-%****************************************************************/
-\begin{code}
-
-char *flagtext[] = {
-"",
-"Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>",
-"",
-" +RTS Indicates run time system options follow",
-" -RTS Indicates program arguments follow",
-" --RTS Indicates that ALL subsequent arguments will be given to the",
-" program (including any of these RTS flags)",
-"",
-"The following run time system options are available:",
-"",
-" -? -f Prints this message and exits; the program is not executed",
-"",
-" -K<size> Sets the stack size (default 64k) Egs: -K32k -K512k",
-" -H<size> Sets the heap size (default 4M) -H512k -H16M",
-" -s<file> Summary GC statistics (default file: <program>.stat)",
-" -S<file> Detailed GC statistics (with -Sstderr going to stderr)",
-"",
-#if defined(GCap)
-" -M<n>% Sets minimum size of alloc area as % of heap (default 3%)",
-" -A<size> Fixes size of alloc area, overriding any minimum (-A gives 64k)",
-" -G<size> Fixes size of major generation (default is dynamic threshold)",
-" -F2s Forces program compiled for Appel gc to use 2s collection",
-#else
-# if defined(GCgn)
-" -A<size> Specifies size of alloc area (default 64k)",
-" -G<size> Fixes size of major generation (default is available heap)",
-" -F2s Forces program compiled for Gen gc to use 2s collection",
-# else
-" -M<n>% Minimum % of heap which must be available (default 3%)",
-" -A<size> Fixes size of heap area allocated between GCs (-A gives 64k)",
-# endif
-#endif
-#if defined(FORCE_GC)
-" -j<size> Forces major GC at every <size> bytes allocated",
-#endif /* FORCE_GC */
-#if defined(GCdu)
-" -u<percent> Fixes residency threshold at which mode switches (range 0.0..0.95)",
-#endif
-"",
-#if defined(SM_DO_BH_UPDATE)
-" -N No black-holing (for use when a signal handler is present)",
-#endif
-" -Z Don't squeeze out update frames on stack overflow",
-" -B Sound the bell at the start of each (major) garbage collection",
-#if defined(USE_COST_CENTRES) || defined(GUM)
-"",
-" -p<sort> Produce cost centre time profile (output file <program>.prof)",
-" sort: T = time (default), A = alloc, C = cost centre label",
-" -P<sort> Produce serial time profile (output file <program>.time)",
-" and a -p profile with detailed caf/enter/tick/alloc info",
-#if defined(USE_COST_CENTRES)
-"",
-" -h<break-down> Heap residency profile (output file <program>.hp)",
-" break-down: C = cost centre (default), M = module, G = group",
-" D = closure description, Y = type description",
-" T<ints>,<start> = time closure created",
-" ints: no. of interval bands plotted (default 18)",
-" start: seconds after which intervals start (default 0.0)",
-" A subset of closures may be selected by the attached cost centre using:",
-" -c{mod:lab,mod:lab...}, specific module:label cost centre(s)",
-" -m{mod,mod...} all cost centres from the specified modules(s)",
-" -g{grp,grp...} all cost centres from the specified group(s)",
-" Selections can also be made by description, type, kind and age:",
-" -d{des,des...} closures with specified closure descriptions",
-" -y{typ,typ...} closures with specified type descriptions",
-" -k{knd,knd...} closures of the specified kinds",
-" -a<age> closures which survived <age> complete intervals",
-" The selection logic used is summarised as follows:",
-" ([-c] or [-m] or [-g]) and ([-d] or [-y] or [-k]) and [-a]",
-" where an option is true if not specified",
-#endif
-"",
-" -z<tbl><size> set hash table <size> for <tbl> (C, M, G, D or Y)",
-"",
-" -i<secs> Number of seconds in a profiling interval (default 1.0):",
-" heap profile (-h) and/or serial time profile (-P) frequency",
-#endif /* USE_COST_CENTRES */
-#if defined(LIFE_PROFILE)
-"",
-" -l<res> Produce liftime and update profile (output file <program>.life)",
-" res: the age resolution in bytes allocated (default 10,000)",
-#endif /* LIFE_PROFILE */
-"",
-#if defined(DO_REDN_COUNTING)
-" -r<file> Produce reduction profiling statistics (with -rstderr for stderr)",
-"",
-#endif
-" -I Use debugging miniInterpret with stack and heap sanity-checking.",
-" -T<level> Trace garbage collection execution (debugging)",
-#ifdef CONCURRENT
-"",
-# ifdef PAR
-" -N<n> Use <n> PVMish processors in parallel (default: 2)",
-/* NB: the -N<n> is implemented by the driver!! */
-# endif
-" -C<secs> Context-switch interval in seconds",
-" (0 or no argument means switch as often as possible)",
-" the default is .01 sec; resolution is .01 sec",
-" -e<size> Size of spark pools (default 100)",
-# ifdef PAR
-" -q Enable activity profile (output files in ~/<program>*.gr)",
-" -qb Enable binary activity profile (output file /tmp/<program>.gb)",
-#else
-" -q[v] Enable quasi-parallel profile (output file <program>.qp)",
-# endif
-" -t<num> Set maximum number of advisory threads per PE (default 32)",
-" -o<num> Set stack chunk size (default 1024)",
-# ifdef PAR
-" -d Turn on PVM-ish debugging",
-" -O Disable output for performance measurement",
-# endif /* PAR */
-#endif /* CONCURRENT */
-"",
-"Other RTS options may be available for programs compiled a different way.",
-"The GHC User's Guide has full details.",
-"",
-0
-};
-
-#define RTS 1
-#define PGM 0
-
-#ifndef atof
-extern double atof();
-/* no proto because some machines use const and some do not */
-#endif
-
-void
-setupRtsFlags(argc, argv, rts_argc, rts_argv)
-int *argc;
-I_ *rts_argc;
-char *argv[], *rts_argv[];
-{
- I_ error = 0;
- I_ mode;
- I_ arg, total_arg;
- char *last_slash;
-
- /* Remove directory from argv[0] -- default files in current directory */
-
- if ((last_slash = (char *) rindex(argv[0], '/')) != NULL)
- strcpy(argv[0], last_slash+1);
-
- /* Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts */
- /* argv[0] must be PGM argument -- leave in argv */
-
- total_arg = *argc;
- arg = 1;
-
- *argc = 1;
- *rts_argc = 0;
-
- for (mode = PGM; arg < total_arg && strcmp("--RTS", argv[arg]) != 0; arg++) {
- if (strcmp("+RTS", argv[arg]) == 0) {
- mode = RTS;
- }
- else if (strcmp("-RTS", argv[arg]) == 0) {
- mode = PGM;
- }
- else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
- rts_argv[(*rts_argc)++] = argv[arg];
- }
- else if (mode == PGM) {
- argv[(*argc)++] = argv[arg];
- }
- else {
- fflush(stdout);
- fprintf(stderr, "setupRtsFlags: Too many RTS arguments (max %d)\n",
- MAX_RTS_ARGS-1);
- EXIT(EXIT_FAILURE);
- }
- }
- if (arg < total_arg) {
- /* arg must be --RTS; process remaining program arguments */
- while (++arg < total_arg) {
- argv[(*argc)++] = argv[arg];
- }
- }
- argv[*argc] = (char *) 0;
- rts_argv[*rts_argc] = (char *) 0;
-
- /* Process RTS (rts_argv) part: mainly to determine statsfile */
-
- for (arg = 0; arg < *rts_argc; arg++) {
- if (rts_argv[arg][0] == '-') {
- switch(rts_argv[arg][1]) {
- case '?':
- case 'f':
- error = 1;
- break;
-
- case 'Z': /* Don't squeeze out update frames */
- squeeze_upd_frames = 0;
- break;
-
-#if defined(SM_DO_BH_UPDATE)
- case 'N':
- noBlackHoles++;
- break;
-#endif
-
- case 'I':
- doSanityChks++;
-#if defined(__STG_TAILJUMPS__)
- /* Blech -- too many errors if run in parallel -- KH */
- fprintf(stderr, "setupRtsFlags: Using Tail Jumps: Sanity checks not possible: %s\n", rts_argv[arg]);
- error = 1;
-#endif
- break;
-
- case 'U':
- traceUpdates++;
-#if ! defined(DO_RUNTIME_TRACE_UPDATES)
- fprintf(stderr, "setupRtsFlags: Update Tracing not compiled in: %s\n", rts_argv[arg]);
- error = 1;
-#endif
- break;
-
- case 'r': /* Basic profiling stats */
- showRednCountStats++;
-#if ! defined(DO_REDN_COUNTING)
- fprintf(stderr, "setupRtsFlags: Reduction counting not compiled in: %s\n", rts_argv[arg]);
- error = 1;
-
-#else /* ticky-ticky! */
- if (strcmp(rts_argv[arg]+2, "stderr") == 0) /* use real stderr */
- tickyfile = stderr;
- else if (rts_argv[arg][2] != '\0') /* ticky file specified */
- tickyfile = fopen(rts_argv[arg]+2,"w");
- else {
- char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.ticky */
- sprintf(stats_filename, TICKY_FILENAME_FMT, argv[0]);
- tickyfile = fopen(stats_filename,"w");
- }
- if (tickyfile == NULL) {
- fprintf(stderr, "Can't open tickyfile %s\n",
- rts_argv[arg]+2);
- error = 1;
- } else {
- /* Write argv and rtsv into start of ticky file */
- I_ count;
- for(count = 0; count < *argc; count++)
- fprintf(tickyfile, "%s ", argv[count]);
- fprintf(tickyfile, "+RTS ");
- for(count = 0; count < *rts_argc; count++)
- fprintf(tickyfile, "%s ", rts_argv[count]);
- fprintf(tickyfile, "\n");
- }
-#endif /* ticky-ticky! */
- break;
-
- case 's': /* Also used by GC -- open file here */
- case 'S':
-#ifdef PAR
- /* Opening all those files would almost certainly fail... */
- ParallelStats = rtsTrue;
- main_statsfile = stderr; /* temporary; ToDo: rm */
-#else
- if (strcmp(rts_argv[arg]+2, "stderr") == 0) /* use real stderr */
- main_statsfile = stderr;
- else if (rts_argv[arg][2] != '\0') /* stats file specified */
- main_statsfile = fopen(rts_argv[arg]+2,"w");
- else {
- char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.stat */
- sprintf(stats_filename, STAT_FILENAME_FMT, argv[0]);
- main_statsfile = fopen(stats_filename,"w");
- }
- if (main_statsfile == NULL) {
- fprintf(stderr, "Can't open statsfile %s\n", rts_argv[arg]+2);
- error = 1;
- } else {
- /* Write argv and rtsv into start of stats file */
- I_ count;
- for(count = 0; count < *argc; count++)
- fprintf(main_statsfile, "%s ", argv[count]);
- fprintf(main_statsfile, "+RTS ");
- for(count = 0; count < *rts_argc; count++)
- fprintf(main_statsfile, "%s ", rts_argv[count]);
- fprintf(main_statsfile, "\n");
- }
-#endif
- break;
-
- case 'P': /* detailed cost centre profiling (time/alloc) */
- case 'p': /* cost centre profiling (time/alloc) */
- case 'i': /* serial profiling -- initial timer interval */
-#if ! (defined(USE_COST_CENTRES) || defined(GUM))
- fprintf(stderr, "setupRtsFlags: Not built for cost centre profiling: %s\n", rts_argv[arg]);
- error = 1;
-#endif /* ! (USE_COST_CENTRES || GUM) */
- break;
- case 'h': /* serial heap profile */
- case 'z': /* size of index tables */
- case 'c': /* cost centre label select */
- case 'm': /* cost centre module select */
- case 'g': /* cost centre group select */
- case 'd': /* closure descr select */
- case 'y': /* closure type select */
- case 'k': /* closure kind select */
- case 'a': /* closure age select */
-#if ! defined(USE_COST_CENTRES)
- fprintf(stderr, "setupRtsFlags: Not built for cost centre profiling: %s\n", rts_argv[arg]);
- error = 1;
-#endif /* ! USE_COST_CENTRES */
- break;
-
- case 'j': /* force GC option */
-#if defined(FORCE_GC)
- force_GC++;
- if (rts_argv[arg][2]) {
- GCInterval = decode(rts_argv[arg]+2) / sizeof(W_);
- }
-#else /* ! FORCE_GC */
- fprintf(stderr, "setupRtsFlags: Not built for forcing GC: %s\n", rts_argv[arg]);
- error = 1;
-#endif /* ! FORCE_GC */
- break;
-
- case 'l': /* life profile option */
-#if defined(LIFE_PROFILE)
- do_life_prof++;
- if (rts_argv[arg][2]) {
- LifeInterval = decode(rts_argv[arg]+2) / sizeof(W_);
- }
-#else /* ! LIFE_PROFILE */
- fprintf(stderr, "setupRtsFlags: Not built for lifetime profiling: %s\n", rts_argv[arg]);
- error = 1;
-#endif /* ! LIFE_PROFILE */
- break;
-
- /* Flags for the threaded RTS */
-
-#ifdef CONCURRENT
- case 'C': /* context switch interval */
- if (rts_argv[arg][2] != '\0') {
- /* Convert to milliseconds */
- contextSwitchTime = (I_) ((atof(rts_argv[arg]+2) * 1000));
- contextSwitchTime = (contextSwitchTime / CS_MIN_MILLISECS)
- * CS_MIN_MILLISECS;
- if (contextSwitchTime < CS_MIN_MILLISECS)
- contextSwitchTime = CS_MIN_MILLISECS;
- } else
- contextSwitchTime = 0;
- break;
-#if !defined(GRAN)
- case 'e':
- if (rts_argv[arg][2] != '\0') {
- MaxLocalSparks = strtol(rts_argv[arg]+2, (char **) NULL, 10);
- if (MaxLocalSparks <= 0) {
- fprintf(stderr, "setupRtsFlags: bad value for -e\n");
- error = 1;
- }
- } else
- MaxLocalSparks = DEFAULT_MAX_LOCAL_SPARKS;
- break;
-#endif
-#ifdef PAR
- case 'q': /* activity profile option */
- if (rts_argv[arg][2] == 'b')
- do_gr_binary++;
- else
- do_gr_profile++;
- break;
-#else
- case 'q': /* quasi-parallel profile option */
- if (rts_argv[arg][2] == 'v')
- do_qp_prof = 2;
- else
- do_qp_prof++;
- break;
-#endif
- case 't':
- if (rts_argv[arg][2] != '\0') {
- MaxThreads = strtol(rts_argv[arg]+2, (char **) NULL, 10);
- } else {
- fprintf(stderr, "setupRtsFlags: missing size for -t\n");
- error = 1;
- }
- break;
-
- case 'o':
- if (rts_argv[arg][2] != '\0') {
- StkOChunkSize = decode(rts_argv[arg]+2);
- if (StkOChunkSize < MIN_STKO_CHUNK_SIZE)
- StkOChunkSize = MIN_STKO_CHUNK_SIZE;
- } else {
- fprintf(stderr, "setupRtsFlags: missing size for -o\n");
- error = 1;
- }
- break;
-
-# ifdef PAR
- case 'O':
- OutputDisabled = rtsTrue;
- break;
-
-# else /* PAR */
-
-# if !defined(GRAN)
- case 'b': /* will fall through to disaster */
-# else
- case 'b':
- if (rts_argv[arg][2] != '\0') {
-
- /* Should we emulate hbcpp */
- if(strcmp((rts_argv[arg]+2),"roken")==0) {
- ++DoAlwaysCreateThreads;
- strcpy(rts_argv[arg]+2,"oring");
- }
-
- /* or a ridiculously idealised simulator */
- if(strcmp((rts_argv[arg]+2),"oring")==0) {
- gran_latency = gran_fetchtime = gran_additional_latency =
- gran_gunblocktime = gran_lunblocktime
- = gran_threadcreatetime = gran_threadqueuetime
- = gran_threadscheduletime = gran_threaddescheduletime
- = gran_threadcontextswitchtime
- = 0;
-
- gran_mpacktime = gran_munpacktime = 0;
-
- gran_arith_cost = gran_float_cost = gran_load_cost
- = gran_store_cost = gran_branch_cost = 0;
-
- gran_heapalloc_cost = 1;
-
- /* ++DoFairSchedule; */
- ++DoStealThreadsFirst;
- ++DoThreadMigration;
- ++do_gr_profile;
- }
-
- /* or a ridiculously idealised simulator */
- if(strcmp((rts_argv[arg]+2),"onzo")==0) {
- gran_latency = gran_fetchtime = gran_additional_latency =
- gran_gunblocktime = gran_lunblocktime
- = gran_threadcreatetime = gran_threadqueuetime
- = gran_threadscheduletime = gran_threaddescheduletime
- = gran_threadcontextswitchtime
- = 0;
-
- gran_mpacktime = gran_munpacktime = 0;
-
- /* Keep default values for these
- gran_arith_cost = gran_float_cost = gran_load_cost
- = gran_store_cost = gran_branch_cost = 0;
- */
-
- gran_heapalloc_cost = 1;
-
- /* ++DoFairSchedule; */ /* -b-R */
- /* ++DoStealThreadsFirst; */ /* -b-T */
- ++DoReScheduleOnFetch; /* -bZ */
- ++DoThreadMigration; /* -bM */
- ++do_gr_profile; /* -bP */
-# if defined(GRAN_CHECK) && defined(GRAN)
- debug = 0x20; /* print event statistics */
-# endif
- }
-
- /* Communication and task creation cost parameters */
- else switch(rts_argv[arg][2]) {
- case 'l':
- if (rts_argv[arg][3] != '\0')
- {
- gran_gunblocktime = gran_latency = decode(rts_argv[arg]+3);
- gran_fetchtime = 2* gran_latency;
- }
- else
- gran_latency = LATENCY;
- break;
-
- case 'a':
- if (rts_argv[arg][3] != '\0')
- gran_additional_latency = decode(rts_argv[arg]+3);
- else
- gran_additional_latency = ADDITIONAL_LATENCY;
- break;
-
- case 'm':
- if (rts_argv[arg][3] != '\0')
- gran_mpacktime = decode(rts_argv[arg]+3);
- else
- gran_mpacktime = MSGPACKTIME;
- break;
-
- case 'x':
- if (rts_argv[arg][3] != '\0')
- gran_mtidytime = decode(rts_argv[arg]+3);
- else
- gran_mtidytime = 0;
- break;
-
- case 'r':
- if (rts_argv[arg][3] != '\0')
- gran_munpacktime = decode(rts_argv[arg]+3);
- else
- gran_munpacktime = MSGUNPACKTIME;
- break;
-
- case 'f':
- if (rts_argv[arg][3] != '\0')
- gran_fetchtime = decode(rts_argv[arg]+3);
- else
- gran_fetchtime = FETCHTIME;
- break;
-
- case 'n':
- if (rts_argv[arg][3] != '\0')
- gran_gunblocktime = decode(rts_argv[arg]+3);
- else
- gran_gunblocktime = GLOBALUNBLOCKTIME;
- break;
-
- case 'u':
- if (rts_argv[arg][3] != '\0')
- gran_lunblocktime = decode(rts_argv[arg]+3);
- else
- gran_lunblocktime = LOCALUNBLOCKTIME;
- break;
-
- /* Thread-related metrics */
- case 't':
- if (rts_argv[arg][3] != '\0')
- gran_threadcreatetime = decode(rts_argv[arg]+3);
- else
- gran_threadcreatetime = THREADCREATETIME;
- break;
-
- case 'q':
- if (rts_argv[arg][3] != '\0')
- gran_threadqueuetime = decode(rts_argv[arg]+3);
- else
- gran_threadqueuetime = THREADQUEUETIME;
- break;
-
- case 'c':
- if (rts_argv[arg][3] != '\0')
- gran_threadscheduletime = decode(rts_argv[arg]+3);
- else
- gran_threadscheduletime = THREADSCHEDULETIME;
-
- gran_threadcontextswitchtime = gran_threadscheduletime
- + gran_threaddescheduletime;
- break;
-
- case 'd':
- if (rts_argv[arg][3] != '\0')
- gran_threaddescheduletime = decode(rts_argv[arg]+3);
- else
- gran_threaddescheduletime = THREADDESCHEDULETIME;
-
- gran_threadcontextswitchtime = gran_threadscheduletime
- + gran_threaddescheduletime;
- break;
-
- /* Instruction Cost Metrics */
- case 'A':
- if (rts_argv[arg][3] != '\0')
- gran_arith_cost = decode(rts_argv[arg]+3);
- else
- gran_arith_cost = ARITH_COST;
- break;
-
- case 'F':
- if (rts_argv[arg][3] != '\0')
- gran_float_cost = decode(rts_argv[arg]+3);
- else
- gran_float_cost = FLOAT_COST;
- break;
-
- case 'B':
- if (rts_argv[arg][3] != '\0')
- gran_branch_cost = decode(rts_argv[arg]+3);
- else
- gran_branch_cost = BRANCH_COST;
- break;
-
- case 'L':
- if (rts_argv[arg][3] != '\0')
- gran_load_cost = decode(rts_argv[arg]+3);
- else
- gran_load_cost = LOAD_COST;
- break;
-
- case 'S':
- if (rts_argv[arg][3] != '\0')
- gran_store_cost = decode(rts_argv[arg]+3);
- else
- gran_store_cost = STORE_COST;
- break;
-
- case 'H':
- if (rts_argv[arg][3] != '\0')
- gran_heapalloc_cost = decode(rts_argv[arg]+3);
- else
- gran_heapalloc_cost = 0;
- break;
-
- case 'y':
- if (rts_argv[arg][3] != '\0')
- FetchStrategy = decode(rts_argv[arg]+3);
- else
- FetchStrategy = 4; /* default: fetch everything */
- break;
-
- /* General Parameters */
- case 'p':
- if (rts_argv[arg][3] != '\0')
- {
- max_proc = decode(rts_argv[arg]+3);
- if(max_proc > MAX_PROC || max_proc < 1)
- {
- fprintf(stderr,"setupRtsFlags: no more than %u processors allowed\n", MAX_PROC);
- error = 1;
- }
- }
- else
- max_proc = MAX_PROC;
- break;
-
- case 'C':
- ++DoAlwaysCreateThreads;
- ++DoThreadMigration;
- break;
-
- case 'G':
- ++DoGUMMFetching;
- break;
-
- case 'M':
- ++DoThreadMigration;
- break;
-
- case 'R':
- ++DoFairSchedule;
- break;
-
- case 'T':
- ++DoStealThreadsFirst;
- ++DoThreadMigration;
- break;
-
- case 'Z':
- ++DoReScheduleOnFetch;
- break;
-
- case 'z':
- ++SimplifiedFetch;
- break;
-
- case 'N':
- ++PreferSparksOfLocalNodes;
- break;
-
- case 'b':
- ++do_gr_binary;
- break;
-
- case 'P':
- ++do_gr_profile;
- break;
-
- case 's':
- ++do_sp_profile;
- break;
-
- case '-':
- switch(rts_argv[arg][3]) {
-
- case 'C':
- DoAlwaysCreateThreads=0;
- DoThreadMigration=0;
- break;
-
- case 'G':
- DoGUMMFetching=0;
- break;
-
- case 'M':
- DoThreadMigration=0;
- break;
-
- case 'R':
- DoFairSchedule=0;
- break;
-
- case 'T':
- DoStealThreadsFirst=0;
- DoThreadMigration=0;
- break;
-
- case 'Z':
- DoReScheduleOnFetch=0;
- break;
-
- case 'N':
- PreferSparksOfLocalNodes=0;
- break;
-
- case 'P':
- do_gr_profile=0;
- no_gr_profile=1;
- break;
-
- case 's':
- do_sp_profile=0;
- break;
-
- case 'b':
- do_gr_binary=0;
- break;
-
- default:
- badoption( rts_argv[arg] );
- break;
- }
- break;
-
-# if defined(GRAN_CHECK) && defined(GRAN)
- case 'D':
- switch(rts_argv[arg][3]) {
- case 'e': /* event trace */
- fprintf(stderr,"Printing event trace.\n");
- ++event_trace;
- break;
-
- case 'f':
- fprintf(stderr,"Printing forwarding of FETCHNODES.\n");
- debug |= 0x2; /* print fwd messages */
- break;
-
- case 'z':
- fprintf(stderr,"Check for blocked on fetch.\n");
- debug |= 0x4; /* debug non-reschedule-on-fetch */
- break;
-
- case 't':
- fprintf(stderr,"Check for TSO asleep on fetch.\n");
- debug |= 0x10; /* debug TSO asleep for fetch */
- break;
-
- case 'E':
- fprintf(stderr,"Printing event statistics.\n");
- debug |= 0x20; /* print event statistics */
- break;
-
- case 'F':
- fprintf(stderr,"Prohibiting forward.\n");
- NoForward = 1; /* prohibit forwarding */
- break;
-
- case 'm':
- fprintf(stderr,"Printing fetch misses.\n");
- PrintFetchMisses = 1; /* prohibit forwarding */
- break;
-
- case 'd':
- fprintf(stderr,"Debug mode.\n");
- debug |= 0x40;
- break;
-
- case 'D':
- fprintf(stderr,"Severe debug mode.\n");
- debug |= 0x80;
- break;
-
- case '\0':
- debug = 1;
- break;
-
- default:
- badoption( rts_argv[arg] );
- break;
- }
- break;
-# endif
- default:
- badoption( rts_argv[arg] );
- break;
- }
- }
- do_gr_sim++;
- contextSwitchTime = 0;
- break;
-# endif
- case 'J':
- case 'Q':
- case 'D':
- case 'R':
- case 'L':
- case 'O':
- fprintf(stderr, "setupRtsFlags: Not built for parallel execution: %s\n", rts_argv[arg]);
- error = 1;
-# endif /* PAR */
-#else /* CONCURRENT */
- case 't':
- fprintf(stderr, "setupRtsFlags: Not built for threaded execution: %s\n", rts_argv[arg]);
- error = 1;
-
-#endif /* CONCURRENT */
- case 'H': /* SM options -- ignore */
- case 'A':
- case 'G':
- case 'F':
- case 'K':
- case 'M':
- case 'B':
- case 'T':
-#ifdef GCdu
- case 'u': /* set dual mode threshold */
-#endif
- break;
-
- default: /* Unknown option ! */
- fprintf(stderr, "setupRtsFlags: Unknown RTS option: %s\n", rts_argv[arg]);
- error = 1;
- break;
- }
- }
- else {
- fflush(stdout);
- fprintf(stderr, "setupRtsFlags: Unexpected RTS argument: %s\n",
- rts_argv[arg]);
- error = 1;
- }
- }
- if (error == 1) {
- char **p;
- fflush(stdout);
- for (p = flagtext; *p; p++)
- fprintf(stderr, "%s\n", *p);
- EXIT(EXIT_FAILURE);
- }
-}
-\end{code}
-
Sets up and returns a string indicating the date/time of the run.
Successive calls simply return the same string again. Initially
called by @main.lc@ to initialise the string at the start of the run.
Only used for profiling.
\begin{code}
-#if defined(USE_COST_CENTRES) || defined(CONCURRENT)
+#if defined(PROFILING) || defined(CONCURRENT)
# include <time.h>
char *
ToDo: Will this work under threads?
\begin{code}
-StgStablePtr errorHandler = -1;
+StgStablePtr errorHandler = -1; /* NB: prone to magic-value-ery (WDP 95/12) */
-StgInt getErrorHandler()
+StgInt
+getErrorHandler(STG_NO_ARGS)
{
return (StgInt) errorHandler;
}
#ifndef PAR
-void raiseError( handler )
-StgStablePtr handler;
+void
+raiseError( handler )
+ StgStablePtr handler;
{
- if (handler == -1) {
+ if (handler == -1) { /* beautiful magic value... (WDP 95/12) */
shutdownHaskell();
+ EXIT(EXIT_FAILURE);
} else {
TopClosure = deRefStablePointer( handler );
longjmp(restart_main,1);
\begin{code}
StgInt
catchError( newErrorHandler )
-StgStablePtr newErrorHandler;
+ StgStablePtr newErrorHandler;
{
StgStablePtr oldErrorHandler = errorHandler;
errorHandler = newErrorHandler;
projects / ghc-hetmet.git / blobdiff