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