1 /* ----------------------------------------------------------------------------
2 Time-stamp: <Tue Mar 21 2000 20:25:55 Stardate: [-30]4539.25 hwloidl>
3 $Id: SysMan.c,v 1.3 2000/03/31 03:09:37 hwloidl Exp $
5 GUM System Manager Program
6 Handles startup, shutdown and global synchronisation of the parallel system.
8 The Parade/AQUA Projects, Glasgow University, 1994-1995.
9 GdH/APART Projects, Heriot-Watt University, Edinburgh, 1997-1999.
10 P. Trinder, November 30th. 1994.
12 P. Trinder, July 1997.
13 H-W. Loidl, November 1999.
15 ------------------------------------------------------------------------- */
17 //@node GUM System Manager Program, , ,
18 //@section GUM System Manager Program
30 //@node General docu, Includes, GUM System Manager Program, GUM System Manager Program
31 //@subsection General docu
35 The Sysman task currently controls initiation, termination, of a
36 parallel Haskell program running under GUM. In the future it may
37 control global GC synchronisation and statistics gathering. Based on
38 K. Hammond's SysMan.lc in Graph for PVM. SysMan is unusual in that it
39 is not part of the executable produced by ghc: it is a free-standing
40 program that spawns PVM tasks (logical PEs) to evaluate the
41 program. After initialisation it runs in parallel with the PE tasks,
44 OK children, buckle down for some serious weirdness, it works like this ...
47 o The argument vector (argv) for SysMan has one the following 2 shapes:
49 -------------------------------------------------------------------------------
50 | SysMan path | debug flag | pvm-executable path | Num. PEs | Program Args ...|
51 -------------------------------------------------------------------------------
53 -------------------------------------------------------------------
54 | SysMan path | pvm-executable path | Num. PEs | Program Args ... |
55 -------------------------------------------------------------------
57 The "pvm-executable path" is an absolute path of where PVM stashes the
58 code for each PE. The arguments passed on to each PE-executable
61 -------------------------------
62 | Num. PEs | Program Args ... |
63 -------------------------------
65 The arguments passed to the Main-thread PE-executable are
67 -------------------------------------------------------------------
68 | main flag | pvm-executable path | Num. PEs | Program Args ... |
69 -------------------------------------------------------------------
71 o SysMan's algorithm is as follows.
73 o use PVM to spawn (nPE-1) PVM tasks
74 o fork SysMan to create the main-thread PE. This permits the main-thread to
75 read and write to stdin and stdout.
76 o Barrier-synchronise waiting for all of the PE-tasks to start.
77 o Broadcast the SysMan task-id, so that the main thread knows it.
78 o Wait for the Main-thread PE to send it's task-id.
79 o Broadcast an array of the PE task-ids to all of the PE-tasks.
80 o Enter a loop awaiting incoming messages, e.g. failure, Garbage-collection,
83 The forked Main-thread algorithm, in SysMan, is as follows.
85 o disconnects from PVM.
86 o sets a flag in argv to indicate that it is the main thread.
87 o `exec's a copy of the pvm-executable (i.e. the program being run)
90 The pvm-executable run by each PE-task, is initialised as follows.
92 o Registers with PVM, obtaining a task-id.
93 o Joins the barrier synchronisation awaiting the other PEs.
94 o Receives and records the task-id of SysMan, for future use.
95 o If the PE is the main thread it sends its task-id to SysMan.
96 o Receives and records the array of task-ids of the other PEs.
101 //@node Includes, Macros etc, General docu, GUM System Manager Program
102 //@subsection Includes
105 #include "ParTypes.h"
107 #include "Parallel.h"
109 //@node Macros etc, Variables, Includes, GUM System Manager Program
110 //@subsection Macros etc
112 #define NON_POSIX_SOURCE /* so says Solaris */
114 #define checkerr(c) do { \
116 pvm_perror("Sysman"); \
117 fprintf(stderr,"Sysman"); \
118 stg_exit(EXIT_FAILURE); \
122 /* SysMan is put on top of the GHC routine that does the RtsFlags handling.
123 So, we cannot use the standard macros. For the time being we use a macro
124 that is fixed at compile time.
126 /* debugging enabled */
127 #define IF_PAR_DEBUG(c,s) { s; }
128 /* debugging disabled */
129 // #define IF_PAR_DEBUG(c,s) /* nothing */
131 //@node Variables, Main fct, Macros etc, GUM System Manager Program
132 //@subsection Variables
135 The following definitions included so that SysMan can be linked with Low
136 Level Communications module (LLComms). They are not used in SysMan. */
138 GlobalTaskId mytid, SysManTask;
139 rtsBool IAmMainThread;
140 rtsBool GlobalStopPending = rtsFalse;
141 /* Handle unexpected messages correctly */
143 static GlobalTaskId gtids[MAX_PES];
144 static GlobalTaskId sysman_id, sender_id, mainThread_id;
145 static unsigned PEsTerminated = 0;
146 static rtsBool Finishing = rtsFalse;
147 static long PEbuffer[MAX_PES];
150 //@node Main fct, Auxiliary fcts, Variables, GUM System Manager Program
151 //@subsection Main fct
154 main (int argc, char **argv) {
158 int i, cc, spawn_flag = PvmTaskDefault;
159 char *petask, *pvmExecutable;
162 setbuf(stdout, NULL); // disable buffering of stdout
163 setbuf(stderr, NULL); // disable buffering of stderr
166 if (*argv[1] == '-') {
167 spawn_flag = PvmTaskDebug;
171 sysman_id = pvm_mytid(); /* This must be the first PVM call */
176 Get the full path and filename of the pvm executable (stashed in some
177 PVM directory), and the number of PEs from the command line.
179 pvmExecutable = argv[1];
180 nPEs = atoi(argv[2]);
182 if ((petask = getenv(PETASK)) == NULL) // PETASK set by driver
185 IF_PAR_DEBUG(verbose,
186 fprintf(stderr,"== [%x] nPEs (%s) = %d\n",
187 sysman_id, petask, nPEs));
189 /* Check that we can create the number of PE and IMU tasks requested */
190 if (nPEs > MAX_PES) {
191 fprintf(stderr,"SysMan: No more than %d PEs allowed (%d requested)\n",
193 stg_exit(EXIT_FAILURE);
196 Now create the PE Tasks. We spawn (nPEs-1) pvm threads: the Main Thread
197 (which starts execution and performs IO) is created by forking SysMan
201 /* Initialise the PE task arguments from Sysman's arguments */
204 IF_PAR_DEBUG(verbose,
205 fprintf(stderr, "== [%x] Spawning %d PEs(%s) ...\n",
206 sysman_id, nPEs, petask);
207 fprintf(stderr, " args: ");
208 for (i = 0; pargv[i]; ++i)
209 fprintf(stderr, "%s, ", pargv[i]);
210 fprintf(stderr, "\n"));
212 checkerr(pvm_spawn(petask, pargv, spawn_flag, "", nPEs, gtids));
214 * Stash the task-ids of the PEs away in a buffer, once we know
215 * the Main Thread's task-id, we'll broadcast them all.
217 for (i = 0; i < nPEs; i++)
218 PEbuffer[i+1] = (long) gtids[i];
220 IF_PAR_DEBUG(verbose,
221 fprintf(stderr,"== [%x] Spawned\n", sysman_id));
225 Create the MainThread PE by forking SysMan. This arcane coding
226 is required to allow MainThread to read stdin and write to stdout.
229 nPEs++; /* Record that the number of PEs is increasing */
231 checkerr(cc); /* Parent continues as SysMan */
232 IF_PAR_DEBUG(verbose,
233 fprintf(stderr,"== [%x] SysMan Task is [t%x]\n", sysman_id));
236 SysMan joins PECTLGROUP, so that it can wait (at the
237 barrier sysnchronisation a few instructions later) for the
238 other PE-tasks to start.
240 The manager group (MGRGROUP) is vestigial at the moment. It
241 may eventually include a statistics manager, and a (global)
242 garbage collector manager.
244 checkerr(pvm_joingroup(PECTLGROUP));
245 IF_PAR_DEBUG(verbose,
246 fprintf(stderr,"== [%x] Joined PECTLGROUP \n", sysman_id));
248 /* Wait for all the PEs to arrive */
249 checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
251 IF_PAR_DEBUG(verbose,
252 fprintf(stderr,"== [%x] PECTLGROUP barrier passed \n",
255 /* Broadcast SysMan's ID, so Main Thread PE knows it */
256 pvm_initsend(PvmDataDefault);
257 pvm_bcast(PEGROUP, PP_SYSMAN_TID);
259 /* Wait for Main Thread to identify itself*/
260 addr = waitForPEOp(PP_MAIN_TASK, ANY_GLOBAL_TASK);
261 pvm_bufinfo(addr, &nbytes, &opcode, &mainThread_id);
262 PEbuffer[0] = mainThread_id;
264 IF_PAR_DEBUG(verbose,
265 fprintf(stderr,"== [%x] SysMan received Main Task = %x\n",
266 sysman_id, mainThread_id));
268 /* Now that we have them all, broadcast Global Task Ids of all PEs */
269 pvm_initsend(PvmDataDefault);
270 PutArgs(PEbuffer, nPEs);
271 pvm_bcast(PEGROUP, PP_PETIDS);
273 IF_PAR_DEBUG(verbose,
274 fprintf(stderr,"== [%x] Sysman successfully initialized!\n",
277 //@cindex message handling loop
278 /* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
279 /* Main message handling loop */
280 /* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
281 /* Process incoming messages */
283 if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0)
284 pvm_perror("Sysman: Receiving Message");
286 pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
290 fprintf(stderr,"== [%x] SysMan: Message received by SysMan: rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
291 sysman_id, rbufid, nbytes, opcode, sender_id));
295 /* This Function not yet implemented for GUM */
296 fprintf(stderr,"Global GC from %x Not yet implemented for GUM!\n",
298 sync(PECTLGROUP, PP_FULL_SYSTEM);
299 broadcast(PEGROUP, PP_GC_INIT);
301 /* broadcast(PEGROUP, PP_INIT); */
305 fprintf(stderr,"PP_STATS_ON (from %x) not yet implemented for GUM!\n",
310 fprintf(stderr,"PP_STATS_OFF (from %x) not yet implemented for GUM!\n",
315 IF_PAR_DEBUG(verbose,
316 fprintf(stderr,"== [%x] Finish from %x\n",
317 sysman_id, sender_id));
321 pvm_initsend(PvmDataDefault);
322 pvm_bcast(PEGROUP, PP_FINISH);
326 if (PEsTerminated >= nPEs) {
327 IF_PAR_DEBUG(verbose,
328 fprintf(stderr,"== [%x] Global Shutdown, Goodbye!! (SysMan has received FINISHes from all PEs)\n",
330 broadcast(PEGROUP, PP_FINISH);
331 broadcast(MGRGROUP, PP_FINISH);
332 pvm_lvgroup(PECTLGROUP);
333 pvm_lvgroup(MGRGROUP);
341 IF_PAR_DEBUG(verbose,
342 fprintf(stderr,"== [%x] Fail from %x\n",
343 sysman_id, sender_id));
346 broadcast(PEGROUP, PP_FAIL);
353 char *opname = GetOpName(opcode);
354 fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
356 fprintf(stderr,"Qagh: Sysman: Unrecognised opcode (%x)\n",
363 } /* forked Sysman Process */
365 fprintf(stderr, "Main Thread PE has been forked; doing an execv(%s,...)\n",
367 pvmendtask(); /* Disconnect from PVM to avoid confusion: */
368 /* executable reconnects */
369 *argv[0] = '-'; /* Flag that this is the Main Thread PE */
370 execv(pvmExecutable,argv); /* Parent task becomes Main Thread PE */
375 //@node Auxiliary fcts, Index, Main fct, GUM System Manager Program
376 //@subsection Auxiliary fcts
379 * This reproduced from RtsUtlis to save linking with a whole ball of wax
381 /* result-checking malloc wrappers. */
383 //@cindex stgMallocBytes
386 stgMallocBytes (int n, char *msg)
390 if ((space = (char *) malloc((size_t) n)) == NULL) {
392 fprintf(stderr, msg);
393 // MallocFailHook((W_) n, msg); /*msg*/
394 stg_exit(EXIT_FAILURE);
399 /* Needed here because its used in loads of places like LLComms etc */
409 //@node Index, , Auxiliary fcts, GUM System Manager Program
413 //* main:: @cindex\s-+main
414 //* message handling loop:: @cindex\s-+message handling loop
415 //* stgMallocBytes:: @cindex\s-+stgMallocBytes
416 //* stg_exit:: @cindex\s-+stg_exit