ghc/runtime/gum/LLComms.lc

   1 %****************************************************************************
   2 %
   3 \section[LLComms.lc]{GUM Low-Level Inter-Task Communication}
   4 %
   5 % This module defines PVM Routines for PE-PE  communication.
   6 %
   7 % (c) The Parade/AQUA Projects, Glasgow University, 1994-1995
   8 %     P. Trinder, December 5th. 1994.
   9 %
  10 %****************************************************************************
  11
  12
  13 \begin{code}
  14 #ifdef PAR /* whole file */
  15 \end{code}
  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 \begin{onlylatex}
  22 \begin{center}
  23 \end{onlylatex}
  24 \begin{tabular}{|l|l|} \hline
  25 Routine         &       Arguments \\ \hline
  26                 &               \\
  27 @SendOp@        &       0                       \\
  28 @SendOp1@       &       1                       \\
  29 @SendOp2@       &       2                       \\
  30 @SendOpN@       &       vector                  \\
  31 @SendOpV@       &       variable                \\
  32 @SendOpNV@      &       variable+ vector        \\
  33 \end{tabular}
  34 \begin{onlylatex}
  35 \end{center}
  36 \end{onlylatex}
  37
  38 First the standard include files.
  39
  40 \begin{code}
  41 #define NON_POSIX_SOURCE /* so says Solaris */
  42
  43 #include "rtsdefs.h"
  44
  45 #include "LLC.h"
  46 #ifdef __STDC__
  47 #include <stdarg.h>
  48 #else
  49 #include <varargs.h>
  50 #endif
  51 \end{code}
  52
  53 Then some miscellaneous functions.
  54 @GetOpName@ returns the character-string name of any opcode.
  55
  56 \begin{code}
  57 char *UserPEOpNames[] = { PEOP_NAMES };
  58
  59 char *
  60 GetOpName(op)
  61 unsigned op;
  62 {
  63     if (op >= MIN_PEOPS && op <= MAX_PEOPS)
  64         return (UserPEOpNames[op - MIN_PEOPS]);
  65
  66     else
  67         return ("Unknown PE Opcode");
  68 }
  69
  70 void NullException(STG_NO_ARGS)
  71 {
  72   fprintf(stderr,"Null_Exception: called");
  73 }
  74 void (*ExceptionHandler)() = NullException;
  75
  76
  77 \end{code}
  78
  79 @trace_SendOp@ handles the tracing of messages at the OS level.  If
  80 tracing is on (as specified by @PETrace@, @SystemTrace@ and
  81 @ReplyTrace@), then a message is printed.  The opcode and address word
  82 of the previous PE opcode is recorded in the variables @lastSendOp@ and
  83 @lastPEaddress@. @PElastop@ is a Boolean which records whether the
  84 last message sent was for a PE or an IMU.
  85
  86 \begin{code}
  87 rtsBool PETrace = rtsFalse, IMUTrace = rtsFalse, SystemTrace = rtsFalse, ReplyTrace = rtsFalse;
  88
  89 static void
  90 trace_SendOp(op, dest, data1, data2)
  91 OPCODE op;
  92 GLOBAL_TASK_ID dest;
  93 unsigned data1, data2;
  94 {
  95     char *OpName;
  96
  97     if (!ReplyTrace && op == REPLY_OK)
  98         return;
  99
 100     OpName = GetOpName(op);
 101 /*    fprintf(stderr, " %s [%x,%x] sent from %x to %x\n", OpName, data1, data2, mytid, dest);*/
 102 }
 103
 104 \end{code}
 105
 106 @SendOp@ sends a 0-argument message with opcode {\em op} to
 107 the global task {\em task}.
 108
 109 \begin{code}
 110 void
 111 SendOp(op, task)
 112 OPCODE op;
 113 GLOBAL_TASK_ID task;
 114 {
 115     trace_SendOp(op, task,0,0);
 116
 117     pvm_initsend(PvmDataRaw);
 118     pvm_send( task, op );
 119 }
 120 \end{code}
 121
 122 @SendOp1@ sends a 1-argument message with opcode {\em op}
 123 to the global task {\em task}.
 124
 125 \begin{code}
 126 void
 127 SendOp1(op, task, arg1)
 128 OPCODE op;
 129 GLOBAL_TASK_ID task;
 130 StgWord arg1;
 131 {
 132     trace_SendOp(op, task, arg1,0);
 133
 134     pvm_initsend(PvmDataRaw);
 135     PutArg1(arg1);
 136     pvm_send( task, op );
 137 }
 138
 139 \end{code}
 140
 141 @SendOp2@ is used by the FP code only.
 142
 143 \begin{code}
 144 void
 145 SendOp2(op, task, arg1, arg2)
 146 OPCODE op;
 147 GLOBAL_TASK_ID task;
 148 StgWord arg1;
 149 StgWord arg2;
 150 {
 151     trace_SendOp(op, task, arg1, arg2);
 152
 153     pvm_initsend(PvmDataRaw);
 154     PutArg1(arg1);
 155     PutArg2(arg2);
 156     pvm_send( task, op );
 157 }
 158 \end{code}
 159
 160 @SendOpV@ takes a variable number of arguments, as specified by {\em n}.
 161 For example,
 162 \begin{verbatim}
 163     SendOpV( PP_STATS, StatsTask, 3, start_time, stop_time, sparkcount);
 164 \end{verbatim}
 165
 166 \begin{code}
 167
 168 #ifdef __STDC__
 169 void
 170 SendOpV(OPCODE op, GLOBAL_TASK_ID task, int n, ...)
 171 #else
 172 void
 173 SendOpV(op, task, n, va_alist)
 174 OPCODE op;
 175 GLOBAL_TASK_ID task;
 176 int n;
 177 va_dcl
 178 #endif
 179 {
 180     va_list ap;
 181     int i;
 182     StgWord arg;
 183
 184 #ifdef __STDC__
 185     va_start(ap, n);
 186 #else
 187     va_start(ap);
 188 #endif
 189
 190     trace_SendOp(op, task, 0, 0);
 191
 192     pvm_initsend(PvmDataRaw);
 193
 194     for (i = 0; i < n; ++i) {
 195         arg = va_arg(ap, StgWord);
 196         PutArgN(i, arg);
 197     }
 198     va_end(ap);
 199
 200     pvm_send(task, op);
 201 }
 202 \end{code}
 203
 204 @SendOpNV@ takes a variable-size datablock, as specified by {\em
 205 nelem} and a variable number of arguments, as specified by {\em
 206 narg}. N.B. The datablock and the additional arguments are contiguous
 207 and are copied over together.  For example,
 208
 209 \begin{verbatim}
 210         SendOpNV(PP_RESUME, tsoga.pe, 6, nelem, data,
 211             (W_) ga.weight, (W_) ga.loc.gc.gtid, (W_) ga.loc.gc.slot,
 212             (W_) tsoga.weight, (W_) tsoga.loc.gc.gtid, (W_) tsoga.loc.gc.slot);
 213 \end{verbatim}
 214
 215 Important: The variable arguments must all be StgWords.
 216
 217 \begin{code}
 218
 219 #ifdef __STDC__
 220 void
 221 SendOpNV(OPCODE op, GLOBAL_TASK_ID task, int nelem, StgWord *datablock, int narg, ...)
 222 #else
 223 void
 224 SendOpNV(op, task, nelem, datablock, narg, va_alist)
 225 OPCODE op;
 226 GLOBAL_TASK_ID task;
 227 int nelem;
 228 StgWord *datablock;
 229 int narg;
 230 va_dcl
 231 #endif
 232 {
 233     va_list ap;
 234     int i;
 235     StgWord arg;
 236
 237 #ifdef __STDC__
 238     va_start(ap, narg);
 239 #else
 240     va_start(ap);
 241 #endif
 242
 243     trace_SendOp(op, task, 0, 0);
 244 /*  fprintf(stderr,"SendOpNV: op = %x, task = %x, narg = %d, nelem = %d\n",op,task,narg,nelem); */
 245
 246     pvm_initsend(PvmDataRaw);
 247
 248     for (i = 0; i < narg; ++i) {
 249         arg = va_arg(ap, StgWord);
 250 /*      fprintf(stderr,"SendOpNV: arg = %d\n",arg); */
 251         PutArgN(i, arg);
 252     }
 253     arg = (StgWord) nelem;
 254     PutArgN(narg, arg);
 255
 256 /*  for (i=0; i < nelem; ++i) fprintf(stderr, "%d ",datablock[i]); */
 257 /*  fprintf(stderr," in SendOpNV\n");*/
 258
 259     PutArgs(datablock, nelem);
 260     va_end(ap);
 261
 262     pvm_send(task, op);
 263 }
 264 \end{code}
 265
 266
 267 @SendOpN@ take a variable size array argument, whose size is given by
 268 {\em n}.  For example,
 269
 270 \begin{verbatim}
 271     SendOpN( PP_STATS, StatsTask, 3, stats_array);
 272 \end{verbatim}
 273
 274 \begin{code}
 275
 276 void
 277 SendOpN(op, task, n, args)
 278 OPCODE op;
 279 GLOBAL_TASK_ID task;
 280 int n;
 281 StgWord *args;
 282
 283 {
 284     long arg;
 285
 286     trace_SendOp(op, task, 0, 0);
 287
 288     pvm_initsend(PvmDataRaw);
 289     arg = (long) n;
 290     PutArgN(0, arg);
 291     PutArgs(args, n);
 292     pvm_send(task, op);
 293 }
 294 \end{code}
 295
 296 @WaitForPEOp@ waits for a packet from global task {\em who} with the
 297 opcode {\em op}.  Other opcodes are handled by the standard exception handler.
 298
 299 \begin{code}
 300 PACKET WaitForPEOp(op, who)
 301 OPCODE op;
 302 GLOBAL_TASK_ID who;
 303 {
 304   PACKET p;
 305   int nbytes;
 306   OPCODE opcode;
 307   GLOBAL_TASK_ID sender_id;
 308   rtsBool match;
 309
 310   do {
 311 /*    fprintf(stderr,"WaitForPEOp: op = %x, who = %x\n",op,who); */
 312     while((p = pvm_recv(ANY_TASK,ANY_OPCODE)) < 0)
 313       pvm_perror("WaitForPEOp: Waiting for PEOp");
 314
 315     pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 316
 317     match = (op == ANY_OPCODE || op == opcode) && (who == ANY_TASK || who == sender_id);
 318
 319     if(match)
 320       return(p);
 321
 322     /* Handle the unexpected opcodes */
 323     HandleException(p);
 324
 325   } while(rtsTrue);
 326 }
 327 \end{code}
 328
 329 \begin{code}
 330
 331 OPCODE
 332 Opcode(p)
 333 PACKET p;
 334 {
 335   int nbytes;
 336   OPCODE opcode;
 337   GLOBAL_TASK_ID sender_id;
 338   pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 339   return(opcode);
 340 }
 341
 342 GLOBAL_TASK_ID
 343 Sender_Task(p)
 344 PACKET p;
 345 {
 346   int nbytes;
 347   OPCODE opcode;
 348   GLOBAL_TASK_ID sender_id;
 349   pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 350   return(sender_id);
 351 }
 352
 353 void
 354 get_opcode_and_sender(p,popcode,psender_id)
 355 PACKET p;
 356 OPCODE *popcode;
 357 GLOBAL_TASK_ID *psender_id;
 358 {
 359   int nbytes;
 360   pvm_bufinfo( p, &nbytes, popcode, psender_id );
 361 }
 362
 363 \end{code}
 364
 365 @PEStartUp@ does the low-level comms specific startup stuff for a
 366 PE. It initialises the comms system, joins the appropriate groups,
 367 synchronises with the other PEs. Finally it receives from Control the
 368 array of Global Task Ids.
 369
 370 \begin{code}
 371
 372 static char *
 373 xmalloc(n)
 374 unsigned n;
 375 {
 376     char *p = malloc(n);
 377
 378     if (p == NULL) {
 379         fprintf(stderr, "Memory allocation of %u bytes failed\n", n);
 380         EXIT(EXIT_FAILURE);
 381     }
 382     return p;
 383 }
 384
 385 GLOBAL_TASK_ID *
 386 PEStartUp(nPEs)
 387 unsigned nPEs;
 388 {
 389     int i;
 390     PACKET addr;
 391     long *buffer = (long *) xmalloc(sizeof(long) * nPEs);
 392     GLOBAL_TASK_ID *PEs = (GLOBAL_TASK_ID *) xmalloc(sizeof(GLOBAL_TASK_ID) * nPEs);
 393
 394     mytid = _my_gtid;           /* Initialise PVM and get task id into global
 395                                  * variable */
 396
 397 /*    fprintf(stderr,"PEStartup, No. PEs = %d \n", nPEs); */
 398     checkComms(pvm_joingroup(PEGROUP), "PEStartup");
 399 /*    fprintf(stderr,"PEStartup, Joined PEGROUP\n"); */
 400     checkComms(pvm_joingroup(PECTLGROUP), "PEStartup");
 401 /*    fprintf(stderr,"PEStartup, Joined PECTLGROUP\n"); */
 402     checkComms(pvm_barrier(PECTLGROUP, nPEs + 1), "PEStartup");
 403 /*    fprintf(stderr,"PEStartup, Passed PECTLGROUP barrier\n"); */
 404
 405     addr = WaitForPEOp(PP_PETIDS, ANY_GLOBAL_TASK);
 406     GetArgs(buffer, nPEs);
 407     for (i = 0; i < nPEs; ++i) {
 408         PEs[i] = (GLOBAL_TASK_ID) buffer[i];
 409         /* fprintf(stderr,"PEs[%d] = %x \n", i, PEs[i]);  */
 410     }
 411     free(buffer);
 412     return PEs;
 413 }
 414 \end{code}
 415
 416 @PEShutdown@ does the low-level comms-specific shutdown stuff for a
 417 single PE. It leaves the groups and then exits from pvm.
 418
 419 \begin{code}
 420 void
 421 PEShutDown(STG_NO_ARGS)
 422 {
 423      checkComms(pvm_lvgroup(PEGROUP),"PEShutDown");
 424      checkComms(pvm_lvgroup(PECTLGROUP),"PEShutDown");
 425      checkComms(pvm_exit(),"PEShutDown");
 426 }
 427 \end{code}
 428
 429 @heapChkCounter@ tracks the number of heap checks since the last probe.
 430 Not currently used! We check for messages when a thread is resheduled.
 431
 432 \begin{code}
 433 int heapChkCounter = 0;
 434 \end{code}
 435
 436 \begin{code}
 437 #endif /* PAR -- whole file */
 438 \end{code}