1 /* ----------------------------------------------------------------------------
2 Time-stamp: <Wed Mar 21 2001 17:16:28 Stardate: [-30]6363.59 hwloidl>
4 GUM System Manager Program
5 Handles startup, shutdown and global synchronisation of the parallel system.
7 The Parade/AQUA Projects, Glasgow University, 1994-1995.
8 GdH/APART Projects, Heriot-Watt University, Edinburgh, 1997-2000.
10 ------------------------------------------------------------------------- */
12 //@node GUM System Manager Program, , ,
13 //@section GUM System Manager Program
21 //* Aux startup and shutdown fcts::
23 //* Message handlers::
28 //@node General docu, Includes, GUM System Manager Program, GUM System Manager Program
29 //@subsection General docu
32 The Sysman task currently controls initiation, termination, of a
33 parallel Haskell program running under GUM. In the future it may
34 control global GC synchronisation and statistics gathering. Based on
35 K. Hammond's SysMan.lc in Graph for PVM. SysMan is unusual in that it
36 is not part of the executable produced by ghc: it is a free-standing
37 program that spawns PVM tasks (logical PEs) to evaluate the
38 program. After initialisation it runs in parallel with the PE tasks,
41 OK children, buckle down for some serious weirdness, it works like this ...
43 o The argument vector (argv) for SysMan has one the following 2 shapes:
45 -------------------------------------------------------------------------------
46 | SysMan path | debug flag | pvm-executable path | Num. PEs | Program Args ...|
47 -------------------------------------------------------------------------------
49 -------------------------------------------------------------------
50 | SysMan path | pvm-executable path | Num. PEs | Program Args ... |
51 -------------------------------------------------------------------
53 The "pvm-executable path" is an absolute path of where PVM stashes the
54 code for each PE. The arguments passed on to each PE-executable
57 -------------------------------
58 | Num. PEs | Program Args ... |
59 -------------------------------
61 The arguments passed to the Main-thread PE-executable are
63 -------------------------------------------------------------------
64 | main flag | pvm-executable path | Num. PEs | Program Args ... |
65 -------------------------------------------------------------------
67 o SysMan's algorithm is as follows.
69 o use PVM to spawn (nPE-1) PVM tasks
70 o fork SysMan to create the main-thread PE. This permits the main-thread to
71 read and write to stdin and stdout.
72 o Wait for all the PE-tasks to reply back saying they are ready and if they were the
74 o Broadcast an array of the PE task-ids out to all of the PE-tasks.
75 o Enter a loop awaiting incoming messages, e.g. failure, Garbage-collection,
78 The forked Main-thread algorithm, in SysMan, is as follows.
80 o disconnects from PVM.
81 o sets a flag in argv to indicate that it is the main thread.
82 o `exec's a copy of the pvm-executable (i.e. the program being run)
85 The pvm-executable run by each PE-task, is initialised as follows.
87 o Registers with PVM, obtaining a task-id.
88 o If it was main it gets SysMan's task-id from argv otherwise it can use pvm_parent.
89 oSends a ready message to SysMan together with a flag indicating if it was main or not.
90 o Receives from SysMan the array of task-ids of the other PEs.
91 o If the number of task-ids sent was larger than expected then it must have been a task
92 generated after the rest of the program had started, so it sends its own task-id message
93 to all the tasks it was told about.
98 //@node Includes, Macros etc, General docu, GUM System Manager Program
99 //@subsection Includes
101 /* Evidently not Posix */
102 /* #include "PosixSource.h" */
105 #include "ParTypes.h"
107 #include "Parallel.h"
108 #include "ParallelRts.h" // stats only
110 //@node Macros etc, Variables, Includes, GUM System Manager Program
111 //@subsection Macros etc
113 /* SysMan is put on top of the GHC routine that does the RtsFlags handling.
114 So, we cannot use the standard macros. For the time being we use a macro
115 that is fixed at compile time.
122 /* debugging enabled */
123 //#define IF_PAR_DEBUG(c,s) { s; }
124 /* debugging disabled */
125 #define IF_PAR_DEBUG(c,s) /* nothing */
127 void *stgMallocBytes (int n, char *msg);
129 //@node Variables, Prototypes, Macros etc, GUM System Manager Program
130 //@subsection Variables
133 The following definitions included so that SysMan can be linked with Low
134 Level Communications module (LLComms). They are not used in SysMan.
138 static unsigned PEsArrived = 0;
139 static GlobalTaskId gtids[MAX_PES];
140 static GlobalTaskId sysman_id, sender_id;
141 static unsigned PEsTerminated = 0;
142 static rtsBool Finishing = rtsFalse;
143 static long PEbuffer[MAX_PES];
144 nat nSpawn = 0; // current no. of spawned tasks (see gtids)
145 nat nPEs = 0; // number of PEs specified on startup
147 /* PVM-ish variables */
148 char *petask, *pvmExecutable;
150 int cc, spawn_flag = PvmTaskDefault;
152 #if 0 && defined(PAR_TICKY)
153 /* ToDo: use allGlobalParStats to collect stats of all PEs */
154 GlobalParStats *allGlobalParStats[MAX_PES];
157 //@node Prototypes, Aux startup and shutdown fcts, Variables, GUM System Manager Program
158 //@subsection Prototypes
160 /* prototypes for message handlers called from the main loop of SysMan */
161 void newPE(int nbytes, int opcode, int sender_id);
162 void readyPE(int nbytes, int opcode, int sender_id);
163 void finishPE(int nbytes, int opcode, int sender_id, int exit_code);
165 //@node Aux startup and shutdown fcts, Main fct, Prototypes, GUM System Manager Program
166 //@subsection Aux startup and shutdown fcts
169 Create the PE Tasks. We spawn (nPEs-1) pvm threads: the Main Thread
170 (which starts execution and performs IO) is created by forking SysMan
173 createPEs(int total_nPEs) {
174 int i, spawn_nPEs, iSpawn = 0, nArch, nHost;
175 struct pvmhostinfo *hostp;
178 spawn_nPEs = total_nPEs-1;
179 if (spawn_nPEs > 0) {
180 IF_PAR_DEBUG(verbose,
181 fprintf(stderr, "==== [%x] Spawning %d PEs(%s) ...\n",
182 sysman_id, spawn_nPEs, petask);
183 fprintf(stderr, " args: ");
184 for (i = 0; pargv[i]; ++i)
185 fprintf(stderr, "%s, ", pargv[i]);
186 fprintf(stderr, "\n"));
188 pvm_config(&nHost,&nArch,&hostp);
189 sysman_host=pvm_tidtohost(sysman_id);
191 /* create PEs on the specific machines in the specified order! */
192 for (i=0; (iSpawn<spawn_nPEs) && (i<nHost); i++)
193 if (hostp[i].hi_tid != sysman_host) {
194 checkComms(pvm_spawn(petask, pargv, spawn_flag+PvmTaskHost,
195 hostp[i].hi_name, 1, gtids+iSpawn),
197 IF_PAR_DEBUG(verbose,
198 fprintf(stderr, "==== [%x] Spawned PE %d onto %s\n",
199 sysman_id, i, hostp[i].hi_name));
203 /* create additional PEs anywhere you like */
204 if (iSpawn<spawn_nPEs) {
205 checkComms(pvm_spawn(petask, pargv, spawn_flag, "",
206 spawn_nPEs-iSpawn, gtids+iSpawn),
208 IF_PAR_DEBUG(verbose,
209 fprintf(stderr,"==== [%x] Spawned %d additional PEs anywhere\n",
210 sysman_id, spawn_nPEs-iSpawn));
215 /* old code with random placement of PEs; make that a variant? */
216 # error "Broken startup in SysMan"
217 { /* let pvm place the PEs anywhere; not used anymore */
218 checkComms(pvm_spawn(petask, pargv, spawn_flag, "", spawn_nPEs, gtids),"SysMan startup");
219 IF_PAR_DEBUG(verbose,
220 fprintf(stderr,"==== [%x] Spawned\n", sysman_id));
225 // iSpawn=spawn_nPEs;
231 Check if this pvm task is in the list of tasks we spawned and are waiting
232 on, if so then remove it.
236 alreadySpawned (GlobalTaskId g) {
239 for (i=0; i<nSpawn; i++)
242 gtids[i] = gtids[nSpawn]; //the last takes its place
249 broadcastFinish(void) {
251 int tids[MAX_PES]; /* local buffer of all surviving PEs */
253 for (i=0, j=0; i<nPEs; i++)
255 tids[j++]=PEbuffer[i]; //extract valid tids
257 IF_PAR_DEBUG(verbose,
258 fprintf(stderr,"==== [%x] Broadcasting Finish to %d PEs; initiating shutdown\n",
261 /* ToDo: move into LLComms.c */
262 pvm_initsend(PvmDataDefault);
263 pvm_mcast(tids,j,PP_FINISH);
267 broadcastPEtids (void) {
270 IF_PAR_DEBUG(verbose,
271 fprintf(stderr,"==== [%x] SysMan sending PE table to all PEs\n", sysman_id);
273 fprintf(stderr,"++++ [%x] PE table as seen by SysMan:\n", mytid);
274 for (i = 0; i < nPEs; i++) {
275 fprintf(stderr,"++++ PEbuffer[%d] = %x\n", i, PEbuffer[i]);
279 broadcastOpN(PP_PETIDS, PEGROUP, nPEs, &PEbuffer);
282 //@node Main fct, Message handlers, Aux startup and shutdown fcts, GUM System Manager Program
283 //@subsection Main fct
287 main (int argc, char **argv) {
289 int opcode, nbytes, nSpawn;
292 setbuf(stdout, NULL); // disable buffering of stdout
293 setbuf(stderr, NULL); // disable buffering of stderr
295 IF_PAR_DEBUG(verbose,
297 "==== RFP: GdH enabled SysMan reporting for duty\n"));
300 if (*argv[1] == '-') {
301 spawn_flag = PvmTaskDebug;
305 sysman_id = pvm_mytid(); /* This must be the first PVM call */
308 fprintf(stderr, "==== PVM initialisation failure\n");
313 Get the full path and filename of the pvm executable (stashed in some
314 PVM directory), and the number of PEs from the command line.
316 pvmExecutable = argv[1];
317 nPEs = atoi(argv[2]);
320 /* as usual 0 means infinity: use all PEs specified in PVM config */
322 struct pvmhostinfo *hostp;
324 /* get info on PVM config */
325 pvm_config(&nHost,&nArch,&hostp);
327 sprintf(argv[2],"%d",nPEs); /* ToCheck: does this work on all archs */
330 /* get the name of the binary to execute */
331 if ((petask = getenv(PETASK)) == NULL) // PETASK set by driver
334 IF_PAR_DEBUG(verbose,
335 fprintf(stderr,"==== [%x] nPEs: %d; executable: |%s|\n",
336 sysman_id, nPEs, petask));
338 /* Check that we can create the number of PE and IMU tasks requested.
340 This comment is most entertaining since we haven't been using IMUs
341 for the last 10 years or so -- HWL */
342 if ((nPEs > MAX_PES) || (nPEs<1)) {
343 fprintf(stderr,"==** SysMan: No more than %d PEs allowed (%d requested)\n Reconfigure GUM setting MAX_PE in ghc/includes/Parallel.h to a higher value\n",
348 IF_PAR_DEBUG(verbose,
349 fprintf(stderr,"==== [%x] is SysMan Task\n", sysman_id));
351 /* Initialise the PE task arguments from Sysman's arguments */
354 /* Initialise list of all PE identifiers */
357 for (i=0; i<nPEs; i++)
360 /* start up the required number of PEs */
361 nSpawn = createPEs(nPEs);
364 Create the MainThread PE by forking SysMan. This arcane coding
365 is required to allow MainThread to read stdin and write to stdout.
368 //nPEs++; /* Record that the number of PEs is increasing */
370 checkComms(cc,"SysMan fork"); /* Parent continues as SysMan */
372 PEbuffer[0]=0; /* we accept the first main and assume its valid. */
373 PEsArrived=1; /* assume you've got main */
375 IF_PAR_DEBUG(verbose,
376 fprintf(stderr,"==== [%x] Sysman successfully initialized!\n",
379 //@cindex message handling loop
380 /* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
381 /* Main message handling loop */
382 /* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
383 /* Process incoming messages */
385 if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0) {
386 pvm_perror("==** Sysman: Receiving Message (pvm_recv)");
390 pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
392 /* very low level debugging
393 IF_PAR_DEBUG(verbose,
394 fprintf(stderr,"== [%x] SysMan: Message received by SysMan: rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
395 sysman_id, rbufid, nbytes, opcode, sender_id));
400 case PP_NEWPE: /* a new PE is registering for work */
401 newPE(nbytes, opcode, sender_id);
404 case PP_READY: /* startup complete; let PEs start working */
405 readyPE(nbytes, opcode, sender_id);
409 case PP_GC_INIT: /* start global GC */
410 /* This Function not yet implemented for GUM */
411 fprintf(stderr,"==** Global GC requested by PE %x. Not yet implemented for GUM!\n",
415 case PP_STATS_ON: /* enable statistics gathering */
416 fprintf(stderr,"==** PP_STATS_ON requested by %x. Not yet implemented for GUM!\n",
420 case PP_STATS_OFF: /* disable statistics gathering */
421 fprintf(stderr,"==** PP_STATS_OFF requested by %x. Not yet implemented for GUM!\n",
427 int exit_code = getExitCode(nbytes, &sender_id);
428 finishPE(nbytes, opcode, sender_id, exit_code);
434 char *opname = GetOpName(opcode);
435 fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
437 fprintf(stderr,"==** Qagh: Sysman: Unrecognised opcode (%x)\n",
444 /* end of SysMan!! */
446 /* forked main thread begins here */
447 IF_PAR_DEBUG(verbose,
448 fprintf(stderr, "==== Main Thread PE has been forked; doing an execv(%s,...)\n",
450 pvmendtask(); // Disconnect from PVM to avoid confusion:
451 // executable reconnects
453 // RFP: assumes that length(arvv[0])>=9 !!!
454 sprintf(argv[0],"-%08X",sysman_id); /*flag that its the Main Thread PE and include sysman's id*/
455 execv(pvmExecutable,argv); /* Parent task becomes Main Thread PE */
460 //@node Message handlers, Auxiliary fcts, Main fct, GUM System Manager Program
461 //@subsection Message handlers
465 A new PE has been added to the configuration.
468 newPE(int nbytes, int opcode, int sender_id) {
469 IF_PAR_DEBUG(verbose,
470 fprintf(stderr,"==== [%x] SysMan detected a new host\n",
473 /* Determine the new machine... assume its the last on the config list? */
474 if (nSpawn < MAX_PES) {
476 struct pvmhostinfo *hostp;
478 /* get conmfiguration of PVM machine */
479 pvm_config(&nHost,&nArch,&hostp);
481 checkComms(pvm_spawn(petask, pargv, spawn_flag+PvmTaskHost,
482 hostp[nHost].hi_name, 1, gtids+nSpawn),
485 IF_PAR_DEBUG(verbose,
486 fprintf(stderr, "==== [%x] Spawned onto %s\n",
487 sysman_id, hostp[nHost].hi_name));
493 Let it be known that PE @sender_id@ participates in the computation.
496 readyPE(int nbytes, int opcode, int sender_id) {
500 struct pvmhostinfo *hostp;
502 //ASSERT(opcode==PP_READY);
504 IF_PAR_DEBUG(verbose,
505 fprintf(stderr,"==== [%x] SysMan received PP_READY message from %x\n",
506 sysman_id, sender_id));
508 pvm_config(&nHost,&nArch,&hostp);
512 //if ((isMain && (PEbuffer[0]==0)) || alreadySpawned(sender_id)) {
513 if (nPEs >= MAX_PES) {
514 fprintf(stderr,"==== [%x] SysMan doesn't need PE %d (max %d PEs allowed)\n",
515 sysman_id, sender_id, MAX_PES);
519 IF_PAR_DEBUG(verbose,
520 fprintf(stderr,"==== [%x] SysMan found Main PE %x\n",
521 sysman_id, sender_id));
522 PEbuffer[0]=sender_id;
524 /* search for PE in list of PEs */
525 for(i=1; i<nPEs; i++)
526 if (PEbuffer[i]==sender_id) {
530 /* it's a new PE: add it to the list of PEs */
532 PEbuffer[nextPE++] = sender_id;
534 IF_PAR_DEBUG(verbose,
535 fprintf(stderr,"==== [%x] SysMan: found PE %d as [%x] on host %s\n",
536 sysman_id, PEsArrived, sender_id, hostp[PEsArrived].hi_name));
538 PEbuffer[PEsArrived++] = sender_id;
542 /* enable better handling of unexpected terminations */
543 checkComms( pvm_notify(PvmTaskExit, PP_FINISH, 1, &sender_id),
546 /* finished registration of all PEs => enable notification */
547 if ((PEsArrived==nPEs) && PEbuffer[0]) {
548 checkComms( pvm_notify(PvmHostAdd, PP_NEWPE, -1, 0),
550 IF_PAR_DEBUG(verbose,
551 fprintf(stderr,"==== [%x] SysMan initialising notificaton for new hosts\n", sysman_id));
554 /* finished notification => send off the PE ids */
555 if ((PEsArrived>=nPEs) && PEbuffer[0]) {
556 if (PEsArrived>nPEs) {
557 IF_PAR_DEBUG(verbose,
558 fprintf(stderr,"==== [%x] Weird: %d PEs registered, but we only asked for %d\n", sysman_id, PEsArrived, nPEs));
568 Shut down the corresponding PE. Check whether it is a regular shutdown
569 or an uncontrolled termination.
572 finishPE(int nbytes, int opcode, int sender_id, int exitCode) {
575 IF_PAR_DEBUG(verbose,
576 fprintf(stderr,"==== [%x] SysMan received PP_FINISH message from %x (exit code: %d)\n",
577 sysman_id, sender_id, exitCode));
579 /* Is it relevant to us? Count the first message */
580 for (i=0; i<nPEs; i++)
581 if (PEbuffer[i] == sender_id) {
585 /* handle exit code */
586 if (exitCode<0) { /* a task exit before a controlled finish? */
587 fprintf(stderr,"==== [%x] Termination at %x with exit(%d)\n",
588 sysman_id, sender_id, exitCode);
589 } else if (exitCode>0) { /* an abnormal exit code? */
590 fprintf(stderr,"==== [%x] Uncontrolled termination at %x with exit(%d)\n",
591 sysman_id, sender_id, exitCode);
592 } else if (!Finishing) { /* exitCode==0 which is good news */
593 if (i!=0) { /* someone other than main PE terminated first? */
594 fprintf(stderr,"==== [%x] Unexpected early termination at %x\n",
595 sysman_id, sender_id);
597 /* start shutdown by broadcasting FINISH to other PEs */
598 IF_PAR_DEBUG(verbose,
599 fprintf(stderr,"==== [%x] Initiating shutdown (requested by [%x] RIP) (exit code: %d)\n", sysman_id, sender_id, exitCode));
604 /* we are in a shutdown already */
605 IF_PAR_DEBUG(verbose,
606 fprintf(stderr,"==== [%x] Finish from %x during shutdown (%d PEs terminated so far; %d total)\n",
607 sysman_id, sender_id, PEsTerminated, nPEs));
610 if (PEsTerminated >= nPEs) {
611 IF_PAR_DEBUG(verbose,
612 fprintf(stderr,"==== [%x] Global Shutdown, Goodbye!! (SysMan has received FINISHes from all PEs)\n", sysman_id));
614 /* received finish from everybody; now, we can exit, too */
615 exit(EXIT_SUCCESS); /* Qapla'! */
620 //@node Auxiliary fcts, Index, Message handlers, GUM System Manager Program
621 //@subsection Auxiliary fcts
623 /* Needed here because its used in loads of places like LLComms etc */
628 * called from STG-land to exit the program
634 fprintf(stderr, "==// [%x] %s in SysMan code; sending PP_FINISH to all PEs ...\n",
635 mytid,(n!=0)?"FAILURE":"FINISH");
642 //@node Index, , Auxiliary fcts, GUM System Manager Program
646 //* main:: @cindex\s-+main
647 //* message handling loop:: @cindex\s-+message handling loop
648 //* stgMallocBytes:: @cindex\s-+stgMallocBytes
649 //* stg_exit:: @cindex\s-+stg_exit