1 %****************************************************************************
3 \section[ParInit.lc]{Initialising the parallel RTS}
5 % (c) The Parade/AQUA Projects, Glasgow University, 1995.
6 % P. Trinder, January 17th 1995.
7 % An extension based on Kevin Hammond's GRAPH for PVM version
9 %****************************************************************************
12 #ifdef PAR /* whole file */
15 #define NON_POSIX_SOURCE /* so says Solaris */
24 Global conditions defined here.
28 OkToGC = rtsFalse, /* Set after initialisation */
29 IAmMainThread = rtsFalse, /* Set for the main thread */
30 GlobalStopPending = rtsFalse, /* Terminate */
31 GlobalGCPending = rtsFalse; /* Start Global GC */
34 Task identifiers for various interesting global tasks.
37 GLOBAL_TASK_ID IOTask = 0, /* The IO Task Id */
38 SysManTask = 0, /* The System Manager Task Id */
39 GCManTask = 0, /* The GC Manager Task Id */
40 StatsManTask = 0, /* The Statistics Manager Task Id*/
41 mytid = 0; /* This PE's Task Id */
45 REAL_TIME main_start_time; /* When the program started */
46 REAL_TIME main_stop_time; /* When the program finished */
47 jmp_buf exit_parallel_system; /* How to abort from the RTS */
53 rtsBool TraceSparks = rtsFalse; /* Enable the spark trace mode */
54 rtsBool SparkLocally = rtsFalse; /* Use local threads if possible */
55 rtsBool DelaySparks = rtsFalse; /* Use delayed sparking */
56 rtsBool LocalSparkStrategy = rtsFalse; /* Either delayed threads or local threads */
57 rtsBool GlobalSparkStrategy = rtsFalse; /* Export all threads */
59 rtsBool DeferGlobalUpdates = rtsFalse; /* Defer updating of global nodes */
60 rtsBool fishing = rtsFalse; /* We have no fish out in the stream */
65 RunParallelSystem(program_closure)
66 StgPtr program_closure;
69 /* Return here when exiting the program. */
70 if (setjmp(exit_parallel_system) != 0)
73 /* Show that we've started */
74 if (IAmMainThread && ! RTSflags.ParFlags.outputDisabled)
75 fprintf(stderr, "Starting main program...\n");
77 /* Record the start time for statistics purposes. */
78 main_start_time = usertime();
79 /* fprintf(stderr, "Start time is %u\n", main_start_time); */
82 * Start the main scheduler which will fish for threads on all but the PE with
86 ScheduleThreads(program_closure);
91 @myexit@ defines how to terminate the program. If the exit code is
92 non-zero (i.e. an error has occurred), the PE should not halt until
93 outstanding error messages have been processed. Otherwise, messages
94 might be sent to non-existent Task Ids. The infinite loop will actually
95 terminate, since @STG_Exception@ will call @myexit@\tr{(0)} when
96 it received a @PP_FINISH@ from the system manager task.
100 myexit(n) /* NB: "EXIT" is set to "myexit" for parallel world */
103 GlobalStopPending = rtsTrue;
104 SendOp(PP_FINISH, SysManTask);
106 WaitForTermination();
108 WaitForPEOp(PP_FINISH, SysManTask);
110 fprintf(stderr,"PE %lx shutting down, %ld Threads run, %ld Sparks created, %ld Sparks ignored\n", (W_) mytid, threadId, sparksCreated, sparksIgnored); /* HWL */
112 /* And actually terminate -- always with code 0 */
113 longjmp(exit_parallel_system, 1);
118 void srand48 PROTO((long));
119 time_t time PROTO((time_t *));
122 initParallelSystem(STG_NO_ARGS)
124 /* Don't buffer standard channels... */
128 srand48(time(NULL) * getpid()); /*Initialise Random-number generator seed*/
130 OkToGC = rtsFalse; /* Must not GC till we have set up the environment */
131 /* because C is hanging onto heap pointers */
132 /* maybe bogus for the new RTS? -- KH */
133 /* And for the GUM system? PWT */
139 @SynchroniseSystem@ synchronises the reduction task with the system manager.
145 SynchroniseSystem(STG_NO_ARGS)
150 _SetMyExceptionHandler(STG_Exception);
152 PEs = PEStartUp(nPEs);
154 /* Initialize global address tables */
157 /* Record the shortened the PE identifiers for LAGA etc. tables */
158 for (i = 0; i < nPEs; ++i)
159 registerTask(PEs[i]);
161 /* pvm_notify( PvmTaskExit, PP_FAIL, 1, &SysManTask); /? Setup an error handler */
163 /* Initialise the PE task array? */
166 #endif /* PAR -- whole file */