1 %/****************************************************************
3 %* This is where everything starts *
5 %****************************************************************/
8 #if defined(PROFILING) || defined(PAR) || 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 #else /* not STDC_HEADERS and not HAVE_STRING_H */
24 /* memory.h and strings.h conflict on some systems. */
25 #endif /* not STDC_HEADERS and not HAVE_STRING_H */
27 #if defined(PROFILING) || defined(PAR) || defined(GRAN)
28 /* need some "time" things */
30 /* ToDo: This is a mess! Improve ? */
32 # ifdef HAVE_SYS_TYPES_H
33 # include <sys/types.h>
36 # ifdef HAVE_SYS_TIMES_H
37 # include <sys/times.h>
40 # ifdef HAVE_SYS_TIME_H
41 # include <sys/time.h>
43 #endif /* PROFILING || PAR */
46 STGRegisterTable MainRegTable;
50 void shutdownHaskell(STG_NO_ARGS);
52 EXTFUN(startStgWorld);
53 extern void PrintTickyInfo(STG_NO_ARGS);
54 extern void checkAStack(STG_NO_ARGS);
56 /* a real nasty Global Variable */
57 /* moved to main/TopClosure(13)?.lc -- *one* of them will get linked in
58 P_ TopClosure = GHCmain_mainPrimIO_closure;
61 /* structure to carry around info about the storage manager */
62 smInfo StorageMgrInfo;
65 extern I_ OkToGC, buckets;
66 extern rtsBool TraceSparks, DelaySparks,
69 void RunParallelSystem PROTO((P_));
70 void initParallelSystem(STG_NO_ARGS);
71 void SynchroniseSystem(STG_NO_ARGS);
73 void SetTrace PROTO((W_ address, I_ level/*?*/));
76 void *stgAllocForGMP PROTO((size_t));
77 void *stgReallocForGMP PROTO ((void *, size_t, size_t));
78 void stgDeallocForGMP PROTO ((void *, size_t));
80 /* NeXTs can't just reach out and touch "end", to use in
81 distinguishing things in static vs dynamic (malloc'd) memory.
83 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
87 int prog_argc; /* an "int" so as to match normal "argc" */
89 int rts_argc; /* ditto */
90 char *rts_argv[MAX_RTS_ARGS];
93 jmp_buf restart_main; /* For restarting after a signal */
97 int nPEs = 0; /* Number of PEs */
100 int /* return type of "main" is defined by the C standard */
101 main(int argc, char *argv[])
108 The very first thing we do is grab the start time...just in case we're
109 collecting timing statistics.
115 The parallel system needs to be initialised and synchronised before
116 the program is run. This is done {\em before} heap allocation, so we
117 can grab all remaining heap without needing to consider the System
118 Manager's requirements.
122 if (*argv[0] == '-') { /* Look to see whether we're the Main Thread */
123 IAmMainThread = rtsTrue;
124 argv++; argc--; /* Strip off flag argument */
125 /* fprintf(stderr, "I am Main Thread\n"); */
128 * Grab the number of PEs out of the argument vector, and
129 * eliminate it from further argument processing.
131 nPEs = atoi(argv[1]);
134 initEachPEHook(); /* HWL: hook to be execed on each PE */
138 #if defined(PROFILING) || defined(PAR) || defined(GRAN)
139 /* setup string indicating time of run -- only used for profiling */
143 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
144 get_end_result = get_end();
148 divide the command-line args between pgm and RTS; figure out
149 what statsfile to use (if any); [if so, write the whole
152 This is unlikely to work well in parallel! KH.
154 initRtsFlagsDefaults();
155 defaultsHook(); /* the one supplied does nothing;
156 the user may have supplied a more interesting one.
159 setupRtsFlags(&argc, argv, &rts_argc, rts_argv);
164 /* Initialise the parallel system -- before initHeap! */
165 initParallelSystem();
168 #if defined(PROFILING) || defined(PAR)
169 if (init_cc_profiling(rts_argc, rts_argv, prog_argv) != 0) {
171 fprintf(stderr, "init_cc_profiling failed!\n");
177 if (!RTSflags.GranFlags.granSimStats_suppressed)
178 if (init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv) != 0) {
179 fprintf(stderr, "init_gr_simulation failed!\n");
185 if (RTSflags.ParFlags.granSimStats)
186 init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv);
189 /* initialize the storage manager */
193 if (! initStacks( &StorageMgrInfo )) {
195 fprintf(stderr, "initStacks failed!\n");
200 if (! initHeap( &StorageMgrInfo )) {
202 fprintf(stderr, "initHeap failed!\n");
206 #if defined(CONCURRENT) && !defined(GRAN)
207 if (!initThreadPools()) {
209 fprintf(stderr, "initThreadPools failed!\n");
214 #if defined(PROFILING) || defined(PAR)
215 /* call cost centre registering routine (after heap allocated) */
219 #if defined(TICKY_TICKY)
220 max_SpA = MAIN_SpA; /* initial high-water marks */
224 /* Tell GNU multi-precision pkg about our custom alloc functions */
225 mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
227 /* Record initialization times */
230 #if defined(PROFILING) || defined(CONCURRENT)
232 * Both the context-switcher and the cost-center profiler use
235 if (install_vtalrm_handler()) {
237 fprintf(stderr, "Can't install VTALRM handler.\n");
240 #if (defined(CONCURRENT) && defined(PROFILING)) || defined(PAR)
241 if (! time_profiling)
242 RTSflags.CcFlags.msecsPerTick = RTSflags.ConcFlags.ctxtSwitchTime;
244 if (RTSflags.ConcFlags.ctxtSwitchTime % (1000/TICK_FREQUENCY) == 0)
245 RTSflags.CcFlags.msecsPerTick = TICK_MILLISECS;
247 RTSflags.CcFlags.msecsPerTick = CS_MIN_MILLISECS;
249 RTSflags.CcFlags.ctxtSwitchTicks = RTSflags.ConcFlags.ctxtSwitchTime / RTSflags.CcFlags.msecsPerTick;
250 RTSflags.CcFlags.profilerTicks = TICK_MILLISECS / RTSflags.CcFlags.msecsPerTick;
258 #endif /* PROFILING || CONCURRENT */
261 setjmp(restart_main);
266 AvailableStack = AvailableTSO = PrelBase_Z91Z93_closure;
267 # if defined(GRAN) /* HWL */
268 /* Moved in here from ScheduleThreads, to handle a restart_main
269 (because of a signal) properly. */
270 for (i=0; i<RTSflags.GranFlags.proc; i++)
272 RunnableThreadsHd[i] = RunnableThreadsTl[i] = PrelBase_Z91Z93_closure;
273 WaitThreadsHd[i] = WaitThreadsTl[i] = PrelBase_Z91Z93_closure;
274 PendingSparksHd[i][REQUIRED_POOL] = PendingSparksHd[i][ADVISORY_POOL] =
275 PendingSparksTl[i][REQUIRED_POOL] = PendingSparksTl[i][ADVISORY_POOL] =
279 RunnableThreadsHd = RunnableThreadsTl = PrelBase_Z91Z93_closure;
280 WaitingThreadsHd = WaitingThreadsTl = PrelBase_Z91Z93_closure;
281 PendingSparksHd[REQUIRED_POOL] =
282 PendingSparksTl[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL];
283 PendingSparksHd[ADVISORY_POOL] =
284 PendingSparksTl[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL];
287 CurrentTSO = PrelBase_Z91Z93_closure;
290 RunParallelSystem(TopClosure);
292 STKO_LINK(MainStkO) = PrelBase_Z91Z93_closure;
293 ScheduleThreads(TopClosure);
296 #else /* not threaded (sequential) */
298 miniInterpret((StgFunPtr)startStgWorld);
300 #endif /* !CONCURRENT */
303 return(EXIT_SUCCESS); /* don't use EXIT! :-) */
307 It should be possible to call @shutdownHaskell@ whenever you want to
308 shut a Haskell program down in an orderly way.
310 Note that some of this code probably depends on the integrity of
311 various internal data structures so this should not be called in
312 response to detecting a catastrophic error.
316 shutdownHaskell(STG_NO_ARGS)
321 /* For some reason this must be before exitSM */
322 if (!RTSflags.GranFlags.granSimStats_suppressed)
326 if (! exitSM(&StorageMgrInfo) ) {
328 fprintf(stderr, "exitSM failed!\n");
332 #if defined(PROFILING)
333 heap_profile_finish();
335 #if defined(PROFILING) || defined(PAR)
336 report_cc_profiling(1 /* final */ );
339 #if defined(TICKY_TICKY)
340 if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
344 /* This fflush is important, because: if "main" just returns,
345 then we will end up in pre-supplied exit code that will close
346 streams and flush buffers. In particular we have seen: it
347 will close fd 0 (stdin), then flush fd 1 (stdout), then <who
350 But if you're playing with sockets, that "close fd 0" might
351 suggest to the daemon that all is over, only to be presented
352 with more stuff on "fd 1" at the flush.
354 The fflush avoids this sad possibility.
359 Sets up and returns a string indicating the date/time of the run.
360 Successive calls simply return the same string again. Initially
361 called by @main.lc@ to initialise the string at the start of the run.
362 Only used for profiling.
365 #if defined(PROFILING) || defined(CONCURRENT) || defined(GRAN)
369 time_str(STG_NO_ARGS)
371 static time_t now = 0;
372 static char nowstr[26];
376 strcpy(nowstr, ctime(&now));
377 strcpy(nowstr+16,nowstr+19);
382 #endif /* profiling */
385 ToDo: Will this work under threads?
388 StgStablePtr errorHandler = -1; /* NB: prone to magic-value-ery (WDP 95/12) */
391 getErrorHandler(STG_NO_ARGS)
393 return (StgInt) errorHandler;
399 raiseError( handler )
400 StgStablePtr handler;
402 if (handler == -1) { /* beautiful magic value... (WDP 95/12) */
406 TopClosure = deRefStablePointer( handler );
407 longjmp(restart_main,1);
414 catchError( newErrorHandler )
415 StgStablePtr newErrorHandler;
417 StgStablePtr oldErrorHandler = errorHandler;
418 errorHandler = newErrorHandler;
419 return oldErrorHandler;
425 If we have installed an error handler, we might want to
426 indicate that we have successfully recovered from an error by
427 decrementing the counter.
431 decrementErrorCount()
433 ErrorIO_call_count-=1;