1 /* ----------------------------------------------------------------------------
2 * Time-stamp: <Mon Mar 19 2001 22:10:38 Stardate: [-30]6354.62 hwloidl>
3 * $Id: LLComms.c,v 1.5 2001/08/14 13:40:10 sewardj Exp $
5 * GUM Low-Level Inter-Task Communication
7 * This module defines PVM Routines for PE-PE communication.
9 * P. Trinder, December 5th. 1994.
10 * P. Trinder, July 1998
11 * H-W. Loidl, November 1999 -
12 --------------------------------------------------------------------------- */
14 #ifdef PAR /* whole file */
16 //@node GUM Low-Level Inter-Task Communication, , ,
17 //@section GUM Low-Level Inter-Task Communication
20 *This module defines the routines which communicate between PEs. The
21 *code is based on Kevin Hammond's GRIP RTS. (OpCodes.h defines
22 *PEOp1 etc. in terms of sendOp1 etc.).
30 *sendOpV & variable \\
31 *sendOpNV & variable+ vector \\
33 *First the standard include files.
39 //* Auxiliary functions::
43 //@node Macros etc, Includes, GUM Low-Level Inter-Task Communication, GUM Low-Level Inter-Task Communication
44 //@subsection Macros etc
46 /* Evidently not Posix */
47 /* #include "PosixSource.h" */
49 #define UNUSED /* nothing */
51 //@node Includes, Auxiliary functions, Macros etc, GUM Low-Level Inter-Task Communication
52 //@subsection Includes
58 #include "ParallelRts.h"
60 # include "ParallelDebug.h"
70 /* Cannot use std macro when compiling for SysMan */
71 /* debugging enabled */
72 // #define IF_PAR_DEBUG(c,s) { s; }
73 /* debugging disabled */
74 #define IF_PAR_DEBUG(c,s) /* nothing */
76 //@node Auxiliary functions, Index, Includes, GUM Low-Level Inter-Task Communication
77 //@subsection Auxiliary functions
80 * heapChkCounter tracks the number of heap checks since the last probe.
81 * Not currently used! We check for messages when a thread is resheduled.
83 int heapChkCounter = 0;
86 * Then some miscellaneous functions.
87 * getOpName returns the character-string name of any OpCode.
90 char *UserPEOpNames[] = { PEOP_NAMES };
96 if (op >= MIN_PEOPS && op <= MAX_PEOPS)
97 return (UserPEOpNames[op - MIN_PEOPS]);
99 return ("Unknown PE OpCode");
103 * traceSendOp handles the tracing of messages.
106 //@cindex traceSendOp
108 traceSendOp(OpCode op, GlobalTaskId dest UNUSED,
109 unsigned int data1 UNUSED, unsigned int data2 UNUSED)
113 OpName = getOpName(op);
115 fprintf(stderr," %s [%x,%x] sent from %x to %x",
116 OpName, data1, data2, mytid, dest));
120 * sendOp sends a 0-argument message with OpCode {\em op} to
121 * the global task {\em task}.
126 sendOp(OpCode op, GlobalTaskId task)
128 traceSendOp(op, task,0,0);
130 pvm_initsend(PvmDataRaw);
135 * sendOp1 sends a 1-argument message with OpCode {\em op}
136 * to the global task {\em task}.
141 sendOp1(OpCode op, GlobalTaskId task, StgWord arg1)
143 traceSendOp(op, task, arg1,0);
145 pvm_initsend(PvmDataRaw);
152 * sendOp2 is used by the FP code only.
157 sendOp2(OpCode op, GlobalTaskId task, StgWord arg1, StgWord arg2)
159 traceSendOp(op, task, arg1, arg2);
161 pvm_initsend(PvmDataRaw);
169 * sendOpV takes a variable number of arguments, as specified by {\em n}.
172 * sendOpV( PP_STATS, StatsTask, 3, start_time, stop_time, sparkcount);
177 sendOpV(OpCode op, GlobalTaskId task, int n, ...)
185 traceSendOp(op, task, 0, 0);
187 pvm_initsend(PvmDataRaw);
189 for (i = 0; i < n; ++i) {
190 arg = va_arg(ap, StgWord);
200 * sendOpNV takes a variable-size datablock, as specified by {\em
201 * nelem} and a variable number of arguments, as specified by {\em
202 * narg}. N.B. The datablock and the additional arguments are contiguous
203 * and are copied over together. For example,
205 * sendOpNV(PP_RESUME, tsoga.pe, 6, nelem, data,
206 * (W_) ga.weight, (W_) ga.loc.gc.gtid, (W_) ga.loc.gc.slot,
207 * (W_) tsoga.weight, (W_) tsoga.loc.gc.gtid, (W_) tsoga.loc.gc.slot);
209 * Important: The variable arguments must all be StgWords.
211 sendOpNV(_, tid, m, n, data, x1, ..., xm):
214 +------------------------------
215 | x1 | ... | xm | n | data ....
216 +------------------------------
221 sendOpNV(OpCode op, GlobalTaskId task, int nelem,
222 StgWord *datablock, int narg, ...)
230 traceSendOp(op, task, 0, 0);
232 fprintf(stderr,"~~ sendOpNV: op = %x (%s), task = %x, narg = %d, nelem = %d",
233 op, getOpName(op), task, narg, nelem));
235 pvm_initsend(PvmDataRaw);
237 for (i = 0; i < narg; ++i) {
238 arg = va_arg(ap, StgWord);
240 fprintf(stderr,"~~ sendOpNV: arg = %d\n",arg));
243 arg = (StgWord) nelem;
246 /* for (i=0; i < nelem; ++i) fprintf(stderr, "%d ",datablock[i]); */
247 /* fprintf(stderr," in sendOpNV\n");*/
249 PutArgs(datablock, nelem);
256 * sendOpN take a variable size array argument, whose size is given by
257 * {\em n}. For example,
259 * sendOpN( PP_STATS, StatsTask, 3, stats_array);
264 sendOpN(OpCode op, GlobalTaskId task, int n, StgPtr args)
268 traceSendOp(op, task, 0, 0);
270 pvm_initsend(PvmDataRaw);
278 * broadcastOpN is as sendOpN but broadcasts to all members of a group.
282 broadcastOpN(OpCode op, char *group, int n, StgPtr args)
286 //traceSendOp(op, task, 0, 0);
288 pvm_initsend(PvmDataRaw);
292 pvm_bcast(group, op);
296 waitForPEOp waits for a packet from global task who with the
297 OpCode op. If ignore is true all other messages are simply ignored;
298 otherwise they are handled by processUnexpected.
300 //@cindex waitForPEOp
302 waitForPEOp(OpCode op, GlobalTaskId who, void(*processUnexpected)(rtsPacket) )
307 GlobalTaskId sender_id;
310 IF_PAR_DEBUG(verbose,
311 fprintf(stderr,"~~ waitForPEOp: expecting op = %x (%s), who = [%x]\n",
312 op, getOpName(op), who));
315 while((p = pvm_recv(ANY_TASK,ANY_OPCODE)) < 0)
316 pvm_perror("waitForPEOp: Waiting for PEOp");
318 pvm_bufinfo( p, &nbytes, &opCode, &sender_id );
319 match = (op == ANY_OPCODE || op == opCode) &&
320 (who == ANY_TASK || who == sender_id);
323 IF_PAR_DEBUG(verbose,
325 "~~waitForPEOp: Qapla! received: OpCode = %#x (%s), sender_id = [%x]",
326 opCode, getOpName(opCode), sender_id));
331 /* Handle the unexpected OpCodes */
332 if (processUnexpected!=NULL) {
333 (*processUnexpected)(p);
335 IF_PAR_DEBUG(verbose,
337 "~~ waitForPEOp: ignoring OpCode = %#x (%s), sender_id = [%x]",
338 opCode, getOpName(opCode), sender_id));
345 processUnexpected processes unexpected messages. If the message is a
346 FINISH it exits the prgram, and PVM gracefully
348 //@cindex processUnexpectedMessage
350 processUnexpectedMessage(rtsPacket packet) {
351 OpCode opCode = getOpcode(packet);
353 IF_PAR_DEBUG(verbose,
354 GlobalTaskId sender = senderTask(packet);
355 fprintf(stderr,"~~ [%x] processUnexpected: Received %x (%s), sender %x\n",
356 mytid, opCode, getOpName(opCode), sender));
360 stg_exit(EXIT_SUCCESS);
363 /* Anything we're not prepared to deal with. Note that ALL OpCodes
364 are discarded during termination -- this helps prevent bizarre
367 // if (!GlobalStopPending)
369 GlobalTaskId errorTask;
372 getOpcodeAndSender(packet, &opCode, &errorTask);
373 fprintf(stderr,"== Task %x: Unexpected OpCode %x from %x in processUnexpected",
374 mytid, opCode, errorTask );
376 stg_exit(EXIT_FAILURE);
383 getOpcode(rtsPacket p)
387 GlobalTaskId sender_id;
388 /* read PVM buffer */
389 pvm_bufinfo(p, &nbytes, &OpCode, &sender_id);
390 /* return tag of the buffer as opcode */
394 //@cindex getOpcodeAndSender
396 getOpcodeAndSender(rtsPacket p, OpCode *opCodep, GlobalTaskId *senderIdp)
399 /* read PVM buffer */
400 pvm_bufinfo(p, &nbytes, opCodep, senderIdp);
405 senderTask(rtsPacket p)
409 GlobalTaskId sender_id;
410 /* read PVM buffer */
411 pvm_bufinfo(p, &nbytes, &opCode, &sender_id);
416 * startUpPE does the low-level comms specific startup stuff for a
417 * PE. It initialises the comms system, joins the appropriate groups
418 * allocates the PE buffer
425 mytid = _my_gtid; /* Initialise PVM and get task id into global var.*/
427 IF_PAR_DEBUG(verbose,
428 fprintf(stderr,"== [%x] PEStartup: Task id = [%x], No. PEs = %d \n",
429 mytid, mytid, nPEs));
430 checkComms(pvm_joingroup(PEGROUP), "PEStartup");
431 IF_PAR_DEBUG(verbose,
432 fprintf(stderr,"== [%x] PEStartup: Joined PEGROUP\n", mytid));
436 * PEShutdown does the low-level comms-specific shutdown stuff for a
437 * single PE. It leaves the groups and then exits from pvm.
443 IF_PAR_DEBUG(verbose,
444 fprintf(stderr, "== [%x] PEshutdown\n", mytid));
446 checkComms(pvm_lvgroup(PEGROUP),"PEShutDown");
447 checkComms(pvm_exit(),"PEShutDown");
451 Extract the exit code out of a PP_FINISH packet (used in SysMan)
454 getExitCode(int nbytes, GlobalTaskId *sender_idp) {
457 if (nbytes==4) { // Notification from a task doing pvm_exit
458 GetArgs(sender_idp,1); // Presumably this must be MainPE Id
460 } else if (nbytes==8) { // Doing a controlled shutdown
461 GetArgs(&exitCode,1); // HACK: controlled shutdown == 2 values
462 GetArgs(&exitCode,1);
464 exitCode = -2; // everything else
469 #endif /* PAR -- whole file */
471 //@node Index, , Auxiliary functions, GUM Low-Level Inter-Task Communication
475 //* getOpName:: @cindex\s-+getOpName
476 //* traceSendOp:: @cindex\s-+traceSendOp
477 //* sendOp:: @cindex\s-+sendOp
478 //* sendOp1:: @cindex\s-+sendOp1
479 //* sendOp2:: @cindex\s-+sendOp2
480 //* sendOpV:: @cindex\s-+sendOpV
481 //* sendOpNV:: @cindex\s-+sendOpNV
482 //* sendOpN:: @cindex\s-+sendOpN
483 //* waitForPEOp:: @cindex\s-+waitForPEOp
484 //* processUnexpectedMessage:: @cindex\s-+processUnexpectedMessage
485 //* getOpcode:: @cindex\s-+getOpcode
486 //* getOpcodeAndSender:: @cindex\s-+getOpcodeAndSender
487 //* senderTask:: @cindex\s-+senderTask
488 //* startUpPE:: @cindex\s-+startUpPE
489 //* shutDownPE:: @cindex\s-+shutDownPE