ghc/rts/gum/LLComms.c

   1 /* -----------------------------------------------------------------------------
   2  *
   3  * $Id: LLComms.c,v 1.2 1998/12/02 13:29:06 simonm Exp $
   4  *
   5  * GUM Low-Level Inter-Task Communication
   6  *
   7  * This module defines PVM Routines for PE-PE  communication.
   8  *
   9  *     P. Trinder, December 5th. 1994.
  10  *     Adapted for the new RTS, P. Trinder July 1998
  11  *
  12  ---------------------------------------------------------------------------- */
  13
  14 #ifdef PAR /* whole file */
  15
  16 /*
  17  *This module defines the routines which communicate between PEs.  The
  18  *code is based on Kevin Hammond's GRIP RTS. (Opcodes.h defines
  19  *PEOp1 etc. in terms of SendOp1 etc.).
  20  *
  21  *Routine       &       Arguments
  22  *              &
  23  *SendOp        &       0                       \\
  24  *SendOp1       &       1                       \\
  25  *SendOp2       &       2                       \\
  26  *SendOpN       &       vector                  \\
  27  *SendOpV       &       variable                \\
  28  *SendOpNV      &       variable+ vector        \\
  29  *
  30  *First the standard include files.
  31  */
  32
  33 #define NON_POSIX_SOURCE /* so says Solaris */
  34
  35 #include "Rts.h"
  36 #include "RtsUtils.h"
  37 #include "Parallel.h"
  38
  39 #include "LLC.h"
  40 #ifdef __STDC__
  41 #include <stdarg.h>
  42 #else
  43 #include <varargs.h>
  44 #endif
  45
  46 /*
  47  *Then some miscellaneous functions.
  48  *GetOpName returns the character-string name of any opcode.
  49  */
  50
  51 char *UserPEOpNames[] = { PEOP_NAMES };
  52
  53 char *
  54 GetOpName(nat op)
  55 {
  56     if (op >= MIN_PEOPS && op <= MAX_PEOPS)
  57         return (UserPEOpNames[op - MIN_PEOPS]);
  58
  59     else
  60         return ("Unknown PE Opcode");
  61 }
  62
  63 /*
  64  * trace_SendOp handles the tracing of messages.
  65  */
  66
  67 static void
  68 trace_SendOp(OPCODE op, GLOBAL_TASK_ID dest UNUSED,
  69              unsigned int data1 UNUSED, unsigned int data2 UNUSED)
  70 {
  71     char *OpName;
  72
  73     OpName = GetOpName(op);
  74 /*    fprintf(stderr, " %s [%x,%x] sent from %x to %x\n", OpName, data1, data2, mytid, dest);*/
  75 }
  76
  77 /*
  78  *SendOp sends a 0-argument message with opcode {\em op} to
  79  *the global task {\em task}.
  80  */
  81
  82 void
  83 SendOp(OPCODE op, GLOBAL_TASK_ID task)
  84 {
  85     trace_SendOp(op, task,0,0);
  86
  87     pvm_initsend(PvmDataRaw);
  88     pvm_send( task, op );
  89 }
  90
  91 /*
  92  *SendOp1 sends a 1-argument message with opcode {\em op}
  93  *to the global task {\em task}.
  94  */
  95
  96 void
  97 SendOp1(OPCODE op, GLOBAL_TASK_ID task, StgWord arg1)
  98 {
  99     trace_SendOp(op, task, arg1,0);
 100
 101     pvm_initsend(PvmDataRaw);
 102     PutArg1(arg1);
 103     pvm_send( task, op );
 104 }
 105
 106
 107 /*
 108  *SendOp2 is used by the FP code only.
 109  */
 110
 111 void
 112 SendOp2(OPCODE op, GLOBAL_TASK_ID task, StgWord arg1, StgWord arg2)
 113 {
 114     trace_SendOp(op, task, arg1, arg2);
 115
 116     pvm_initsend(PvmDataRaw);
 117     PutArg1(arg1);
 118     PutArg2(arg2);
 119     pvm_send( task, op );
 120 }
 121
 122 /*
 123  *
 124  *SendOpV takes a variable number of arguments, as specified by {\em n}.
 125  *For example,
 126  *
 127  *    SendOpV( PP_STATS, StatsTask, 3, start_time, stop_time, sparkcount);
 128  */
 129
 130 void
 131 SendOpV(OPCODE op, GLOBAL_TASK_ID task, int n, ...)
 132 {
 133     va_list ap;
 134     int i;
 135     StgWord arg;
 136
 137     va_start(ap, n);
 138
 139     trace_SendOp(op, task, 0, 0);
 140
 141     pvm_initsend(PvmDataRaw);
 142
 143     for (i = 0; i < n; ++i) {
 144         arg = va_arg(ap, StgWord);
 145         PutArgN(i, arg);
 146     }
 147     va_end(ap);
 148
 149     pvm_send(task, op);
 150 }
 151
 152 /*
 153  *
 154  *SendOpNV takes a variable-size datablock, as specified by {\em
 155  *nelem} and a variable number of arguments, as specified by {\em
 156  *narg}. N.B. The datablock and the additional arguments are contiguous
 157  *and are copied over together.  For example,
 158  *
 159  *        SendOpNV(PP_RESUME, tsoga.pe, 6, nelem, data,
 160  *          (W_) ga.weight, (W_) ga.loc.gc.gtid, (W_) ga.loc.gc.slot,
 161  *          (W_) tsoga.weight, (W_) tsoga.loc.gc.gtid, (W_) tsoga.loc.gc.slot);
 162  *
 163  *Important: The variable arguments must all be StgWords.
 164  */
 165
 166 void
 167 SendOpNV(OPCODE op, GLOBAL_TASK_ID task, int nelem,
 168          StgWord *datablock, int narg, ...)
 169 {
 170     va_list ap;
 171     int i;
 172     StgWord arg;
 173
 174     va_start(ap, narg);
 175
 176     trace_SendOp(op, task, 0, 0);
 177 /*  fprintf(stderr,"SendOpNV: op = %x, task = %x, narg = %d, nelem = %d\n",op,task,narg,nelem); */
 178
 179     pvm_initsend(PvmDataRaw);
 180
 181     for (i = 0; i < narg; ++i) {
 182         arg = va_arg(ap, StgWord);
 183 /*      fprintf(stderr,"SendOpNV: arg = %d\n",arg); */
 184         PutArgN(i, arg);
 185     }
 186     arg = (StgWord) nelem;
 187     PutArgN(narg, arg);
 188
 189 /*  for (i=0; i < nelem; ++i) fprintf(stderr, "%d ",datablock[i]); */
 190 /*  fprintf(stderr," in SendOpNV\n");*/
 191
 192     PutArgs(datablock, nelem);
 193     va_end(ap);
 194
 195     pvm_send(task, op);
 196 }
 197
 198 /*
 199  *SendOpN take a variable size array argument, whose size is given by
 200  *{\em n}.  For example,
 201  *
 202  *    SendOpN( PP_STATS, StatsTask, 3, stats_array);
 203  */
 204
 205 void
 206 SendOpN(OPCODE op, GLOBAL_TASK_ID task, int n, StgPtr args)
 207 {
 208     long arg;
 209
 210     trace_SendOp(op, task, 0, 0);
 211
 212     pvm_initsend(PvmDataRaw);
 213     arg = (long) n;
 214     PutArgN(0, arg);
 215     PutArgs(args, n);
 216     pvm_send(task, op);
 217 }
 218
 219 /*
 220  *WaitForPEOp waits for a packet from global task {\em who} with the
 221  *opcode {\em op}.  Other opcodes are handled by processUnexpected.
 222  */
 223 PACKET
 224 WaitForPEOp(OPCODE op, GLOBAL_TASK_ID who)
 225 {
 226   PACKET p;
 227   int nbytes;
 228   OPCODE opcode;
 229   GLOBAL_TASK_ID sender_id;
 230   rtsBool match;
 231
 232   do {
 233 #if 0
 234     fprintf(stderr,"WaitForPEOp: op = %x, who = %x\n",op,who);
 235 #endif
 236     while((p = pvm_recv(ANY_TASK,ANY_OPCODE)) < 0)
 237       pvm_perror("WaitForPEOp: Waiting for PEOp");
 238
 239     pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 240 #if 0
 241     fprintf(stderr,"WaitForPEOp: received: opcode = %x, sender_id = %x\n",opcode,sender_id);
 242 #endif
 243     match = (op == ANY_OPCODE || op == opcode) && (who == ANY_TASK || who == sender_id);
 244
 245     if(match)
 246       return(p);
 247
 248     /* Handle the unexpected opcodes */
 249     ProcessUnexpected(p);
 250
 251   } while(rtsTrue);
 252 }
 253
 254 /*
 255  *ProcessUnexpected processes unexpected messages. If the message is a
 256  *FINISH it exits the prgram, and PVM gracefully
 257  */
 258 void
 259 ProcessUnexpected(PACKET packet)
 260 {
 261     OPCODE opcode = Opcode(packet);
 262
 263 #ifdef 0
 264     {
 265       GLOBAL_TASK_ID sender = Sender_Task(packet);
 266       fprintf(stderr,"ProcessUnexpected: Received %s (%x), sender %x\n",GetOpName(opcode),opcode,sender);
 267     }
 268 #endif
 269
 270     switch (opcode) {
 271
 272     case PP_FINISH:
 273         stg_exit(EXIT_SUCCESS);
 274         break;
 275
 276       /* Anything we're not prepared to deal with.  Note that ALL opcodes are discarded
 277          during termination -- this helps prevent bizarre race conditions.
 278       */
 279       default:
 280         if (!GlobalStopPending)
 281           {
 282             GLOBAL_TASK_ID ErrorTask;
 283             int opcode;
 284
 285             get_opcode_and_sender(packet,&opcode,&ErrorTask);
 286             fprintf(stderr,"Task %x: Unexpected opcode %x from %x in ProcessUnexpected\n",
 287                     mytid, opcode, ErrorTask );
 288
 289             stg_exit(EXIT_FAILURE);
 290           }
 291     }
 292 }
 293
 294 OPCODE
 295 Opcode(PACKET p)
 296 {
 297   int nbytes;
 298   OPCODE opcode;
 299   GLOBAL_TASK_ID sender_id;
 300   pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 301   return(opcode);
 302 }
 303
 304 GLOBAL_TASK_ID
 305 Sender_Task(PACKET p)
 306 {
 307   int nbytes;
 308   OPCODE opcode;
 309   GLOBAL_TASK_ID sender_id;
 310   pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 311   return(sender_id);
 312 }
 313
 314 void
 315 get_opcode_and_sender(PACKET p, OPCODE *popcode, GLOBAL_TASK_ID *psender_id)
 316 {
 317   int nbytes;
 318   pvm_bufinfo( p, &nbytes, popcode, psender_id );
 319 }
 320
 321
 322 /*
 323  *PEStartUp does the low-level comms specific startup stuff for a
 324  *PE. It initialises the comms system, joins the appropriate groups,
 325  *synchronises with the other PEs. Receives and records in a global
 326  *variable the task-id of SysMan. If this is the main thread (discovered
 327  *in main.lc), identifies itself to SysMan. Finally it receives
 328  *from SysMan an array of the Global Task Ids of each PE, which is
 329  *returned as the value of the function.
 330  */
 331 GLOBAL_TASK_ID *
 332 PEStartUp(nat nPEs)
 333 {
 334     int i;
 335     PACKET addr;
 336     long *buffer = (long *) stgMallocBytes(sizeof(long) * nPEs, "PEStartUp (buffer)");
 337     GLOBAL_TASK_ID *PEs
 338       = (GLOBAL_TASK_ID *) stgMallocBytes(sizeof(GLOBAL_TASK_ID) * nPEs, "PEStartUp (PEs)");
 339
 340     mytid = _my_gtid;           /* Initialise PVM and get task id into global var.*/
 341
 342 /*    fprintf(stderr,"PEStartup, Task id = [%x], No. PEs = %d \n", mytid, nPEs); */
 343     checkComms(pvm_joingroup(PEGROUP), "PEStartup");
 344 /*    fprintf(stderr,"PEStartup, Joined PEGROUP\n"); */
 345     checkComms(pvm_joingroup(PECTLGROUP), "PEStartup");
 346 /*    fprintf(stderr,"PEStartup, Joined PECTLGROUP\n"); */
 347     checkComms(pvm_barrier(PECTLGROUP, nPEs+1), "PEStartup");
 348 /*    fprintf(stderr,"PEStartup, Passed PECTLGROUP barrier\n"); */
 349
 350     addr = WaitForPEOp(PP_SYSMAN_TID, ANY_GLOBAL_TASK);
 351     SysManTask = Sender_Task(addr);
 352     if (IAmMainThread) {                /* Main Thread Identifies itself to SysMan */
 353         pvm_initsend(PvmDataDefault);
 354         pvm_send(SysManTask, PP_MAIN_TASK);
 355     }
 356     addr = WaitForPEOp(PP_PETIDS, ANY_GLOBAL_TASK);
 357     GetArgs(buffer, nPEs);
 358     for (i = 0; i < nPEs; ++i) {
 359         PEs[i] = (GLOBAL_TASK_ID) buffer[i];
 360 #if 0
 361         fprintf(stderr,"PEs[%d] = %x \n", i, PEs[i]);
 362 #endif
 363     }
 364     free(buffer);
 365     return PEs;
 366 }
 367
 368 /*
 369  *PEShutdown does the low-level comms-specific shutdown stuff for a
 370  *single PE. It leaves the groups and then exits from pvm.
 371  */
 372 void
 373 PEShutDown(void)
 374 {
 375      checkComms(pvm_lvgroup(PEGROUP),"PEShutDown");
 376      checkComms(pvm_lvgroup(PECTLGROUP),"PEShutDown");
 377      checkComms(pvm_exit(),"PEShutDown");
 378 }
 379
 380 /*
 381 heapChkCounter tracks the number of heap checks since the last probe.
 382 Not currently used! We check for messages when a thread is resheduled.
 383 */
 384 int heapChkCounter = 0;
 385
 386 #endif /* PAR -- whole file */
 387