ghc/runtime/gum/SysMan.lc

   1 %****************************************************************************
   2 %
   3 \section[Sysman.lc]{GUM Sysman Program}
   4 %
   5 %  (c) The Parade/AQUA Projects, Glasgow University, 1994-1995.
   6 %      P. Trinder, November 30th. 1994.
   7 %
   8 %****************************************************************************
   9
  10 The Sysman task controls initiation, termination, global GC
  11 synchronisation and statistics gathering of a parallel Haskell program
  12 running under GUM. Based on K. Hammond's SysMan.lc in Graph for
  13 PVM. SysMan is unusual in that it is not part of the executable
  14 produced by ghc: it is a free-standing program that spawns PVM tasks
  15 (logical PEs) to evaluate the program.
  16
  17 OK children, buckle down for some serious wierdness, it works like this.
  18
  19 \begin{itemize}
  20 \item The argument vector (argv) for SysMan has one the following 2 shapes:
  21 @
  22 -------------------------------------------------------------------------------
  23 | SysMan path | debug flag | pvm-executable path | Num. PEs | Program Args ...|
  24 -------------------------------------------------------------------------------
  25
  26 -------------------------------------------------------------------
  27 | SysMan path | pvm-executable path | Num. PEs | Program Args ... |
  28 -------------------------------------------------------------------
  29 @
  30 The "pvm-executable path" is an absolute path of where PVM stashes the
  31 code for each PE. The arguments passed on to each PE-executable
  32 spawned by PVM are:
  33 @
  34 -------------------------------
  35 | Num. PEs | Program Args ... |
  36 -------------------------------
  37 @
  38 The arguments passed to the Main-thread PE-executable are
  39 @
  40 -------------------------------------------------------------------
  41 | main flag | pvm-executable path | Num. PEs | Program Args ... |
  42 -------------------------------------------------------------------
  43 @
  44 \item SysMan's algorithm is as follows.
  45 \begin{itemize}
  46 \item use PVM to spawn (nPE-1) PVM tasks
  47 \item fork SysMan to create the main-thread PE. This permits the main-thread to
  48 read and write to stdin and stdout.
  49 \item Barrier-synchronise waiting for all of the PE-tasks to start.
  50 \item Broadcast the SysMan task-id, so that the main thread knows it.
  51 \item Wait for the Main-thread PE to send it's task-id.
  52 \item Broadcast an array of the PE task-ids to all of the PE-tasks.
  53 \item Enter a loop awaiting incoming messages, e.g. failure, Garbage-collection,
  54 termination.
  55 \end{itemize}
  56
  57 The forked Main-thread algorithm, in SysMan, is as follows.
  58 \begin{itemize}
  59 \item disconnects from PVM.
  60 \item sets a flag in argv to indicate that it is the main thread.
  61 \item `exec's a copy of the pvm-executable (i.e. the program being run)
  62 \end{itemize}
  63
  64 The pvm-executable run by each PE-task, is initialised as follows.
  65 \begin{itemize}
  66 \item Registers with PVM, obtaining a task-id.
  67 \item Joins the barrier synchronisation awaiting the other PEs.
  68 \item Receives and records the task-id of SysMan, for future use.
  69 \item If the PE is the main thread it sends its task-id to SysMan.
  70 \item Receives and records the array of task-ids of the other PEs.
  71 \item Begins execution
  72 \end{itemize}
  73
  74 \end{itemize}
  75 \begin{code}
  76 #define NON_POSIX_SOURCE /* so says Solaris */
  77
  78 #include "rtsdefs.h"
  79 #include "LLC.h"
  80 \end{code}
  81
  82 The following definitions included so that SysMan can be linked with
  83 Low Level Communications module (LLComms). They are not used in
  84 SysMan.
  85
  86 \begin{code}
  87 GLOBAL_TASK_ID mytid, SysManTask;
  88 rtsBool IAmMainThread;
  89 \end{code}
  90
  91
  92 \begin{code}
  93 static GLOBAL_TASK_ID gtids[MAX_PES], StatsTask = 0;
  94 static long PEbuffer[MAX_PES];
  95 int nPEs = 0;
  96 static GLOBAL_TASK_ID sysman_id, sender_id, mainThread_id;
  97 static unsigned PEsTerminated = 0;
  98 static rtsBool Finishing = rtsFalse;
  99 \end{code}
 100
 101 \begin{code}
 102 #define checkerr(c)     do {if((c)<0) { pvm_perror("Sysman"); EXIT(EXIT_FAILURE); }} while(0)
 103 \end{code}
 104
 105 This Function not yet implemented for GUM
 106
 107 \begin{code}
 108 static void
 109 DoGlobalGC(STG_NO_ARGS)
 110 {}
 111 /*
 112 static void
 113 HandleException(STG_NO_ARGS)
 114 {}
 115 */
 116 \end{code}
 117
 118 \begin{code}
 119 main(int argc, char **argv)
 120 {
 121     int rbufid;
 122     int opcode, nbytes;
 123     char **pargv;
 124     int i, cc;
 125     int spawn_flag = PvmTaskDefault;
 126     PACKET addr;
 127
 128     char *petask, *pvmExecutable;
 129
 130     setbuf(stdout, NULL);
 131     setbuf(stderr, NULL);
 132
 133     if (argc > 1) {
 134         if (*argv[1] == '-') {
 135             spawn_flag = PvmTaskDebug;
 136             argv[1] = argv[0];
 137             argv++; argc--;
 138         }
 139         sysman_id = pvm_mytid();/* This must be the first PVM call */
 140         checkerr(sysman_id);
 141
 142         /*
 143         Get the full path and filename of the pvm executable (stashed in some
 144         PVM directory.
 145         */
 146         pvmExecutable = argv[1];
 147
 148         nPEs = atoi(argv[2]);
 149
 150         if ((petask = getenv(PETASK)) == NULL)
 151             petask = PETASK;
 152
 153 #if 0
 154         fprintf(stderr, "nPEs (%s) = %d\n", petask, nPEs);
 155 #endif
 156
 157         /* Check that we can create the number of PE and IMU tasks requested */
 158         if (nPEs > MAX_PES) {
 159             fprintf(stderr, "No more than %d PEs allowed (%d requested)\n", MAX_PES, nPEs);
 160             EXIT(EXIT_FAILURE);
 161         }
 162
 163         /*
 164         Now create the PE Tasks. We spawn (nPEs-1) pvm threads: the Main Thread
 165         (which starts execution and performs IO) is created by forking SysMan
 166         */
 167         if (nPEs > 0) {
 168             nPEs--;
 169             /* Initialise the PE task arguments from Sysman's arguments */
 170             pargv = argv + 2;
 171 #if 1
 172             fprintf(stderr, "Spawning %d PEs(%s) ...\n", nPEs, petask);
 173             fprintf(stderr, "  args: ");
 174             for (i = 0; pargv[i]; ++i)
 175                 fprintf(stderr, "%s, ", pargv[i]);
 176             fprintf(stderr, "\n");
 177 #endif
 178             checkerr(pvm_spawn(petask, pargv, spawn_flag, "", nPEs, gtids));
 179             /*
 180              * Stash the task-ids of the PEs away in a buffer, once we know
 181              * the Main Thread's task-id, we'll broadcast them all.
 182              */
 183             for (i = 0; i < nPEs; i++)
 184                 PEbuffer[i+1] = (long) gtids[i];
 185 #if 1
 186             fprintf(stderr, "Spawned /* PWT */\n");
 187 #endif
 188         }
 189
 190         /*
 191         Create the MainThread PE by forking SysMan. This arcane coding
 192         is required to allow MainThread to read stdin and write to stdout.
 193         PWT 18/1/96
 194         */
 195         nPEs++;                         /* Record that the number of PEs is increasing */
 196         if (cc = fork()) {
 197             checkerr(cc);               /* Parent continues as SysMan */
 198 #if 1
 199             fprintf(stderr, "SysMan Task is [t%x]\n", sysman_id);
 200 #endif
 201             /*
 202             SysMan joins PECTLGROUP, so that it can wait (at the
 203             barrier sysnchronisation a few instructions later) for the
 204             other PE-tasks to start.
 205
 206             The manager group (MGRGROUP) is vestigial at the moment. It
 207             may eventually include a statistics manager, and a (global)
 208             garbage collector manager.
 209             */
 210             checkerr(pvm_joingroup(PECTLGROUP));
 211 #if 1
 212             fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
 213 #endif
 214             /* Wait for all the PEs to arrive */
 215             checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
 216 #if 1
 217             fprintf(stderr, "PECTLGROUP  barrier passed /* HWL */\n");
 218 #endif
 219             /* Broadcast SysMan's ID, so Main Thread PE knows it */
 220             pvm_initsend(PvmDataDefault);
 221             pvm_bcast(PEGROUP, PP_SYSMAN_TID);
 222
 223             /* Wait for Main Thread to identify itself*/
 224             addr = WaitForPEOp(PP_MAIN_TASK, ANY_GLOBAL_TASK);
 225             pvm_bufinfo(addr, &nbytes, &opcode, &mainThread_id );
 226             PEbuffer[0] = mainThread_id;
 227 #if 1
 228             fprintf(stderr,"SysMan received Main Task = %x\n",mainThread_id);
 229 #endif
 230             /* Now that we have them all, broadcast Global Task Ids of all PEs */
 231             pvm_initsend(PvmDataDefault);
 232             PutArgs(PEbuffer, nPEs);
 233             pvm_bcast(PEGROUP, PP_PETIDS);
 234 #if 1
 235             fprintf(stderr, "Sysman successfully initialized!\n");
 236 #endif
 237             /* Process incoming messages */
 238             while (1) {
 239                 if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0)
 240                     pvm_perror("Sysman: Receiving Message");
 241                 else {
 242                     pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
 243 #if 0
 244                   fprintf(stderr, "HWL-DBG(SysMan; main loop): rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
 245                       rbufid, nbytes, opcode, sender_id);
 246 #endif
 247                   switch (opcode) {
 248                     case PP_GC_INIT:
 249                       /* This Function not yet implemented for GUM */
 250                       fprintf(stderr, "Global GC from %x Not yet implemented for GUM!\n", sender_id);
 251                       sync(PECTLGROUP, PP_FULL_SYSTEM);
 252                       broadcast(PEGROUP, PP_GC_INIT);
 253                       DoGlobalGC();
 254 /*                    broadcast(PEGROUP, PP_INIT); */
 255                       break;
 256
 257                     case PP_STATS_ON:
 258                     case PP_STATS_OFF:
 259                         /* This Function not yet implemented for GUM */
 260                         break;
 261
 262                     case PP_FINISH:
 263                         fprintf(stderr, "Finish from %x\n", sender_id);
 264                         if (!Finishing) {
 265                           long buf = (long) StatsTask;
 266                           Finishing = rtsTrue;
 267                           pvm_initsend(PvmDataDefault);
 268                           pvm_pklong(&buf, 1, 1);
 269                           pvm_bcast(PEGROUP, PP_FINISH);
 270                       } else {
 271                           ++PEsTerminated;
 272                       }
 273                       if (PEsTerminated >= nPEs) {
 274                           broadcast(PEGROUP, PP_FINISH);
 275                           broadcast(MGRGROUP, PP_FINISH);
 276                           pvm_lvgroup(PECTLGROUP);
 277                           pvm_lvgroup(MGRGROUP);
 278                           pvm_exit();
 279                           EXIT(EXIT_SUCCESS);
 280                       }
 281                       break;
 282
 283                   case PP_FAIL:
 284                       fprintf(stderr, "Fail from %x\n", sender_id);
 285                       if (!Finishing) {
 286                           Finishing = rtsTrue;
 287                           broadcast(PEGROUP, PP_FAIL);
 288                       }
 289                       break;
 290
 291                   default:
 292                       {
 293 /*                        char *opname = GetOpName(opcode);
 294                           fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
 295                                 opname,opcode); */
 296                           fprintf(stderr, "Sysman: Unrecognised opcode (%x)\n",
 297                                 opcode);
 298                       }
 299                       break;
 300                   }     /* switch */
 301               }         /* else */
 302           }             /* while 1 */
 303       }                 /* forked Sysman Process */
 304       else {
 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 */
 309       }
 310   }                     /* argc > 1 */
 311 }                       /* main */
 312 \end{code}
 313
 314 @myexit@ for the system manager.
 315
 316 \begin{code}
 317
 318 void
 319 myexit(n)
 320 I_ n;
 321 {
 322 #ifdef exit
 323 #undef exit
 324 #endif
 325     exit(n);
 326 }
 327
 328 \end{code}