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], IOTask =  0, 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;
  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(argc, argv)
  56 int argc;
  57 char **argv;
  58 {
  59     int rbufid;
  60     int opcode, nbytes;
  61     char **pargv;
  62     int i;
  63 #if 0
  64     int status;
  65 #endif
  66     int spawn_flag = PvmTaskDefault;
  67
  68     char *petask;
  69
  70     setbuf(stdout, NULL);
  71     setbuf(stderr, NULL);
  72
  73     if (argc > 1) {
  74         if (*argv[1] == '-') {
  75             spawn_flag = PvmTaskDebug;
  76             argv[1] = argv[0];
  77             argv++; argc--;
  78         }
  79         sysman_id = pvm_mytid();/* This must be the first PVM call */
  80         checkerr(sysman_id);
  81
  82         nPEs = atoi(argv[1]);
  83
  84         if ((petask = getenv(PETASK)) == NULL)
  85             petask = PETASK;
  86
  87 #if 1
  88         fprintf(stderr, "nPEs (%s) = %d\n", petask, nPEs);
  89 #endif
  90
  91         /* Check that we can create the number of PE and IMU tasks requested */
  92         if (nPEs > MAX_PES) {
  93             fprintf(stderr, "No more than %d PEs allowed (%d requested)\n", MAX_PES, nPEs);
  94             EXIT(EXIT_FAILURE);
  95         }
  96         /* Create the PE Tasks */
  97         if (nPEs > 0) {
  98             /* Initialise the PE task arguments from Sysman's arguments */
  99             pargv = argv + 1;
 100 #if 0
 101             fprintf(stderr, "Spawning %d PEs(%s) ...\n", nPEs, petask);
 102             fprintf(stderr, "  args: ");
 103             for (i = 0; pargv[i]; ++i)
 104                 fprintf(stderr, "%s, ", pargv[i]);
 105             fprintf(stderr, "\n");
 106 #endif
 107
 108             checkerr(pvm_spawn(petask, pargv, spawn_flag, "", nPEs, gtids));
 109             for (i = 0; i < nPEs; i++)
 110                 PEbuffer[i] = (long) gtids[i];
 111 #if 0
 112             fprintf(stderr, "Spawned /* PWT */\n");
 113 #endif
 114
 115         }
 116         /* Join the PE  sysman groups in order to allow barrier synchronisation */
 117         checkerr(pvm_joingroup(PECTLGROUP));
 118 #if 0
 119         fprintf(stderr, "Joined PECTLGROUP /* PWT */\n");
 120 #endif
 121
 122         /* Wait for all the PEs and IMUs to arrive */
 123         checkerr(pvm_barrier(PECTLGROUP, nPEs + 1));
 124
 125 #if 0
 126         fprintf(stderr, "PECTLGROUP  barrier passed /* HWL */\n");
 127 #endif
 128
 129         /* Broadcast Global Task Ids of all PEs */
 130
 131         pvm_initsend(PvmDataDefault);
 132         PutArgs(PEbuffer, nPEs);
 133         pvm_bcast(PEGROUP, PP_PETIDS);
 134
 135 #if 0
 136         /* Find an IO task */
 137         for (i = 0; IOTask <= 0 || status != PvmOk; ++i) {
 138             IOTask = pvm_gettid(PEGROUP, i);
 139             status = pvm_pstat(IOTask);
 140             fprintf(stderr, "Task %x, Status %x\n", IOTask, status);
 141         }
 142 #endif
 143
 144         IOTask = gtids[0];
 145 #if 0
 146         fprintf(stderr, "IO Task is [t%x]\n", IOTask);
 147 #endif
 148
 149         pvm_initsend(PvmDataDefault);
 150         pvm_send(IOTask, PP_IO_INIT);
 151
 152         pvm_initsend(PvmDataDefault);
 153         pvm_bcast(PEGROUP, PP_INIT);
 154 #if 0
 155         fprintf(stderr, "Broadcast PP_INIT to all PEs\n");
 156 #endif
 157
 158         /* HWL-DEBUG */
 159 #if 0
 160         fprintf(stderr, "Sysman successfully initialized!\n");
 161 #endif
 162
 163         /* Process incoming messages */
 164         while (1) {
 165             if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0)
 166                 pvm_perror("Sysman: Receiving Message");
 167
 168             else {
 169                 pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
 170
 171 #if 0
 172                 fprintf(stderr, "HWL-DBG(SysMan; main loop): rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
 173                   rbufid, nbytes, opcode, sender_id);
 174 #endif
 175
 176                 switch (opcode) {
 177                 case PP_GC_INIT:
 178                     /* This Function not yet implemented for GUM */
 179                     fprintf(stderr, "Global GC from %x Not yet implemented for GUM!\n", sender_id);
 180                     sync(PECTLGROUP, PP_FULL_SYSTEM);
 181                     broadcast(PEGROUP, PP_GC_INIT);
 182                     DoGlobalGC();
 183                     broadcast(PEGROUP, PP_INIT);
 184                     break;
 185
 186                 case PP_STATS_ON:
 187                 case PP_STATS_OFF:
 188                     /* This Function not yet implemented for GUM */
 189                     break;
 190
 191                 case PP_FINISH:
 192                     fprintf(stderr, "Finish from %x\n", sender_id);
 193                     if (!Finishing) {
 194                         long buf = (long) StatsTask;
 195                         Finishing = rtsTrue;
 196                         pvm_initsend(PvmDataDefault);
 197                         pvm_pklong(&buf, 1, 1);
 198                         pvm_bcast(PEGROUP, PP_FINISH);
 199                     } else {
 200                         ++PEsTerminated;
 201                     }
 202
 203                     if (PEsTerminated >= nPEs) {
 204                         broadcast(PEGROUP, PP_FINISH);
 205                         broadcast(MGRGROUP, PP_FINISH);
 206                         pvm_lvgroup(PEGROUP);
 207                         pvm_lvgroup(PECTLGROUP);
 208                         pvm_lvgroup(MGRGROUP);
 209                         pvm_exit();
 210                         EXIT(EXIT_SUCCESS);
 211                     }
 212                     break;
 213
 214                 case PP_FAIL:
 215                     fprintf(stderr, "Fail from %x\n", sender_id);
 216                     if (!Finishing) {
 217                         Finishing = rtsTrue;
 218                         broadcast(PEGROUP, PP_FAIL);
 219                     }
 220                     break;
 221
 222                 default:
 223                     {
 224 /*                    char *opname = GetOpName(opcode);
 225                       fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
 226                                      opname,opcode);    */
 227                         fprintf(stderr, "Sysman: Unrecognised opcode (%x)\n",
 228                           opcode);
 229                     }
 230                     break;
 231                 }
 232             }
 233         }
 234     }
 235 }
 236 \end{code}
 237
 238 @myexit@ for the system manager.
 239
 240 \begin{code}
 241
 242 void
 243 myexit(n)
 244 I_ n;
 245 {
 246 #ifdef exit
 247 #undef exit
 248 #endif
 249     exit(n);
 250 }
 251
 252 \end{code}