X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fruntime%2Fgum%2FSysMan.lc;h=b1e9d13e26cee99ddf7b66b421deb8764a3bcdff;hb=2bc355fa50e75e512ddd887bd5567aba184f3f0a;hp=e18aaad637dc58bb59d3d94fb867bc84dbfe877f;hpb=10521d8418fd3a1cf32882718b5bd28992db36fd;p=ghc-hetmet.git diff --git a/ghc/runtime/gum/SysMan.lc b/ghc/runtime/gum/SysMan.lc index e18aaad..b1e9d13 100644 --- a/ghc/runtime/gum/SysMan.lc +++ b/ghc/runtime/gum/SysMan.lc @@ -4,13 +4,76 @@ % % (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 */ @@ -18,19 +81,22 @@ in Graph for PVM. #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} @@ -46,7 +112,7 @@ DoGlobalGC(STG_NO_ARGS) {} /* static void -HandleException(STG_NO_ARGS) +HandleException(PACKET p) {} */ \end{code} @@ -57,13 +123,11 @@ main(int argc, char **argv) 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); @@ -75,14 +139,21 @@ main(int argc, char **argv) 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 @@ -91,10 +162,15 @@ main(int argc, char **argv) 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: "); @@ -102,151 +178,138 @@ main(int argc, char **argv) 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.