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     fprintf(stderr,"WaitForPEOp: received: opcode = %x, sender_id = %x\n",opcode,sender_id);
 285
 286     match = (op == ANY_OPCODE || op == opcode) && (who == ANY_TASK || who == sender_id);
 287
 288     if(match)
 289       return(p);
 290
 291     /* Handle the unexpected opcodes */
 292     HandleException(p);
 293
 294   } while(rtsTrue);
 295 }
 296 \end{code}
 297
 298 \begin{code}
 299
 300 OPCODE
 301 Opcode(p)
 302 PACKET p;
 303 {
 304   int nbytes;
 305   OPCODE opcode;
 306   GLOBAL_TASK_ID sender_id;
 307   pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 308   return(opcode);
 309 }
 310
 311 GLOBAL_TASK_ID
 312 Sender_Task(p)
 313 PACKET p;
 314 {
 315   int nbytes;
 316   OPCODE opcode;
 317   GLOBAL_TASK_ID sender_id;
 318   pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
 319   return(sender_id);
 320 }
 321
 322 void
 323 get_opcode_and_sender(p,popcode,psender_id)
 324 PACKET p;
 325 OPCODE *popcode;
 326 GLOBAL_TASK_ID *psender_id;
 327 {
 328   int nbytes;
 329   pvm_bufinfo( p, &nbytes, popcode, psender_id );
 330 }
 331
 332 \end{code}
 333
 334 @PEStartUp@ does the low-level comms specific startup stuff for a
 335 PE. It initialises the comms system, joins the appropriate groups,
 336 synchronises with the other PEs. Finally it receives from Control the
 337 array of Global Task Ids.
 338
 339 \begin{code}
 340 GLOBAL_TASK_ID *
 341 PEStartUp(nPEs)
 342 unsigned nPEs;
 343 {
 344     int i;
 345     PACKET addr;
 346     long *buffer = (long *) stgMallocBytes(sizeof(long) * nPEs, "PEStartUp (buffer)");
 347     GLOBAL_TASK_ID *PEs
 348       = (GLOBAL_TASK_ID *) stgMallocBytes(sizeof(GLOBAL_TASK_ID) * nPEs, "PEStartUp (PEs)");
 349
 350     mytid = _my_gtid;           /* Initialise PVM and get task id into global var.*/
 351
 352     fprintf(stderr,"PEStartup, Task id = [%x], No. PEs = %d \n", mytid, 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_SYSMAN_TID, ANY_GLOBAL_TASK);
 361     SysManTask = Sender_Task(addr);
 362     if (IAmMainThread) {                /* Main Thread Identifies itself to SysMan */
 363         pvm_initsend(PvmDataDefault);
 364         pvm_send(SysManTask, PP_MAIN_TASK);
 365     }
 366     addr = WaitForPEOp(PP_PETIDS, ANY_GLOBAL_TASK);
 367     GetArgs(buffer, nPEs);
 368
 369     for (i = 0; i < nPEs; ++i) {
 370         PEs[i] = (GLOBAL_TASK_ID) buffer[i];
 371         fprintf(stderr,"PEs[%d] = %x \n", i, PEs[i]);
 372     }
 373     free(buffer);
 374     return PEs;
 375 }
 376 \end{code}
 377
 378 @PEShutdown@ does the low-level comms-specific shutdown stuff for a
 379 single PE. It leaves the groups and then exits from pvm.
 380
 381 \begin{code}
 382 void
 383 PEShutDown(STG_NO_ARGS)
 384 {
 385      checkComms(pvm_lvgroup(PEGROUP),"PEShutDown");
 386      checkComms(pvm_lvgroup(PECTLGROUP),"PEShutDown");
 387      checkComms(pvm_exit(),"PEShutDown");
 388 }
 389 \end{code}
 390
 391 @heapChkCounter@ tracks the number of heap checks since the last probe.
 392 Not currently used! We check for messages when a thread is resheduled.
 393
 394 \begin{code}
 395 int heapChkCounter = 0;
 396 \end{code}
 397
 398 \begin{code}
 399 #endif /* PAR -- whole file */
 400 \end{code}