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)
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 = Main_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 extern void RunParallelSystem PROTO((P_));
70 extern void initParallelSystem(STG_NO_ARGS);
71 extern void SynchroniseSystem(STG_NO_ARGS);
73 extern void SetTrace PROTO((W_ address, I_ level/*?*/));
76 #if defined(GRAN_CHECK) && defined(GRAN)
78 extern W_ event_trace ;
79 extern W_ event_trace_all ;
82 extern void *stgAllocForGMP PROTO((size_t));
83 extern void *stgReallocForGMP PROTO ((void *, size_t, size_t));
84 extern void stgDeallocForGMP PROTO ((void *, size_t));
86 /* NeXTs can't just reach out and touch "end", to use in
87 distinguishing things in static vs dynamic (malloc'd) memory.
89 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
93 int prog_argc; /* an "int" so as to match normal "argc" */
95 int rts_argc; /* ditto */
96 char *rts_argv[MAX_RTS_ARGS];
99 jmp_buf restart_main; /* For restarting after a signal */
103 int nPEs = 0; /* Number of PEs */
106 int /* return type of "main" is defined by the C standard */
107 main(int argc, char *argv[])
111 The very first thing we do is grab the start time...just in case we're
112 collecting timing statistics.
118 The parallel system needs to be initialised and synchronised before
119 the program is run. This is done {\em before} heap allocation, so we
120 can grab all remaining heap without needing to consider the System
121 Manager's requirements.
125 if (*argv[0] == '-') { /* Look to see whether we're the Main Thread */
126 IAmMainThread = rtsTrue;
128 fprintf(stderr, "I am Main Thread\n");
131 * Grab the number of PEs out of the argument vector, and
132 * eliminate it from further argument processing.
134 nPEs = atoi(argv[1]);
140 #if defined(PROFILING) || defined(PAR)
141 /* setup string indicating time of run -- only used for profiling */
145 #if nextstep2_TARGET_OS || nextstep3_TARGET_OS /* ToDo: use END_BY_FUNNY_MEANS or something */
146 get_end_result = get_end();
150 divide the command-line args between pgm and RTS; figure out
151 what statsfile to use (if any); [if so, write the whole
154 This is unlikely to work well in parallel! KH.
156 initRtsFlagsDefaults();
157 defaultsHook(); /* the one supplied does nothing;
158 the user may have supplied a more interesting one.
161 setupRtsFlags(&argc, argv, &rts_argc, rts_argv);
166 /* Initialise the parallel system -- before initHeap! */
167 initParallelSystem();
170 #if defined(PROFILING) || defined(PAR)
171 if (init_cc_profiling(rts_argc, rts_argv, prog_argv) != 0) {
173 fprintf(stderr, "init_cc_profiling failed!\n");
178 #if defined(CONCURRENT) && defined(GRAN)
180 if (init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv) != 0) {
181 fprintf(stderr, "init_gr_simulation failed!\n"); EXIT(EXIT_FAILURE);
186 if (RTSflags.ParFlags.granSimStats)
187 init_gr_profiling(rts_argc, rts_argv, prog_argc, prog_argv);
190 /* initialize the storage manager */
194 if (! initStacks( &StorageMgrInfo )) {
196 fprintf(stderr, "initStacks failed!\n");
201 if (! initHeap( &StorageMgrInfo )) {
203 fprintf(stderr, "initHeap failed!\n");
207 #if defined(CONCURRENT) && !defined(GRAN)
208 if (!initThreadPools()) {
210 fprintf(stderr, "initThreadPools failed!\n");
215 #if defined(PROFILING) || defined(PAR)
216 /* call cost centre registering routine (after heap allocated) */
220 #if defined(TICKY_TICKY)
221 max_SpA = MAIN_SpA; /* initial high-water marks */
225 /* Tell GNU multi-precision pkg about our custom alloc functions */
226 mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
228 /* Record initialization times */
231 #if defined(PROFILING) || defined(CONCURRENT)
233 * Both the context-switcher and the cost-center profiler use
236 if (install_vtalrm_handler()) {
238 fprintf(stderr, "Can't install VTALRM handler.\n");
241 #if (defined(CONCURRENT) && defined(PROFILING)) || defined(PAR)
242 if (! time_profiling)
243 RTSflags.CcFlags.msecsPerTick = RTSflags.ConcFlags.ctxtSwitchTime;
245 if (RTSflags.ConcFlags.ctxtSwitchTime % (1000/TICK_FREQUENCY) == 0)
246 RTSflags.CcFlags.msecsPerTick = TICK_MILLISECS;
248 RTSflags.CcFlags.msecsPerTick = CS_MIN_MILLISECS;
250 RTSflags.CcFlags.ctxtSwitchTicks = RTSflags.ConcFlags.ctxtSwitchTime / RTSflags.CcFlags.msecsPerTick;
251 RTSflags.CcFlags.profilerTicks = TICK_MILLISECS / RTSflags.CcFlags.msecsPerTick;
259 #endif /* PROFILING || CONCURRENT */
262 setjmp(restart_main);
267 # if defined(GRAN) /* HWL */
268 /* RunnableThreadsHd etc. are init in ScheduleThreads */
270 * I'm not sure about this. Note that this code is for re-initializing
271 * things when a longjmp to restart_main occurs. --JSM
275 AvailableStack = AvailableTSO = Nil_closure;
276 RunnableThreadsHd = RunnableThreadsTl = Nil_closure;
277 WaitingThreadsHd = WaitingThreadsTl = Nil_closure;
278 PendingSparksHd[REQUIRED_POOL] =
279 PendingSparksTl[REQUIRED_POOL] = PendingSparksBase[REQUIRED_POOL];
280 PendingSparksHd[ADVISORY_POOL] =
281 PendingSparksTl[ADVISORY_POOL] = PendingSparksBase[ADVISORY_POOL];
284 CurrentTSO = Nil_closure;
287 RunParallelSystem(TopClosure);
289 STKO_LINK(MainStkO) = Nil_closure;
290 ScheduleThreads(TopClosure);
293 #else /* not threaded (sequential) */
295 miniInterpret((StgFunPtr)startStgWorld);
297 #endif /* !CONCURRENT */
300 return(EXIT_SUCCESS); /* don't use EXIT! :-) */
304 It should be possible to call @shutdownHaskell@ whenever you want to
305 shut a Haskell program down in an orderly way.
307 Note that some of this code probably depends on the integrity of
308 various internal data structures so this should not be called in
309 response to detecting a catastrophic error.
313 shutdownHaskell(STG_NO_ARGS)
317 if (! exitSM(&StorageMgrInfo)) {
319 fprintf(stderr, "exitSM failed!\n");
323 #if defined(PROFILING)
324 heap_profile_finish();
326 #if defined(PROFILING) || defined(PAR)
327 report_cc_profiling(1 /* final */ );
330 #if defined(TICKY_TICKY)
331 if (RTSflags.TickyFlags.showTickyStats) PrintTickyInfo();
334 #if defined(GRAN_CHECK) && defined(GRAN)
335 if (PrintFetchMisses)
336 fprintf(stderr,"Number of fetch misses: %d\n",fetch_misses);
339 fprintf(stderr,"COUNT statistics:\n");
340 fprintf(stderr," Total number of updates: %u\n",nUPDs);
341 fprintf(stderr," Needed to awaken BQ: %u with avg BQ len of: %f\n",
342 nUPDs_BQ,(float)BQ_lens/(float)nUPDs_BQ);
343 fprintf(stderr," Number of PAPs: %u\n",nPAPs);
351 /* This fflush is important, because: if "main" just returns,
352 then we will end up in pre-supplied exit code that will close
353 streams and flush buffers. In particular we have seen: it
354 will close fd 0 (stdin), then flush fd 1 (stdout), then <who
357 But if you're playing with sockets, that "close fd 0" might
358 suggest to the daemon that all is over, only to be presented
359 with more stuff on "fd 1" at the flush.
361 The fflush avoids this sad possibility.
366 Sets up and returns a string indicating the date/time of the run.
367 Successive calls simply return the same string again. Initially
368 called by @main.lc@ to initialise the string at the start of the run.
369 Only used for profiling.
372 #if defined(PROFILING) || defined(CONCURRENT)
376 time_str(STG_NO_ARGS)
378 static time_t now = 0;
379 static char nowstr[26];
383 strcpy(nowstr, ctime(&now));
384 strcpy(nowstr+16,nowstr+19);
389 #endif /* profiling */
392 ToDo: Will this work under threads?
395 StgStablePtr errorHandler = -1; /* NB: prone to magic-value-ery (WDP 95/12) */
398 getErrorHandler(STG_NO_ARGS)
400 return (StgInt) errorHandler;
406 raiseError( handler )
407 StgStablePtr handler;
409 if (handler == -1) { /* beautiful magic value... (WDP 95/12) */
413 TopClosure = deRefStablePointer( handler );
414 longjmp(restart_main,1);
421 catchError( newErrorHandler )
422 StgStablePtr newErrorHandler;
424 StgStablePtr oldErrorHandler = errorHandler;
425 errorHandler = newErrorHandler;
426 return oldErrorHandler;
432 If we have installed an error handler, we might want to
433 indicate that we have successfully recovered from an error by
434 decrementing the counter.
438 decrementErrorCount()
440 ErrorIO_call_count-=1;