BoxedString* getReverseOpName(int op_type) {
bool reversed = false;
op_type = getReverseCmpOp(op_type, reversed);
if (reversed)
return getOpName(op_type);
BoxedString* normal_name = getOpName(op_type);
// TODO inefficient
return internStringImmortal(("__r" + normal_name->s().substr(2).str()).c_str());
}
//@cindex processUnexpectedMessage
void
processUnexpectedMessage(rtsPacket packet) {
OpCode opCode = getOpcode(packet);
IF_PAR_DEBUG(verbose,
GlobalTaskId sender = senderTask(packet);
fprintf(stderr,"~~ [%x] processUnexpected: Received %x (%s), sender %x\n",
mytid, opCode, getOpName(opCode), sender));
switch (opCode) {
case PP_FINISH:
stg_exit(EXIT_SUCCESS);
break;
/* Anything we're not prepared to deal with. Note that ALL OpCodes
are discarded during termination -- this helps prevent bizarre
race conditions. */
default:
// if (!GlobalStopPending)
{
GlobalTaskId errorTask;
OpCode opCode;
getOpcodeAndSender(packet, &opCode, &errorTask);
fprintf(stderr,"== Task %x: Unexpected OpCode %x from %x in processUnexpected",
mytid, opCode, errorTask );
stg_exit(EXIT_FAILURE);
}
}
}
//@cindex sendOpNV
void
sendOpNV(OpCode op, GlobalTaskId task, int nelem,
StgWord *datablock, int narg, ...)
{
va_list ap;
int i;
StgWord arg;
va_start(ap, narg);
traceSendOp(op, task, 0, 0);
IF_PAR_DEBUG(trace,
fprintf(stderr,"~~ sendOpNV: op = %x (%s), task = %x, narg = %d, nelem = %d",
op, getOpName(op), task, narg, nelem));
pvm_initsend(PvmDataRaw);
for (i = 0; i < narg; ++i) {
arg = va_arg(ap, StgWord);
IF_PAR_DEBUG(trace,
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);
}
//@cindex waitForPEOp
rtsPacket
waitForPEOp(OpCode op, GlobalTaskId who, void(*processUnexpected)(rtsPacket) )
{
rtsPacket p;
int nbytes;
OpCode opCode;
GlobalTaskId sender_id;
rtsBool match;
IF_PAR_DEBUG(verbose,
fprintf(stderr,"~~ waitForPEOp: expecting op = %x (%s), who = [%x]\n",
op, getOpName(op), who));
do {
while((p = pvm_recv(ANY_TASK,ANY_OPCODE)) < 0)
pvm_perror("waitForPEOp: Waiting for PEOp");
pvm_bufinfo( p, &nbytes, &opCode, &sender_id );
match = (op == ANY_OPCODE || op == opCode) &&
(who == ANY_TASK || who == sender_id);
if (match) {
IF_PAR_DEBUG(verbose,
fprintf(stderr,
"~~waitForPEOp: Qapla! received: OpCode = %#x (%s), sender_id = [%x]",
opCode, getOpName(opCode), sender_id));
return(p);
}
/* Handle the unexpected OpCodes */
if (processUnexpected!=NULL) {
(*processUnexpected)(p);
} else {
IF_PAR_DEBUG(verbose,
fprintf(stderr,
"~~ waitForPEOp: ignoring OpCode = %#x (%s), sender_id = [%x]",
opCode, getOpName(opCode), sender_id));
}
} while(rtsTrue);
}
//@cindex traceSendOp
static void
traceSendOp(OpCode op, GlobalTaskId dest UNUSED,
unsigned int data1 UNUSED, unsigned int data2 UNUSED)
{
char *OpName;
OpName = getOpName(op);
IF_PAR_DEBUG(trace,
fprintf(stderr," %s [%x,%x] sent from %x to %x",
OpName, data1, data2, mytid, dest));
}
bool ASTPrintVisitor::visit_unaryop(AST_UnaryOp* node) {
switch (node->op_type) {
case AST_TYPE::Invert:
stream << "~";
break;
case AST_TYPE::Not:
stream << "not ";
break;
case AST_TYPE::UAdd:
stream << "+";
break;
case AST_TYPE::USub:
stream << "-";
break;
default:
RELEASE_ASSERT(0, "%s", getOpName(node->op_type)->c_str());
break;
}
stream << "(";
node->operand->accept(this);
stream << ")";
return true;
}
rtsBool MP_send(PEId node, OpCode tag, StgWord8 *data, uint32_t length) {
/* MPI normally uses blocking send operations (MPI_*send). When
* using nonblocking operations (MPI_I*send), dataspace must remain
* untouched until the message has been delivered (MPI_Wait)!
*
* We copy the data to be sent into the mpiMsgBuffer and call MPI_Isend.
* We can reuse slots in the buffer where messages are already delivered.
* The requests array stores a request for each send operation which
* can be tested by MPI_Testany for delivered messages.
* MP_send should return false to indicate a send failure (the
* message buffer has 0 free slots).
*
*/
int sendIndex;
int hasFreeSpace;
//MPI_Status* status;
StgPtr sendPos; // used for pointer arithmetics, based on assumption that
// sizeof(void*)==sizeof(StgWord) (see includes/stg/Types.h)
ASSERT(node > 0 && node <= nPEs);
IF_PAR_DEBUG(mpcomm,
debugBelch("MPI sending message to PE %u "
"(tag %d (%s), datasize %u)\n",
node, tag, getOpName(tag), length));
// adjust node no.
node--;
//case each slot in buffer has been used
if (msgCount == maxMsgs) {
// looking for free space in buffer
IF_PAR_DEBUG(mpcomm,
debugBelch("looking for free space in buffer\n"));
MPI_Testany(msgCount, requests, &sendIndex, &hasFreeSpace,
MPI_STATUS_IGNORE);
// if (status->MPI_ERROR)
// barf("a send operation returned an error with code %d"
// "and sendIndex is %d and hasFreeSpace %d",
// status->MPI_ERROR, sendIndex, hasFreeSpace);
}
//case still slots in buffer unused
else {
hasFreeSpace = 1;
sendIndex = msgCount++;
}
// send the message
if (!hasFreeSpace) {
IF_PAR_DEBUG(mpcomm,
debugBelch("MPI CANCELED sending message to PE %u "
"(tag %d (%s), datasize %u)\n",
node, tag, getOpName(tag), length));
return rtsFalse;
}
//calculate offset in mpiMsgBuffer
// using ptr. arithmetics and void* size (see includes/stg/Types.h)
sendPos = ((StgPtr)mpiMsgBuffer) + sendIndex * DATASPACEWORDS;
memcpy((void*)sendPos, data, length);
if (ISSYSCODE(tag)) {
// case system message (workaroud: send it on both communicators,
// because there is no receive on two comunicators.)
MPI_Isend(&pingMessage, 1, MPI_INT, node, tag,
sysComm, &sysRequest);
}
MPI_Isend(sendPos, length, MPI_BYTE, node, tag,
MPI_COMM_WORLD, &(requests[sendIndex]));
IF_PAR_DEBUG(mpcomm,
debugBelch("Done sending message to PE %u\n", node+1));
return rtsTrue;
}
BoxedString* getInplaceOpName(int op_type) {
BoxedString* normal_name = getOpName(op_type);
// TODO inefficient
return internStringImmortal(("__i" + normal_name->s().substr(2).str()).c_str());
}
