%****************************************************************************
The Sysman task controls initiation, termination, global GC
-synchronisation and statistics gathering. Based on K. Hammond's SysMan.lc
-in Graph for PVM.
-
+synchronisation and statistics gathering of a parallel Haskell program
+running under GUM. Based on K. Hammond's SysMan.lc in Graph for
+PVM. SysMan is unusual in that it is not part of the executable
+produced by ghc: it is a free-standing program that spawns PVM tasks
+(logical PEs) to evaluate the program.
+
+OK children, buckle down for some serious wierdness, it works like this.
+
+\begin{itemize}
+\item The argument vector (argv) for SysMan has one the following 2 shapes:
+@
+-------------------------------------------------------------------------------
+| SysMan path | debug flag | pvm-executable path | Num. PEs | Program Args ...|
+-------------------------------------------------------------------------------
+
+-------------------------------------------------------------------
+| SysMan path | pvm-executable path | Num. PEs | Program Args ... |
+-------------------------------------------------------------------
+@
+The "pvm-executable path" is an absolute path of where PVM stashes the
+code for each PE. The arguments passed on to each PE-executable
+spawned by PVM are:
+@
+-------------------------------
+| Num. PEs | Program Args ... |
+-------------------------------
+@
+The arguments passed to the Main-thread PE-executable are
+@
+-------------------------------------------------------------------
+| main flag | pvm-executable path | Num. PEs | Program Args ... |
+-------------------------------------------------------------------
+@
+\item SysMan's algorithm is as follows.
+\begin{itemize}
+\item use PVM to spawn (nPE-1) PVM tasks
+\item fork SysMan to create the main-thread PE. This permits the main-thread to
+read and write to stdin and stdout.
+\item Barrier-synchronise waiting for all of the PE-tasks to start.
+\item Broadcast the SysMan task-id, so that the main thread knows it.
+\item Wait for the Main-thread PE to send it's task-id.
+\item Broadcast an array of the PE task-ids to all of the PE-tasks.
+\item Enter a loop awaiting incoming messages, e.g. failure, Garbage-collection,
+termination.
+\end{itemize}
+
+The forked Main-thread algorithm, in SysMan, is as follows.
+\begin{itemize}
+\item disconnects from PVM.
+\item sets a flag in argv to indicate that it is the main thread.
+\item `exec's a copy of the pvm-executable (i.e. the program being run)
+\end{itemize}
+
+The pvm-executable run by each PE-task, is initialised as follows.
+\begin{itemize}
+\item Registers with PVM, obtaining a task-id.
+\item Joins the barrier synchronisation awaiting the other PEs.
+\item Receives and records the task-id of SysMan, for future use.
+\item If the PE is the main thread it sends its task-id to SysMan.
+\item Receives and records the array of task-ids of the other PEs.
+\item Begins execution
+\end{itemize}
+
+\end{itemize}
\begin{code}
#define NON_POSIX_SOURCE /* so says Solaris */
#include "LLC.h"
\end{code}
+The following definitions included so that SysMan can be linked with
+Low Level Communications module (LLComms). They are not used in
+SysMan.
+
\begin{code}
-static GLOBAL_TASK_ID gtids[MAX_PES], StatsTask = 0;
-static long PEbuffer[MAX_PES];
-static int nPEs = 0;
+GLOBAL_TASK_ID mytid, SysManTask;
+rtsBool IAmMainThread;
\end{code}
+
\begin{code}
+static GLOBAL_TASK_ID gtids[MAX_PES], StatsTask = 0;
+static long PEbuffer[MAX_PES];
+int nPEs = 0;
static GLOBAL_TASK_ID sysman_id, sender_id, mainThread_id;
-
-GLOBAL_TASK_ID mytid;
-
static unsigned PEsTerminated = 0;
-
static rtsBool Finishing = rtsFalse;
\end{code}
char **pargv;
int i, cc;
int spawn_flag = PvmTaskDefault;
+ PACKET addr;
char *petask, *pvmExecutable;
argv[1] = argv[0];
argv++; argc--;
}
- mainThread_id = pvm_mytid();/* This must be the first PVM call */
- checkerr(mainThread_id);
+ sysman_id = pvm_mytid();/* This must be the first PVM call */
+ checkerr(sysman_id);
- nPEs = atoi(argv[1]);
+ /*
+ Get the full path and filename of the pvm executable (stashed in some
+ PVM directory.
+ */
+ pvmExecutable = argv[1];
+
+ nPEs = atoi(argv[2]);
if ((petask = getenv(PETASK)) == NULL)
petask = PETASK;
fprintf(stderr, "No more than %d PEs allowed (%d requested)\n", MAX_PES, nPEs);
EXIT(EXIT_FAILURE);
}
- /*
- Get the full path and filename of the pvm executable (stashed in some
- PVM directory.
- */
- pvmExecutable = argv[2];
- /* Create the PE Tasks */
+ /*
+ Now create the PE Tasks. We spawn (nPEs-1) pvm threads: the Main Thread
+ (which starts execution and performs IO) is created by forking SysMan
+ */
if (nPEs > 0) {
- /* Spawn nPEs-1 pvm threads: the Main Thread (starts execution and performs
- IO is created by forking SysMan */
nPEs--;
+ /* Initialise the PE task arguments from Sysman's arguments */
+ pargv = argv + 2;
#if 1
fprintf(stderr, "Spawning %d PEs(%s) ...\n", nPEs, petask);
fprintf(stderr, " args: ");
fprintf(stderr, "%s, ", pargv[i]);
fprintf(stderr, "\n");
#endif
- /* Initialise the PE task arguments from Sysman's arguments */
- pargv = argv + 2;
checkerr(pvm_spawn(petask, pargv, spawn_flag, "", nPEs, gtids));
- PEbuffer[0] = mainThread_id;
+ /*
+ * Stash the task-ids of the PEs away in a buffer, once we know
+ * the Main Thread's task-id, we'll broadcast them all.
+ */
for (i = 0; i < nPEs; i++)
- PEbuffer[i++] = (long) gtids[i];
+ PEbuffer[i+1] = (long) gtids[i];
#if 1
fprintf(stderr, "Spawned /* PWT */\n");
#endif
-
}
- /*
- SysMan joins PECTLGROUP, so that it can wait (at the
- barrier sysnchronisation a few instructions later) for the
- other PE-tasks to start.
-
- Other comments on PVM groupery:
-
- The manager group (MGRGROUP) is vestigial at the moment. It
- may eventually include a statistics manager, garbage
- collector manager.
-
- I suspect that you're [Kei Davis] right: Sysman shouldn't
- be in PEGROUP, it's a hangover from GRIP.
-
- (Phil Trinder, 95/10)
- */
- checkerr(pvm_joingroup(PECTLGROUP));
-#if 1
- fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
-#endif
-
- /* Wait for all the PEs and IMUs to arrive */
- checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
-#if 1
- fprintf(stderr, "PECTLGROUP barrier passed /* HWL */\n");
-#endif
/*
Create the MainThread PE by forking SysMan. This arcane coding
is required to allow MainThread to read stdin and write to stdout.
PWT 18/1/96
*/
+ nPEs++; /* Record that the number of PEs is increasing */
if (cc = fork()) {
- checkerr(cc);
- exec($some path$/petask) /* Parent task become Main Thread PE */
- } else {
- /* Child continues as SysMan */
- pvmendtask(); /* Disconnect from PVM to avoid confusion */
- sysman_id = pvm_mytid(); /* Reconnect to PVM to get new task id */
-
- /* Broadcast Global Task Ids of all PEs */
-
- pvm_initsend(PvmDataDefault);
- PutArgs(PEbuffer, nPEs);
- pvm_bcast(PEGROUP, PP_PETIDS);
-
+ checkerr(cc); /* Parent continues as SysMan */
#if 1
- fprintf(stderr, "Main Thread Task is [t%x]\n", mainThread_id);
+ fprintf(stderr, "SysMan Task is [t%x]\n", sysman_id);
#endif
-
- pvm_initsend(PvmDataDefault);
- pvm_send(mainThread_id, PP_IO_INIT);
-
- pvm_initsend(PvmDataDefault);
- pvm_bcast(PEGROUP, PP_INIT);
+ /*
+ SysMan joins PECTLGROUP, so that it can wait (at the
+ barrier sysnchronisation a few instructions later) for the
+ other PE-tasks to start.
+
+ The manager group (MGRGROUP) is vestigial at the moment. It
+ may eventually include a statistics manager, and a (global)
+ garbage collector manager.
+ */
+ checkerr(pvm_joingroup(PECTLGROUP));
#if 1
- fprintf(stderr, "Broadcast PP_INIT to all PEs\n");
+ fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
#endif
-
- /* HWL-DEBUG */
+ /* Wait for all the PEs to arrive */
+ checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
#if 1
- fprintf(stderr, "Sysman successfully initialized!\n");
+ fprintf(stderr, "PECTLGROUP barrier passed /* HWL */\n");
#endif
+ /* Broadcast SysMan's ID, so Main Thread PE knows it */
+ pvm_initsend(PvmDataDefault);
+ pvm_bcast(PEGROUP, PP_SYSMAN_TID);
- /* Process incoming messages */
- while (1) {
- if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0)
- pvm_perror("Sysman: Receiving Message");
-
- else {
- pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
-
+ /* Wait for Main Thread to identify itself*/
+ addr = WaitForPEOp(PP_MAIN_TASK, ANY_GLOBAL_TASK);
+ pvm_bufinfo(addr, &nbytes, &opcode, &mainThread_id );
+ PEbuffer[0] = mainThread_id;
+#if 1
+ fprintf(stderr,"SysMan received Main Task = %x\n",mainThread_id);
+#endif
+ /* Now that we have them all, broadcast Global Task Ids of all PEs */
+ pvm_initsend(PvmDataDefault);
+ PutArgs(PEbuffer, nPEs);
+ pvm_bcast(PEGROUP, PP_PETIDS);
+#if 1
+ fprintf(stderr, "Sysman successfully initialized!\n");
+#endif
+ /* Process incoming messages */
+ while (1) {
+ if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0)
+ pvm_perror("Sysman: Receiving Message");
+ else {
+ pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
#if 0
fprintf(stderr, "HWL-DBG(SysMan; main loop): rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
- rbufid, nbytes, opcode, sender_id);
+ rbufid, nbytes, opcode, sender_id);
#endif
-
switch (opcode) {
- case PP_GC_INIT:
- /* This Function not yet implemented for GUM */
- fprintf(stderr, "Global GC from %x Not yet implemented for GUM!\n", sender_id);
- sync(PECTLGROUP, PP_FULL_SYSTEM);
- broadcast(PEGROUP, PP_GC_INIT);
- DoGlobalGC();
- broadcast(PEGROUP, PP_INIT);
- break;
-
- case PP_STATS_ON:
- case PP_STATS_OFF:
+ case PP_GC_INIT:
/* This Function not yet implemented for GUM */
+ fprintf(stderr, "Global GC from %x Not yet implemented for GUM!\n", sender_id);
+ sync(PECTLGROUP, PP_FULL_SYSTEM);
+ broadcast(PEGROUP, PP_GC_INIT);
+ DoGlobalGC();
+/* broadcast(PEGROUP, PP_INIT); */
break;
- case PP_FINISH:
- fprintf(stderr, "Finish from %x\n", sender_id);
- if (!Finishing) {
- long buf = (long) StatsTask;
- Finishing = rtsTrue;
- pvm_initsend(PvmDataDefault);
- pvm_pklong(&buf, 1, 1);
- pvm_bcast(PEGROUP, PP_FINISH);
+ case PP_STATS_ON:
+ case PP_STATS_OFF:
+ /* This Function not yet implemented for GUM */
+ break;
+
+ case PP_FINISH:
+ fprintf(stderr, "Finish from %x\n", sender_id);
+ if (!Finishing) {
+ long buf = (long) StatsTask;
+ Finishing = rtsTrue;
+ pvm_initsend(PvmDataDefault);
+ pvm_pklong(&buf, 1, 1);
+ pvm_bcast(PEGROUP, PP_FINISH);
} else {
- ++PEsTerminated;
+ ++PEsTerminated;
}
-
if (PEsTerminated >= nPEs) {
- broadcast(PEGROUP, PP_FINISH);
- broadcast(MGRGROUP, PP_FINISH);
- pvm_lvgroup(PEGROUP);
- pvm_lvgroup(PECTLGROUP);
- pvm_lvgroup(MGRGROUP);
- pvm_exit();
- EXIT(EXIT_SUCCESS);
+ broadcast(PEGROUP, PP_FINISH);
+ broadcast(MGRGROUP, PP_FINISH);
+ pvm_lvgroup(PECTLGROUP);
+ pvm_lvgroup(MGRGROUP);
+ pvm_exit();
+ EXIT(EXIT_SUCCESS);
}
break;
case PP_FAIL:
fprintf(stderr, "Fail from %x\n", sender_id);
if (!Finishing) {
- Finishing = rtsTrue;
- broadcast(PEGROUP, PP_FAIL);
+ Finishing = rtsTrue;
+ broadcast(PEGROUP, PP_FAIL);
}
break;
default:
{
-/* char *opname = GetOpName(opcode);
- fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
- opname,opcode); */
- fprintf(stderr, "Sysman: Unrecognised opcode (%x)\n",
- opcode);
+/* char *opname = GetOpName(opcode);
+ fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
+ opname,opcode); */
+ fprintf(stderr, "Sysman: Unrecognised opcode (%x)\n",
+ opcode);
}
break;
- }
- }
- }
- }
- return(0);
-}
+ } /* switch */
+ } /* else */
+ } /* while 1 */
+ } /* forked Sysman Process */
+ else {
+ pvmendtask(); /* Disconnect from PVM to avoid confusion: */
+ /* executable reconnects */
+ *argv[0] = '-'; /* Flag that this is the Main Thread PE */
+ execv(pvmExecutable,argv); /* Parent task becomes Main Thread PE */
+ }
+ } /* argc > 1 */
+} /* main */
\end{code}
@myexit@ for the system manager.
projects / ghc-hetmet.git / blobdiff