1 /* -----------------------------------------------------------------------------
3 * $Id: LLComms.c,v 1.3 1999/08/26 08:23:44 panne 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 * Adapted for the new RTS, P. Trinder July 1998
12 ---------------------------------------------------------------------------- */
14 #ifdef PAR /* whole file */
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.).
27 *SendOpV & variable \\
28 *SendOpNV & variable+ vector \\
30 *First the standard include files.
33 #define NON_POSIX_SOURCE /* so says Solaris */
47 *Then some miscellaneous functions.
48 *GetOpName returns the character-string name of any opcode.
51 char *UserPEOpNames[] = { PEOP_NAMES };
56 if (op >= MIN_PEOPS && op <= MAX_PEOPS)
57 return (UserPEOpNames[op - MIN_PEOPS]);
60 return ("Unknown PE Opcode");
64 * trace_SendOp handles the tracing of messages.
68 trace_SendOp(OPCODE op, GLOBAL_TASK_ID dest STG_UNUSED,
69 unsigned int data1 STG_UNUSED, unsigned int data2 STG_UNUSED)
73 OpName = GetOpName(op);
74 /* fprintf(stderr, " %s [%x,%x] sent from %x to %x\n", OpName, data1, data2, mytid, dest);*/
78 *SendOp sends a 0-argument message with opcode {\em op} to
79 *the global task {\em task}.
83 SendOp(OPCODE op, GLOBAL_TASK_ID task)
85 trace_SendOp(op, task,0,0);
87 pvm_initsend(PvmDataRaw);
92 *SendOp1 sends a 1-argument message with opcode {\em op}
93 *to the global task {\em task}.
97 SendOp1(OPCODE op, GLOBAL_TASK_ID task, StgWord arg1)
99 trace_SendOp(op, task, arg1,0);
101 pvm_initsend(PvmDataRaw);
103 pvm_send( task, op );
108 *SendOp2 is used by the FP code only.
112 SendOp2(OPCODE op, GLOBAL_TASK_ID task, StgWord arg1, StgWord arg2)
114 trace_SendOp(op, task, arg1, arg2);
116 pvm_initsend(PvmDataRaw);
119 pvm_send( task, op );
124 *SendOpV takes a variable number of arguments, as specified by {\em n}.
127 * SendOpV( PP_STATS, StatsTask, 3, start_time, stop_time, sparkcount);
131 SendOpV(OPCODE op, GLOBAL_TASK_ID task, int n, ...)
139 trace_SendOp(op, task, 0, 0);
141 pvm_initsend(PvmDataRaw);
143 for (i = 0; i < n; ++i) {
144 arg = va_arg(ap, StgWord);
154 *SendOpNV takes a variable-size datablock, as specified by {\em
155 *nelem} and a variable number of arguments, as specified by {\em
156 *narg}. N.B. The datablock and the additional arguments are contiguous
157 *and are copied over together. For example,
159 * SendOpNV(PP_RESUME, tsoga.pe, 6, nelem, data,
160 * (W_) ga.weight, (W_) ga.loc.gc.gtid, (W_) ga.loc.gc.slot,
161 * (W_) tsoga.weight, (W_) tsoga.loc.gc.gtid, (W_) tsoga.loc.gc.slot);
163 *Important: The variable arguments must all be StgWords.
167 SendOpNV(OPCODE op, GLOBAL_TASK_ID task, int nelem,
168 StgWord *datablock, int narg, ...)
176 trace_SendOp(op, task, 0, 0);
177 /* fprintf(stderr,"SendOpNV: op = %x, task = %x, narg = %d, nelem = %d\n",op,task,narg,nelem); */
179 pvm_initsend(PvmDataRaw);
181 for (i = 0; i < narg; ++i) {
182 arg = va_arg(ap, StgWord);
183 /* fprintf(stderr,"SendOpNV: arg = %d\n",arg); */
186 arg = (StgWord) nelem;
189 /* for (i=0; i < nelem; ++i) fprintf(stderr, "%d ",datablock[i]); */
190 /* fprintf(stderr," in SendOpNV\n");*/
192 PutArgs(datablock, nelem);
199 *SendOpN take a variable size array argument, whose size is given by
200 *{\em n}. For example,
202 * SendOpN( PP_STATS, StatsTask, 3, stats_array);
206 SendOpN(OPCODE op, GLOBAL_TASK_ID task, int n, StgPtr args)
210 trace_SendOp(op, task, 0, 0);
212 pvm_initsend(PvmDataRaw);
220 *WaitForPEOp waits for a packet from global task {\em who} with the
221 *opcode {\em op}. Other opcodes are handled by processUnexpected.
224 WaitForPEOp(OPCODE op, GLOBAL_TASK_ID who)
229 GLOBAL_TASK_ID sender_id;
234 fprintf(stderr,"WaitForPEOp: op = %x, who = %x\n",op,who);
236 while((p = pvm_recv(ANY_TASK,ANY_OPCODE)) < 0)
237 pvm_perror("WaitForPEOp: Waiting for PEOp");
239 pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
241 fprintf(stderr,"WaitForPEOp: received: opcode = %x, sender_id = %x\n",opcode,sender_id);
243 match = (op == ANY_OPCODE || op == opcode) && (who == ANY_TASK || who == sender_id);
248 /* Handle the unexpected opcodes */
249 ProcessUnexpected(p);
255 *ProcessUnexpected processes unexpected messages. If the message is a
256 *FINISH it exits the prgram, and PVM gracefully
259 ProcessUnexpected(PACKET packet)
261 OPCODE opcode = Opcode(packet);
265 GLOBAL_TASK_ID sender = Sender_Task(packet);
266 fprintf(stderr,"ProcessUnexpected: Received %s (%x), sender %x\n",GetOpName(opcode),opcode,sender);
273 stg_exit(EXIT_SUCCESS);
276 /* Anything we're not prepared to deal with. Note that ALL opcodes are discarded
277 during termination -- this helps prevent bizarre race conditions.
280 if (!GlobalStopPending)
282 GLOBAL_TASK_ID ErrorTask;
285 get_opcode_and_sender(packet,&opcode,&ErrorTask);
286 fprintf(stderr,"Task %x: Unexpected opcode %x from %x in ProcessUnexpected\n",
287 mytid, opcode, ErrorTask );
289 stg_exit(EXIT_FAILURE);
299 GLOBAL_TASK_ID sender_id;
300 pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
305 Sender_Task(PACKET p)
309 GLOBAL_TASK_ID sender_id;
310 pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
315 get_opcode_and_sender(PACKET p, OPCODE *popcode, GLOBAL_TASK_ID *psender_id)
318 pvm_bufinfo( p, &nbytes, popcode, psender_id );
323 *PEStartUp does the low-level comms specific startup stuff for a
324 *PE. It initialises the comms system, joins the appropriate groups,
325 *synchronises with the other PEs. Receives and records in a global
326 *variable the task-id of SysMan. If this is the main thread (discovered
327 *in main.lc), identifies itself to SysMan. Finally it receives
328 *from SysMan an array of the Global Task Ids of each PE, which is
329 *returned as the value of the function.
336 long *buffer = (long *) stgMallocBytes(sizeof(long) * nPEs, "PEStartUp (buffer)");
338 = (GLOBAL_TASK_ID *) stgMallocBytes(sizeof(GLOBAL_TASK_ID) * nPEs, "PEStartUp (PEs)");
340 mytid = _my_gtid; /* Initialise PVM and get task id into global var.*/
342 /* fprintf(stderr,"PEStartup, Task id = [%x], No. PEs = %d \n", mytid, nPEs); */
343 checkComms(pvm_joingroup(PEGROUP), "PEStartup");
344 /* fprintf(stderr,"PEStartup, Joined PEGROUP\n"); */
345 checkComms(pvm_joingroup(PECTLGROUP), "PEStartup");
346 /* fprintf(stderr,"PEStartup, Joined PECTLGROUP\n"); */
347 checkComms(pvm_barrier(PECTLGROUP, nPEs+1), "PEStartup");
348 /* fprintf(stderr,"PEStartup, Passed PECTLGROUP barrier\n"); */
350 addr = WaitForPEOp(PP_SYSMAN_TID, ANY_GLOBAL_TASK);
351 SysManTask = Sender_Task(addr);
352 if (IAmMainThread) { /* Main Thread Identifies itself to SysMan */
353 pvm_initsend(PvmDataDefault);
354 pvm_send(SysManTask, PP_MAIN_TASK);
356 addr = WaitForPEOp(PP_PETIDS, ANY_GLOBAL_TASK);
357 GetArgs(buffer, nPEs);
358 for (i = 0; i < nPEs; ++i) {
359 PEs[i] = (GLOBAL_TASK_ID) buffer[i];
361 fprintf(stderr,"PEs[%d] = %x \n", i, PEs[i]);
369 *PEShutdown does the low-level comms-specific shutdown stuff for a
370 *single PE. It leaves the groups and then exits from pvm.
375 checkComms(pvm_lvgroup(PEGROUP),"PEShutDown");
376 checkComms(pvm_lvgroup(PECTLGROUP),"PEShutDown");
377 checkComms(pvm_exit(),"PEShutDown");
381 heapChkCounter tracks the number of heap checks since the last probe.
382 Not currently used! We check for messages when a thread is resheduled.
384 int heapChkCounter = 0;
386 #endif /* PAR -- whole file */