+++ /dev/null
-%****************************************************************************
-%
-\section[LLComms.lc]{GUM Low-Level Inter-Task Communication}
-%
-% This module defines PVM Routines for PE-PE communication.
-%
-% (c) The Parade/AQUA Projects, Glasgow University, 1994-1995
-% P. Trinder, December 5th. 1994.
-%
-%****************************************************************************
-
-
-\begin{code}
-#ifdef PAR /* whole file */
-\end{code}
-
-This module defines the routines which communicate between PEs. The
-code is based on Kevin Hammond's GRIP RTS. (@Opcodes.h@ defines
-@PEOp1@ etc. in terms of @SendOp1@ etc.).
-
-\begin{onlylatex}
-\begin{center}
-\end{onlylatex}
-\begin{tabular}{|l|l|} \hline
-Routine & Arguments \\ \hline
- & \\
-@SendOp@ & 0 \\
-@SendOp1@ & 1 \\
-@SendOp2@ & 2 \\
-@SendOpN@ & vector \\
-@SendOpV@ & variable \\
-@SendOpNV@ & variable+ vector \\
-\end{tabular}
-\begin{onlylatex}
-\end{center}
-\end{onlylatex}
-
-First the standard include files.
-
-\begin{code}
-#define NON_POSIX_SOURCE /* so says Solaris */
-
-#include "rtsdefs.h"
-
-#include "LLC.h"
-#ifdef __STDC__
-#include <stdarg.h>
-#else
-#include <varargs.h>
-#endif
-\end{code}
-
-Then some miscellaneous functions.
-@GetOpName@ returns the character-string name of any opcode.
-
-\begin{code}
-char *UserPEOpNames[] = { PEOP_NAMES };
-
-char *
-GetOpName(op)
-unsigned op;
-{
- if (op >= MIN_PEOPS && op <= MAX_PEOPS)
- return (UserPEOpNames[op - MIN_PEOPS]);
-
- else
- return ("Unknown PE Opcode");
-}
-
-void
-NullException(STG_NO_ARGS)
-{
- fprintf(stderr,"Null_Exception: called");
-}
-
-void (*ExceptionHandler)() = NullException;
-\end{code}
-
-@trace_SendOp@ handles the tracing of messages at the OS level. If
-tracing is on (as specified by @PETrace@, @SystemTrace@ and
-@ReplyTrace@), then a message is printed. The opcode and address word
-of the previous PE opcode is recorded in the variables @lastSendOp@ and
-@lastPEaddress@. @PElastop@ is a Boolean which records whether the
-last message sent was for a PE or an IMU.
-
-\begin{code}
-rtsBool PETrace = rtsFalse, IMUTrace = rtsFalse, SystemTrace = rtsFalse, ReplyTrace = rtsFalse;
-
-static void
-trace_SendOp(OPCODE op, GLOBAL_TASK_ID dest, unsigned int data1, unsigned int data2)
-{
- char *OpName;
-
- if (!ReplyTrace && op == REPLY_OK)
- return;
-
- OpName = GetOpName(op);
-/* fprintf(stderr, " %s [%x,%x] sent from %x to %x\n", OpName, data1, data2, mytid, dest);*/
-}
-
-\end{code}
-
-@SendOp@ sends a 0-argument message with opcode {\em op} to
-the global task {\em task}.
-
-\begin{code}
-void
-SendOp(op, task)
-OPCODE op;
-GLOBAL_TASK_ID task;
-{
- trace_SendOp(op, task,0,0);
-
- pvm_initsend(PvmDataRaw);
- pvm_send( task, op );
-}
-\end{code}
-
-@SendOp1@ sends a 1-argument message with opcode {\em op}
-to the global task {\em task}.
-
-\begin{code}
-void
-SendOp1(op, task, arg1)
-OPCODE op;
-GLOBAL_TASK_ID task;
-StgWord arg1;
-{
- trace_SendOp(op, task, arg1,0);
-
- pvm_initsend(PvmDataRaw);
- PutArg1(arg1);
- pvm_send( task, op );
-}
-
-\end{code}
-
-@SendOp2@ is used by the FP code only.
-
-\begin{code}
-void
-SendOp2(op, task, arg1, arg2)
-OPCODE op;
-GLOBAL_TASK_ID task;
-StgWord arg1;
-StgWord arg2;
-{
- trace_SendOp(op, task, arg1, arg2);
-
- pvm_initsend(PvmDataRaw);
- PutArg1(arg1);
- PutArg2(arg2);
- pvm_send( task, op );
-}
-\end{code}
-
-@SendOpV@ takes a variable number of arguments, as specified by {\em n}.
-For example,
-\begin{verbatim}
- SendOpV( PP_STATS, StatsTask, 3, start_time, stop_time, sparkcount);
-\end{verbatim}
-
-\begin{code}
-void
-SendOpV(OPCODE op, GLOBAL_TASK_ID task, int n, ...)
-{
- va_list ap;
- int i;
- StgWord arg;
-
- va_start(ap, n);
-
- trace_SendOp(op, task, 0, 0);
-
- pvm_initsend(PvmDataRaw);
-
- for (i = 0; i < n; ++i) {
- arg = va_arg(ap, StgWord);
- PutArgN(i, arg);
- }
- va_end(ap);
-
- pvm_send(task, op);
-}
-\end{code}
-
-@SendOpNV@ takes a variable-size datablock, as specified by {\em
-nelem} and a variable number of arguments, as specified by {\em
-narg}. N.B. The datablock and the additional arguments are contiguous
-and are copied over together. For example,
-
-\begin{verbatim}
- SendOpNV(PP_RESUME, tsoga.pe, 6, nelem, data,
- (W_) ga.weight, (W_) ga.loc.gc.gtid, (W_) ga.loc.gc.slot,
- (W_) tsoga.weight, (W_) tsoga.loc.gc.gtid, (W_) tsoga.loc.gc.slot);
-\end{verbatim}
-
-Important: The variable arguments must all be StgWords.
-
-\begin{code}
-
-void
-SendOpNV(OPCODE op, GLOBAL_TASK_ID task, int nelem, StgWord *datablock, int narg, ...)
-{
- va_list ap;
- int i;
- StgWord arg;
-
- va_start(ap, narg);
-
- trace_SendOp(op, task, 0, 0);
-/* fprintf(stderr,"SendOpNV: op = %x, task = %x, narg = %d, nelem = %d\n",op,task,narg,nelem); */
-
- pvm_initsend(PvmDataRaw);
-
- for (i = 0; i < narg; ++i) {
- arg = va_arg(ap, StgWord);
-/* fprintf(stderr,"SendOpNV: arg = %d\n",arg); */
- PutArgN(i, arg);
- }
- arg = (StgWord) nelem;
- PutArgN(narg, arg);
-
-/* for (i=0; i < nelem; ++i) fprintf(stderr, "%d ",datablock[i]); */
-/* fprintf(stderr," in SendOpNV\n");*/
-
- PutArgs(datablock, nelem);
- va_end(ap);
-
- pvm_send(task, op);
-}
-\end{code}
-
-
-@SendOpN@ take a variable size array argument, whose size is given by
-{\em n}. For example,
-
-\begin{verbatim}
- SendOpN( PP_STATS, StatsTask, 3, stats_array);
-\end{verbatim}
-
-\begin{code}
-
-void
-SendOpN(op, task, n, args)
-OPCODE op;
-GLOBAL_TASK_ID task;
-int n;
-StgWord *args;
-
-{
- long arg;
-
- trace_SendOp(op, task, 0, 0);
-
- pvm_initsend(PvmDataRaw);
- arg = (long) n;
- PutArgN(0, arg);
- PutArgs(args, n);
- pvm_send(task, op);
-}
-\end{code}
-
-@WaitForPEOp@ waits for a packet from global task {\em who} with the
-opcode {\em op}. Other opcodes are handled by the standard exception handler.
-
-\begin{code}
-PACKET WaitForPEOp(op, who)
-OPCODE op;
-GLOBAL_TASK_ID who;
-{
- PACKET p;
- int nbytes;
- OPCODE opcode;
- GLOBAL_TASK_ID sender_id;
- rtsBool match;
-
- do {
-#if 0
- fprintf(stderr,"WaitForPEOp: op = %x, who = %x\n",op,who);
-#endif
- while((p = pvm_recv(ANY_TASK,ANY_OPCODE)) < 0)
- pvm_perror("WaitForPEOp: Waiting for PEOp");
-
- pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
-#if 0
- fprintf(stderr,"WaitForPEOp: received: opcode = %x, sender_id = %x\n",opcode,sender_id);
-#endif
- match = (op == ANY_OPCODE || op == opcode) && (who == ANY_TASK || who == sender_id);
-
- if(match)
- return(p);
-
- /* Handle the unexpected opcodes */
- HandleException(p);
-
- } while(rtsTrue);
-}
-\end{code}
-
-\begin{code}
-
-OPCODE
-Opcode(p)
-PACKET p;
-{
- int nbytes;
- OPCODE opcode;
- GLOBAL_TASK_ID sender_id;
- pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
- return(opcode);
-}
-
-GLOBAL_TASK_ID
-Sender_Task(p)
-PACKET p;
-{
- int nbytes;
- OPCODE opcode;
- GLOBAL_TASK_ID sender_id;
- pvm_bufinfo( p, &nbytes, &opcode, &sender_id );
- return(sender_id);
-}
-
-void
-get_opcode_and_sender(p,popcode,psender_id)
-PACKET p;
-OPCODE *popcode;
-GLOBAL_TASK_ID *psender_id;
-{
- int nbytes;
- pvm_bufinfo( p, &nbytes, popcode, psender_id );
-}
-
-\end{code}
-
-@PEStartUp@ does the low-level comms specific startup stuff for a
-PE. It initialises the comms system, joins the appropriate groups,
-synchronises with the other PEs. Receives and records in a global
-variable the task-id of SysMan. If this is the main thread (discovered
-in main.lc), identifies itself to SysMan. Finally it receives
-from SysMan an array of the Global Task Ids of each PE, which is
-returned as the value of the function.
-
-\begin{code}
-GLOBAL_TASK_ID *
-PEStartUp(nPEs)
-unsigned nPEs;
-{
- int i;
- PACKET addr;
- long *buffer = (long *) stgMallocBytes(sizeof(long) * nPEs, "PEStartUp (buffer)");
- GLOBAL_TASK_ID *PEs
- = (GLOBAL_TASK_ID *) stgMallocBytes(sizeof(GLOBAL_TASK_ID) * nPEs, "PEStartUp (PEs)");
-
- mytid = _my_gtid; /* Initialise PVM and get task id into global var.*/
-
-/* fprintf(stderr,"PEStartup, Task id = [%x], No. PEs = %d \n", mytid, nPEs); */
- checkComms(pvm_joingroup(PEGROUP), "PEStartup");
-/* fprintf(stderr,"PEStartup, Joined PEGROUP\n"); */
- checkComms(pvm_joingroup(PECTLGROUP), "PEStartup");
-/* fprintf(stderr,"PEStartup, Joined PECTLGROUP\n"); */
- checkComms(pvm_barrier(PECTLGROUP, nPEs+1), "PEStartup");
-/* fprintf(stderr,"PEStartup, Passed PECTLGROUP barrier\n"); */
-
- addr = WaitForPEOp(PP_SYSMAN_TID, ANY_GLOBAL_TASK);
- SysManTask = Sender_Task(addr);
- if (IAmMainThread) { /* Main Thread Identifies itself to SysMan */
- pvm_initsend(PvmDataDefault);
- pvm_send(SysManTask, PP_MAIN_TASK);
- }
- addr = WaitForPEOp(PP_PETIDS, ANY_GLOBAL_TASK);
- GetArgs(buffer, nPEs);
- for (i = 0; i < nPEs; ++i) {
- PEs[i] = (GLOBAL_TASK_ID) buffer[i];
-#if 0
- fprintf(stderr,"PEs[%d] = %x \n", i, PEs[i]);
-#endif
- }
- free(buffer);
- return PEs;
-}
-\end{code}
-
-@PEShutdown@ does the low-level comms-specific shutdown stuff for a
-single PE. It leaves the groups and then exits from pvm.
-
-\begin{code}
-void
-PEShutDown(STG_NO_ARGS)
-{
- checkComms(pvm_lvgroup(PEGROUP),"PEShutDown");
- checkComms(pvm_lvgroup(PECTLGROUP),"PEShutDown");
- checkComms(pvm_exit(),"PEShutDown");
-}
-\end{code}
-
-@heapChkCounter@ tracks the number of heap checks since the last probe.
-Not currently used! We check for messages when a thread is resheduled.
-
-\begin{code}
-int heapChkCounter = 0;
-\end{code}
-
-\begin{code}
-#endif /* PAR -- whole file */
-\end{code}
projects / ghc-hetmet.git / blobdiff