1 /****************************************************************************
3 GUM System Manager Program
5 The Parade/AQUA Projects, Glasgow University, 1994-1995.
6 P. Trinder, November 30th. 1994.
11 ****************************************************************************
13 The Sysman task currently controls initiation, termination, of a
14 parallel Haskell program running under GUM. In the future it may
15 control global GC synchronisation and statistics gathering. Based on
16 K. Hammond's SysMan.lc in Graph for PVM. SysMan is unusual in that it
17 is not part of the executable produced by ghc: it is a free-standing
18 program that spawns PVM tasks (logical PEs) to evaluate the
19 program. After initialisation it runs in parallel with the PE tasks,
22 OK children, buckle down for some serious weirdness, it works like this ...
25 o The argument vector (argv) for SysMan has one the following 2 shapes:
27 -------------------------------------------------------------------------------
28 | SysMan path | debug flag | pvm-executable path | Num. PEs | Program Args ...|
29 -------------------------------------------------------------------------------
31 -------------------------------------------------------------------
32 | SysMan path | pvm-executable path | Num. PEs | Program Args ... |
33 -------------------------------------------------------------------
35 The "pvm-executable path" is an absolute path of where PVM stashes the
36 code for each PE. The arguments passed on to each PE-executable
39 -------------------------------
40 | Num. PEs | Program Args ... |
41 -------------------------------
43 The arguments passed to the Main-thread PE-executable are
45 -------------------------------------------------------------------
46 | main flag | pvm-executable path | Num. PEs | Program Args ... |
47 -------------------------------------------------------------------
49 o SysMan's algorithm is as follows.
51 o use PVM to spawn (nPE-1) PVM tasks
52 o fork SysMan to create the main-thread PE. This permits the main-thread to
53 read and write to stdin and stdout.
54 o Barrier-synchronise waiting for all of the PE-tasks to start.
55 o Broadcast the SysMan task-id, so that the main thread knows it.
56 o Wait for the Main-thread PE to send it's task-id.
57 o Broadcast an array of the PE task-ids to all of the PE-tasks.
58 o Enter a loop awaiting incoming messages, e.g. failure, Garbage-collection,
61 The forked Main-thread algorithm, in SysMan, is as follows.
63 o disconnects from PVM.
64 o sets a flag in argv to indicate that it is the main thread.
65 o `exec's a copy of the pvm-executable (i.e. the program being run)
68 The pvm-executable run by each PE-task, is initialised as follows.
70 o Registers with PVM, obtaining a task-id.
71 o Joins the barrier synchronisation awaiting the other PEs.
72 o Receives and records the task-id of SysMan, for future use.
73 o If the PE is the main thread it sends its task-id to SysMan.
74 o Receives and records the array of task-ids of the other PEs.
77 ***************************************************************************/
79 #define NON_POSIX_SOURCE /* so says Solaris */
87 *The following definitions included so that SysMan can be linked with
88 *Low Level Communications module (LLComms). They are not used in
92 GLOBAL_TASK_ID mytid, SysManTask;
93 rtsBool IAmMainThread;
94 rtsBool GlobalStopPending = rtsFalse; /* Handle Unexpexted messages correctly */
96 static GLOBAL_TASK_ID gtids[MAX_PES];
97 static long PEbuffer[MAX_PES];
99 static GLOBAL_TASK_ID sysman_id, sender_id, mainThread_id;
100 static unsigned PEsTerminated = 0;
101 static rtsBool Finishing = rtsFalse;
104 * This reproduced from RtsUtlis to save linking with a whole ball of wax
106 stgMallocBytes (int n, char *msg)
110 if ((space = (char *) malloc((size_t) n)) == NULL) {
112 fprintf(stderr,"stgMallocBytes failed: ", msg);
113 stg_exit(EXIT_FAILURE);
118 #define checkerr(c) do {if((c)<0) { pvm_perror("Sysman"); exit(EXIT_FAILURE); }} while(0)
120 main(int argc, char **argv)
126 int spawn_flag = PvmTaskDefault;
129 char *petask, *pvmExecutable;
131 setbuf(stdout, NULL);
132 setbuf(stderr, NULL);
135 if (*argv[1] == '-') {
136 spawn_flag = PvmTaskDebug;
140 sysman_id = pvm_mytid();/* This must be the first PVM call */
145 Get the full path and filename of the pvm executable (stashed in some
148 pvmExecutable = argv[1];
150 nPEs = atoi(argv[2]);
152 if ((petask = getenv(PETASK)) == NULL)
156 fprintf(stderr, "nPEs (%s) = %d\n", petask, nPEs);
159 /* Check that we can create the number of PE and IMU tasks requested */
160 if (nPEs > MAX_PES) {
161 fprintf(stderr, "No more than %d PEs allowed (%d requested)\n", MAX_PES, nPEs);
166 Now create the PE Tasks. We spawn (nPEs-1) pvm threads: the Main Thread
167 (which starts execution and performs IO) is created by forking SysMan
171 /* Initialise the PE task arguments from Sysman's arguments */
174 fprintf(stderr, "Spawning %d PEs(%s) ...\n", nPEs, petask);
175 fprintf(stderr, " args: ");
176 for (i = 0; pargv[i]; ++i)
177 fprintf(stderr, "%s, ", pargv[i]);
178 fprintf(stderr, "\n");
180 checkerr(pvm_spawn(petask, pargv, spawn_flag, "", nPEs, gtids));
182 * Stash the task-ids of the PEs away in a buffer, once we know
183 * the Main Thread's task-id, we'll broadcast them all.
185 for (i = 0; i < nPEs; i++)
186 PEbuffer[i+1] = (long) gtids[i];
188 fprintf(stderr, "Spawned /* PWT */\n");
193 Create the MainThread PE by forking SysMan. This arcane coding
194 is required to allow MainThread to read stdin and write to stdout.
197 nPEs++; /* Record that the number of PEs is increasing */
199 checkerr(cc); /* Parent continues as SysMan */
201 fprintf(stderr, "SysMan Task is [t%x]\n", sysman_id);
204 SysMan joins PECTLGROUP, so that it can wait (at the
205 barrier sysnchronisation a few instructions later) for the
206 other PE-tasks to start.
208 The manager group (MGRGROUP) is vestigial at the moment. It
209 may eventually include a statistics manager, and a (global)
210 garbage collector manager.
212 checkerr(pvm_joingroup(PECTLGROUP));
214 fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
216 /* Wait for all the PEs to arrive */
217 checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
219 fprintf(stderr, "PECTLGROUP barrier passed /* HWL */\n");
221 /* Broadcast SysMan's ID, so Main Thread PE knows it */
222 pvm_initsend(PvmDataDefault);
223 pvm_bcast(PEGROUP, PP_SYSMAN_TID);
225 /* Wait for Main Thread to identify itself*/
226 addr = WaitForPEOp(PP_MAIN_TASK, ANY_GLOBAL_TASK);
227 pvm_bufinfo(addr, &nbytes, &opcode, &mainThread_id );
228 PEbuffer[0] = mainThread_id;
230 fprintf(stderr,"SysMan received Main Task = %x\n",mainThread_id);
232 /* Now that we have them all, broadcast Global Task Ids of all PEs */
233 pvm_initsend(PvmDataDefault);
234 PutArgs(PEbuffer, nPEs);
235 pvm_bcast(PEGROUP, PP_PETIDS);
237 fprintf(stderr, "Sysman successfully initialized!\n");
239 /* Process incoming messages */
241 if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0)
242 pvm_perror("Sysman: Receiving Message");
244 pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
246 fprintf(stderr, "HWL-DBG(SysMan; main loop): rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
247 rbufid, nbytes, opcode, sender_id);
251 /* This Function not yet implemented for GUM */
252 fprintf(stderr, "Global GC from %x Not yet implemented for GUM!\n", sender_id);
253 sync(PECTLGROUP, PP_FULL_SYSTEM);
254 broadcast(PEGROUP, PP_GC_INIT);
256 /* broadcast(PEGROUP, PP_INIT); */
261 /* This Function not yet implemented for GUM */
266 fprintf(stderr, "\nFinish from %x\n", sender_id);
268 pvm_initsend(PvmDataDefault);
269 pvm_bcast(PEGROUP, PP_FINISH);
273 if (PEsTerminated >= nPEs) {
274 broadcast(PEGROUP, PP_FINISH);
275 broadcast(MGRGROUP, PP_FINISH);
276 pvm_lvgroup(PECTLGROUP);
277 pvm_lvgroup(MGRGROUP);
284 fprintf(stderr, "Fail from %x\n", sender_id);
287 broadcast(PEGROUP, PP_FAIL);
293 /* char *opname = GetOpName(opcode);
294 fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
296 fprintf(stderr, "Sysman: Unrecognised opcode (%x)\n",
303 } /* forked Sysman Process */
305 pvmendtask(); /* Disconnect from PVM to avoid confusion: */
306 /* executable reconnects */
307 *argv[0] = '-'; /* Flag that this is the Main Thread PE */
308 execv(pvmExecutable,argv); /* Parent task becomes Main Thread PE */
313 /* Needed here because its used in loads of places like LLComms etc */