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
  71 NullException(STG_NO_ARGS)
  72 {
  73   fprintf(stderr,"Null_Exception: called");
  74 }
  75
  76 void (*ExceptionHandler)() = NullException;
  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(OPCODE op, GLOBAL_TASK_ID dest, unsigned int data1, unsigned int data2)
  91 {
  92     char *OpName;
  93
  94     if (!ReplyTrace && op == REPLY_OK)
  95         return;
  96
  97     OpName = GetOpName(op);
  98 /*    fprintf(stderr, " %s [%x,%x] sent from %x to %x\n", OpName, data1, data2, mytid, dest);*/
  99 }
 100
 101 \end{code}
 102
 103 @SendOp@ sends a 0-argument message with opcode {\em op} to
 104 the global task {\em task}.
 105
 106 \begin{code}
 107 void
 108 SendOp(op, task)
 109 OPCODE op;
 110 GLOBAL_TASK_ID task;
 111 {
 112     trace_SendOp(op, task,0,0);
 113
 114     pvm_initsend(PvmDataRaw);
 115     pvm_send( task, op );
 116 }
 117 \end{code}
 118
 119 @SendOp1@ sends a 1-argument message with opcode {\em op}
 120 to the global task {\em task}.
 121
 122 \begin{code}
 123 void
 124 SendOp1(op, task, arg1)
 125 OPCODE op;
 126 GLOBAL_TASK_ID task;
 127 StgWord arg1;
 128 {
 129     trace_SendOp(op, task, arg1,0);
 130
 131     pvm_initsend(PvmDataRaw);
 132     PutArg1(arg1);
 133     pvm_send( task, op );
 134 }
 135
 136 \end{code}
 137
 138 @SendOp2@ is used by the FP code only.
 139
 140 \begin{code}
 141 void
 142 SendOp2(op, task, arg1, arg2)
 143 OPCODE op;
 144 GLOBAL_TASK_ID task;
 145 StgWord arg1;
 146 StgWord arg2;
 147 {
 148     trace_SendOp(op, task, arg1, arg2);
 149
 150     pvm_initsend(PvmDataRaw);
 151     PutArg1(arg1);
 152     PutArg2(arg2);
 153     pvm_send( task, op );
 154 }
 155 \end{code}
 156
 157 @SendOpV@ takes a variable number of arguments, as specified by {\em n}.
 158 For example,
 159 \begin{verbatim}
 160     SendOpV( PP_STATS, StatsTask, 3, start_time, stop_time, sparkcount);
 161 \end{verbatim}
 162
 163 \begin{code}
 164 void
 165 SendOpV(OPCODE op, GLOBAL_TASK_ID task, int n, ...)
 166 {
 167     va_list ap;
 168     int i;
 169     StgWord arg;
 170
 171     va_start(ap, n);
 172
 173     trace_SendOp(op, task, 0, 0);
 174
 175     pvm_initsend(PvmDataRaw);
 176
 177     for (i = 0; i < n; ++i) {
 178         arg = va_arg(ap, StgWord);
 179         PutArgN(i, arg);
 180     }
 181     va_end(ap);
 182
 183     pvm_send(task, op);
 184 }
 185 \end{code}
 186
 187 @SendOpNV@ takes a variable-size datablock, as specified by {\em
 188 nelem} and a variable number of arguments, as specified by {\em
 189 narg}. N.B. The datablock and the additional arguments are contiguous
 190 and are copied over together.  For example,
 191
 192 \begin{verbatim}
 193         SendOpNV(PP_RESUME, tsoga.pe, 6, nelem, data,
 194             (W_) ga.weight, (W_) ga.loc.gc.gtid, (W_) ga.loc.gc.slot,
 195             (W_) tsoga.weight, (W_) tsoga.loc.gc.gtid, (W_) tsoga.loc.gc.slot);
 196 \end{verbatim}
 197
 198 Important: The variable arguments must all be StgWords.
 199
 200 \begin{code}
 201
 202 void
 203 SendOpNV(OPCODE op, GLOBAL_TASK_ID task, int nelem, StgWord *datablock, int narg, ...)
 204 {
 205     va_list ap;
 206     int i;
 207     StgWord arg;
 208
 209     va_start(ap, narg);
 210
 211     trace_SendOp(op, task, 0, 0);
 212 /*  fprintf(stderr,"SendOpNV: op = %x, task = %x, narg = %d, nelem = %d\n",op,task,narg,nelem); */
 213
 214     pvm_initsend(PvmDataRaw);
 215
 216     for (i = 0; i < narg; ++i) {
 217         arg = va_arg(ap, StgWord);
 218 /*      fprintf(stderr,"SendOpNV: arg = %d\n",arg); */
 219         PutArgN(i, arg);
 220     }
 221     arg = (StgWord) nelem;
 222     PutArgN(narg, arg);
 223
 224 /*  for (i=0; i < nelem; ++i) fprintf(stderr, "%d ",datablock[i]); */
 225 /*  fprintf(stderr," in SendOpNV\n");*/
 226
 227     PutArgs(datablock, nelem);
 228     va_end(ap);
 229
 230     pvm_send(task, op);
 231 }
 232 \end{code}
 233
 234
 235 @SendOpN@ take a variable size array argument, whose size is given by
 236 {\em n}.  For example,
 237
 238 \begin{verbatim}
 239     SendOpN( PP_STATS, StatsTask, 3, stats_array);
 240 \end{verbatim}
 241
 242 \begin{code}
 243
 244 void
 245 SendOpN(op, task, n, args)
 246 OPCODE op;
 247 GLOBAL_TASK_ID task;
 248 int n;
 249 StgWord *args;
 250
 251 {
 252     long arg;
 253
 254     trace_SendOp(op, task, 0, 0);
 255
 256     pvm_initsend(PvmDataRaw);
 257     arg = (long) n;
 258     PutArgN(0, arg);
 259     PutArgs(args, n);
 260     pvm_send(task, op);
 261 }
 262 \end{code}
 263
 264 @WaitForPEOp@ waits for a packet from global task {\em who} with the
 265 opcode {\em op}.  Other opcodes are handled by the standard exception handler.
 266
 267 \begin{code}
 268 PACKET WaitForPEOp(op, who)
 269 OPCODE op;
 270 GLOBAL_TASK_ID who;
 271 {
 272   PACKET p;
 273   int nbytes;
 274   OPCODE opcode;
 275   GLOBAL_TASK_ID sender_id;
 276   rtsBool match;
 277
 278   do {
 279 /*    fprintf(stderr,"WaitForPEOp: op = %x, who = %x\n",op,who); */
 280     while((p = pvm_recv(ANY_TASK,ANY_OPCODE)) < 0)
 281       pvm_perror("WaitForPEOp: Waiting for PEOp");
 282
 283     pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 284
 285     match = (op == ANY_OPCODE || op == opcode) && (who == ANY_TASK || who == sender_id);
 286
 287     if(match)
 288       return(p);
 289
 290     /* Handle the unexpected opcodes */
 291     HandleException(p);
 292
 293   } while(rtsTrue);
 294 }
 295 \end{code}
 296
 297 \begin{code}
 298
 299 OPCODE
 300 Opcode(p)
 301 PACKET p;
 302 {
 303   int nbytes;
 304   OPCODE opcode;
 305   GLOBAL_TASK_ID sender_id;
 306   pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 307   return(opcode);
 308 }
 309
 310 GLOBAL_TASK_ID
 311 Sender_Task(p)
 312 PACKET p;
 313 {
 314   int nbytes;
 315   OPCODE opcode;
 316   GLOBAL_TASK_ID sender_id;
 317   pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 318   return(sender_id);
 319 }
 320
 321 void
 322 get_opcode_and_sender(p,popcode,psender_id)
 323 PACKET p;
 324 OPCODE *popcode;
 325 GLOBAL_TASK_ID *psender_id;
 326 {
 327   int nbytes;
 328   pvm_bufinfo( p, &nbytes, popcode, psender_id );
 329 }
 330
 331 \end{code}
 332
 333 @PEStartUp@ does the low-level comms specific startup stuff for a
 334 PE. It initialises the comms system, joins the appropriate groups,
 335 synchronises with the other PEs. Finally it receives from Control the
 336 array of Global Task Ids.
 337
 338 \begin{code}
 339 GLOBAL_TASK_ID *
 340 PEStartUp(nPEs)
 341 unsigned nPEs;
 342 {
 343     int i;
 344     PACKET addr;
 345     long *buffer = (long *) stgMallocBytes(sizeof(long) * nPEs, "PEStartUp (buffer)");
 346     GLOBAL_TASK_ID *PEs
 347       = (GLOBAL_TASK_ID *) stgMallocBytes(sizeof(GLOBAL_TASK_ID) * nPEs, "PEStartUp (PEs)");
 348
 349     mytid = _my_gtid;           /* Initialise PVM and get task id into global
 350                                  * variable */
 351
 352 /*    fprintf(stderr,"PEStartup, No. PEs = %d \n", nPEs); */
 353     checkComms(pvm_joingroup(PEGROUP), "PEStartup");
 354 /*    fprintf(stderr,"PEStartup, Joined PEGROUP\n"); */
 355     checkComms(pvm_joingroup(PECTLGROUP), "PEStartup");
 356 /*    fprintf(stderr,"PEStartup, Joined PECTLGROUP\n"); */
 357     checkComms(pvm_barrier(PECTLGROUP, nPEs + 1), "PEStartup");
 358 /*    fprintf(stderr,"PEStartup, Passed PECTLGROUP barrier\n"); */
 359
 360     addr = WaitForPEOp(PP_PETIDS, ANY_GLOBAL_TASK);
 361     GetArgs(buffer, nPEs);
 362     for (i = 0; i < nPEs; ++i) {
 363         PEs[i] = (GLOBAL_TASK_ID) buffer[i];
 364         /* fprintf(stderr,"PEs[%d] = %x \n", i, PEs[i]);  */
 365     }
 366     free(buffer);
 367     return PEs;
 368 }
 369 \end{code}
 370
 371 @PEShutdown@ does the low-level comms-specific shutdown stuff for a
 372 single PE. It leaves the groups and then exits from pvm.
 373
 374 \begin{code}
 375 void
 376 PEShutDown(STG_NO_ARGS)
 377 {
 378      checkComms(pvm_lvgroup(PEGROUP),"PEShutDown");
 379      checkComms(pvm_lvgroup(PECTLGROUP),"PEShutDown");
 380      checkComms(pvm_exit(),"PEShutDown");
 381 }
 382 \end{code}
 383
 384 @heapChkCounter@ tracks the number of heap checks since the last probe.
 385 Not currently used! We check for messages when a thread is resheduled.
 386
 387 \begin{code}
 388 int heapChkCounter = 0;
 389 \end{code}
 390
 391 \begin{code}
 392 #endif /* PAR -- whole file */
 393 \end{code}