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. Based on K. Hammond's SysMan.lc
  12 in Graph for PVM.
  13
  14 \begin{code}
  15 #define NON_POSIX_SOURCE /* so says Solaris */
  16
  17 #include "rtsdefs.h"
  18 #include "LLC.h"
  19 \end{code}
  20
  21 \begin{code}
  22 static GLOBAL_TASK_ID gtids[MAX_PES], StatsTask = 0;
  23 static long PEbuffer[MAX_PES];
  24 static int nPEs = 0;
  25 \end{code}
  26
  27 \begin{code}
  28 static GLOBAL_TASK_ID sysman_id, sender_id, mainThread_id;
  29
  30 GLOBAL_TASK_ID mytid;
  31
  32 static unsigned PEsTerminated = 0;
  33
  34 static rtsBool Finishing = rtsFalse;
  35 \end{code}
  36
  37 \begin{code}
  38 #define checkerr(c)     do {if((c)<0) { pvm_perror("Sysman"); EXIT(EXIT_FAILURE); }} while(0)
  39 \end{code}
  40
  41 This Function not yet implemented for GUM
  42
  43 \begin{code}
  44 static void
  45 DoGlobalGC(STG_NO_ARGS)
  46 {}
  47 /*
  48 static void
  49 HandleException(STG_NO_ARGS)
  50 {}
  51 */
  52 \end{code}
  53
  54 \begin{code}
  55 main(int argc, char **argv)
  56 {
  57     int rbufid;
  58     int opcode, nbytes;
  59     char **pargv;
  60     int i, cc;
  61     int spawn_flag = PvmTaskDefault;
  62
  63     char *petask, *pvmExecutable;
  64
  65     setbuf(stdout, NULL);
  66     setbuf(stderr, NULL);
  67
  68     if (argc > 1) {
  69         if (*argv[1] == '-') {
  70             spawn_flag = PvmTaskDebug;
  71             argv[1] = argv[0];
  72             argv++; argc--;
  73         }
  74         mainThread_id = pvm_mytid();/* This must be the first PVM call */
  75         checkerr(mainThread_id);
  76
  77         nPEs = atoi(argv[1]);
  78
  79         if ((petask = getenv(PETASK)) == NULL)
  80             petask = PETASK;
  81
  82 #if 0
  83         fprintf(stderr, "nPEs (%s) = %d\n", petask, nPEs);
  84 #endif
  85
  86         /* Check that we can create the number of PE and IMU tasks requested */
  87         if (nPEs > MAX_PES) {
  88             fprintf(stderr, "No more than %d PEs allowed (%d requested)\n", MAX_PES, nPEs);
  89             EXIT(EXIT_FAILURE);
  90         }
  91         /*
  92         Get the full path and filename of the pvm executable (stashed in some
  93         PVM directory.
  94         */
  95         pvmExecutable = argv[2];
  96
  97         /* Create the PE Tasks */
  98         if (nPEs > 0) {
  99             /*  Spawn nPEs-1 pvm threads: the Main Thread (starts execution and performs
 100                 IO is created by forking SysMan */
 101             nPEs--;
 102 #if 1
 103             fprintf(stderr, "Spawning %d PEs(%s) ...\n", nPEs, petask);
 104             fprintf(stderr, "  args: ");
 105             for (i = 0; pargv[i]; ++i)
 106                 fprintf(stderr, "%s, ", pargv[i]);
 107             fprintf(stderr, "\n");
 108 #endif
 109             /* Initialise the PE task arguments from Sysman's arguments */
 110             pargv = argv + 2;
 111             checkerr(pvm_spawn(petask, pargv, spawn_flag, "", nPEs, gtids));
 112             PEbuffer[0] = mainThread_id;
 113             for (i = 0; i < nPEs; i++)
 114                 PEbuffer[i++] = (long) gtids[i];
 115 #if 1
 116             fprintf(stderr, "Spawned /* PWT */\n");
 117 #endif
 118
 119         }
 120         /*
 121            SysMan joins PECTLGROUP, so that it can wait (at the
 122            barrier sysnchronisation a few instructions later) for the
 123            other PE-tasks to start.
 124
 125            Other comments on PVM groupery:
 126
 127            The manager group (MGRGROUP) is vestigial at the moment. It
 128            may eventually include a statistics manager, garbage
 129            collector manager.
 130
 131            I suspect that you're [Kei Davis] right: Sysman shouldn't
 132            be in PEGROUP, it's a hangover from GRIP.
 133
 134            (Phil Trinder, 95/10)
 135         */
 136         checkerr(pvm_joingroup(PECTLGROUP));
 137 #if 1
 138         fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
 139 #endif
 140
 141         /* Wait for all the PEs and IMUs to arrive */
 142         checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
 143
 144 #if 1
 145         fprintf(stderr, "PECTLGROUP  barrier passed /* HWL */\n");
 146 #endif
 147         /*
 148         Create the MainThread PE by forking SysMan. This arcane coding
 149         is required to allow MainThread to read stdin and write to stdout.
 150         PWT 18/1/96
 151         */
 152         if (cc = fork()) {
 153           checkerr(cc);
 154           exec($some path$/petask)              /* Parent task become Main Thread PE */
 155         } else {
 156                                         /* Child continues as SysMan */
 157           pvmendtask();                 /* Disconnect from PVM to avoid confusion */
 158           sysman_id = pvm_mytid();      /* Reconnect to PVM to get new task id */
 159
 160           /* Broadcast Global Task Ids of all PEs */
 161
 162           pvm_initsend(PvmDataDefault);
 163           PutArgs(PEbuffer, nPEs);
 164           pvm_bcast(PEGROUP, PP_PETIDS);
 165
 166 #if 1
 167           fprintf(stderr, "Main Thread Task is [t%x]\n", mainThread_id);
 168 #endif
 169
 170           pvm_initsend(PvmDataDefault);
 171           pvm_send(mainThread_id, PP_IO_INIT);
 172
 173           pvm_initsend(PvmDataDefault);
 174           pvm_bcast(PEGROUP, PP_INIT);
 175 #if 1
 176           fprintf(stderr, "Broadcast PP_INIT to all PEs\n");
 177 #endif
 178
 179         /* HWL-DEBUG */
 180 #if 1
 181           fprintf(stderr, "Sysman successfully initialized!\n");
 182 #endif
 183
 184         /* Process incoming messages */
 185           while (1) {
 186               if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0)
 187                   pvm_perror("Sysman: Receiving Message");
 188
 189               else {
 190                   pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
 191
 192 #if 0
 193                   fprintf(stderr, "HWL-DBG(SysMan; main loop): rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
 194                     rbufid, nbytes, opcode, sender_id);
 195 #endif
 196
 197                   switch (opcode) {
 198                   case PP_GC_INIT:
 199                     /* This Function not yet implemented for GUM */
 200                     fprintf(stderr, "Global GC from %x Not yet implemented for GUM!\n", sender_id);
 201                     sync(PECTLGROUP, PP_FULL_SYSTEM);
 202                     broadcast(PEGROUP, PP_GC_INIT);
 203                     DoGlobalGC();
 204                     broadcast(PEGROUP, PP_INIT);
 205                     break;
 206
 207                   case PP_STATS_ON:
 208                   case PP_STATS_OFF:
 209                       /* This Function not yet implemented for GUM */
 210                       break;
 211
 212                   case PP_FINISH:
 213                       fprintf(stderr, "Finish from %x\n", sender_id);
 214                       if (!Finishing) {
 215                         long buf = (long) StatsTask;
 216                         Finishing = rtsTrue;
 217                         pvm_initsend(PvmDataDefault);
 218                         pvm_pklong(&buf, 1, 1);
 219                         pvm_bcast(PEGROUP, PP_FINISH);
 220                       } else {
 221                         ++PEsTerminated;
 222                       }
 223
 224                       if (PEsTerminated >= nPEs) {
 225                         broadcast(PEGROUP, PP_FINISH);
 226                         broadcast(MGRGROUP, PP_FINISH);
 227                         pvm_lvgroup(PEGROUP);
 228                         pvm_lvgroup(PECTLGROUP);
 229                         pvm_lvgroup(MGRGROUP);
 230                         pvm_exit();
 231                         EXIT(EXIT_SUCCESS);
 232                       }
 233                       break;
 234
 235                   case PP_FAIL:
 236                       fprintf(stderr, "Fail from %x\n", sender_id);
 237                       if (!Finishing) {
 238                         Finishing = rtsTrue;
 239                         broadcast(PEGROUP, PP_FAIL);
 240                       }
 241                       break;
 242
 243                   default:
 244                       {
 245 /*                      char *opname = GetOpName(opcode);
 246                         fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
 247                                      opname,opcode);    */
 248                         fprintf(stderr, "Sysman: Unrecognised opcode (%x)\n",
 249                           opcode);
 250                       }
 251                       break;
 252                   }
 253             }
 254         }
 255     }
 256     return(0);
 257 }
 258 \end{code}
 259
 260 @myexit@ for the system manager.
 261
 262 \begin{code}
 263
 264 void
 265 myexit(n)
 266 I_ n;
 267 {
 268 #ifdef exit
 269 #undef exit
 270 #endif
 271     exit(n);
 272 }
 273
 274 \end{code}