ghc/rts/gum/SysMan.c

   1 /****************************************************************************
   2
   3    GUM System Manager Program
   4
   5    The Parade/AQUA Projects, Glasgow University, 1994-1995.
   6    P. Trinder, November 30th. 1994.
   7    Adapted for new RTS
   8    P. Trinder, July 1997.
   9
  10
  11 ****************************************************************************
  12
  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,
  20 awaiting messages.
  21
  22 OK children, buckle down for some serious weirdness, it works like this ...
  23
  24
  25 o The argument vector (argv) for SysMan has one the following 2 shapes:
  26
  27 -------------------------------------------------------------------------------
  28 | SysMan path | debug flag | pvm-executable path | Num. PEs | Program Args ...|
  29 -------------------------------------------------------------------------------
  30
  31 -------------------------------------------------------------------
  32 | SysMan path | pvm-executable path | Num. PEs | Program Args ... |
  33 -------------------------------------------------------------------
  34
  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
  37 spawned by PVM are:
  38
  39 -------------------------------
  40 | Num. PEs | Program Args ... |
  41 -------------------------------
  42
  43 The arguments passed to the Main-thread PE-executable are
  44
  45 -------------------------------------------------------------------
  46 | main flag | pvm-executable path | Num. PEs | Program Args ... |
  47 -------------------------------------------------------------------
  48
  49 o SysMan's algorithm is as follows.
  50
  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,
  59 termination.
  60
  61 The forked Main-thread algorithm, in SysMan, is as follows.
  62
  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)
  66
  67
  68 The pvm-executable run by each PE-task, is initialised as follows.
  69
  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.
  75 o Begins execution.
  76
  77 ***************************************************************************/
  78
  79 #define NON_POSIX_SOURCE /* so says Solaris */
  80
  81 #include "Rts.h"
  82 #include "ParTypes.h"
  83 #include "LLC.h"
  84 #include "Parallel.h"
  85
  86 /*
  87  *The following definitions included so that SysMan can be linked with
  88  *Low Level Communications module (LLComms). They are not used in
  89  *SysMan.
  90  */
  91
  92 GLOBAL_TASK_ID mytid, SysManTask;
  93 rtsBool IAmMainThread;
  94 rtsBool GlobalStopPending =     rtsFalse;       /* Handle Unexpexted messages correctly */
  95
  96 static GLOBAL_TASK_ID gtids[MAX_PES];
  97 static long PEbuffer[MAX_PES];
  98 int nPEs = 0;
  99 static GLOBAL_TASK_ID sysman_id, sender_id, mainThread_id;
 100 static unsigned PEsTerminated = 0;
 101 static rtsBool Finishing = rtsFalse;
 102
 103 /*
 104  * This reproduced from RtsUtlis to save linking with a whole ball of wax
 105  */
 106 stgMallocBytes (int n, char *msg)
 107 {
 108     char *space;
 109
 110     if ((space = (char *) malloc((size_t) n)) == NULL) {
 111         fflush(stdout);
 112         fprintf(stderr,"stgMallocBytes failed: ", msg);
 113         stg_exit(EXIT_FAILURE);
 114     }
 115     return space;
 116 }
 117
 118 #define checkerr(c)     do {if((c)<0) { pvm_perror("Sysman"); exit(EXIT_FAILURE); }} while(0)
 119
 120 main(int argc, char **argv)
 121 {
 122     int rbufid;
 123     int opcode, nbytes;
 124     char **pargv;
 125     int i, cc;
 126     int spawn_flag = PvmTaskDefault;
 127     PACKET addr;
 128
 129     char *petask, *pvmExecutable;
 130
 131     setbuf(stdout, NULL);
 132     setbuf(stderr, NULL);
 133
 134     if (argc > 1) {
 135         if (*argv[1] == '-') {
 136             spawn_flag = PvmTaskDebug;
 137             argv[1] = argv[0];
 138             argv++; argc--;
 139         }
 140         sysman_id = pvm_mytid();/* This must be the first PVM call */
 141
 142         checkerr(sysman_id);
 143
 144         /*
 145         Get the full path and filename of the pvm executable (stashed in some
 146         PVM directory.
 147         */
 148         pvmExecutable = argv[1];
 149
 150         nPEs = atoi(argv[2]);
 151
 152         if ((petask = getenv(PETASK)) == NULL)
 153             petask = PETASK;
 154
 155 #if 1
 156         fprintf(stderr, "nPEs (%s) = %d\n", petask, nPEs);
 157 #endif
 158
 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);
 162             exit(EXIT_FAILURE);
 163         }
 164
 165         /*
 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
 168         */
 169         nPEs--;
 170         if (nPEs > 0) {
 171             /* Initialise the PE task arguments from Sysman's arguments */
 172             pargv = argv + 2;
 173 #if 1
 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");
 179 #endif
 180             checkerr(pvm_spawn(petask, pargv, spawn_flag, "", nPEs, gtids));
 181             /*
 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.
 184              */
 185             for (i = 0; i < nPEs; i++)
 186                 PEbuffer[i+1] = (long) gtids[i];
 187 #if 1
 188             fprintf(stderr, "Spawned /* PWT */\n");
 189 #endif
 190         }
 191
 192         /*
 193         Create the MainThread PE by forking SysMan. This arcane coding
 194         is required to allow MainThread to read stdin and write to stdout.
 195         PWT 18/1/96
 196         */
 197         nPEs++;                         /* Record that the number of PEs is increasing */
 198         if ((cc = fork())) {
 199             checkerr(cc);               /* Parent continues as SysMan */
 200 #if 1
 201             fprintf(stderr, "SysMan Task is [t%x]\n", sysman_id);
 202 #endif
 203             /*
 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.
 207
 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.
 211             */
 212             checkerr(pvm_joingroup(PECTLGROUP));
 213 #if 1
 214             fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
 215 #endif
 216             /* Wait for all the PEs to arrive */
 217             checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
 218 #if 1
 219             fprintf(stderr, "PECTLGROUP  barrier passed /* HWL */\n");
 220 #endif
 221             /* Broadcast SysMan's ID, so Main Thread PE knows it */
 222             pvm_initsend(PvmDataDefault);
 223             pvm_bcast(PEGROUP, PP_SYSMAN_TID);
 224
 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;
 229 #if 1
 230             fprintf(stderr,"SysMan received Main Task = %x\n",mainThread_id);
 231 #endif
 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);
 236 #if 1
 237             fprintf(stderr, "Sysman successfully initialized!\n");
 238 #endif
 239             /* Process incoming messages */
 240             while (1) {
 241                 if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0)
 242                     pvm_perror("Sysman: Receiving Message");
 243                 else {
 244                     pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
 245 #if 1
 246                   fprintf(stderr, "HWL-DBG(SysMan; main loop): rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
 247                       rbufid, nbytes, opcode, sender_id);
 248 #endif
 249                   switch (opcode) {
 250                     case PP_GC_INIT:
 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);
 255 /*                    DoGlobalGC();                */
 256 /*                    broadcast(PEGROUP, PP_INIT); */
 257                       break;
 258
 259                     case PP_STATS_ON:
 260                     case PP_STATS_OFF:
 261                         /* This Function not yet implemented for GUM */
 262                         break;
 263
 264                     case PP_FINISH:
 265                         if (!Finishing) {
 266                           fprintf(stderr, "\nFinish from %x\n", sender_id);
 267                           Finishing = rtsTrue;
 268                           pvm_initsend(PvmDataDefault);
 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
 313 /* Needed here because its used in loads of places like LLComms etc */
 314
 315 void stg_exit(n)
 316 I_ n;
 317 {
 318     exit(n);
 319 }