%
% (c) The Parade/AQUA Projects, Glasgow University, 1994-1995.
% P. Trinder, November 30th. 1994.
-%
+%
%****************************************************************************
-The Sysman task controls initiation, termination, global GC
-synchronisation and statistics gathering. Based on K. Hammond's SysMan.lc
-in Graph for PVM.
-
+The Sysman task currently controls initiation, termination, of a
+parallel Haskell program running under GUM. In the future it may
+control global GC synchronisation and statistics gathering. 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. After initialisation it runs in parallel with the PE tasks,
+awaiting messages.
+
+OK children, buckle down for some serious weirdness, it works like this ...
+
+\begin{itemize}
+\item The argument vector (argv) for SysMan has one the following 2 shapes:
+\begin{verbatim}
+-------------------------------------------------------------------------------
+| SysMan path | debug flag | pvm-executable path | Num. PEs | Program Args ...|
+-------------------------------------------------------------------------------
+
+-------------------------------------------------------------------
+| SysMan path | pvm-executable path | Num. PEs | Program Args ... |
+-------------------------------------------------------------------
+\end{verbatim}
+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:
+\begin{verbatim}
+-------------------------------
+| Num. PEs | Program Args ... |
+-------------------------------
+\end{verbatim}
+The arguments passed to the Main-thread PE-executable are
+\begin{verbatim}
+-------------------------------------------------------------------
+| main flag | pvm-executable path | Num. PEs | Program Args ... |
+-------------------------------------------------------------------
+\end{verbatim}
+\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}
-\begin{code}
-static GLOBAL_TASK_ID gtids[MAX_PES], IOTask = 0, StatsTask = 0;
-static long PEbuffer[MAX_PES];
-static int nPEs = 0;
-\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 sysman_id, sender_id;
+GLOBAL_TASK_ID mytid, SysManTask;
+rtsBool IAmMainThread;
+\end{code}
-GLOBAL_TASK_ID mytid;
+\begin{code}
+static GLOBAL_TASK_ID gtids[MAX_PES];
+static long PEbuffer[MAX_PES];
+int nPEs = 0;
+static GLOBAL_TASK_ID sysman_id, sender_id, mainThread_id;
static unsigned PEsTerminated = 0;
-
static rtsBool Finishing = rtsFalse;
\end{code}
{}
/*
static void
-HandleException(STG_NO_ARGS)
+HandleException(PACKET p)
{}
*/
\end{code}
int rbufid;
int opcode, nbytes;
char **pargv;
- int i;
-#if 0
- int status;
-#endif
+ int i, cc;
int spawn_flag = PvmTaskDefault;
+ PACKET addr;
- char *petask;
+ char *petask, *pvmExecutable;
setbuf(stdout, NULL);
setbuf(stderr, NULL);
argv++; argc--;
}
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;
-#if 1
+#if 0
fprintf(stderr, "nPEs (%s) = %d\n", petask, nPEs);
#endif
fprintf(stderr, "No more than %d PEs allowed (%d requested)\n", MAX_PES, nPEs);
EXIT(EXIT_FAILURE);
}
- /* 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
+ */
+ nPEs--;
if (nPEs > 0) {
/* Initialise the PE task arguments from Sysman's arguments */
- pargv = argv + 1;
+ pargv = argv + 2;
#if 0
fprintf(stderr, "Spawning %d PEs(%s) ...\n", nPEs, petask);
fprintf(stderr, " args: ");
fprintf(stderr, "%s, ", pargv[i]);
fprintf(stderr, "\n");
#endif
-
checkerr(pvm_spawn(petask, pargv, spawn_flag, "", nPEs, gtids));
+ /*
+ * 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 0
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)
+ /*
+ 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
*/
- checkerr(pvm_joingroup(PECTLGROUP));
+ nPEs++; /* Record that the number of PEs is increasing */
+ if (cc = fork()) {
+ checkerr(cc); /* Parent continues as SysMan */
#if 0
- fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
+ fprintf(stderr, "SysMan Task is [t%x]\n", sysman_id);
#endif
-
- /* Wait for all the PEs and IMUs to arrive */
- checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
-
-#if 0
- fprintf(stderr, "PECTLGROUP barrier passed /* HWL */\n");
-#endif
-
- /* Broadcast Global Task Ids of all PEs */
-
- pvm_initsend(PvmDataDefault);
- PutArgs(PEbuffer, nPEs);
- pvm_bcast(PEGROUP, PP_PETIDS);
-
+ /*
+ 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 0
- /* Find an IO task */
- for (i = 0; IOTask <= 0 || status != PvmOk; ++i) {
- IOTask = pvm_gettid(PEGROUP, i);
- status = pvm_pstat(IOTask);
- fprintf(stderr, "Task %x, Status %x\n", IOTask, status);
- }
+ fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
#endif
-
- IOTask = gtids[0];
+ /* Wait for all the PEs to arrive */
+ checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
#if 0
- fprintf(stderr, "IO Task is [t%x]\n", IOTask);
+ fprintf(stderr, "PECTLGROUP barrier passed /* HWL */\n");
#endif
-
- pvm_initsend(PvmDataDefault);
- pvm_send(IOTask, PP_IO_INIT);
-
- pvm_initsend(PvmDataDefault);
- pvm_bcast(PEGROUP, PP_INIT);
+ /* Broadcast SysMan's ID, so Main Thread PE knows it */
+ pvm_initsend(PvmDataDefault);
+ pvm_bcast(PEGROUP, PP_SYSMAN_TID);
+
+ /* 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 0
- fprintf(stderr, "Broadcast PP_INIT to all PEs\n");
-#endif
-
- /* HWL-DEBUG */
+ 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 0
- fprintf(stderr, "Sysman successfully initialized!\n");
+ 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);
-
+ /* 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);
+ fprintf(stderr, "HWL-DBG(SysMan; main loop): rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
+ 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:
- /* 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;
- }
-
- 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);
- }
- break;
-
- case PP_FAIL:
- fprintf(stderr, "Fail from %x\n", sender_id);
- if (!Finishing) {
- 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);
- }
- break;
- }
- }
- }
- }
- return(0);
-}
+ 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:
+ /* This Function not yet implemented for GUM */
+ break;
+
+ case PP_FINISH:
+ if (!Finishing) {
+ fprintf(stderr, "\nFinish from %x\n", sender_id);
+ Finishing = rtsTrue;
+ pvm_initsend(PvmDataDefault);
+ pvm_bcast(PEGROUP, PP_FINISH);
+ } else {
+ ++PEsTerminated;
+ }
+ if (PEsTerminated >= nPEs) {
+ 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);
+ }
+ break;
+
+ default:
+ {
+/* char *opname = GetOpName(opcode);
+ fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
+ opname,opcode); */
+ fprintf(stderr, "Sysman: Unrecognised opcode (%x)\n",
+ opcode);
+ }
+ break;
+ } /* 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