src/libs/ck-libs/ampi/ampi.C

   1 #ifndef AMPI_PRINT_MSG_SIZES
   2 #define AMPI_PRINT_MSG_SIZES 0 // Record and print comm routines used & message sizes
   3 #endif
   4
   5 #define AMPIMSGLOG    0
   6 #define AMPI_PRINT_IDLE 0
   7
   8 #include "ampiimpl.h"
   9 #include "tcharm.h"
  10
  11
  12 #if CMK_BIGSIM_CHARM
  13 #include "bigsim_logs.h"
  14 #endif
  15
  16 #if CMK_TRACE_ENABLED
  17 #include "register.h" // for _chareTable, _entryTable
  18 #endif
  19
  20 /* change this to MPI_ERRORS_RETURN to not abort on errors */
  21 #define AMPI_ERRHANDLER MPI_ERRORS_ARE_FATAL
  22
  23 /* change this define to "x" to trace all send/recv's */
  24 #define MSG_ORDER_DEBUG(x) //x /* empty */
  25 /* change this define to "x" to trace user calls */
  26 #define USER_CALL_DEBUG(x) // ckout<<"vp "<<TCHARM_Element()<<": "<<x<<endl;
  27 #define STARTUP_DEBUG(x) //ckout<<"ampi[pe "<<CkMyPe()<<"] "<< x <<endl;
  28 #define FUNCCALL_DEBUG(x) //x /* empty */
  29
  30 /* For MPI_Get_library_version */
  31 CMI_EXTERNC_VARIABLE const char * const CmiCommitID;
  32
  33 static CkDDT *getDDT() noexcept {
  34   return &getAmpiParent()->myDDT;
  35 }
  36
  37 /* if error checking is disabled, ampiErrhandler is defined as a macro in ampiimpl.h */
  38 #if AMPI_ERROR_CHECKING
  39 int ampiErrhandler(const char* func, int errcode) noexcept {
  40   if (AMPI_ERRHANDLER == MPI_ERRORS_ARE_FATAL && errcode != MPI_SUCCESS) {
  41     // Abort with a nice message of the form: 'func' failed with error code 'errstr'.
  42     //  where 'func' is the name of the failed AMPI_ function and 'errstr'
  43     //  is the string returned by AMPI_Error_string for errcode.
  44     int funclen = strlen(func);
  45     const char* filler = " failed with error code ";
  46     int fillerlen = strlen(filler);
  47     int errstrlen;
  48     char errstr[MPI_MAX_ERROR_STRING];
  49     MPI_Error_string(errcode, errstr, &errstrlen);
  50     vector<char> str(funclen + fillerlen + errstrlen);
  51     strcpy(str.data(), func);
  52     strcat(str.data(), filler);
  53     strcat(str.data(), errstr);
  54     CkAbort(str.data());
  55   }
  56   return errcode;
  57 }
  58 #endif
  59
  60 #if AMPI_PRINT_MSG_SIZES
  61 #if !AMPI_ERROR_CHECKING
  62 #error "AMPI_PRINT_MSG_SIZES requires AMPI error checking to be enabled!\n"
  63 #endif
  64 #include <string>
  65 #include <sstream>
  66 #include "ckliststring.h"
  67 CkpvDeclare(CkListString, msgSizesRanks);
  68
  69 bool ampiParent::isRankRecordingMsgSizes() noexcept {
  70   return (!CkpvAccess(msgSizesRanks).isEmpty() && CkpvAccess(msgSizesRanks).includes(thisIndex));
  71 }
  72
  73 void ampiParent::recordMsgSize(const char* func, int msgSize) noexcept {
  74   if (isRankRecordingMsgSizes()) {
  75     msgSizes[func][msgSize]++;
  76   }
  77 }
  78
  79 typedef std::unordered_map<std::string, std::map<int, int> >::iterator outer_itr_t;
  80 typedef std::map<int, int>::iterator inner_itr_t;
  81
  82 void ampiParent::printMsgSizes() noexcept {
  83   if (isRankRecordingMsgSizes()) {
  84     // Prints msgSizes in the form: "AMPI_Routine: [ (num_msgs: msg_size) ... ]".
  85     // Each routine has its messages sorted by size, smallest to largest.
  86     std::stringstream ss;
  87     ss << std::endl << "Rank " << thisIndex << ":" << std::endl;
  88     for (outer_itr_t i = msgSizes.begin(); i != msgSizes.end(); ++i) {
  89       ss << i->first << ": [ ";
  90       for (inner_itr_t j = i->second.begin(); j != i->second.end(); ++j) {
  91         ss << "(" << j->second << ": " << j->first << " B) ";
  92       }
  93       ss << "]" << std::endl;
  94     }
  95     CkPrintf("%s", ss.str().c_str());
  96   }
  97 }
  98 #endif //AMPI_PRINT_MSG_SIZES
  99
 100 inline int checkCommunicator(const char* func, MPI_Comm comm) noexcept {
 101   if (comm == MPI_COMM_NULL)
 102     return ampiErrhandler(func, MPI_ERR_COMM);
 103   return MPI_SUCCESS;
 104 }
 105
 106 inline int checkCount(const char* func, int count) noexcept {
 107   if (count < 0)
 108     return ampiErrhandler(func, MPI_ERR_COUNT);
 109   return MPI_SUCCESS;
 110 }
 111
 112 inline int checkData(const char* func, MPI_Datatype data) noexcept {
 113   if (data == MPI_DATATYPE_NULL)
 114     return ampiErrhandler(func, MPI_ERR_TYPE);
 115   return MPI_SUCCESS;
 116 }
 117
 118 inline int checkTag(const char* func, int tag) noexcept {
 119   if (tag != MPI_ANY_TAG && (tag < 0 || tag > MPI_TAG_UB_VALUE))
 120     return ampiErrhandler(func, MPI_ERR_TAG);
 121   return MPI_SUCCESS;
 122 }
 123
 124 inline int checkRank(const char* func, int rank, MPI_Comm comm) noexcept {
 125   int size = (comm == MPI_COMM_NULL) ? 0 : getAmpiInstance(comm)->getSize();
 126   if (((rank >= 0) && (rank < size)) ||
 127       (rank == MPI_ANY_SOURCE)       ||
 128       (rank == MPI_PROC_NULL)        ||
 129       (rank == MPI_ROOT))
 130     return MPI_SUCCESS;
 131   return ampiErrhandler(func, MPI_ERR_RANK);
 132 }
 133
 134 inline int checkBuf(const char* func, const void *buf, int count) noexcept {
 135   if ((count != 0 && buf == NULL) || buf == MPI_IN_PLACE)
 136     return ampiErrhandler(func, MPI_ERR_BUFFER);
 137   return MPI_SUCCESS;
 138 }
 139
 140 inline int errorCheck(const char* func, MPI_Comm comm, int ifComm, int count,
 141                       int ifCount, MPI_Datatype data, int ifData, int tag,
 142                       int ifTag, int rank, int ifRank, const void *buf1, int ifBuf1,
 143                       const void *buf2=0, int ifBuf2=0) noexcept {
 144   int ret;
 145   if (ifComm) {
 146     ret = checkCommunicator(func, comm);
 147     if (ret != MPI_SUCCESS)
 148       return ampiErrhandler(func, ret);
 149   }
 150   if (ifCount) {
 151     ret = checkCount(func, count);
 152     if (ret != MPI_SUCCESS)
 153       return ampiErrhandler(func, ret);
 154   }
 155   if (ifData) {
 156     ret = checkData(func, data);
 157     if (ret != MPI_SUCCESS)
 158       return ampiErrhandler(func, ret);
 159   }
 160   if (ifTag) {
 161     ret = checkTag(func, tag);
 162     if (ret != MPI_SUCCESS)
 163       return ampiErrhandler(func, ret);
 164   }
 165   if (ifRank) {
 166     ret = checkRank(func, rank, comm);
 167     if (ret != MPI_SUCCESS)
 168       return ampiErrhandler(func, ret);
 169   }
 170   if (ifBuf1 && ifData) {
 171     ret = checkBuf(func, buf1, count*getDDT()->getSize(data));
 172     if (ret != MPI_SUCCESS)
 173       return ampiErrhandler(func, ret);
 174   }
 175   if (ifBuf2 && ifData) {
 176     ret = checkBuf(func, buf2, count*getDDT()->getSize(data));
 177     if (ret != MPI_SUCCESS)
 178       return ampiErrhandler(func, ret);
 179   }
 180 #if AMPI_PRINT_MSG_SIZES
 181   getAmpiParent()->recordMsgSize(func, getDDT()->getSize(data) * count);
 182 #endif
 183   return MPI_SUCCESS;
 184 }
 185
 186 //------------- startup -------------
 187 static mpi_comm_worlds mpi_worlds;
 188
 189 int _mpi_nworlds; /*Accessed by ampif*/
 190 int MPI_COMM_UNIVERSE[MPI_MAX_COMM_WORLDS]; /*Accessed by user code*/
 191
 192 class AmpiComplex {
 193  public:
 194   float re, im;
 195   void operator+=(const AmpiComplex &a) noexcept {
 196     re+=a.re;
 197     im+=a.im;
 198   }
 199   void operator*=(const AmpiComplex &a) noexcept {
 200     float nu_re=re*a.re-im*a.im;
 201     im=re*a.im+im*a.re;
 202     re=nu_re;
 203   }
 204   int operator>(const AmpiComplex &a) noexcept {
 205     CkAbort("AMPI> Cannot compare complex numbers with MPI_MAX\n");
 206     return 0;
 207   }
 208   int operator<(const AmpiComplex &a) noexcept {
 209     CkAbort("AMPI> Cannot compare complex numbers with MPI_MIN\n");
 210     return 0;
 211   }
 212 };
 213
 214 class AmpiDoubleComplex {
 215  public:
 216   double re, im;
 217   void operator+=(const AmpiDoubleComplex &a) noexcept {
 218     re+=a.re;
 219     im+=a.im;
 220   }
 221   void operator*=(const AmpiDoubleComplex &a) noexcept {
 222     double nu_re=re*a.re-im*a.im;
 223     im=re*a.im+im*a.re;
 224     re=nu_re;
 225   }
 226   int operator>(const AmpiDoubleComplex &a) noexcept {
 227     CkAbort("AMPI> Cannot compare double complex numbers with MPI_MAX\n");
 228     return 0;
 229   }
 230   int operator<(const AmpiDoubleComplex &a) noexcept {
 231     CkAbort("AMPI> Cannot compare double complex numbers with MPI_MIN\n");
 232     return 0;
 233   }
 234 };
 235
 236 class AmpiLongDoubleComplex {
 237  public:
 238   long double re, im;
 239   void operator+=(const AmpiLongDoubleComplex &a) noexcept {
 240     re+=a.re;
 241     im+=a.im;
 242   }
 243   void operator*=(const AmpiLongDoubleComplex &a) noexcept {
 244     long double nu_re=re*a.re-im*a.im;
 245     im=re*a.im+im*a.re;
 246     re=nu_re;
 247   }
 248   int operator>(const AmpiLongDoubleComplex &a) noexcept {
 249     CkAbort("AMPI> Cannot compare long double complex numbers with MPI_MAX\n");
 250     return 0;
 251   }
 252   int operator<(const AmpiLongDoubleComplex &a) noexcept {
 253     CkAbort("AMPI> Cannot compare long double complex numbers with MPI_MIN\n");
 254     return 0;
 255   }
 256 };
 257
 258 typedef struct { float val; int idx; } FloatInt;
 259 typedef struct { double val; int idx; } DoubleInt;
 260 typedef struct { long val; int idx; } LongInt;
 261 typedef struct { int val; int idx; } IntInt;
 262 typedef struct { short val; int idx; } ShortInt;
 263 typedef struct { long double val; int idx; } LongdoubleInt;
 264 typedef struct { float val; float idx; } FloatFloat;
 265 typedef struct { double val; double idx; } DoubleDouble;
 266
 267 /* For MPI_MAX, MPI_MIN, MPI_SUM, and MPI_PROD: */
 268 #define MPI_OP_SWITCH(OPNAME) \
 269   int i; \
 270 switch (*datatype) { \
 271   case MPI_CHAR: for(i=0;i<(*len);i++) { MPI_OP_IMPL(char); } break; \
 272   case MPI_SHORT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed short int); } break; \
 273   case MPI_INT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed int); } break; \
 274   case MPI_LONG: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed long); } break; \
 275   case MPI_UNSIGNED_CHAR: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned char); } break; \
 276   case MPI_UNSIGNED_SHORT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned short); } break; \
 277   case MPI_UNSIGNED: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned int); } break; \
 278   case MPI_UNSIGNED_LONG: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned long); } break; \
 279   case MPI_FLOAT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(float); } break; \
 280   case MPI_DOUBLE: for(i=0;i<(*len);i++) { MPI_OP_IMPL(double); } break; \
 281   case MPI_COMPLEX: for(i=0;i<(*len);i++) { MPI_OP_IMPL(AmpiComplex); } break; \
 282   case MPI_DOUBLE_COMPLEX: for(i=0;i<(*len);i++) { MPI_OP_IMPL(AmpiDoubleComplex); } break; \
 283   case MPI_LONG_LONG_INT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed long long); } break; \
 284   case MPI_SIGNED_CHAR: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed char); } break; \
 285   case MPI_UNSIGNED_LONG_LONG: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned long long); } break; \
 286   case MPI_WCHAR: for(i=0;i<(*len);i++) { MPI_OP_IMPL(wchar_t); } break; \
 287   case MPI_INT8_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int8_t); } break; \
 288   case MPI_INT16_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int16_t); } break; \
 289   case MPI_INT32_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int32_t); } break; \
 290   case MPI_INT64_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int64_t); } break; \
 291   case MPI_UINT8_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint8_t); } break; \
 292   case MPI_UINT16_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint16_t); } break; \
 293   case MPI_UINT32_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint32_t); } break; \
 294   case MPI_UINT64_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint64_t); } break; \
 295   case MPI_FLOAT_COMPLEX: for(i=0;i<(*len);i++) { MPI_OP_IMPL(AmpiComplex); } break; \
 296   case MPI_LONG_DOUBLE_COMPLEX: for(i=0;i<(*len);i++) { MPI_OP_IMPL(AmpiLongDoubleComplex); } break; \
 297   case MPI_AINT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(MPI_Aint); } break; \
 298   default: \
 299            ckerr << "Type " << *datatype << " with Op "#OPNAME" not supported." << endl; \
 300   CkAbort("Unsupported MPI datatype for MPI Op"); \
 301 };\
 302
 303 /* For MPI_LAND, MPI_LOR, and MPI_LXOR: */
 304 #define MPI_LOGICAL_OP_SWITCH(OPNAME) \
 305   int i; \
 306 switch (*datatype) { \
 307   case MPI_SHORT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed short int); } break; \
 308   case MPI_INT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed int); } break; \
 309   case MPI_LONG: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed long); } break; \
 310   case MPI_UNSIGNED_CHAR: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned char); } break; \
 311   case MPI_UNSIGNED_SHORT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned short); } break; \
 312   case MPI_UNSIGNED: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned int); } break; \
 313   case MPI_UNSIGNED_LONG: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned long); } break; \
 314   case MPI_LONG_LONG_INT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed long long); } break; \
 315   case MPI_SIGNED_CHAR: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed char); } break; \
 316   case MPI_UNSIGNED_LONG_LONG: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned long long); } break; \
 317   case MPI_INT8_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int8_t); } break; \
 318   case MPI_INT16_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int16_t); } break; \
 319   case MPI_INT32_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int32_t); } break; \
 320   case MPI_INT64_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int64_t); } break; \
 321   case MPI_UINT8_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint8_t); } break; \
 322   case MPI_UINT16_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint16_t); } break; \
 323   case MPI_UINT32_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint32_t); } break; \
 324   case MPI_UINT64_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint64_t); } break; \
 325   case MPI_LOGICAL: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int); } break; \
 326   case MPI_C_BOOL: for(i=0;i<(*len);i++) { MPI_OP_IMPL(bool); } break; \
 327   case MPI_AINT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(MPI_Aint); } break; \
 328   default: \
 329            ckerr << "Type " << *datatype << " with Op "#OPNAME" not supported." << endl; \
 330   CkAbort("Unsupported MPI datatype for MPI Op"); \
 331 };\
 332
 333 /* For MPI_BAND, MPI_BOR, and MPI_BXOR: */
 334 #define MPI_BITWISE_OP_SWITCH(OPNAME) \
 335   int i; \
 336 switch (*datatype) { \
 337   case MPI_SHORT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed short int); } break; \
 338   case MPI_INT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed int); } break; \
 339   case MPI_LONG: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed long); } break; \
 340   case MPI_UNSIGNED_CHAR: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned char); } break; \
 341   case MPI_UNSIGNED_SHORT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned short); } break; \
 342   case MPI_UNSIGNED: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned int); } break; \
 343   case MPI_UNSIGNED_LONG: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned long); } break; \
 344   case MPI_LONG_LONG_INT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed long long); } break; \
 345   case MPI_SIGNED_CHAR: for(i=0;i<(*len);i++) { MPI_OP_IMPL(signed char); } break; \
 346   case MPI_UNSIGNED_LONG_LONG: for(i=0;i<(*len);i++) { MPI_OP_IMPL(unsigned long long); } break; \
 347   case MPI_INT8_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int8_t); } break; \
 348   case MPI_INT16_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int16_t); } break; \
 349   case MPI_INT32_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int32_t); } break; \
 350   case MPI_INT64_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(int64_t); } break; \
 351   case MPI_UINT8_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint8_t); } break; \
 352   case MPI_UINT16_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint16_t); } break; \
 353   case MPI_UINT32_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint32_t); } break; \
 354   case MPI_UINT64_T: for(i=0;i<(*len);i++) { MPI_OP_IMPL(uint64_t); } break; \
 355   case MPI_BYTE: for(i=0;i<(*len);i++) { MPI_OP_IMPL(char); } break; \
 356   case MPI_AINT: for(i=0;i<(*len);i++) { MPI_OP_IMPL(MPI_Aint); } break; \
 357   default: \
 358            ckerr << "Type " << *datatype << " with Op "#OPNAME" not supported." << endl; \
 359   CkAbort("Unsupported MPI datatype for MPI Op"); \
 360 };\
 361
 362 void MPI_MAX_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 363 #define MPI_OP_IMPL(type) \
 364   if(((type *)invec)[i] > ((type *)inoutvec)[i]) ((type *)inoutvec)[i] = ((type *)invec)[i];
 365   MPI_OP_SWITCH(MPI_MAX)
 366 #undef MPI_OP_IMPL
 367 }
 368
 369 void MPI_MIN_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 370 #define MPI_OP_IMPL(type) \
 371   if(((type *)invec)[i] < ((type *)inoutvec)[i]) ((type *)inoutvec)[i] = ((type *)invec)[i];
 372   MPI_OP_SWITCH(MPI_MIN)
 373 #undef MPI_OP_IMPL
 374 }
 375
 376 void MPI_SUM_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 377 #define MPI_OP_IMPL(type) \
 378   ((type *)inoutvec)[i] += ((type *)invec)[i];
 379   MPI_OP_SWITCH(MPI_SUM)
 380 #undef MPI_OP_IMPL
 381 }
 382
 383 void MPI_PROD_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 384 #define MPI_OP_IMPL(type) \
 385   ((type *)inoutvec)[i] *= ((type *)invec)[i];
 386   MPI_OP_SWITCH(MPI_PROD)
 387 #undef MPI_OP_IMPL
 388 }
 389
 390 void MPI_REPLACE_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 391 #define MPI_OP_IMPL(type) \
 392   ((type *)inoutvec)[i] = ((type *)invec)[i];
 393   MPI_OP_SWITCH(MPI_REPLACE)
 394 #undef MPI_OP_IMPL
 395 }
 396
 397 void MPI_NO_OP_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 398   /* no-op */
 399 }
 400
 401 void MPI_LAND_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 402 #define MPI_OP_IMPL(type) \
 403   ((type *)inoutvec)[i] = ((type *)inoutvec)[i] && ((type *)invec)[i];
 404   MPI_LOGICAL_OP_SWITCH(MPI_LAND)
 405 #undef MPI_OP_IMPL
 406 }
 407
 408 void MPI_BAND_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 409 #define MPI_OP_IMPL(type) \
 410   ((type *)inoutvec)[i] = ((type *)inoutvec)[i] & ((type *)invec)[i];
 411   MPI_BITWISE_OP_SWITCH(MPI_BAND)
 412 #undef MPI_OP_IMPL
 413 }
 414
 415 void MPI_LOR_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 416 #define MPI_OP_IMPL(type) \
 417   ((type *)inoutvec)[i] = ((type *)inoutvec)[i] || ((type *)invec)[i];
 418   MPI_LOGICAL_OP_SWITCH(MPI_LOR)
 419 #undef MPI_OP_IMPL
 420 }
 421
 422 void MPI_BOR_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 423 #define MPI_OP_IMPL(type) \
 424   ((type *)inoutvec)[i] = ((type *)inoutvec)[i] | ((type *)invec)[i];
 425   MPI_BITWISE_OP_SWITCH(MPI_BOR)
 426 #undef MPI_OP_IMPL
 427 }
 428
 429 void MPI_LXOR_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 430 #define MPI_OP_IMPL(type) \
 431   ((type *)inoutvec)[i] = (((type *)inoutvec)[i]&&(!((type *)invec)[i]))||(!(((type *)inoutvec)[i])&&((type *)invec)[i]);
 432   MPI_LOGICAL_OP_SWITCH(MPI_LXOR)
 433 #undef MPI_OP_IMPL
 434 }
 435
 436 void MPI_BXOR_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 437 #define MPI_OP_IMPL(type) \
 438   ((type *)inoutvec)[i] = ((type *)inoutvec)[i] ^ ((type *)invec)[i];
 439   MPI_BITWISE_OP_SWITCH(MPI_BXOR)
 440 #undef MPI_OP_IMPL
 441 }
 442
 443 #ifndef MIN
 444 #define MIN(a,b) (a < b ? a : b)
 445 #endif
 446
 447 void MPI_MAXLOC_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 448   int i;
 449
 450   switch (*datatype) {
 451     case MPI_FLOAT_INT:
 452       for(i=0;i<(*len);i++){
 453         if(((FloatInt *)invec)[i].val > ((FloatInt *)inoutvec)[i].val)
 454           ((FloatInt *)inoutvec)[i] = ((FloatInt *)invec)[i];
 455         else if(((FloatInt *)invec)[i].val == ((FloatInt *)inoutvec)[i].val)
 456           ((FloatInt *)inoutvec)[i].idx = MIN(((FloatInt *)inoutvec)[i].idx, ((FloatInt *)invec)[i].idx);
 457       }
 458       break;
 459     case MPI_DOUBLE_INT:
 460       for(i=0;i<(*len);i++){
 461         if(((DoubleInt *)invec)[i].val > ((DoubleInt *)inoutvec)[i].val)
 462           ((DoubleInt *)inoutvec)[i] = ((DoubleInt *)invec)[i];
 463         else if(((DoubleInt *)invec)[i].val == ((DoubleInt *)inoutvec)[i].val)
 464           ((DoubleInt *)inoutvec)[i].idx = MIN(((DoubleInt *)inoutvec)[i].idx, ((DoubleInt *)invec)[i].idx);
 465       }
 466       break;
 467     case MPI_LONG_INT:
 468       for(i=0;i<(*len);i++){
 469         if(((LongInt *)invec)[i].val > ((LongInt *)inoutvec)[i].val)
 470           ((LongInt *)inoutvec)[i] = ((LongInt *)invec)[i];
 471         else if(((LongInt *)invec)[i].val == ((LongInt *)inoutvec)[i].val)
 472           ((LongInt *)inoutvec)[i].idx = MIN(((LongInt *)inoutvec)[i].idx, ((LongInt *)invec)[i].idx);
 473       }
 474       break;
 475     case MPI_2INT:
 476       for(i=0;i<(*len);i++){
 477         if(((IntInt *)invec)[i].val > ((IntInt *)inoutvec)[i].val)
 478           ((IntInt *)inoutvec)[i] = ((IntInt *)invec)[i];
 479         else if(((IntInt *)invec)[i].val == ((IntInt *)inoutvec)[i].val)
 480           ((IntInt *)inoutvec)[i].idx = MIN(((IntInt *)inoutvec)[i].idx, ((IntInt *)invec)[i].idx);
 481       }
 482       break;
 483     case MPI_SHORT_INT:
 484       for(i=0;i<(*len);i++){
 485         if(((ShortInt *)invec)[i].val > ((ShortInt *)inoutvec)[i].val)
 486           ((ShortInt *)inoutvec)[i] = ((ShortInt *)invec)[i];
 487         else if(((ShortInt *)invec)[i].val == ((ShortInt *)inoutvec)[i].val)
 488           ((ShortInt *)inoutvec)[i].idx = MIN(((ShortInt *)inoutvec)[i].idx, ((ShortInt *)invec)[i].idx);
 489       }
 490       break;
 491     case MPI_LONG_DOUBLE_INT:
 492       for(i=0;i<(*len);i++){
 493         if(((LongdoubleInt *)invec)[i].val > ((LongdoubleInt *)inoutvec)[i].val)
 494           ((LongdoubleInt *)inoutvec)[i] = ((LongdoubleInt *)invec)[i];
 495         else if(((LongdoubleInt *)invec)[i].val == ((LongdoubleInt *)inoutvec)[i].val)
 496           ((LongdoubleInt *)inoutvec)[i].idx = MIN(((LongdoubleInt *)inoutvec)[i].idx, ((LongdoubleInt *)invec)[i].idx);
 497       }
 498       break;
 499     case MPI_2FLOAT:
 500       for(i=0;i<(*len);i++){
 501         if(((FloatFloat *)invec)[i].val > ((FloatFloat *)inoutvec)[i].val)
 502           ((FloatFloat *)inoutvec)[i] = ((FloatFloat *)invec)[i];
 503         else if(((FloatFloat *)invec)[i].val == ((FloatFloat *)inoutvec)[i].val)
 504           ((FloatFloat *)inoutvec)[i].idx = MIN(((FloatFloat *)inoutvec)[i].idx, ((FloatFloat *)invec)[i].idx);
 505       }
 506       break;
 507     case MPI_2DOUBLE:
 508       for(i=0;i<(*len);i++){
 509         if(((DoubleDouble *)invec)[i].val > ((DoubleDouble *)inoutvec)[i].val)
 510           ((DoubleDouble *)inoutvec)[i] = ((DoubleDouble *)invec)[i];
 511         else if(((DoubleDouble *)invec)[i].val == ((DoubleDouble *)inoutvec)[i].val)
 512           ((DoubleDouble *)inoutvec)[i].idx = MIN(((DoubleDouble *)inoutvec)[i].idx, ((DoubleDouble *)invec)[i].idx);
 513       }
 514       break;
 515     default:
 516       ckerr << "Type " << *datatype << " with Op MPI_MAXLOC not supported." << endl;
 517       CkAbort("exiting");
 518   }
 519 }
 520
 521 void MPI_MINLOC_USER_FN( void *invec, void *inoutvec, int *len, MPI_Datatype *datatype){
 522   int i;
 523   switch (*datatype) {
 524     case MPI_FLOAT_INT:
 525       for(i=0;i<(*len);i++){
 526         if(((FloatInt *)invec)[i].val < ((FloatInt *)inoutvec)[i].val)
 527           ((FloatInt *)inoutvec)[i] = ((FloatInt *)invec)[i];
 528         else if(((FloatInt *)invec)[i].val == ((FloatInt *)inoutvec)[i].val)
 529           ((FloatInt *)inoutvec)[i].idx = MIN(((FloatInt *)inoutvec)[i].idx, ((FloatInt *)invec)[i].idx);
 530       }
 531       break;
 532     case MPI_DOUBLE_INT:
 533       for(i=0;i<(*len);i++){
 534         if(((DoubleInt *)invec)[i].val < ((DoubleInt *)inoutvec)[i].val)
 535           ((DoubleInt *)inoutvec)[i] = ((DoubleInt *)invec)[i];
 536         else if(((DoubleInt *)invec)[i].val == ((DoubleInt *)inoutvec)[i].val)
 537           ((DoubleInt *)inoutvec)[i].idx = MIN(((DoubleInt *)inoutvec)[i].idx, ((DoubleInt *)invec)[i].idx);
 538       }
 539       break;
 540     case MPI_LONG_INT:
 541       for(i=0;i<(*len);i++){
 542         if(((LongInt *)invec)[i].val < ((LongInt *)inoutvec)[i].val)
 543           ((LongInt *)inoutvec)[i] = ((LongInt *)invec)[i];
 544         else if(((LongInt *)invec)[i].val == ((LongInt *)inoutvec)[i].val)
 545           ((LongInt *)inoutvec)[i].idx = MIN(((LongInt *)inoutvec)[i].idx, ((LongInt *)invec)[i].idx);
 546       }
 547       break;
 548     case MPI_2INT:
 549       for(i=0;i<(*len);i++){
 550         if(((IntInt *)invec)[i].val < ((IntInt *)inoutvec)[i].val)
 551           ((IntInt *)inoutvec)[i] = ((IntInt *)invec)[i];
 552         else if(((IntInt *)invec)[i].val == ((IntInt *)inoutvec)[i].val)
 553           ((IntInt *)inoutvec)[i].idx = MIN(((IntInt *)inoutvec)[i].idx, ((IntInt *)invec)[i].idx);
 554       }
 555       break;
 556     case MPI_SHORT_INT:
 557       for(i=0;i<(*len);i++){
 558         if(((ShortInt *)invec)[i].val < ((ShortInt *)inoutvec)[i].val)
 559           ((ShortInt *)inoutvec)[i] = ((ShortInt *)invec)[i];
 560         else if(((ShortInt *)invec)[i].val == ((ShortInt *)inoutvec)[i].val)
 561           ((ShortInt *)inoutvec)[i].idx = MIN(((ShortInt *)inoutvec)[i].idx, ((ShortInt *)invec)[i].idx);
 562       }
 563       break;
 564     case MPI_LONG_DOUBLE_INT:
 565       for(i=0;i<(*len);i++){
 566         if(((LongdoubleInt *)invec)[i].val < ((LongdoubleInt *)inoutvec)[i].val)
 567           ((LongdoubleInt *)inoutvec)[i] = ((LongdoubleInt *)invec)[i];
 568         else if(((LongdoubleInt *)invec)[i].val == ((LongdoubleInt *)inoutvec)[i].val)
 569           ((LongdoubleInt *)inoutvec)[i].idx = MIN(((LongdoubleInt *)inoutvec)[i].idx, ((LongdoubleInt *)invec)[i].idx);
 570       }
 571       break;
 572     case MPI_2FLOAT:
 573       for(i=0;i<(*len);i++){
 574         if(((FloatFloat *)invec)[i].val < ((FloatFloat *)inoutvec)[i].val)
 575           ((FloatFloat *)inoutvec)[i] = ((FloatFloat *)invec)[i];
 576         else if(((FloatFloat *)invec)[i].val == ((FloatFloat *)inoutvec)[i].val)
 577           ((FloatFloat *)inoutvec)[i].idx = MIN(((FloatFloat *)inoutvec)[i].idx, ((FloatFloat *)invec)[i].idx);
 578       }
 579       break;
 580     case MPI_2DOUBLE:
 581       for(i=0;i<(*len);i++){
 582         if(((DoubleDouble *)invec)[i].val < ((DoubleDouble *)inoutvec)[i].val)
 583           ((DoubleDouble *)inoutvec)[i] = ((DoubleDouble *)invec)[i];
 584         else if(((DoubleDouble *)invec)[i].val == ((DoubleDouble *)inoutvec)[i].val)
 585           ((DoubleDouble *)inoutvec)[i].idx = MIN(((DoubleDouble *)inoutvec)[i].idx, ((DoubleDouble *)invec)[i].idx);
 586       }
 587       break;
 588     default:
 589       ckerr << "Type " << *datatype << " with Op MPI_MINLOC not supported." << endl;
 590       CkAbort("exiting");
 591   }
 592 }
 593
 594 /*
 595  * AMPI's generic reducer type, AmpiReducer, is used only
 596  * for MPI_Op/MPI_Datatype combinations that Charm++ does
 597  * not have built-in support for. AmpiReducer reduction
 598  * contributions all contain an AmpiOpHeader, that contains
 599  * the function pointer to an MPI_User_function* that is
 600  * applied to all contributions in AmpiReducerFunc().
 601  *
 602  * If AmpiReducer is used, the final reduction message will
 603  * have an additional sizeof(AmpiOpHeader) bytes in the
 604  * buffer before any user data. ampi::processRednMsg() strips
 605  * the header.
 606  *
 607  * If a non-commutative (user-defined) reduction is used,
 608  * ampi::processNoncommutativeRednMsg() strips the headers
 609  * and applies the op to all contributions in rank order.
 610  */
 611 CkReduction::reducerType AmpiReducer;
 612
 613 // every msg contains a AmpiOpHeader structure before user data
 614 CkReductionMsg *AmpiReducerFunc(int nMsg, CkReductionMsg **msgs) noexcept {
 615   AmpiOpHeader *hdr = (AmpiOpHeader *)msgs[0]->getData();
 616   MPI_Datatype dtype;
 617   int szhdr, szdata, len;
 618   MPI_User_function* func;
 619   func = hdr->func;
 620   dtype = hdr->dtype;
 621   szdata = hdr->szdata;
 622   len = hdr->len;
 623   szhdr = sizeof(AmpiOpHeader);
 624
 625   CkReductionMsg *retmsg = CkReductionMsg::buildNew(szhdr+szdata,NULL,AmpiReducer,msgs[0]);
 626   void *retPtr = (char *)retmsg->getData() + szhdr;
 627   for(int i=1;i<nMsg;i++){
 628     (*func)((void *)((char *)msgs[i]->getData()+szhdr),retPtr,&len,&dtype);
 629   }
 630   return retmsg;
 631 }
 632
 633 static CkReduction::reducerType getBuiltinReducerType(MPI_Datatype type, MPI_Op op) noexcept
 634 {
 635   switch (type) {
 636     case MPI_INT32_T:
 637       if (getDDT()->getSize(MPI_INT32_T) != getDDT()->getSize(MPI_INT)) break;
 638       // else: fall thru to MPI_INT
 639     case MPI_INT:
 640       switch (op) {
 641         case MPI_MAX:  return CkReduction::max_int;
 642         case MPI_MIN:  return CkReduction::min_int;
 643         case MPI_SUM:  return CkReduction::sum_int;
 644         case MPI_PROD: return CkReduction::product_int;
 645         case MPI_LAND: return CkReduction::logical_and_int;
 646         case MPI_LOR:  return CkReduction::logical_or_int;
 647         case MPI_LXOR: return CkReduction::logical_xor_int;
 648         case MPI_BAND: return CkReduction::bitvec_and_int;
 649         case MPI_BOR:  return CkReduction::bitvec_or_int;
 650         case MPI_BXOR: return CkReduction::bitvec_xor_int;
 651         default:       break;
 652       }
 653     case MPI_FLOAT:
 654       switch (op) {
 655         case MPI_MAX:  return CkReduction::max_float;
 656         case MPI_MIN:  return CkReduction::min_float;
 657         case MPI_SUM:  return CkReduction::sum_float;
 658         case MPI_PROD: return CkReduction::product_float;
 659         default:       break;
 660       }
 661     case MPI_DOUBLE:
 662       switch (op) {
 663         case MPI_MAX:  return CkReduction::max_double;
 664         case MPI_MIN:  return CkReduction::min_double;
 665         case MPI_SUM:  return CkReduction::sum_double;
 666         case MPI_PROD: return CkReduction::product_double;
 667         default:       break;
 668       }
 669     case MPI_INT8_T:
 670       if (getDDT()->getSize(MPI_INT8_T) != getDDT()->getSize(MPI_CHAR)) break;
 671       // else: fall thru to MPI_CHAR
 672     case MPI_CHAR:
 673       switch (op) {
 674         case MPI_MAX:  return CkReduction::max_char;
 675         case MPI_MIN:  return CkReduction::min_char;
 676         case MPI_SUM:  return CkReduction::sum_char;
 677         case MPI_PROD: return CkReduction::product_char;
 678         default:       break;
 679       }
 680     case MPI_INT16_T:
 681       if (getDDT()->getSize(MPI_INT16_T) != getDDT()->getSize(MPI_SHORT)) break;
 682       // else: fall thru to MPI_SHORT
 683     case MPI_SHORT:
 684       switch (op) {
 685         case MPI_MAX:  return CkReduction::max_short;
 686         case MPI_MIN:  return CkReduction::min_short;
 687         case MPI_SUM:  return CkReduction::sum_short;
 688         case MPI_PROD: return CkReduction::product_short;
 689         default:       break;
 690       }
 691     case MPI_LONG:
 692       switch (op) {
 693         case MPI_MAX:  return CkReduction::max_long;
 694         case MPI_MIN:  return CkReduction::min_long;
 695         case MPI_SUM:  return CkReduction::sum_long;
 696         case MPI_PROD: return CkReduction::product_long;
 697         default:       break;
 698       }
 699     case MPI_INT64_T:
 700       if (getDDT()->getSize(MPI_INT64_T) != getDDT()->getSize(MPI_LONG_LONG)) break;
 701       // else: fall thru to MPI_LONG_LONG
 702     case MPI_LONG_LONG:
 703       switch (op) {
 704         case MPI_MAX:  return CkReduction::max_long_long;
 705         case MPI_MIN:  return CkReduction::min_long_long;
 706         case MPI_SUM:  return CkReduction::sum_long_long;
 707         case MPI_PROD: return CkReduction::product_long_long;
 708         default:       break;
 709       }
 710     case MPI_UINT8_T:
 711       if (getDDT()->getSize(MPI_UINT8_T) != getDDT()->getSize(MPI_UNSIGNED_CHAR)) break;
 712       // else: fall thru to MPI_UNSIGNED_CHAR
 713     case MPI_UNSIGNED_CHAR:
 714       switch (op) {
 715         case MPI_MAX:  return CkReduction::max_uchar;
 716         case MPI_MIN:  return CkReduction::min_uchar;
 717         case MPI_SUM:  return CkReduction::sum_uchar;
 718         case MPI_PROD: return CkReduction::product_uchar;
 719         default:       break;
 720       }
 721     case MPI_UINT16_T:
 722       if (getDDT()->getSize(MPI_UINT16_T) != getDDT()->getSize(MPI_UNSIGNED_SHORT)) break;
 723       // else: fall thru to MPI_UNSIGNED_SHORT
 724     case MPI_UNSIGNED_SHORT:
 725       switch (op) {
 726         case MPI_MAX:  return CkReduction::max_ushort;
 727         case MPI_MIN:  return CkReduction::min_ushort;
 728         case MPI_SUM:  return CkReduction::sum_ushort;
 729         case MPI_PROD: return CkReduction::product_ushort;
 730         default:       break;
 731       }
 732     case MPI_UINT32_T:
 733       if (getDDT()->getSize(MPI_UINT32_T) != getDDT()->getSize(MPI_UNSIGNED)) break;
 734       // else: fall thru to MPI_UNSIGNED
 735     case MPI_UNSIGNED:
 736       switch (op) {
 737         case MPI_MAX:  return CkReduction::max_uint;
 738         case MPI_MIN:  return CkReduction::min_uint;
 739         case MPI_SUM:  return CkReduction::sum_uint;
 740         case MPI_PROD: return CkReduction::product_uint;
 741         default:       break;
 742       }
 743     case MPI_UNSIGNED_LONG:
 744       switch (op) {
 745         case MPI_MAX:  return CkReduction::max_ulong;
 746         case MPI_MIN:  return CkReduction::min_ulong;
 747         case MPI_SUM:  return CkReduction::sum_ulong;
 748         case MPI_PROD: return CkReduction::product_ulong;
 749         default:       break;
 750       }
 751     case MPI_UINT64_T:
 752       if (getDDT()->getSize(MPI_UINT64_T) != getDDT()->getSize(MPI_UNSIGNED_LONG_LONG)) break;
 753       // else: fall thru to MPI_UNSIGNED_LONG_LONG
 754     case MPI_UNSIGNED_LONG_LONG:
 755       switch (op) {
 756         case MPI_MAX:  return CkReduction::max_ulong_long;
 757         case MPI_MIN:  return CkReduction::min_ulong_long;
 758         case MPI_SUM:  return CkReduction::sum_ulong_long;
 759         case MPI_PROD: return CkReduction::product_ulong_long;
 760         default:       break;
 761       }
 762     case MPI_C_BOOL:
 763       switch (op) {
 764         case MPI_LAND: return CkReduction::logical_and_bool;
 765         case MPI_LOR:  return CkReduction::logical_or_bool;
 766         case MPI_LXOR: return CkReduction::logical_xor_bool;
 767         default:       break;
 768       }
 769     case MPI_LOGICAL:
 770       switch (op) {
 771         case MPI_LAND: return CkReduction::logical_and_int;
 772         case MPI_LOR:  return CkReduction::logical_or_int;
 773         case MPI_LXOR: return CkReduction::logical_xor_int;
 774         default:       break;
 775       }
 776     case MPI_BYTE:
 777       switch (op) {
 778         case MPI_BAND: return CkReduction::bitvec_and_bool;
 779         case MPI_BOR:  return CkReduction::bitvec_or_bool;
 780         case MPI_BXOR: return CkReduction::bitvec_xor_bool;
 781         default:       break;
 782       }
 783     default:
 784       break;
 785   }
 786   return CkReduction::invalid;
 787 }
 788
 789 class Builtin_kvs{
 790  public:
 791   int tag_ub,host,io,wtime_is_global,appnum,lastusedcode,universe_size;
 792   int win_disp_unit,win_create_flavor,win_model;
 793   int ampi_tmp;
 794   void* win_base;
 795   MPI_Aint win_size;
 796   Builtin_kvs() noexcept {
 797     tag_ub = MPI_TAG_UB_VALUE;
 798     host = MPI_PROC_NULL;
 799     io = 0;
 800     wtime_is_global = 0;
 801     appnum = 0;
 802     lastusedcode = MPI_ERR_LASTCODE;
 803     universe_size = 0;
 804     win_base = NULL;
 805     win_size = 0;
 806     win_disp_unit = 0;
 807     win_create_flavor = MPI_WIN_FLAVOR_CREATE;
 808     win_model = MPI_WIN_SEPARATE;
 809     ampi_tmp = 0;
 810   }
 811 };
 812
 813 // ------------ startup support -----------
 814 int _ampi_fallback_setup_count = -1;
 815 CDECL void AMPI_Setup(void);
 816 FDECL void FTN_NAME(AMPI_SETUP,ampi_setup)(void);
 817
 818 FDECL void FTN_NAME(MPI_MAIN,mpi_main)(void);
 819
 820 /*Main routine used when missing MPI_Setup routine*/
 821 CDECL
 822 void AMPI_Fallback_Main(int argc,char **argv)
 823 {
 824   AMPI_Main_cpp();
 825   AMPI_Main_cpp(argc,argv);
 826   AMPI_Main_c(argc,argv);
 827   FTN_NAME(MPI_MAIN,mpi_main)();
 828 }
 829
 830 void ampiCreateMain(MPI_MainFn mainFn, const char *name,int nameLen);
 831 /*Startup routine used if user *doesn't* write
 832   a TCHARM_User_setup routine.
 833  */
 834 CDECL
 835 void AMPI_Setup_Switch(void) {
 836   _ampi_fallback_setup_count=0;
 837   FTN_NAME(AMPI_SETUP,ampi_setup)();
 838   AMPI_Setup();
 839   if (_ampi_fallback_setup_count==2)
 840   { //Missing AMPI_Setup in both C and Fortran:
 841     ampiCreateMain(AMPI_Fallback_Main,"default",strlen("default"));
 842   }
 843 }
 844
 845 int AMPI_RDMA_THRESHOLD = AMPI_RDMA_THRESHOLD_DEFAULT;
 846 int AMPI_SMP_RDMA_THRESHOLD = AMPI_SMP_RDMA_THRESHOLD_DEFAULT;
 847 static bool nodeinit_has_been_called=false;
 848 CtvDeclare(ampiParent*, ampiPtr);
 849 CtvDeclare(bool, ampiInitDone);
 850 CtvDeclare(void*,stackBottom);
 851 CtvDeclare(bool, ampiFinalized);
 852 CkpvDeclare(Builtin_kvs, bikvs);
 853 CkpvDeclare(int, ampiThreadLevel);
 854 CkpvDeclare(AmpiMsgPool, msgPool);
 855
 856 CDECL
 857 long ampiCurrentStackUsage(void){
 858   int localVariable;
 859
 860   unsigned long p1 =  (unsigned long)(uintptr_t)((void*)&localVariable);
 861   unsigned long p2 =  (unsigned long)(uintptr_t)(CtvAccess(stackBottom));
 862
 863   if(p1 > p2)
 864     return p1 - p2;
 865   else
 866     return  p2 - p1;
 867 }
 868
 869 FDECL
 870 void FTN_NAME(AMPICURRENTSTACKUSAGE, ampicurrentstackusage)(void){
 871   long usage = ampiCurrentStackUsage();
 872   CkPrintf("[%d] Stack usage is currently %ld\n", CkMyPe(), usage);
 873 }
 874
 875 CDECL
 876 void AMPI_threadstart(void *data);
 877 static int AMPI_threadstart_idx = -1;
 878
 879 #if CMK_TRACE_ENABLED
 880 CsvExtern(funcmap*, tcharm_funcmap);
 881 #endif
 882
 883 static void ampiNodeInit() noexcept
 884 {
 885 #if CMK_TRACE_ENABLED
 886   TCharm::nodeInit(); // make sure tcharm_funcmap is set up
 887   int funclength = sizeof(funclist)/sizeof(char*);
 888   for (int i=0; i<funclength; i++) {
 889     int event_id = traceRegisterUserEvent(funclist[i], -1);
 890     CsvAccess(tcharm_funcmap)->insert(std::pair<std::string, int>(funclist[i], event_id));
 891   }
 892
 893   // rename chare & function to something reasonable
 894   // TODO: find a better way to do this
 895   for (int i=0; i<_chareTable.size(); i++){
 896     if (strcmp(_chareTable[i]->name, "dummy_thread_chare") == 0)
 897       _chareTable[i]->name = "AMPI";
 898   }
 899   for (int i=0; i<_entryTable.size(); i++){
 900     if (strcmp(_entryTable[i]->name, "dummy_thread_ep") == 0)
 901       _entryTable[i]->name = "rank";
 902   }
 903 #endif
 904
 905   _mpi_nworlds=0;
 906   for(int i=0;i<MPI_MAX_COMM_WORLDS; i++)
 907   {
 908     MPI_COMM_UNIVERSE[i] = MPI_COMM_WORLD+1+i;
 909   }
 910   TCHARM_Set_fallback_setup(AMPI_Setup_Switch);
 911
 912   /* read AMPI environment variables */
 913   char *value;
 914   bool rdmaSet = false;
 915   if ((value = getenv("AMPI_RDMA_THRESHOLD"))) {
 916     AMPI_RDMA_THRESHOLD = atoi(value);
 917     rdmaSet = true;
 918   }
 919   if ((value = getenv("AMPI_SMP_RDMA_THRESHOLD"))) {
 920     AMPI_SMP_RDMA_THRESHOLD = atoi(value);
 921     rdmaSet = true;
 922   }
 923   if (rdmaSet && CkMyNode() == 0) {
 924 #if AMPI_RDMA_IMPL
 925     CkPrintf("AMPI> RDMA threshold is %d Bytes and SMP RDMA threshold is %d Bytes.\n", AMPI_RDMA_THRESHOLD, AMPI_SMP_RDMA_THRESHOLD);
 926 #else
 927     CkPrintf("Warning: AMPI RDMA threshold ignored since AMPI RDMA is disabled.\n");
 928 #endif
 929   }
 930
 931   AmpiReducer = CkReduction::addReducer(AmpiReducerFunc, true /*streamable*/);
 932
 933   CkAssert(AMPI_threadstart_idx == -1);    // only initialize once
 934   AMPI_threadstart_idx = TCHARM_Register_thread_function(AMPI_threadstart);
 935
 936   nodeinit_has_been_called=true;
 937
 938    // ASSUME NO ANYTIME MIGRATION and STATIC INSERTON
 939   _isAnytimeMigration = false;
 940   _isStaticInsertion = true;
 941 }
 942
 943 #if AMPI_PRINT_IDLE
 944 static double totalidle=0.0, startT=0.0;
 945 static int beginHandle, endHandle;
 946 static void BeginIdle(void *dummy,double curWallTime) noexcept
 947 {
 948   startT = curWallTime;
 949 }
 950 static void EndIdle(void *dummy,double curWallTime) noexcept
 951 {
 952   totalidle += curWallTime - startT;
 953 }
 954 #endif
 955
 956 static void ampiProcInit() noexcept {
 957   CtvInitialize(ampiParent*, ampiPtr);
 958   CtvInitialize(bool,ampiInitDone);
 959   CtvInitialize(bool,ampiFinalized);
 960   CtvInitialize(void*,stackBottom);
 961
 962   CkpvInitialize(int, ampiThreadLevel);
 963   CkpvAccess(ampiThreadLevel) = MPI_THREAD_SINGLE;
 964
 965   CkpvInitialize(Builtin_kvs, bikvs); // built-in key-values
 966   CkpvAccess(bikvs) = Builtin_kvs();
 967
 968   CkpvInitialize(AmpiMsgPool, msgPool); // pool of small AmpiMsg's
 969   CkpvAccess(msgPool) = AmpiMsgPool(AMPI_MSG_POOL_SIZE, AMPI_POOLED_MSG_SIZE);
 970
 971 #if AMPIMSGLOG
 972   char **argv=CkGetArgv();
 973   msgLogWrite = CmiGetArgFlag(argv, "+msgLogWrite");
 974   if (CmiGetArgIntDesc(argv,"+msgLogRead", &msgLogRank, "Re-play message processing order for AMPI")) {
 975     msgLogRead = 1;
 976   }
 977   char *procs = NULL;
 978   if (CmiGetArgStringDesc(argv, "+msgLogRanks", &procs, "A list of AMPI processors to record , e.g. 0,10,20-30")) {
 979     msgLogRanks.set(procs);
 980   }
 981   CmiGetArgString(argv, "+msgLogFilename", &msgLogFilename);
 982   if (CkMyPe() == 0) {
 983     if (msgLogWrite) CkPrintf("Writing AMPI messages of rank %s to log: %s\n", procs?procs:"", msgLogFilename);
 984     if (msgLogRead) CkPrintf("Reading AMPI messages of rank %s from log: %s\n", procs?procs:"", msgLogFilename);
 985   }
 986 #endif
 987
 988 #if AMPI_PRINT_MSG_SIZES
 989   // Only record and print message sizes if this option is given, and only for those ranks.
 990   // Running with the '+syncprint' option is recommended if printing from multiple ranks.
 991   char *ranks = NULL;
 992   CkpvInitialize(CkListString, msgSizesRanks);
 993   if (CmiGetArgStringDesc(CkGetArgv(), "+msgSizesRanks", &ranks,
 994       "A list of AMPI ranks to record and print message sizes on, e.g. 0,10,20-30")) {
 995     CkpvAccess(msgSizesRanks).set(ranks);
 996   }
 997 #endif
 998 }
 999
1000 #if AMPIMSGLOG
1001 static inline int record_msglog(int rank) noexcept {
1002   return msgLogRanks.includes(rank);
1003 }
1004 #endif
1005
1006 PUPfunctionpointer(MPI_MainFn)
1007
1008 class MPI_threadstart_t {
1009  public:
1010   MPI_MainFn fn;
1011   MPI_threadstart_t() noexcept {}
1012   MPI_threadstart_t(MPI_MainFn fn_) noexcept :fn(fn_) {}
1013   void start() {
1014     char **argv=CmiCopyArgs(CkGetArgv());
1015     int argc=CkGetArgc();
1016
1017     // Set a pointer to somewhere close to the bottom of the stack.
1018     // This is used for roughly estimating the stack usage later.
1019     CtvAccess(stackBottom) = &argv;
1020
1021 #if !CMK_NO_BUILD_SHARED
1022     // If charm++ is built with shared libraries, it does not support
1023     // a custom AMPI_Setup method and always uses AMPI_Fallback_Main.
1024     // Works around bug #1508.
1025     if (_ampi_fallback_setup_count != -1 && _ampi_fallback_setup_count != 2 && CkMyPe() == 0) {
1026       CkAbort("AMPI> The application provided a custom AMPI_Setup() method, "
1027       "but AMPI is built with shared library support. This is an unsupported "
1028       "configuration. Please recompile charm++/AMPI without `-build-shared` or "
1029       "remove the AMPI_Setup() function from your application.\n");
1030     }
1031     AMPI_Fallback_Main(argc,argv);
1032 #else
1033     (fn)(argc,argv);
1034 #endif
1035   }
1036   void pup(PUP::er &p) noexcept {
1037     p|fn;
1038   }
1039 };
1040 PUPmarshall(MPI_threadstart_t)
1041
1042 CDECL
1043 void AMPI_threadstart(void *data)
1044 {
1045   STARTUP_DEBUG("MPI_threadstart")
1046   MPI_threadstart_t t;
1047   pupFromBuf(data,t);
1048 #if CMK_TRACE_IN_CHARM
1049   if(CpvAccess(traceOn)) CthTraceResume(CthSelf());
1050 #endif
1051   t.start();
1052 }
1053
1054 void ampiCreateMain(MPI_MainFn mainFn, const char *name,int nameLen)
1055 {
1056   STARTUP_DEBUG("ampiCreateMain")
1057   int _nchunks=TCHARM_Get_num_chunks();
1058   //Make a new threads array:
1059   MPI_threadstart_t s(mainFn);
1060   memBuf b; pupIntoBuf(b,s);
1061   TCHARM_Create_data(_nchunks,AMPI_threadstart_idx,
1062                      b.getData(), b.getSize());
1063 }
1064
1065 /* TCharm Semaphore ID's for AMPI startup */
1066 #define AMPI_TCHARM_SEMAID 0x00A34100 /* __AMPI__ */
1067 #define AMPI_BARRIER_SEMAID 0x00A34200 /* __AMPI__ */
1068
1069 static CProxy_ampiWorlds ampiWorldsGroup;
1070
1071 void ampiParent::initOps() noexcept
1072 {
1073   ops.resize(MPI_NO_OP+1);
1074   ops[MPI_MAX]     = OpStruct(MPI_MAX_USER_FN);
1075   ops[MPI_MIN]     = OpStruct(MPI_MIN_USER_FN);
1076   ops[MPI_SUM]     = OpStruct(MPI_SUM_USER_FN);
1077   ops[MPI_PROD]    = OpStruct(MPI_PROD_USER_FN);
1078   ops[MPI_LAND]    = OpStruct(MPI_LAND_USER_FN);
1079   ops[MPI_BAND]    = OpStruct(MPI_BAND_USER_FN);
1080   ops[MPI_LOR]     = OpStruct(MPI_LOR_USER_FN);
1081   ops[MPI_BOR]     = OpStruct(MPI_BOR_USER_FN);
1082   ops[MPI_LXOR]    = OpStruct(MPI_LXOR_USER_FN);
1083   ops[MPI_BXOR]    = OpStruct(MPI_BXOR_USER_FN);
1084   ops[MPI_MAXLOC]  = OpStruct(MPI_MAXLOC_USER_FN);
1085   ops[MPI_MINLOC]  = OpStruct(MPI_MINLOC_USER_FN);
1086   ops[MPI_REPLACE] = OpStruct(MPI_REPLACE_USER_FN);
1087   ops[MPI_NO_OP]   = OpStruct(MPI_NO_OP_USER_FN);
1088 }
1089
1090 // Create MPI_COMM_SELF from MPI_COMM_WORLD
1091 static void createCommSelf() noexcept {
1092   STARTUP_DEBUG("ampiInit> creating MPI_COMM_SELF")
1093   MPI_Comm selfComm;
1094   MPI_Group worldGroup, selfGroup;
1095   int ranks[1] = { getAmpiInstance(MPI_COMM_WORLD)->getRank() };
1096
1097   MPI_Comm_group(MPI_COMM_WORLD, &worldGroup);
1098   MPI_Group_incl(worldGroup, 1, ranks, &selfGroup);
1099   MPI_Comm_create(MPI_COMM_WORLD, selfGroup, &selfComm);
1100   MPI_Comm_set_name(selfComm, "MPI_COMM_SELF");
1101
1102   CkAssert(selfComm == MPI_COMM_SELF);
1103   STARTUP_DEBUG("ampiInit> created MPI_COMM_SELF")
1104 }
1105
1106 /*
1107    Called from MPI_Init, a collective initialization call:
1108    creates a new AMPI array and attaches it to the current
1109    set of TCHARM threads.
1110  */
1111 static ampi *ampiInit(char **argv) noexcept
1112 {
1113   FUNCCALL_DEBUG(CkPrintf("Calling from proc %d for tcharm element %d\n", CkMyPe(), TCHARM_Element());)
1114   if (CtvAccess(ampiInitDone)) return NULL; /* Already called ampiInit */
1115   STARTUP_DEBUG("ampiInit> begin")
1116
1117   MPI_Comm new_world;
1118   int _nchunks;
1119   CkArrayOptions opts;
1120   CProxy_ampiParent parent;
1121   if (TCHARM_Element()==0) //the rank of a tcharm object
1122   { /* I'm responsible for building the arrays: */
1123     STARTUP_DEBUG("ampiInit> creating arrays")
1124
1125     // FIXME: Need to serialize global communicator allocation in one place.
1126     //Allocate the next communicator
1127     if(_mpi_nworlds == MPI_MAX_COMM_WORLDS)
1128     {
1129       CkAbort("AMPI> Number of registered comm_worlds exceeded limit.\n");
1130     }
1131     int new_idx=_mpi_nworlds;
1132     new_world=MPI_COMM_WORLD+new_idx;
1133
1134     //Create and attach the ampiParent array
1135     CkArrayID threads;
1136     opts=TCHARM_Attach_start(&threads,&_nchunks);
1137     opts.setSectionAutoDelegate(false);
1138     CkArrayCreatedMsg *m;
1139     CProxy_ampiParent::ckNew(new_world, threads, _nchunks, opts, CkCallbackResumeThread((void*&)m));
1140     parent = CProxy_ampiParent(m->aid);
1141     delete m;
1142     STARTUP_DEBUG("ampiInit> array size "<<_nchunks);
1143   }
1144   int *barrier = (int *)TCharm::get()->semaGet(AMPI_BARRIER_SEMAID);
1145
1146   FUNCCALL_DEBUG(CkPrintf("After BARRIER: sema size %d from tcharm's ele %d\n", TCharm::get()->sema.size(), TCHARM_Element());)
1147
1148   if (TCHARM_Element()==0)
1149   {
1150     //Make a new ampi array
1151     CkArrayID empty;
1152
1153     ampiCommStruct worldComm(new_world,empty,_nchunks);
1154     CProxy_ampi arr;
1155     CkArrayCreatedMsg *m;
1156     CProxy_ampi::ckNew(parent, worldComm, opts, CkCallbackResumeThread((void*&)m));
1157     arr = CProxy_ampi(m->aid);
1158     delete m;
1159
1160     //Broadcast info. to the mpi_worlds array
1161     // FIXME: remove race condition from MPI_COMM_UNIVERSE broadcast
1162     ampiCommStruct newComm(new_world,arr,_nchunks);
1163     if (ampiWorldsGroup.ckGetGroupID().isZero())
1164       ampiWorldsGroup=CProxy_ampiWorlds::ckNew(newComm);
1165     else
1166       ampiWorldsGroup.add(newComm);
1167     STARTUP_DEBUG("ampiInit> arrays created")
1168   }
1169
1170   // Find our ampi object:
1171   ampi *ptr=(ampi *)TCharm::get()->semaGet(AMPI_TCHARM_SEMAID);
1172   CtvAccess(ampiInitDone)=true;
1173   CtvAccess(ampiFinalized)=false;
1174   STARTUP_DEBUG("ampiInit> complete")
1175 #if CMK_BIGSIM_CHARM
1176     //  TRACE_BG_AMPI_START(ptr->getThread(), "AMPI_START");
1177     TRACE_BG_ADD_TAG("AMPI_START");
1178 #endif
1179
1180   getAmpiParent()->initOps(); // initialize reduction operations
1181   vector<int>& keyvals = getAmpiParent()->getKeyvals(MPI_COMM_WORLD);
1182   getAmpiParent()->setAttr(MPI_COMM_WORLD, keyvals, MPI_UNIVERSE_SIZE, &_nchunks);
1183   ptr->setCommName("MPI_COMM_WORLD");
1184
1185   getAmpiParent()->ampiInitCallDone = 0;
1186
1187   CProxy_ampi cbproxy = ptr->getProxy();
1188   CkCallback cb(CkReductionTarget(ampi, allInitDone), cbproxy[0]);
1189   ptr->contribute(cb);
1190
1191   ampiParent *thisParent = getAmpiParent();
1192   while(thisParent->ampiInitCallDone!=1){
1193     thisParent->getTCharmThread()->stop();
1194     /*
1195      * thisParent needs to be updated in case of the parent is being pupped.
1196      * In such case, thisParent got changed
1197      */
1198     thisParent = getAmpiParent();
1199   }
1200
1201   createCommSelf();
1202
1203 #if CMK_BIGSIM_CHARM
1204   BgSetStartOutOfCore();
1205 #endif
1206
1207   return ptr;
1208 }
1209
1210 /// This group is used to broadcast the MPI_COMM_UNIVERSE communicators.
1211 class ampiWorlds : public CBase_ampiWorlds {
1212  public:
1213   ampiWorlds(const ampiCommStruct &nextWorld) noexcept {
1214     ampiWorldsGroup=thisgroup;
1215     add(nextWorld);
1216   }
1217   ampiWorlds(CkMigrateMessage *m) noexcept : CBase_ampiWorlds(m) {}
1218   void pup(PUP::er &p) noexcept { }
1219   void add(const ampiCommStruct &nextWorld) noexcept {
1220     int new_idx=nextWorld.getComm()-(MPI_COMM_WORLD);
1221     mpi_worlds[new_idx]=nextWorld;
1222     if (_mpi_nworlds<=new_idx) _mpi_nworlds=new_idx+1;
1223     STARTUP_DEBUG("ampiInit> listed MPI_COMM_UNIVERSE "<<new_idx)
1224   }
1225 };
1226
1227 //-------------------- ampiParent -------------------------
1228 ampiParent::ampiParent(MPI_Comm worldNo_,CProxy_TCharm threads_,int nRanks_) noexcept
1229 :threads(threads_), worldNo(worldNo_), isTmpRProxySet(false), ampiReqs(64, &reqPool)
1230 {
1231   int barrier = 0x1234;
1232   STARTUP_DEBUG("ampiParent> starting up")
1233   thread=NULL;
1234   worldPtr=NULL;
1235   userAboutToMigrateFn=NULL;
1236   userJustMigratedFn=NULL;
1237   prepareCtv();
1238
1239   // Allocate an empty groupStruct to represent MPI_EMPTY_GROUP
1240   groups.push_back(new groupStruct);
1241
1242   init();
1243
1244   //ensure MPI_INFO_ENV will always be first info object
1245   defineInfoEnv(nRanks_);
1246   // define Info objects for AMPI_Migrate calls
1247   defineInfoMigration();
1248
1249   thread->semaPut(AMPI_BARRIER_SEMAID,&barrier);
1250
1251 #if CMK_FAULT_EVAC
1252   AsyncEvacuate(false);
1253 #endif
1254 }
1255
1256 ampiParent::ampiParent(CkMigrateMessage *msg) noexcept :CBase_ampiParent(msg) {
1257   thread=NULL;
1258   worldPtr=NULL;
1259
1260   init();
1261
1262 #if CMK_FAULT_EVAC
1263   AsyncEvacuate(false);
1264 #endif
1265 }
1266
1267 PUPfunctionpointer(MPI_MigrateFn)
1268
1269 void ampiParent::pup(PUP::er &p) noexcept {
1270   p|threads;
1271   p|worldNo;
1272   p|worldStruct;
1273   p|myDDT;
1274   p|splitComm;
1275   p|groupComm;
1276   p|cartComm;
1277   p|graphComm;
1278   p|distGraphComm;
1279   p|interComm;
1280   p|intraComm;
1281
1282   p|groups;
1283   p|winStructList;
1284   p|infos;
1285   p|ops;
1286
1287   p|reqPool;
1288   ampiReqs.pup(p, &reqPool);
1289
1290   p|kvlist;
1291   p|isTmpRProxySet;
1292   p|tmpRProxy;
1293
1294   p|userAboutToMigrateFn;
1295   p|userJustMigratedFn;
1296
1297   p|ampiInitCallDone;
1298   p|resumeOnRecv;
1299   p|resumeOnColl;
1300   p|numBlockedReqs;
1301   p|bsendBufferSize;
1302   p((char *)&bsendBuffer, sizeof(void *));
1303
1304 #if AMPI_PRINT_MSG_SIZES
1305   p|msgSizes;
1306 #endif
1307 }
1308
1309 void ampiParent::prepareCtv() noexcept {
1310   thread=threads[thisIndex].ckLocal();
1311   if (thread==NULL) CkAbort("AMPIParent cannot find its thread!\n");
1312   CtvAccessOther(thread->getThread(),ampiPtr) = this;
1313   STARTUP_DEBUG("ampiParent> found TCharm")
1314 }
1315
1316 void ampiParent::init() noexcept{
1317   resumeOnRecv = false;
1318   resumeOnColl = false;
1319   numBlockedReqs = 0;
1320   bsendBufferSize = 0;
1321   bsendBuffer = NULL;
1322 #if AMPIMSGLOG
1323   if(msgLogWrite && record_msglog(thisIndex)){
1324     char fname[128];
1325     sprintf(fname, "%s.%d", msgLogFilename,thisIndex);
1326 #if CMK_USE_ZLIB && 0
1327     fMsgLog = gzopen(fname,"wb");
1328     toPUPer = new PUP::tozDisk(fMsgLog);
1329 #else
1330     fMsgLog = fopen(fname,"wb");
1331     CkAssert(fMsgLog != NULL);
1332     toPUPer = new PUP::toDisk(fMsgLog);
1333 #endif
1334   }else if(msgLogRead){
1335     char fname[128];
1336     sprintf(fname, "%s.%d", msgLogFilename,msgLogRank);
1337 #if CMK_USE_ZLIB && 0
1338     fMsgLog = gzopen(fname,"rb");
1339     fromPUPer = new PUP::fromzDisk(fMsgLog);
1340 #else
1341     fMsgLog = fopen(fname,"rb");
1342     CkAssert(fMsgLog != NULL);
1343     fromPUPer = new PUP::fromDisk(fMsgLog);
1344 #endif
1345     CkPrintf("AMPI> opened message log file: %s for replay\n", fname);
1346   }
1347 #endif
1348 }
1349
1350 void ampiParent::finalize() noexcept {
1351 #if AMPIMSGLOG
1352   if(msgLogWrite && record_msglog(thisIndex)){
1353     delete toPUPer;
1354 #if CMK_USE_ZLIB && 0
1355     gzclose(fMsgLog);
1356 #else
1357     fclose(fMsgLog);
1358 #endif
1359   }else if(msgLogRead){
1360     delete fromPUPer;
1361 #if CMK_USE_ZLIB && 0
1362     gzclose(fMsgLog);
1363 #else
1364     fclose(fMsgLog);
1365 #endif
1366   }
1367 #endif
1368 }
1369
1370 void ampiParent::setUserAboutToMigrateFn(MPI_MigrateFn f) noexcept {
1371   userAboutToMigrateFn = f;
1372 }
1373
1374 void ampiParent::setUserJustMigratedFn(MPI_MigrateFn f) noexcept {
1375   userJustMigratedFn = f;
1376 }
1377
1378 void ampiParent::ckAboutToMigrate() noexcept {
1379   if (userAboutToMigrateFn) {
1380     (*userAboutToMigrateFn)();
1381   }
1382 }
1383
1384 void ampiParent::ckJustMigrated() noexcept {
1385   ArrayElement1D::ckJustMigrated();
1386   prepareCtv();
1387   if (userJustMigratedFn) {
1388     (*userJustMigratedFn)();
1389   }
1390 }
1391
1392 void ampiParent::ckJustRestored() noexcept {
1393   FUNCCALL_DEBUG(CkPrintf("Call just restored from ampiParent[%d] with ampiInitCallDone %d\n", thisIndex, ampiInitCallDone);)
1394   ArrayElement1D::ckJustRestored();
1395   prepareCtv();
1396 }
1397
1398 ampiParent::~ampiParent() noexcept {
1399   STARTUP_DEBUG("ampiParent> destructor called");
1400   finalize();
1401 }
1402
1403 //Children call this when they are first created or just migrated
1404 TCharm *ampiParent::registerAmpi(ampi *ptr,ampiCommStruct s,bool forMigration) noexcept
1405 {
1406   if (thread==NULL) prepareCtv(); //Prevents CkJustMigrated race condition
1407
1408   if (s.getComm()>=MPI_COMM_WORLD)
1409   { //We now have our COMM_WORLD-- register it
1410     //Note that split communicators don't keep a raw pointer, so
1411     //they don't need to re-register on migration.
1412     if (worldPtr!=NULL) CkAbort("One ampiParent has two MPI_COMM_WORLDs");
1413     worldPtr=ptr;
1414     worldStruct=s;
1415   }
1416
1417   if (forMigration) { //Restore AmpiRequest*'s in postedReqs:
1418     AmmEntry<AmpiRequest *> *e = ptr->postedReqs.first;
1419     while (e) {
1420       // AmmPupPostedReqs() packed these as MPI_Requests
1421       MPI_Request reqIdx = (MPI_Request)(intptr_t)e->msg;
1422       CkAssert(reqIdx != MPI_REQUEST_NULL);
1423       AmpiRequest* req = ampiReqs[reqIdx];
1424       CkAssert(req);
1425       e->msg = req;
1426       e = e->next;
1427     }
1428   }
1429   else { //Register the new communicator:
1430     MPI_Comm comm = s.getComm();
1431     STARTUP_DEBUG("ampiParent> registering new communicator "<<comm)
1432     if (comm>=MPI_COMM_WORLD) {
1433       // Pass the new ampi to the waiting ampiInit
1434       thread->semaPut(AMPI_TCHARM_SEMAID, ptr);
1435     } else if (isSplit(comm)) {
1436       splitChildRegister(s);
1437     } else if (isGroup(comm)) {
1438       groupChildRegister(s);
1439     } else if (isCart(comm)) {
1440       cartChildRegister(s);
1441     } else if (isGraph(comm)) {
1442       graphChildRegister(s);
1443     } else if (isDistGraph(comm)) {
1444       distGraphChildRegister(s);
1445     } else if (isInter(comm)) {
1446       interChildRegister(s);
1447     } else if (isIntra(comm)) {
1448       intraChildRegister(s);
1449     }else
1450       CkAbort("ampiParent received child with bad communicator");
1451   }
1452
1453   return thread;
1454 }
1455
1456 // reduction client data - preparation for checkpointing
1457 class ckptClientStruct {
1458  public:
1459   const char *dname;
1460   ampiParent *ampiPtr;
1461   ckptClientStruct(const char *s, ampiParent *a) noexcept : dname(s), ampiPtr(a) {}
1462 };
1463
1464 static void checkpointClient(void *param,void *msg) noexcept
1465 {
1466   ckptClientStruct *client = (ckptClientStruct*)param;
1467   const char *dname = client->dname;
1468   ampiParent *ampiPtr = client->ampiPtr;
1469   ampiPtr->Checkpoint(strlen(dname), dname);
1470   delete client;
1471 }
1472
1473 void ampiParent::startCheckpoint(const char* dname) noexcept {
1474   if (thisIndex==0) {
1475     ckptClientStruct *clientData = new ckptClientStruct(dname, this);
1476     CkCallback *cb = new CkCallback(checkpointClient, clientData);
1477     thisProxy.ckSetReductionClient(cb);
1478   }
1479   contribute();
1480
1481   thread->stop();
1482
1483 #if CMK_BIGSIM_CHARM
1484   TRACE_BG_ADD_TAG("CHECKPOINT_RESUME");
1485 #endif
1486 }
1487
1488 void ampiParent::Checkpoint(int len, const char* dname) noexcept {
1489   if (len == 0) {
1490     // memory checkpoint
1491     CkCallback cb(CkIndex_ampiParent::ResumeThread(),thisArrayID);
1492     CkStartMemCheckpoint(cb);
1493   }
1494   else {
1495     char dirname[256];
1496     strncpy(dirname,dname,len);
1497     dirname[len]='\0';
1498     CkCallback cb(CkIndex_ampiParent::ResumeThread(),thisArrayID);
1499     CkStartCheckpoint(dirname,cb);
1500   }
1501 }
1502
1503 void ampiParent::ResumeThread() noexcept {
1504   thread->resume();
1505 }
1506
1507 int ampiParent::createKeyval(MPI_Comm_copy_attr_function *copy_fn, MPI_Comm_delete_attr_function *delete_fn,
1508                              int *keyval, void* extra_state) noexcept {
1509   KeyvalNode* newnode = new KeyvalNode(copy_fn, delete_fn, extra_state);
1510   int idx = kvlist.size();
1511   kvlist.resize(idx+1);
1512   kvlist[idx] = newnode;
1513   *keyval = idx;
1514   return 0;
1515 }
1516
1517 int ampiParent::setUserKeyval(int context, int keyval, void *attribute_val) noexcept {
1518 #if AMPI_ERROR_CHECKING
1519   if (keyval < 0 || keyval >= kvlist.size() || kvlist[keyval] == NULL) {
1520     return MPI_ERR_KEYVAL;
1521   }
1522 #endif
1523   KeyvalNode &kv = *kvlist[keyval];
1524   if (kv.hasVal()) {
1525     int ret = (*kv.delete_fn)(context, keyval, kv.val, kv.extra_state);
1526     if (ret != MPI_SUCCESS) {
1527       return ret;
1528     }
1529   }
1530   kvlist[keyval]->setVal(attribute_val);
1531   return MPI_SUCCESS;
1532 }
1533
1534 int ampiParent::setAttr(int context, vector<int>& keyvals, int keyval, void* attribute_val) noexcept {
1535   if (kv_set_builtin(keyval, attribute_val)) {
1536     return MPI_SUCCESS;
1537   }
1538   keyvals.push_back(keyval);
1539   kvlist[keyval]->incRefCount();
1540   return setUserKeyval(context, keyval, attribute_val);
1541 }
1542
1543 bool ampiParent::kv_set_builtin(int keyval, void* attribute_val) noexcept {
1544   switch(keyval) {
1545     case MPI_TAG_UB:            /*immutable*/ return false;
1546     case MPI_HOST:              /*immutable*/ return false;
1547     case MPI_IO:                /*immutable*/ return false;
1548     case MPI_WTIME_IS_GLOBAL:   /*immutable*/ return false;
1549     case MPI_APPNUM:            /*immutable*/ return false;
1550     case MPI_LASTUSEDCODE:      /*immutable*/ return false;
1551     case MPI_UNIVERSE_SIZE:     (CkpvAccess(bikvs).universe_size)     = *((int*)attribute_val);      return true;
1552     case MPI_WIN_BASE:          (CkpvAccess(bikvs).win_base)          = attribute_val;               return true;
1553     case MPI_WIN_SIZE:          (CkpvAccess(bikvs).win_size)          = *((MPI_Aint*)attribute_val); return true;
1554     case MPI_WIN_DISP_UNIT:     (CkpvAccess(bikvs).win_disp_unit)     = *((int*)attribute_val);      return true;
1555     case MPI_WIN_CREATE_FLAVOR: (CkpvAccess(bikvs).win_create_flavor) = *((int*)attribute_val);      return true;
1556     case MPI_WIN_MODEL:         (CkpvAccess(bikvs).win_model)         = *((int*)attribute_val);      return true;
1557     case AMPI_MY_WTH:           /*immutable*/ return false;
1558     case AMPI_NUM_WTHS:         /*immutable*/ return false;
1559     case AMPI_MY_PROCESS:       /*immutable*/ return false;
1560     case AMPI_NUM_PROCESSES:    /*immutable*/ return false;
1561     default: return false;
1562   };
1563 }
1564
1565 bool ampiParent::kv_get_builtin(int keyval) noexcept {
1566   switch(keyval) {
1567     case MPI_TAG_UB:            kv_builtin_storage = &(CkpvAccess(bikvs).tag_ub);             return true;
1568     case MPI_HOST:              kv_builtin_storage = &(CkpvAccess(bikvs).host);               return true;
1569     case MPI_IO:                kv_builtin_storage = &(CkpvAccess(bikvs).io);                 return true;
1570     case MPI_WTIME_IS_GLOBAL:   kv_builtin_storage = &(CkpvAccess(bikvs).wtime_is_global);    return true;
1571     case MPI_APPNUM:            kv_builtin_storage = &(CkpvAccess(bikvs).appnum);             return true;
1572     case MPI_LASTUSEDCODE:      kv_builtin_storage = &(CkpvAccess(bikvs).lastusedcode);       return true;
1573     case MPI_UNIVERSE_SIZE:     kv_builtin_storage = &(CkpvAccess(bikvs).universe_size);      return true;
1574     case MPI_WIN_BASE:          win_base_storage   = &(CkpvAccess(bikvs).win_base);           return true;
1575     case MPI_WIN_SIZE:          win_size_storage   = &(CkpvAccess(bikvs).win_size);           return true;
1576     case MPI_WIN_DISP_UNIT:     kv_builtin_storage = &(CkpvAccess(bikvs).win_disp_unit);      return true;
1577     case MPI_WIN_CREATE_FLAVOR: kv_builtin_storage = &(CkpvAccess(bikvs).win_create_flavor);  return true;
1578     case MPI_WIN_MODEL:         kv_builtin_storage = &(CkpvAccess(bikvs).win_model);          return true;
1579     default: return false;
1580   };
1581 }
1582
1583 bool ampiParent::getBuiltinKeyval(int keyval, void *attribute_val) noexcept {
1584   if (kv_get_builtin(keyval)){
1585     /* All builtin keyvals are ints except MPI_WIN_BASE, which is a pointer
1586      * to the window's base address in C but an integer representation of
1587      * the base address in Fortran.
1588      * Also, MPI_WIN_SIZE is an MPI_Aint. */
1589     if (keyval == MPI_WIN_BASE)
1590       *((void**)attribute_val) = *win_base_storage;
1591     else if (keyval == MPI_WIN_SIZE)
1592       *(MPI_Aint**)attribute_val = win_size_storage;
1593     else
1594       *(int **)attribute_val = kv_builtin_storage;
1595     return true;
1596   } else {
1597     switch(keyval) {
1598       case AMPI_MY_WTH: *(int *)attribute_val = CkMyPe(); return true;
1599       case AMPI_NUM_WTHS: *(int *)attribute_val = CkNumPes(); return true;
1600       case AMPI_MY_PROCESS: *(int *)attribute_val = CkMyNode(); return true;
1601       case AMPI_NUM_PROCESSES: *(int *)attribute_val = CkNumNodes(); return true;
1602     }
1603   }
1604   return false;
1605 }
1606
1607 // Call copy_fn for each user-defined keyval in old_comm.
1608 int ampiParent::dupUserKeyvals(MPI_Comm old_comm, MPI_Comm new_comm) noexcept {
1609   ampiCommStruct &old_cs = *(ampiCommStruct *)&comm2CommStruct(old_comm);
1610   for (int i=0; i<old_cs.getKeyvals().size(); i++) {
1611     int keyval = old_cs.getKeyvals()[i];
1612     void *val_out;
1613     int flag = 0;
1614     bool isValid = (keyval != MPI_KEYVAL_INVALID && kvlist[keyval] != NULL);
1615     if (isValid) {
1616       // Call the user's copy_fn
1617       KeyvalNode& kv = *kvlist[keyval];
1618       int ret = (*kv.copy_fn)(old_comm, keyval, kv.extra_state, kv.val, &val_out, &flag);
1619       if (ret != MPI_SUCCESS) {
1620         return ret;
1621       }
1622       if (flag == 1) {
1623         // Set keyval in new_comm
1624         ampiCommStruct &cs = *(ampiCommStruct *)&comm2CommStruct(new_comm);
1625         cs.getKeyvals().push_back(keyval);
1626         kv.incRefCount();
1627       }
1628     }
1629   }
1630   return MPI_SUCCESS;
1631 }
1632
1633 int ampiParent::freeUserKeyval(int context, vector<int>& keyvals, int* keyval) noexcept {
1634   if (*keyval < 0 || *keyval >= kvlist.size()) {
1635     return MPI_SUCCESS;
1636   }
1637   // Call the user's delete_fn
1638   KeyvalNode& kv = *kvlist[*keyval];
1639   int ret = (*kv.delete_fn)(context, *keyval, kv.val, kv.extra_state);
1640   if (ret != MPI_SUCCESS) {
1641     return ret;
1642   }
1643   // Remove keyval from comm/win/type keyvals list
1644   kv.clearVal();
1645   for (int i=0; i<keyvals.size(); i++) {
1646     if (keyvals[i] == *keyval) {
1647       keyvals[*keyval] = MPI_KEYVAL_INVALID;
1648     }
1649   }
1650   if (!keyvals.empty()) {
1651     while (keyvals.back() == MPI_KEYVAL_INVALID) keyvals.pop_back();
1652   }
1653   // Remove keyval from parent kvlist if no remaining references to it
1654   if (kv.decRefCount() == 0) {
1655     delete kvlist[*keyval];
1656     kvlist[*keyval] = NULL;
1657   }
1658   *keyval = MPI_KEYVAL_INVALID;
1659   return MPI_SUCCESS;
1660 }
1661
1662 int ampiParent::freeUserKeyvals(int context, vector<int>& keyvals) noexcept {
1663   for (int i=0; i<keyvals.size(); i++) {
1664     int keyval = keyvals[i];
1665     // Call the user's delete_fn
1666     KeyvalNode& kv = *kvlist[keyval];
1667     int ret = (*kv.delete_fn)(context, keyval, kv.val, kv.extra_state);
1668     if (ret != MPI_SUCCESS) {
1669       return ret;
1670     }
1671     kv.clearVal();
1672     keyvals[i] = MPI_KEYVAL_INVALID;
1673     // Remove keyval from parent kvlist if no remaining references to it
1674     if (kv.decRefCount() == 0) {
1675       delete kvlist[keyval];
1676       kvlist[keyval] = NULL;
1677     }
1678   }
1679   keyvals.clear();
1680   return MPI_SUCCESS;
1681 }
1682
1683 bool ampiParent::getUserKeyval(MPI_Comm comm, vector<int>& keyvals, int keyval, void *attribute_val, int *flag) noexcept {
1684   if (keyval < 0 || keyval >= kvlist.size() || kvlist[keyval] == NULL) {
1685     *flag = 0;
1686     return false;
1687   }
1688   else {
1689     for (int i=0; i<keyvals.size(); i++) {
1690       int kv = keyvals[i];
1691       if (keyval == kv) { // Found a matching keyval
1692         *(void **)attribute_val = kvlist[keyval]->getVal();
1693         *flag = 1;
1694         return true;
1695       }
1696     }
1697     *flag = 0;
1698     return false;
1699   }
1700 }
1701
1702 int ampiParent::getAttr(int context, vector<int>& keyvals, int keyval, void *attribute_val, int *flag) noexcept {
1703   if (keyval == MPI_KEYVAL_INVALID) {
1704     *flag = 0;
1705     return MPI_ERR_KEYVAL;
1706   }
1707   else if (getBuiltinKeyval(keyval, attribute_val)) {
1708     *flag = 1;
1709     return MPI_SUCCESS;
1710   }
1711   else if (getUserKeyval(context, keyvals, keyval, attribute_val, flag)) {
1712     *flag = 1;
1713     return MPI_SUCCESS;
1714   }
1715   else {
1716     *flag = 0;
1717     return MPI_SUCCESS;
1718   }
1719 }
1720
1721 int ampiParent::deleteAttr(int context, vector<int>& keyvals, int keyval) noexcept {
1722   return freeUserKeyval(context, keyvals, &keyval);
1723 }
1724
1725 /*
1726  * AMPI Message Matching (Amm) queues:
1727  *   AmpiMsg*'s and AmpiRequest*'s are matched based on 2 ints: [tag, src].
1728  */
1729 template class Amm<AmpiMsg *>;
1730 template class Amm<AmpiRequest *>;
1731
1732 /* free all table entries but not the space pointed to by 'msg' */
1733 template<typename T>
1734 void Amm<T>::freeAll() noexcept
1735 {
1736   AmmEntry<T>* cur = first;
1737   while (cur) {
1738     AmmEntry<T>* toDel = cur;
1739     cur = cur->next;
1740     deleteEntry(toDel);
1741   }
1742 }
1743
1744 /* free all msgs */
1745 template<typename T>
1746 void Amm<T>::flushMsgs() noexcept
1747 {
1748   T msg = get(MPI_ANY_TAG, MPI_ANY_SOURCE);
1749   while (msg) {
1750     delete msg;
1751     msg = get(MPI_ANY_TAG, MPI_ANY_SOURCE);
1752   }
1753 }
1754
1755 template<typename T>
1756 void Amm<T>::put(T msg) noexcept
1757 {
1758   AmmEntry<T>* e = newEntry(msg);
1759   *lasth = e;
1760   lasth = &e->next;
1761 }
1762
1763 template<typename T>
1764 void Amm<T>::put(int tag, int src, T msg) noexcept
1765 {
1766   AmmEntry<T>* e = newEntry(tag, src, msg);
1767   *lasth = e;
1768   lasth = &e->next;
1769 }
1770
1771 template<typename T>
1772 bool Amm<T>::match(const int tags1[AMM_NTAGS], const int tags2[AMM_NTAGS]) const noexcept
1773 {
1774   if (tags1[AMM_TAG]==tags2[AMM_TAG] && tags1[AMM_SRC]==tags2[AMM_SRC]) {
1775     // tag and src match
1776     return true;
1777   }
1778   else if (tags1[AMM_TAG]==tags2[AMM_TAG] && (tags1[AMM_SRC]==MPI_ANY_SOURCE || tags2[AMM_SRC]==MPI_ANY_SOURCE)) {
1779     // tag matches, src is MPI_ANY_SOURCE
1780     return true;
1781   }
1782   else if (tags1[AMM_SRC]==tags2[AMM_SRC] && (tags1[AMM_TAG]==MPI_ANY_TAG || tags2[AMM_TAG]==MPI_ANY_TAG)) {
1783     // src matches, tag is MPI_ANY_TAG
1784     return true;
1785   }
1786   else if ((tags1[AMM_SRC]==MPI_ANY_SOURCE || tags2[AMM_SRC]==MPI_ANY_SOURCE) && (tags1[AMM_TAG]==MPI_ANY_TAG || tags2[AMM_TAG]==MPI_ANY_TAG)) {
1787     // src and tag are MPI_ANY
1788     return true;
1789   }
1790   else {
1791     // no match
1792     return false;
1793   }
1794 }
1795
1796 template<typename T>
1797 T Amm<T>::get(int tag, int src, int* rtags) noexcept
1798 {
1799   AmmEntry<T> *ent, **enth;
1800   T msg;
1801   int tags[AMM_NTAGS] = { tag, src };
1802
1803   enth = &first;
1804   while (true) {
1805     ent = *enth;
1806     if (!ent) return NULL;
1807     if (match(tags, ent->tags)) {
1808       if (rtags) memcpy(rtags, ent->tags, sizeof(int)*AMM_NTAGS);
1809       msg = ent->msg;
1810       // unlike probe, delete the matched entry:
1811       AmmEntry<T>* next = ent->next;
1812       *enth = next;
1813       if (!next) lasth = enth;
1814       deleteEntry(ent);
1815       return msg;
1816     }
1817     enth = &ent->next;
1818   }
1819 }
1820
1821 template<typename T>
1822 T Amm<T>::probe(int tag, int src, int* rtags) noexcept
1823 {
1824   AmmEntry<T> *ent, **enth;
1825   T msg;
1826   int tags[AMM_NTAGS] = { tag, src };
1827   CkAssert(rtags);
1828
1829   enth = &first;
1830   while (true) {
1831     ent = *enth;
1832     if (!ent) return NULL;
1833     if (match(tags, ent->tags)) {
1834       memcpy(rtags, ent->tags, sizeof(int)*AMM_NTAGS);
1835       msg = ent->msg;
1836       return msg;
1837     }
1838     enth = &ent->next;
1839   }
1840 }
1841
1842 template<typename T>
1843 int Amm<T>::size() const noexcept
1844 {
1845   int n = 0;
1846   AmmEntry<T> *e = first;
1847   while (e) {
1848     e = e->next;
1849     n++;
1850   }
1851   return n;
1852 }
1853
1854 template<typename T>
1855 void Amm<T>::pup(PUP::er& p, AmmPupMessageFn msgpup) noexcept
1856 {
1857   int sz;
1858   if (!p.isUnpacking()) {
1859     sz = size();
1860     p|sz;
1861     AmmEntry<T> *doomed, *e = first;
1862     while (e) {
1863       pup_ints(&p, e->tags, AMM_NTAGS);
1864       msgpup(p, (void**)&e->msg);
1865       doomed = e;
1866       e = e->next;
1867       if (p.isDeleting()) {
1868         deleteEntry(doomed);
1869       }
1870     }
1871   } else { // unpacking
1872     p|sz;
1873     for (int i=0; i<sz; i++) {
1874       T msg;
1875       int tags[AMM_NTAGS];
1876       pup_ints(&p, tags, AMM_NTAGS);
1877       msgpup(p, (void**)&msg);
1878       put(tags[0], tags[1], msg);
1879     }
1880   }
1881 }
1882
1883 //----------------------- ampi -------------------------
1884 void ampi::init() noexcept {
1885   parent=NULL;
1886   thread=NULL;
1887   blockingReq=NULL;
1888
1889 #if CMK_FAULT_EVAC
1890   AsyncEvacuate(false);
1891 #endif
1892 }
1893
1894 ampi::ampi() noexcept
1895 {
1896   /* this constructor only exists so we can create an empty array during split */
1897   CkAbort("Default ampi constructor should never be called");
1898 }
1899
1900 ampi::ampi(CkArrayID parent_,const ampiCommStruct &s) noexcept :parentProxy(parent_), oorder(s.getSize())
1901 {
1902   init();
1903
1904   myComm=s; myComm.setArrayID(thisArrayID);
1905   myRank=myComm.getRankForIndex(thisIndex);
1906
1907   findParent(false);
1908 }
1909
1910 ampi::ampi(CkMigrateMessage *msg) noexcept : CBase_ampi(msg)
1911 {
1912   init();
1913 }
1914
1915 void ampi::ckJustMigrated() noexcept
1916 {
1917   findParent(true);
1918   ArrayElement1D::ckJustMigrated();
1919 }
1920
1921 void ampi::ckJustRestored() noexcept
1922 {
1923   FUNCCALL_DEBUG(CkPrintf("Call just restored from ampi[%d]\n", thisIndex);)
1924   findParent(true);
1925   ArrayElement1D::ckJustRestored();
1926 }
1927
1928 void ampi::findParent(bool forMigration) noexcept {
1929   STARTUP_DEBUG("ampi> finding my parent")
1930   parent=parentProxy[thisIndex].ckLocal();
1931 #if CMK_ERROR_CHECKING
1932   if (parent==NULL) CkAbort("AMPI can't find its parent!");
1933 #endif
1934   thread=parent->registerAmpi(this,myComm,forMigration);
1935 #if CMK_ERROR_CHECKING
1936   if (thread==NULL) CkAbort("AMPI can't find its thread!");
1937 #endif
1938 }
1939
1940 //The following method should be called on the first element of the
1941 //ampi array
1942 void ampi::allInitDone() noexcept {
1943   FUNCCALL_DEBUG(CkPrintf("All mpi_init have been called!\n");)
1944   thisProxy.setInitDoneFlag();
1945 }
1946
1947 void ampi::setInitDoneFlag() noexcept {
1948   parent->ampiInitCallDone=1;
1949   parent->getTCharmThread()->start();
1950 }
1951
1952 static void AmmPupUnexpectedMsgs(PUP::er& p,void **msg) noexcept {
1953   CkPupMessage(p,msg,1);
1954   if (p.isDeleting()) delete (AmpiMsg *)*msg;
1955 }
1956
1957 static void AmmPupPostedReqs(PUP::er& p,void **msg) noexcept {
1958   // AmpiRequests objects are PUPed by AmpiRequestList, so here we pack
1959   // the reqIdx of posted requests and in ampiParent::registerAmpi we
1960   // lookup the AmpiRequest*'s using the indices. That is necessary because
1961   // the ampiParent object is unpacked after the ampi objects.
1962   if (p.isPacking()) {
1963     int reqIdx = ((AmpiRequest*)*msg)->getReqIdx();
1964     CkAssert(reqIdx != MPI_REQUEST_NULL);
1965     *msg = (void*)(intptr_t)reqIdx;
1966   }
1967   pup_pointer(&p, msg);
1968 #if CMK_ERROR_CHECKING
1969   if (p.isUnpacking()) {
1970     MPI_Request reqIdx = (MPI_Request)(intptr_t)*msg;
1971     CkAssert(reqIdx != MPI_REQUEST_NULL);
1972   }
1973 #endif
1974 }
1975
1976 void ampi::pup(PUP::er &p) noexcept
1977 {
1978   p|parentProxy;
1979   p|myComm;
1980   p|myRank;
1981   p|tmpVec;
1982   p|remoteProxy;
1983
1984   // pup blockingReq
1985   AmpiReqType reqType;
1986   if (!p.isUnpacking()) {
1987     if (blockingReq) {
1988       reqType = blockingReq->getType();
1989     } else {
1990       reqType = AMPI_INVALID_REQ;
1991     }
1992   }
1993   p|reqType;
1994   if (reqType != AMPI_INVALID_REQ) {
1995     if (p.isUnpacking()) {
1996       switch (reqType) {
1997         case AMPI_I_REQ:
1998           blockingReq = new IReq;
1999           break;
2000         case AMPI_REDN_REQ:
2001           blockingReq = new RednReq;
2002           break;
2003         case AMPI_GATHER_REQ:
2004           blockingReq = new GatherReq;
2005           break;
2006         case AMPI_GATHERV_REQ:
2007           blockingReq = new GathervReq;
2008           break;
2009         case AMPI_SEND_REQ:
2010           blockingReq = new SendReq;
2011           break;
2012         case AMPI_SSEND_REQ:
2013           blockingReq = new SsendReq;
2014           break;
2015         case AMPI_ATA_REQ:
2016           blockingReq = new ATAReq;
2017           break;
2018         case AMPI_G_REQ:
2019           blockingReq = new GReq;
2020           break;
2021         case AMPI_INVALID_REQ:
2022           CkAbort("AMPI> error trying to PUP an invalid request!");
2023           break;
2024       }
2025     }
2026     blockingReq->pup(p);
2027   } else {
2028     blockingReq = NULL;
2029   }
2030   if (p.isDeleting()) {
2031     delete blockingReq; blockingReq = NULL;
2032   }
2033
2034   unexpectedMsgs.pup(p, AmmPupUnexpectedMsgs);
2035   postedReqs.pup(p, AmmPupPostedReqs);
2036
2037   p|greq_classes;
2038
2039   p|oorder;
2040 }
2041
2042 ampi::~ampi() noexcept
2043 {
2044   if (CkInRestarting() || _BgOutOfCoreFlag==1) {
2045     // in restarting, we need to flush messages
2046     unexpectedMsgs.flushMsgs();
2047     postedReqs.freeAll();
2048   }
2049
2050   delete blockingReq; blockingReq = NULL;
2051 }
2052
2053 //------------------------ Communicator Splitting ---------------------
2054 class ampiSplitKey {
2055  public:
2056   int nextSplitComm;
2057   int color; //New class of processes we'll belong to
2058   int key; //To determine rank in new ordering
2059   int rank; //Rank in old ordering
2060   ampiSplitKey() noexcept {}
2061   ampiSplitKey(int nextSplitComm_,int color_,int key_,int rank_) noexcept
2062     :nextSplitComm(nextSplitComm_), color(color_), key(key_), rank(rank_) {}
2063 };
2064
2065 #define MPI_INTER 10
2066
2067 /* "type" may indicate whether call is for a cartesian topology etc. */
2068 void ampi::split(int color,int key,MPI_Comm *dest, int type) noexcept
2069 {
2070 #if CMK_BIGSIM_CHARM
2071   void *curLog; // store current log in timeline
2072   _TRACE_BG_TLINE_END(&curLog);
2073 #endif
2074   if (type == MPI_CART) {
2075     ampiSplitKey splitKey(parent->getNextCart(),color,key,myRank);
2076     int rootIdx=myComm.getIndexForRank(0);
2077     CkCallback cb(CkIndex_ampi::splitPhase1(0),CkArrayIndex1D(rootIdx),myComm.getProxy());
2078     contribute(sizeof(splitKey),&splitKey,CkReduction::concat,cb);
2079
2080     thread->suspend(); //Resumed by ampiParent::cartChildRegister
2081     MPI_Comm newComm=parent->getNextCart()-1;
2082     *dest=newComm;
2083   }
2084   else if (type == MPI_GRAPH) {
2085     ampiSplitKey splitKey(parent->getNextGraph(),color,key,myRank);
2086     int rootIdx=myComm.getIndexForRank(0);
2087     CkCallback cb(CkIndex_ampi::splitPhase1(0),CkArrayIndex1D(rootIdx),myComm.getProxy());
2088     contribute(sizeof(splitKey),&splitKey,CkReduction::concat,cb);
2089
2090     thread->suspend(); //Resumed by ampiParent::graphChildRegister
2091     MPI_Comm newComm=parent->getNextGraph()-1;
2092     *dest=newComm;
2093   }
2094   else if (type == MPI_INTER) {
2095     ampiSplitKey splitKey(parent->getNextInter(),color,key,myRank);
2096     int rootIdx=myComm.getIndexForRank(0);
2097     CkCallback cb(CkIndex_ampi::splitPhaseInter(0),CkArrayIndex1D(rootIdx),myComm.getProxy());
2098     contribute(sizeof(splitKey),&splitKey,CkReduction::concat,cb);
2099
2100     thread->suspend(); //Resumed by ampiParent::interChildRegister
2101     MPI_Comm newComm=parent->getNextInter()-1;
2102     *dest=newComm;
2103   }
2104   else {
2105     ampiSplitKey splitKey(parent->getNextSplit(),color,key,myRank);
2106     int rootIdx=myComm.getIndexForRank(0);
2107     CkCallback cb(CkIndex_ampi::splitPhase1(0),CkArrayIndex1D(rootIdx),myComm.getProxy());
2108     contribute(sizeof(splitKey),&splitKey,CkReduction::concat,cb);
2109
2110     thread->suspend(); //Resumed by ampiParent::splitChildRegister
2111     MPI_Comm newComm=parent->getNextSplit()-1;
2112     *dest=newComm;
2113   }
2114 #if CMK_BIGSIM_CHARM
2115   _TRACE_BG_SET_INFO(NULL, "SPLIT_RESUME", NULL, 0);
2116 #endif
2117 }
2118
2119 CDECL
2120 int compareAmpiSplitKey(const void *a_, const void *b_) {
2121   const ampiSplitKey *a=(const ampiSplitKey *)a_;
2122   const ampiSplitKey *b=(const ampiSplitKey *)b_;
2123   if (a->color!=b->color) return a->color-b->color;
2124   if (a->key!=b->key) return a->key-b->key;
2125   return a->rank-b->rank;
2126 }
2127
2128 // Caller needs to eventually call newAmpi.doneInserting()
2129 CProxy_ampi ampi::createNewChildAmpiSync() noexcept {
2130   CkArrayOptions opts;
2131   opts.bindTo(parentProxy);
2132   opts.setSectionAutoDelegate(false);
2133   opts.setNumInitial(0);
2134   CkArrayID unusedAID;
2135   ampiCommStruct unusedComm;
2136   CkCallback cb(CkCallback::resumeThread);
2137   CProxy_ampi::ckNew(unusedAID, unusedComm, opts, cb);
2138   CkArrayCreatedMsg *newAmpiMsg = static_cast<CkArrayCreatedMsg*>(cb.thread_delay());
2139   CProxy_ampi newAmpi = newAmpiMsg->aid;
2140   delete newAmpiMsg;
2141   return newAmpi;
2142 }
2143
2144 void ampi::splitPhase1(CkReductionMsg *msg) noexcept
2145 {
2146   //Order the keys, which orders the ranks properly:
2147   int nKeys=msg->getSize()/sizeof(ampiSplitKey);
2148   ampiSplitKey *keys=(ampiSplitKey *)msg->getData();
2149   if (nKeys!=myComm.getSize()) CkAbort("ampi::splitReduce expected a split contribution from every rank!");
2150   qsort(keys,nKeys,sizeof(ampiSplitKey),compareAmpiSplitKey);
2151
2152   MPI_Comm newComm = -1;
2153   for(int i=0;i<nKeys;i++){
2154     if(keys[i].nextSplitComm>newComm)
2155       newComm = keys[i].nextSplitComm;
2156   }
2157
2158   //Loop over the sorted keys, which gives us the new arrays:
2159   int lastColor=keys[0].color-1; //The color we're building an array for
2160   CProxy_ampi lastAmpi; //The array for lastColor
2161   int lastRoot=0; //C value for new rank 0 process for latest color
2162   ampiCommStruct lastComm; //Communicator info. for latest color
2163   for (int c=0;c<nKeys;c++) {
2164     if (keys[c].color!=lastColor)
2165     { //Hit a new color-- need to build a new communicator and array
2166       lastColor=keys[c].color;
2167       lastRoot=c;
2168
2169       if (c!=0) lastAmpi.doneInserting();
2170       lastAmpi = createNewChildAmpiSync();
2171
2172       vector<int> indices; //Maps rank to array indices for new array
2173       for (int i=c;i<nKeys;i++) {
2174         if (keys[i].color!=lastColor) break; //Done with this color
2175         int idx=myComm.getIndexForRank(keys[i].rank);
2176         indices.push_back(idx);
2177       }
2178
2179       //FIXME: create a new communicator for each color, instead of
2180       // (confusingly) re-using the same MPI_Comm number for each.
2181       lastComm=ampiCommStruct(newComm,lastAmpi,indices.size(),indices);
2182     }
2183     int newRank=c-lastRoot;
2184     int newIdx=lastComm.getIndexForRank(newRank);
2185
2186     lastAmpi[newIdx].insert(parentProxy,lastComm);
2187   }
2188   lastAmpi.doneInserting();
2189
2190   delete msg;
2191 }
2192
2193 void ampi::splitPhaseInter(CkReductionMsg *msg) noexcept
2194 {
2195   //Order the keys, which orders the ranks properly:
2196   int nKeys=msg->getSize()/sizeof(ampiSplitKey);
2197   ampiSplitKey *keys=(ampiSplitKey *)msg->getData();
2198   if (nKeys!=myComm.getSize()) CkAbort("ampi::splitReduce expected a split contribution from every rank!");
2199   qsort(keys,nKeys,sizeof(ampiSplitKey),compareAmpiSplitKey);
2200
2201   MPI_Comm newComm = -1;
2202   for(int i=0;i<nKeys;i++){
2203     if(keys[i].nextSplitComm>newComm)
2204       newComm = keys[i].nextSplitComm; // FIXME: use nextSplitr instead of nextInter?
2205   }
2206
2207   //Loop over the sorted keys, which gives us the new arrays:
2208   int lastColor=keys[0].color-1; //The color we're building an array for
2209   CProxy_ampi lastAmpi; //The array for lastColor
2210   int lastRoot=0; //C value for new rank 0 process for latest color
2211   ampiCommStruct lastComm; //Communicator info. for latest color
2212
2213   lastAmpi = createNewChildAmpiSync();
2214
2215   for (int c=0;c<nKeys;c++) {
2216     vector<int> indices; // Maps rank to array indices for new array
2217     if (keys[c].color!=lastColor)
2218     { //Hit a new color-- need to build a new communicator and array
2219       lastColor=keys[c].color;
2220       lastRoot=c;
2221
2222       for (int i=c;i<nKeys;i++) {
2223         if (keys[i].color!=lastColor) break; //Done with this color
2224         int idx=myComm.getIndexForRank(keys[i].rank);
2225         indices.push_back(idx);
2226       }
2227
2228       if (c==0) {
2229         lastComm=ampiCommStruct(newComm,lastAmpi,indices.size(),indices, myComm.getRemoteIndices());
2230         for (int i=0; i<indices.size(); i++) {
2231           lastAmpi[indices[i]].insert(parentProxy,lastComm);
2232         }
2233         lastAmpi.doneInserting();
2234       }
2235     }
2236   }
2237
2238   parentProxy[0].ExchangeProxy(lastAmpi);
2239   delete msg;
2240 }
2241
2242 //...newly created array elements register with the parent, which calls:
2243 void ampiParent::splitChildRegister(const ampiCommStruct &s) noexcept {
2244   int idx=s.getComm()-MPI_COMM_FIRST_SPLIT;
2245   if (splitComm.size()<=idx) splitComm.resize(idx+1);
2246   splitComm[idx]=new ampiCommStruct(s);
2247   thread->resume(); //Matches suspend at end of ampi::split
2248 }
2249
2250 //-----------------create communicator from group--------------
2251 // The procedure is like that of comm_split very much,
2252 // so the code is shamelessly copied from above
2253 //   1. reduction to make sure all members have called
2254 //   2. the root in the old communicator create the new array
2255 //   3. ampiParent::register is called to register new array as new comm
2256 class vecStruct {
2257  public:
2258   int nextgroup;
2259   groupStruct vec;
2260   vecStruct() noexcept : nextgroup(-1){}
2261   vecStruct(int nextgroup_, groupStruct vec_) noexcept
2262     : nextgroup(nextgroup_), vec(vec_) { }
2263 };
2264
2265 void ampi::commCreate(const groupStruct vec,MPI_Comm* newcomm) noexcept {
2266   int rootIdx=vec[0];
2267   tmpVec = vec;
2268   CkCallback cb(CkReductionTarget(ampi,commCreatePhase1),CkArrayIndex1D(rootIdx),myComm.getProxy());
2269   MPI_Comm nextgroup = parent->getNextGroup();
2270   contribute(sizeof(nextgroup), &nextgroup,CkReduction::max_int,cb);
2271
2272   if(getPosOp(thisIndex,vec)>=0){
2273     thread->suspend(); //Resumed by ampiParent::groupChildRegister
2274     MPI_Comm retcomm = parent->getNextGroup()-1;
2275     *newcomm = retcomm;
2276   }else{
2277     *newcomm = MPI_COMM_NULL;
2278   }
2279 }
2280
2281 void ampi::insertNewChildAmpiElements(MPI_Comm nextComm, CProxy_ampi newAmpi) noexcept {
2282   ampiCommStruct newCommStruct = ampiCommStruct(nextComm, newAmpi, tmpVec.size(), tmpVec);
2283   for (int i = 0; i < tmpVec.size(); ++i)
2284     newAmpi[tmpVec[i]].insert(parentProxy, newCommStruct);
2285   newAmpi.doneInserting();
2286 }
2287
2288 void ampi::commCreatePhase1(MPI_Comm nextGroupComm) noexcept {
2289   CProxy_ampi newAmpi = createNewChildAmpiSync();
2290   insertNewChildAmpiElements(nextGroupComm, newAmpi);
2291 }
2292
2293 void ampiParent::groupChildRegister(const ampiCommStruct &s) noexcept {
2294   int idx=s.getComm()-MPI_COMM_FIRST_GROUP;
2295   if (groupComm.size()<=idx) groupComm.resize(idx+1);
2296   groupComm[idx]=new ampiCommStruct(s);
2297   thread->resume(); //Matches suspend at end of ampi::split
2298 }
2299
2300 /* Virtual topology communicator creation */
2301
2302 // 0-dimensional cart comm: rank 0 creates a dup of COMM_SELF with topo info.
2303 MPI_Comm ampi::cartCreate0D() noexcept {
2304   if (getRank() == 0) {
2305     tmpVec.clear();
2306     tmpVec.push_back(0);
2307     commCreatePhase1(parent->getNextCart());
2308     MPI_Comm newComm = parent->getNextCart()-1;
2309     ampiCommStruct &newCommStruct = getAmpiParent()->getCart(newComm);
2310     ampiTopology *newTopo = newCommStruct.getTopology();
2311     newTopo->setndims(0);
2312     return newComm;
2313   }
2314   else {
2315     return MPI_COMM_NULL;
2316   }
2317 }
2318
2319 MPI_Comm ampi::cartCreate(groupStruct vec, int ndims, const int* dims) noexcept {
2320   if (ndims == 0) {
2321     return cartCreate0D();
2322   }
2323
2324   // Subtract out ranks from the group that won't be in the new comm
2325   int newsize = dims[0];
2326   for (int i = 1; i < ndims; i++) {
2327     newsize *= dims[i];
2328   }
2329   for (int i = vec.size(); i > newsize; i--) {
2330     vec.pop_back();
2331   }
2332
2333   int rootIdx = vec[0];
2334   tmpVec = vec;
2335   CkCallback cb(CkReductionTarget(ampi,commCreatePhase1),CkArrayIndex1D(rootIdx),myComm.getProxy());
2336
2337   MPI_Comm nextcart = parent->getNextCart();
2338   contribute(sizeof(nextcart), &nextcart,CkReduction::max_int,cb);
2339
2340   if (getPosOp(thisIndex,vec)>=0) {
2341     thread->suspend(); //Resumed by ampiParent::cartChildRegister
2342     return parent->getNextCart()-1;
2343   } else {
2344     return MPI_COMM_NULL;
2345   }
2346 }
2347
2348 void ampiParent::cartChildRegister(const ampiCommStruct &s) noexcept {
2349   int idx=s.getComm()-MPI_COMM_FIRST_CART;
2350   if (cartComm.size()<=idx) {
2351     cartComm.resize(idx+1);
2352     cartComm.length()=idx+1;
2353   }
2354   cartComm[idx]=new ampiCommStruct(s,MPI_CART);
2355   thread->resume(); //Matches suspend at end of ampi::cartCreate
2356 }
2357
2358 void ampi::graphCreate(const groupStruct vec,MPI_Comm* newcomm) noexcept {
2359   int rootIdx=vec[0];
2360   tmpVec = vec;
2361   CkCallback cb(CkReductionTarget(ampi,commCreatePhase1),CkArrayIndex1D(rootIdx),
2362       myComm.getProxy());
2363   MPI_Comm nextgraph = parent->getNextGraph();
2364   contribute(sizeof(nextgraph), &nextgraph,CkReduction::max_int,cb);
2365
2366   if(getPosOp(thisIndex,vec)>=0){
2367     thread->suspend(); //Resumed by ampiParent::graphChildRegister
2368     MPI_Comm retcomm = parent->getNextGraph()-1;
2369     *newcomm = retcomm;
2370   }else
2371     *newcomm = MPI_COMM_NULL;
2372 }
2373
2374 void ampiParent::graphChildRegister(const ampiCommStruct &s) noexcept {
2375   int idx=s.getComm()-MPI_COMM_FIRST_GRAPH;
2376   if (graphComm.size()<=idx) {
2377     graphComm.resize(idx+1);
2378     graphComm.length()=idx+1;
2379   }
2380   graphComm[idx]=new ampiCommStruct(s,MPI_GRAPH);
2381   thread->resume(); //Matches suspend at end of ampi::graphCreate
2382 }
2383
2384 void ampi::distGraphCreate(const groupStruct vec, MPI_Comm* newcomm) noexcept
2385 {
2386   int rootIdx = vec[0];
2387   tmpVec = vec;
2388   CkCallback cb(CkReductionTarget(ampi,commCreatePhase1), CkArrayIndex1D(rootIdx), myComm.getProxy());
2389   MPI_Comm nextDistGraph = parent->getNextDistGraph();
2390   contribute(sizeof(nextDistGraph), &nextDistGraph, CkReduction::max_int, cb);
2391
2392   if (getPosOp(thisIndex,vec) >= 0) {
2393     thread->suspend();
2394     MPI_Comm retcomm = parent->getNextDistGraph()-1;
2395     *newcomm = retcomm;
2396   }
2397   else {
2398     *newcomm = MPI_COMM_NULL;
2399   }
2400 }
2401
2402 void ampiParent::distGraphChildRegister(const ampiCommStruct &s) noexcept
2403 {
2404   int idx = s.getComm()-MPI_COMM_FIRST_DIST_GRAPH;
2405   if (distGraphComm.size() <= idx) {
2406     distGraphComm.resize(idx+1);
2407     distGraphComm.length() = idx+1;
2408   }
2409   distGraphComm[idx] = new ampiCommStruct(s,MPI_DIST_GRAPH);
2410   thread->resume();
2411 }
2412
2413 void ampi::intercommCreate(const groupStruct remoteVec, const int root, MPI_Comm tcomm, MPI_Comm *ncomm) noexcept {
2414   if (thisIndex==root) { // not everybody gets the valid rvec
2415     tmpVec = remoteVec;
2416   }
2417   CkCallback cb(CkReductionTarget(ampi, intercommCreatePhase1),CkArrayIndex1D(root),myComm.getProxy());
2418   MPI_Comm nextinter = parent->getNextInter();
2419   contribute(sizeof(nextinter), &nextinter,CkReduction::max_int,cb);
2420   thread->suspend(); //Not resumed by ampiParent::interChildRegister. Resumed by ExchangeProxy.
2421   *ncomm = parent->getNextInter()-1;
2422 }
2423
2424 void ampi::intercommCreatePhase1(MPI_Comm nextInterComm) noexcept {
2425
2426   CProxy_ampi newAmpi = createNewChildAmpiSync();
2427   groupStruct lgroup = myComm.getIndices();
2428   ampiCommStruct newCommstruct = ampiCommStruct(nextInterComm,newAmpi,lgroup.size(),lgroup,tmpVec);
2429   for(int i=0;i<lgroup.size();i++){
2430     int newIdx=lgroup[i];
2431     newAmpi[newIdx].insert(parentProxy,newCommstruct);
2432   }
2433   newAmpi.doneInserting();
2434
2435   parentProxy[0].ExchangeProxy(newAmpi);
2436 }
2437
2438 void ampiParent::interChildRegister(const ampiCommStruct &s) noexcept {
2439   int idx=s.getComm()-MPI_COMM_FIRST_INTER;
2440   if (interComm.size()<=idx) interComm.resize(idx+1);
2441   interComm[idx]=new ampiCommStruct(s);
2442   // don't resume the thread yet, till parent set remote proxy
2443 }
2444
2445 void ampi::intercommMerge(int first, MPI_Comm *ncomm) noexcept { // first valid only at local root
2446   if(myRank == 0 && first == 1){ // first (lower) group creates the intracommunicator for the higher group
2447     groupStruct lvec = myComm.getIndices();
2448     groupStruct rvec = myComm.getRemoteIndices();
2449     int rsize = rvec.size();
2450     tmpVec = lvec;
2451     for(int i=0;i<rsize;i++)
2452       tmpVec.push_back(rvec[i]);
2453     if(tmpVec.size()==0) CkAbort("Error in ampi::intercommMerge: merging empty comms!\n");
2454   }else{
2455     tmpVec.resize(0);
2456   }
2457
2458   int rootIdx=myComm.getIndexForRank(0);
2459   CkCallback cb(CkReductionTarget(ampi, intercommMergePhase1),CkArrayIndex1D(rootIdx),myComm.getProxy());
2460   MPI_Comm nextintra = parent->getNextIntra();
2461   contribute(sizeof(nextintra), &nextintra,CkReduction::max_int,cb);
2462
2463   thread->suspend(); //Resumed by ampiParent::interChildRegister
2464   MPI_Comm newcomm=parent->getNextIntra()-1;
2465   *ncomm=newcomm;
2466 }
2467
2468 void ampi::intercommMergePhase1(MPI_Comm nextIntraComm) noexcept {
2469   // gets called on two roots, first root creates the comm
2470   if(tmpVec.size()==0) return;
2471   CProxy_ampi newAmpi = createNewChildAmpiSync();
2472   insertNewChildAmpiElements(nextIntraComm, newAmpi);
2473 }
2474
2475 void ampiParent::intraChildRegister(const ampiCommStruct &s) noexcept {
2476   int idx=s.getComm()-MPI_COMM_FIRST_INTRA;
2477   if (intraComm.size()<=idx) intraComm.resize(idx+1);
2478   intraComm[idx]=new ampiCommStruct(s);
2479   thread->resume(); //Matches suspend at end of ampi::split
2480 }
2481
2482 void ampi::topoDup(int topoType, int rank, MPI_Comm comm, MPI_Comm *newComm) noexcept
2483 {
2484   if (getAmpiParent()->isInter(comm)) {
2485     split(0, rank, newComm, MPI_INTER);
2486   } else {
2487     split(0, rank, newComm, topoType);
2488
2489     if (topoType != MPI_UNDEFINED) {
2490       ampiTopology *topo, *newTopo;
2491       if (topoType == MPI_CART) {
2492         topo = getAmpiParent()->getCart(comm).getTopology();
2493         newTopo = getAmpiParent()->getCart(*newComm).getTopology();
2494       } else if (topoType == MPI_GRAPH) {
2495         topo = getAmpiParent()->getGraph(comm).getTopology();
2496         newTopo = getAmpiParent()->getGraph(*newComm).getTopology();
2497       } else {
2498         CkAssert(topoType == MPI_DIST_GRAPH);
2499         topo = getAmpiParent()->getDistGraph(comm).getTopology();
2500         newTopo = getAmpiParent()->getDistGraph(*newComm).getTopology();
2501       }
2502       newTopo->dup(topo);
2503     }
2504   }
2505 }
2506
2507 //------------------------ communication -----------------------
2508 const ampiCommStruct &universeComm2CommStruct(MPI_Comm universeNo) noexcept
2509 {
2510   if (universeNo>MPI_COMM_WORLD) {
2511     int worldDex=universeNo-MPI_COMM_WORLD-1;
2512     if (worldDex>=_mpi_nworlds)
2513       CkAbort("Bad world communicator passed to universeComm2CommStruct");
2514     return mpi_worlds[worldDex];
2515   }
2516   CkAbort("Bad communicator passed to universeComm2CommStruct");
2517   return mpi_worlds[0]; // meaningless return
2518 }
2519
2520 void ampiParent::block() noexcept {
2521   thread->suspend();
2522 }
2523
2524 void ampiParent::yield() noexcept {
2525   thread->schedule();
2526 }
2527
2528 void ampi::unblock() noexcept {
2529   thread->resume();
2530 }
2531
2532 ampiParent* ampiParent::blockOnRecv() noexcept {
2533   resumeOnRecv = true;
2534   // In case this thread is migrated while suspended,
2535   // save myComm to get the ampi instance back. Then
2536   // return "dis" in case the caller needs it.
2537   thread->suspend();
2538   ampiParent* dis = getAmpiParent();
2539   dis->resumeOnRecv = false;
2540   return dis;
2541 }
2542
2543 ampi* ampi::blockOnRecv() noexcept {
2544   parent->resumeOnRecv = true;
2545   // In case this thread is migrated while suspended,
2546   // save myComm to get the ampi instance back. Then
2547   // return "dis" in case the caller needs it.
2548   MPI_Comm comm = myComm.getComm();
2549   thread->suspend();
2550   ampi *dis = getAmpiInstance(comm);
2551   dis->parent->resumeOnRecv = false;
2552   return dis;
2553 }
2554
2555 ampi* ampi::blockOnColl() noexcept {
2556   parent->resumeOnColl = true;
2557   MPI_Comm comm = myComm.getComm();
2558   thread->suspend();
2559   ampi *dis = getAmpiInstance(comm);
2560   dis->parent->resumeOnColl = false;
2561   return dis;
2562 }
2563
2564 // block on (All)Reduce or (All)Gather(v)
2565 ampi* ampi::blockOnRedn(AmpiRequest *req) noexcept {
2566
2567   blockingReq = req;
2568
2569 #if CMK_BIGSIM_CHARM
2570   void *curLog; // store current log in timeline
2571   _TRACE_BG_TLINE_END(&curLog);
2572 #if CMK_TRACE_IN_CHARM
2573   if(CpvAccess(traceOn)) traceSuspend();
2574 #endif
2575 #endif
2576
2577   ampi* dis = blockOnColl();
2578
2579 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
2580   CpvAccess(_currentObj) = dis;
2581 #endif
2582 #if CMK_BIGSIM_CHARM
2583 #if CMK_TRACE_IN_CHARM
2584   if(CpvAccess(traceOn)) CthTraceResume(dis->thread->getThread());
2585 #endif
2586   TRACE_BG_AMPI_BREAK(dis->thread->getThread(), "RECV_RESUME", NULL, 0, 0);
2587   if (dis->blockingReq->eventPe == CkMyPe()) _TRACE_BG_ADD_BACKWARD_DEP(dis->blockingReq->event);
2588 #endif
2589
2590   delete dis->blockingReq; dis->blockingReq = NULL;
2591   return dis;
2592 }
2593
2594 void ampi::ssend_ack(int sreq_idx) noexcept {
2595   if (sreq_idx == 1)
2596     thread->resume();           // MPI_Ssend
2597   else {
2598     sreq_idx -= 2;              // start from 2
2599     AmpiRequestList& reqs = getReqs();
2600     AmpiRequest *sreq = reqs[sreq_idx];
2601     sreq->complete = true;
2602     handleBlockedReq(sreq);
2603     resumeThreadIfReady();
2604   }
2605 }
2606
2607 void ampi::generic(AmpiMsg* msg) noexcept
2608 {
2609   MSG_ORDER_DEBUG(
2610     CkPrintf("AMPI vp %d arrival: tag=%d, src=%d, comm=%d (seq %d) resumeOnRecv %d\n",
2611              thisIndex, msg->getTag(), msg->getSrcRank(), getComm(), msg->getSeq(), parent->resumeOnRecv);
2612   )
2613 #if CMK_BIGSIM_CHARM
2614   TRACE_BG_ADD_TAG("AMPI_generic");
2615   msg->event = NULL;
2616 #endif
2617
2618   if(msg->getSeq() != 0) {
2619     int seqIdx = msg->getSeqIdx();
2620     int n=oorder.put(seqIdx,msg);
2621     if (n>0) { // This message was in-order
2622       inorder(msg);
2623       if (n>1) { // It enables other, previously out-of-order messages
2624         while((msg=oorder.getOutOfOrder(seqIdx))!=0) {
2625           inorder(msg);
2626         }
2627       }
2628     }
2629   } else { //Cross-world or system messages are unordered
2630     inorder(msg);
2631   }
2632   // msg may be free'ed from calling inorder()
2633
2634   resumeThreadIfReady();
2635 }
2636
2637 inline static AmpiRequestList &getReqs() noexcept;
2638
2639 void AmpiRequestList::freeNonPersReq(int &idx) noexcept {
2640   ampiParent* pptr = getAmpiParent();
2641   if (!reqs[idx]->isPersistent()) {
2642     free(pptr->reqPool, idx, pptr->getDDT());
2643     idx = MPI_REQUEST_NULL;
2644   }
2645 }
2646
2647 void AmpiRequestList::free(AmpiRequestPool &reqPool, int idx, CkDDT *ddt) noexcept {
2648   if (idx < 0) return;
2649   reqs[idx]->free(ddt);
2650   reqPool.deleteAmpiRequest(reqs[idx]);
2651   reqs[idx] = NULL;
2652   startIdx = std::min(idx, startIdx);
2653 }
2654
2655 void ampi::inorder(AmpiMsg* msg) noexcept
2656 {
2657   MSG_ORDER_DEBUG(
2658     CkPrintf("AMPI vp %d inorder: tag=%d, src=%d, comm=%d (seq %d)\n",
2659              thisIndex, msg->getTag(), msg->getSrcRank(), getComm(), msg->getSeq());
2660   )
2661
2662 #if CMK_BIGSIM_CHARM
2663   _TRACE_BG_TLINE_END(&msg->event); // store current log
2664   msg->eventPe = CkMyPe();
2665 #endif
2666
2667   //Check posted recvs:
2668   int tag = msg->getTag();
2669   int srcRank = msg->getSrcRank();
2670   AmpiRequest* req = postedReqs.get(tag, srcRank);
2671   if (req) { // receive posted
2672     handleBlockedReq(req);
2673     req->receive(this, msg);
2674   } else {
2675     unexpectedMsgs.put(msg);
2676   }
2677 }
2678
2679 static inline AmpiMsg* rdma2AmpiMsg(char *buf, int size, CMK_REFNUM_TYPE seq, int tag, int srcRank,
2680                                     int ssendReq) noexcept
2681 {
2682   // Convert an Rdma message (parameter marshalled buffer) to an AmpiMsg
2683   AmpiMsg* msg = new (size, 0) AmpiMsg(seq, ssendReq, tag, srcRank, size);
2684   memcpy(msg->data, buf, size); // Assumes the buffer is contiguous
2685   return msg;
2686 }
2687
2688 // RDMA version of ampi::generic
2689 void ampi::genericRdma(char* buf, int size, CMK_REFNUM_TYPE seq, int tag, int srcRank, MPI_Comm destcomm, int ssendReq) noexcept
2690 {
2691   MSG_ORDER_DEBUG(
2692     CkPrintf("[%d] in ampi::genericRdma on index %d, size=%d, seq=%d, srcRank=%d, tag=%d, comm=%d, ssendReq=%d\n",
2693              CkMyPe(), getIndexForRank(getRank()), size, seq, srcRank, tag, destcomm, ssendReq);
2694   )
2695
2696   if (seq != 0) {
2697     int seqIdx = srcRank;
2698     int n = oorder.isInOrder(seqIdx, seq);
2699     if (n > 0) { // This message was in-order
2700       inorderRdma(buf, size, seq, tag, srcRank, destcomm, ssendReq);
2701       if (n > 1) { // It enables other, previously out-of-order messages
2702         AmpiMsg *msg = NULL;
2703         while ((msg = oorder.getOutOfOrder(seqIdx)) != 0) {
2704           inorder(msg);
2705         }
2706       }
2707     } else { // This message was out-of-order: stash it (as an AmpiMsg)
2708       AmpiMsg *msg = rdma2AmpiMsg(buf, size, seq, tag, srcRank, ssendReq);
2709       oorder.putOutOfOrder(seqIdx, msg);
2710     }
2711   } else { // Cross-world or system messages are unordered
2712     inorderRdma(buf, size, seq, tag, srcRank, destcomm, ssendReq);
2713   }
2714
2715   resumeThreadIfReady();
2716 }
2717
2718 // RDMA version of ampi::inorder
2719 void ampi::inorderRdma(char* buf, int size, CMK_REFNUM_TYPE seq, int tag, int srcRank,
2720                        MPI_Comm comm, int ssendReq) noexcept
2721 {
2722   MSG_ORDER_DEBUG(
2723     CkPrintf("AMPI vp %d inorderRdma: tag=%d, src=%d, comm=%d  (seq %d)\n",
2724              thisIndex, tag, srcRank, comm, seq);
2725   )
2726
2727   //Check posted recvs:
2728   AmpiRequest* req = postedReqs.get(tag, srcRank);
2729   if (req) { // receive posted
2730     handleBlockedReq(req);
2731     req->receiveRdma(this, buf, size, ssendReq, srcRank, comm);
2732   } else {
2733     AmpiMsg* msg = rdma2AmpiMsg(buf, size, seq, tag, srcRank, ssendReq);
2734     unexpectedMsgs.put(msg);
2735   }
2736 }
2737
2738 // Callback from ampi::genericRdma() signaling that the send buffer is now safe to re-use
2739 void ampi::completedRdmaSend(CkDataMsg *msg) noexcept
2740 {
2741   // refnum is the index into reqList for this SendReq
2742   int reqIdx = CkGetRefNum(msg);
2743
2744   MSG_ORDER_DEBUG(
2745     CkPrintf("[%d] in ampi::completedRdmaSend on index %d, reqIdx = %d\n",
2746              CkMyPe(), parent->thisIndex, reqIdx);
2747   )
2748
2749   AmpiRequestList& reqList = getReqs();
2750   AmpiRequest* sreq = reqList[reqIdx];
2751   sreq->complete = true;
2752
2753   handleBlockedReq(sreq);
2754   resumeThreadIfReady();
2755   // CkDataMsg is allocated & freed by the runtime, so do not delete msg
2756 }
2757
2758 void handle_MPI_BOTTOM(void* &buf, MPI_Datatype type) noexcept
2759 {
2760   if (buf == MPI_BOTTOM) {
2761     buf = (void*)getDDT()->getType(type)->getLB();
2762     getDDT()->getType(type)->setAbsolute(true);
2763   }
2764 }
2765
2766 void handle_MPI_BOTTOM(void* &buf1, MPI_Datatype type1, void* &buf2, MPI_Datatype type2) noexcept
2767 {
2768   if (buf1 == MPI_BOTTOM) {
2769     buf1 = (void*)getDDT()->getType(type1)->getLB();
2770     getDDT()->getType(type1)->setAbsolute(true);
2771   }
2772   if (buf2 == MPI_BOTTOM) {
2773     buf2 = (void*)getDDT()->getType(type2)->getLB();
2774     getDDT()->getType(type2)->setAbsolute(true);
2775   }
2776 }
2777
2778 AmpiMsg *ampi::makeBcastMsg(const void *buf,int count,MPI_Datatype type,MPI_Comm destcomm) noexcept
2779 {
2780   CkDDT_DataType *ddt = getDDT()->getType(type);
2781   int len = ddt->getSize(count);
2782   CMK_REFNUM_TYPE seq = getSeqNo(AMPI_COLL_DEST, destcomm, MPI_BCAST_TAG);
2783   // Do not use the msg pool for bcasts:
2784   AmpiMsg *msg = new (len, 0) AmpiMsg(seq, 0, MPI_BCAST_TAG, AMPI_COLL_DEST, len);
2785   ddt->serialize((char*)buf, msg->getData(), count, msg->getLength(), PACK);
2786   return msg;
2787 }
2788
2789 AmpiMsg *ampi::makeAmpiMsg(int destRank,int t,int sRank,const void *buf,int count,
2790                            MPI_Datatype type,MPI_Comm destcomm, int ssendReq/*=0*/) noexcept
2791 {
2792   CkDDT_DataType *ddt = getDDT()->getType(type);
2793   int len = ddt->getSize(count);
2794   CMK_REFNUM_TYPE seq = getSeqNo(destRank, destcomm, t);
2795   AmpiMsg *msg = CkpvAccess(msgPool).newAmpiMsg(seq, ssendReq, t, sRank, len);
2796   ddt->serialize((char*)buf, msg->getData(), count, msg->getLength(), PACK);
2797   return msg;
2798 }
2799
2800 MPI_Request ampi::send(int t, int sRank, const void* buf, int count, MPI_Datatype type,
2801                        int rank, MPI_Comm destcomm, int ssendReq/*=0*/, AmpiSendType sendType/*=BLOCKING_SEND*/) noexcept
2802 {
2803 #if CMK_TRACE_IN_CHARM
2804   TRACE_BG_AMPI_BREAK(thread->getThread(), "AMPI_SEND", NULL, 0, 1);
2805 #endif
2806
2807 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
2808   MPI_Comm disComm = myComm.getComm();
2809   ampi *dis = getAmpiInstance(disComm);
2810   CpvAccess(_currentObj) = dis;
2811 #endif
2812
2813   const ampiCommStruct &dest=comm2CommStruct(destcomm);
2814   MPI_Request req = delesend(t,sRank,buf,count,type,rank,destcomm,dest.getProxy(),ssendReq,sendType);
2815   if (sendType == BLOCKING_SEND && req != MPI_REQUEST_NULL) {
2816     AmpiRequestList& reqList = getReqs();
2817     AmpiRequest *sreq = reqList[req];
2818     sreq->wait(MPI_STATUS_IGNORE);
2819     reqList.free(parent->reqPool, req, parent->getDDT());
2820     req = MPI_REQUEST_NULL;
2821   }
2822
2823 #if CMK_TRACE_IN_CHARM
2824   TRACE_BG_AMPI_BREAK(thread->getThread(), "AMPI_SEND_END", NULL, 0, 1);
2825 #endif
2826
2827   if (ssendReq == 1) {
2828     // waiting for receiver side
2829     parent->resumeOnRecv = false;            // so no one else awakes it
2830     parent->block();
2831   }
2832
2833   return req;
2834 }
2835
2836 void ampi::sendraw(int t, int sRank, void* buf, int len, CkArrayID aid, int idx) noexcept
2837 {
2838   AmpiMsg *msg = new (len, 0) AmpiMsg(0, 0, t, sRank, len);
2839   memcpy(msg->getData(), buf, len);
2840   CProxy_ampi pa(aid);
2841   pa[idx].generic(msg);
2842 }
2843
2844 CMK_REFNUM_TYPE ampi::getSeqNo(int destRank, MPI_Comm destcomm, int tag) noexcept {
2845   int seqIdx = (destRank == AMPI_COLL_DEST) ? COLL_SEQ_IDX : destRank;
2846   CMK_REFNUM_TYPE seq = 0;
2847   if (destcomm<=MPI_COMM_WORLD && tag<=MPI_BCAST_TAG) { //Not cross-module: set seqno
2848     seq = oorder.nextOutgoing(seqIdx);
2849   }
2850   return seq;
2851 }
2852
2853 MPI_Request ampi::sendRdmaMsg(int t, int sRank, const void* buf, int size, MPI_Datatype type, int destIdx,
2854                               int destRank, MPI_Comm destcomm, CProxy_ampi arrProxy, int ssendReq) noexcept
2855 {
2856   CMK_REFNUM_TYPE seq = getSeqNo(destRank, destcomm, t);
2857
2858   if (ssendReq) { // Using a SsendReq to track matching receive, so no need for SendReq here
2859     arrProxy[destIdx].genericRdma(CkSendBuffer(buf), size, seq, t, sRank, destcomm, ssendReq);
2860     return MPI_REQUEST_NULL;
2861   }
2862   else { // Set up a SendReq to track completion of the send buffer
2863     MPI_Request req = postReq(parent->reqPool.newSendReq(type, destcomm, getDDT()));
2864     CkCallback completedSendCB(CkIndex_ampi::completedRdmaSend(NULL), thisProxy[thisIndex], true/*inline*/);
2865     completedSendCB.setRefnum(req);
2866
2867     arrProxy[destIdx].genericRdma(CkSendBuffer(buf, completedSendCB), size, seq, t, sRank, destcomm, ssendReq);
2868     return req;
2869   }
2870 }
2871
2872 // Call genericRdma inline on the local destination object
2873 MPI_Request ampi::sendLocalMsg(int t, int sRank, const void* buf, int size, MPI_Datatype type, int destRank,
2874                                MPI_Comm destcomm, ampi* destPtr, int ssendReq, AmpiSendType sendType) noexcept
2875 {
2876   CMK_REFNUM_TYPE seq = getSeqNo(destRank, destcomm, t);
2877
2878   destPtr->genericRdma((char*)buf, size, seq, t, sRank, destcomm, ssendReq);
2879
2880   if (ssendReq || sendType == BLOCKING_SEND) {
2881     return MPI_REQUEST_NULL;
2882   }
2883   else { // SendReq is pre-completed since we directly copied the send buffer
2884     return postReq(parent->reqPool.newSendReq(type, destcomm, getDDT(), AMPI_REQ_COMPLETED));
2885   }
2886 }
2887
2888 MPI_Request ampi::delesend(int t, int sRank, const void* buf, int count, MPI_Datatype type,
2889                            int rank, MPI_Comm destcomm, CProxy_ampi arrProxy, int ssendReq,
2890                            AmpiSendType sendType) noexcept
2891 {
2892   if (rank==MPI_PROC_NULL) return MPI_REQUEST_NULL;
2893   const ampiCommStruct &dest=comm2CommStruct(destcomm);
2894   int destIdx;
2895   if(isInter()){
2896     sRank = thisIndex;
2897     destIdx = dest.getIndexForRemoteRank(rank);
2898     arrProxy = remoteProxy;
2899   } else {
2900     destIdx = dest.getIndexForRank(rank);
2901   }
2902
2903   MSG_ORDER_DEBUG(
2904     CkPrintf("AMPI vp %d send: tag=%d, src=%d, comm=%d (to %d)\n",thisIndex,t,sRank,destcomm,destIdx);
2905   )
2906
2907   ampi *destPtr = arrProxy[destIdx].ckLocal();
2908   CkDDT_DataType *ddt = getDDT()->getType(type);
2909   int size = ddt->getSize(count);
2910   if (ddt->isContig()) {
2911 #if AMPI_LOCAL_IMPL
2912     if (destPtr != NULL) {
2913       return sendLocalMsg(t, sRank, buf, size, type, rank, destcomm, destPtr, ssendReq, sendType);
2914     }
2915 #endif
2916 #if AMPI_RDMA_IMPL
2917     if (size >= AMPI_RDMA_THRESHOLD ||
2918        (size >= AMPI_SMP_RDMA_THRESHOLD && destLikelyWithinProcess(arrProxy, destIdx)))
2919     {
2920       return sendRdmaMsg(t, sRank, buf, size, type, destIdx, rank, destcomm, arrProxy, ssendReq);
2921     }
2922 #endif
2923   }
2924 #if AMPI_LOCAL_IMPL
2925   if (destPtr != NULL) {
2926     destPtr->generic(makeAmpiMsg(rank, t, sRank, buf, count, type, destcomm, ssendReq));
2927     return MPI_REQUEST_NULL;
2928   } else
2929 #endif
2930   {
2931     arrProxy[destIdx].generic(makeAmpiMsg(rank, t, sRank, buf, count, type, destcomm, ssendReq));
2932     return MPI_REQUEST_NULL;
2933   }
2934 }
2935
2936 void ampi::processAmpiMsg(AmpiMsg *msg, const void* buf, MPI_Datatype type, int count) noexcept
2937 {
2938   int ssendReq = msg->getSsendReq();
2939   if (ssendReq > 0) { // send an ack to sender
2940     int srcRank = msg->getSrcRank();
2941     int srcIdx = getIndexForRank(srcRank);
2942     thisProxy[srcIdx].ssend_ack(ssendReq);
2943   }
2944
2945   CkDDT_DataType *ddt = getDDT()->getType(type);
2946
2947   ddt->serialize((char*)buf, msg->getData(), count, msg->getLength(), UNPACK);
2948 }
2949
2950 // RDMA version of ampi::processAmpiMsg
2951 void ampi::processRdmaMsg(const void *sbuf, int slength, int ssendReq, int srank, const void* rbuf,
2952                           int rcount, MPI_Datatype rtype, MPI_Comm comm) noexcept
2953 {
2954   if (ssendReq > 0) { // send an ack to sender
2955     int srcIdx = getIndexForRank(srank);
2956     thisProxy[srcIdx].ssend_ack(ssendReq);
2957   }
2958
2959   CkDDT_DataType *ddt = getDDT()->getType(rtype);
2960
2961   ddt->serialize((char*)rbuf, (char*)sbuf, rcount, slength, UNPACK);
2962 }
2963
2964 void ampi::processRednMsg(CkReductionMsg *msg, const void* buf, MPI_Datatype type, int count) noexcept
2965 {
2966   // The first sizeof(AmpiOpHeader) bytes in the redn msg data are reserved
2967   // for an AmpiOpHeader if our custom AmpiReducer type was used.
2968   int szhdr = (msg->getReducer() == AmpiReducer) ? sizeof(AmpiOpHeader) : 0;
2969   getDDT()->getType(type)->serialize((char*)buf, (char*)msg->getData()+szhdr, count, msg->getLength()-szhdr, UNPACK);
2970 }
2971
2972 void ampi::processNoncommutativeRednMsg(CkReductionMsg *msg, void* buf, MPI_Datatype type, int count, MPI_User_function* func) noexcept
2973 {
2974   CkReduction::tupleElement* results = NULL;
2975   int numReductions = 0;
2976   msg->toTuple(&results, &numReductions);
2977
2978   // Contributions are unordered and consist of a (srcRank, data) tuple
2979   CkReduction::setElement *currentSrc  = (CkReduction::setElement*)results[0].data;
2980   CkReduction::setElement *currentData = (CkReduction::setElement*)results[1].data;
2981   CkDDT_DataType *ddt  = getDDT()->getType(type);
2982   int contributionSize = ddt->getSize(count);
2983   int commSize = getSize();
2984
2985   // Store pointers to each contribution's data at index 'srcRank' in contributionData
2986   vector<void *> contributionData(commSize);
2987   for (int i=0; i<commSize; i++) {
2988     CkAssert(currentSrc && currentData);
2989     int srcRank = *((int*)currentSrc->data);
2990     CkAssert(currentData->dataSize == contributionSize);
2991     contributionData[srcRank] = currentData->data;
2992     currentSrc  = currentSrc->next();
2993     currentData = currentData->next();
2994   }
2995
2996   if (ddt->isContig()) {
2997     // Copy rank 0's contribution into buf first
2998     memcpy(buf, contributionData[0], contributionSize);
2999
3000     // Invoke the MPI_User_function on the contributions in 'rank' order
3001     for (int i=1; i<commSize; i++) {
3002       (*func)(contributionData[i], buf, &count, &type);
3003     }
3004   }
3005   else {
3006     // Deserialize rank 0's contribution into buf first
3007     ddt->serialize((char*)contributionData[0], (char*)buf, count, msg->getLength(), UNPACK);
3008
3009     // Invoke the MPI_User_function on the deserialized contributions in 'rank' order
3010     vector<char> deserializedBuf(ddt->getExtent() * count);
3011     for (int i=1; i<commSize; i++) {
3012       ddt->serialize((char*)contributionData[i], deserializedBuf.data(), count, msg->getLength(), UNPACK);
3013       (*func)(deserializedBuf.data(), buf, &count, &type);
3014     }
3015   }
3016   delete [] results;
3017 }
3018
3019 void ampi::processGatherMsg(CkReductionMsg *msg, const void* buf, MPI_Datatype type, int recvCount) noexcept
3020 {
3021   CkReduction::tupleElement* results = NULL;
3022   int numReductions = 0;
3023   msg->toTuple(&results, &numReductions);
3024
3025   // Re-order the gather data based on the rank of the contributor
3026   CkReduction::setElement *currentSrc  = (CkReduction::setElement*)results[0].data;
3027   CkReduction::setElement *currentData = (CkReduction::setElement*)results[1].data;
3028   CkDDT_DataType *ddt    = getDDT()->getType(type);
3029   int contributionSize   = ddt->getSize(recvCount);
3030   int contributionExtent = ddt->getExtent()*recvCount;
3031
3032   for (int i=0; i<getSize(); i++) {
3033     CkAssert(currentSrc && currentData);
3034     int srcRank = *((int*)currentSrc->data);
3035     CkAssert(currentData->dataSize == contributionSize);
3036     ddt->serialize(&(((char*)buf)[srcRank*contributionExtent]), currentData->data, recvCount, contributionSize, UNPACK);
3037     currentSrc  = currentSrc->next();
3038     currentData = currentData->next();
3039   }
3040   delete [] results;
3041 }
3042
3043 void ampi::processGathervMsg(CkReductionMsg *msg, const void* buf, MPI_Datatype type,
3044                              int* recvCounts, int* displs) noexcept
3045 {
3046   CkReduction::tupleElement* results = NULL;
3047   int numReductions = 0;
3048   msg->toTuple(&results, &numReductions);
3049
3050   // Re-order the gather data based on the rank of the contributor
3051   CkReduction::setElement *currentSrc  = (CkReduction::setElement*)results[0].data;
3052   CkReduction::setElement *currentData = (CkReduction::setElement*)results[1].data;
3053   CkDDT_DataType *ddt    = getDDT()->getType(type);
3054   int contributionSize   = ddt->getSize();
3055   int contributionExtent = ddt->getExtent();
3056
3057   for (int i=0; i<getSize(); i++) {
3058     CkAssert(currentSrc && currentData);
3059     int srcRank = *((int*)currentSrc->data);
3060     CkAssert(currentData->dataSize == contributionSize*recvCounts[srcRank]);
3061     ddt->serialize(&((char*)buf)[displs[srcRank]*contributionExtent], currentData->data, recvCounts[srcRank], contributionSize * recvCounts[srcRank], UNPACK);
3062     currentSrc  = currentSrc->next();
3063     currentData = currentData->next();
3064   }
3065   delete [] results;
3066 }
3067
3068 static inline void clearStatus(MPI_Status *sts) noexcept {
3069   if (sts != MPI_STATUS_IGNORE) {
3070     sts->MPI_TAG    = MPI_ANY_TAG;
3071     sts->MPI_SOURCE = MPI_ANY_SOURCE;
3072     sts->MPI_COMM   = MPI_COMM_NULL;
3073     sts->MPI_LENGTH = 0;
3074     sts->MPI_ERROR  = MPI_SUCCESS;
3075     sts->MPI_CANCEL = 0;
3076   }
3077 }
3078
3079 static inline void clearStatus(MPI_Status sts[], int idx) noexcept {
3080   if (sts != MPI_STATUSES_IGNORE) {
3081     clearStatus(&sts[idx]);
3082   }
3083 }
3084
3085 static inline bool handle_MPI_PROC_NULL(int src, MPI_Comm comm, MPI_Status* sts) noexcept
3086 {
3087   if (src == MPI_PROC_NULL) {
3088     clearStatus(sts);
3089     if (sts != MPI_STATUS_IGNORE) sts->MPI_SOURCE = MPI_PROC_NULL;
3090     return true;
3091   }
3092   return false;
3093 }
3094
3095 int ampi::recv(int t, int s, void* buf, int count, MPI_Datatype type, MPI_Comm comm, MPI_Status *sts) noexcept
3096 {
3097   MPI_Comm disComm = myComm.getComm();
3098   if (handle_MPI_PROC_NULL(s, disComm, sts)) return 0;
3099
3100 #if CMK_BIGSIM_CHARM
3101    void *curLog; // store current log in timeline
3102   _TRACE_BG_TLINE_END(&curLog);
3103 #if CMK_TRACE_IN_CHARM
3104   if(CpvAccess(traceOn)) traceSuspend();
3105 #endif
3106 #endif
3107
3108   if (isInter()) {
3109     s = myComm.getIndexForRemoteRank(s);
3110   }
3111
3112   MSG_ORDER_DEBUG(
3113     CkPrintf("AMPI vp %d blocking recv: tag=%d, src=%d, comm=%d\n",thisIndex,t,s,comm);
3114   )
3115
3116   ampi *dis = getAmpiInstance(disComm);
3117   MPI_Status tmpStatus;
3118   AmpiMsg* msg = unexpectedMsgs.get(t, s, (sts == MPI_STATUS_IGNORE) ? (int*)&tmpStatus : (int*)sts);
3119   if (msg) { // the matching message has already arrived
3120     if (sts != MPI_STATUS_IGNORE) {
3121       sts->MPI_SOURCE = msg->getSrcRank();
3122       sts->MPI_TAG    = msg->getTag();
3123       sts->MPI_COMM   = comm;
3124       sts->MPI_LENGTH = msg->getLength();
3125       sts->MPI_CANCEL = 0;
3126     }
3127     processAmpiMsg(msg, buf, type, count);
3128 #if CMK_BIGSIM_CHARM
3129     TRACE_BG_AMPI_BREAK(thread->getThread(), "RECV_RESUME", NULL, 0, 0);
3130     if (msg->eventPe == CkMyPe()) _TRACE_BG_ADD_BACKWARD_DEP(msg->event);
3131 #endif
3132     CkpvAccess(msgPool).deleteAmpiMsg(msg);
3133   }
3134   else { // post a request and block until the matching message arrives
3135     int request = postReq(dis->parent->reqPool.newIReq(buf, count, type, s, t, comm, getDDT(), AMPI_REQ_BLOCKED));
3136     CkAssert(parent->numBlockedReqs == 0);
3137     parent->numBlockedReqs = 1;
3138     dis = dis->blockOnRecv(); // "dis" is updated in case an ampi thread is migrated while waiting for a message
3139     parent = dis->parent;
3140     AmpiRequestList& reqs = parent->getReqs();
3141     if (sts != MPI_STATUS_IGNORE) {
3142       AmpiRequest& req = *reqs[request];
3143       sts->MPI_SOURCE = req.src;
3144       sts->MPI_TAG    = req.tag;
3145       sts->MPI_COMM   = req.comm;
3146       sts->MPI_LENGTH = req.getNumReceivedBytes(getDDT());
3147       sts->MPI_CANCEL = 0;
3148     }
3149     reqs.freeNonPersReq(request);
3150   }
3151
3152 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
3153   CpvAccess(_currentObj) = dis;
3154   MSG_ORDER_DEBUG( printf("[%d] AMPI thread rescheduled  to Index %d buf %p src %d\n",CkMyPe(),dis->thisIndex,buf,s); )
3155 #endif
3156 #if CMK_BIGSIM_CHARM && CMK_TRACE_IN_CHARM
3157   //Due to the reason mentioned the in the else-statement above, we need to
3158   //use "dis" as "this" in the case of migration (or out-of-core execution in BigSim)
3159   if(CpvAccess(traceOn)) CthTraceResume(dis->thread->getThread());
3160 #endif
3161
3162   return 0;
3163 }
3164
3165 void ampi::probe(int t, int s, MPI_Comm comm, MPI_Status *sts) noexcept
3166 {
3167   if (handle_MPI_PROC_NULL(s, comm, sts)) return;
3168
3169 #if CMK_BIGSIM_CHARM
3170   void *curLog; // store current log in timeline
3171   _TRACE_BG_TLINE_END(&curLog);
3172 #endif
3173
3174   ampi *dis = getAmpiInstance(comm);
3175   AmpiMsg *msg = NULL;
3176   while(1) {
3177     MPI_Status tmpStatus;
3178     msg = unexpectedMsgs.probe(t, s, (sts == MPI_STATUS_IGNORE) ? (int*)&tmpStatus : (int*)sts);
3179     if (msg) break;
3180     // "dis" is updated in case an ampi thread is migrated while waiting for a message
3181     dis = dis->blockOnRecv();
3182   }
3183
3184   if (sts != MPI_STATUS_IGNORE) {
3185     sts->MPI_SOURCE = msg->getSrcRank();
3186     sts->MPI_TAG    = msg->getTag();
3187     sts->MPI_COMM   = comm;
3188     sts->MPI_LENGTH = msg->getLength();
3189     sts->MPI_CANCEL = 0;
3190   }
3191
3192 #if CMK_BIGSIM_CHARM
3193   _TRACE_BG_SET_INFO((char *)msg, "PROBE_RESUME",  &curLog, 1);
3194 #endif
3195 }
3196
3197 void ampi::mprobe(int t, int s, MPI_Comm comm, MPI_Status *sts, MPI_Message *message) noexcept
3198 {
3199   if (handle_MPI_PROC_NULL(s, comm, sts)) {
3200     *message = MPI_MESSAGE_NO_PROC;
3201     return;
3202   }
3203
3204 #if CMK_BIGSIM_CHARM
3205   void *curLog; // store current log in timeline
3206   _TRACE_BG_TLINE_END(&curLog);
3207 #endif
3208
3209   ampi *dis = this;
3210   AmpiMsg *msg = NULL;
3211   while(1) {
3212     MPI_Status tmpStatus;
3213     // We call get() rather than probe() here because we want to remove this msg
3214     // from ampi::unexpectedMsgs and then insert it into ampiParent::matchedMsgs
3215     msg = unexpectedMsgs.get(t, s, (sts == MPI_STATUS_IGNORE) ? (int*)&tmpStatus : (int*)sts);
3216     if (msg)
3217       break;
3218     // "dis" is updated in case an ampi thread is migrated while waiting for a message
3219     dis = dis->blockOnRecv();
3220   }
3221
3222   msg->setComm(comm);
3223   *message = parent->putMatchedMsg(msg);
3224
3225   if (sts != MPI_STATUS_IGNORE) {
3226     sts->MPI_SOURCE = msg->getSrcRank();
3227     sts->MPI_TAG    = msg->getTag();
3228     sts->MPI_COMM   = msg->getComm();
3229     sts->MPI_LENGTH = msg->getLength();
3230     sts->MPI_CANCEL = 0;
3231   }
3232
3233 #if CMK_BIGSIM_CHARM
3234   _TRACE_BG_SET_INFO((char *)msg, "MPROBE_RESUME",  &curLog, 1);
3235 #endif
3236 }
3237
3238 int ampi::iprobe(int t, int s, MPI_Comm comm, MPI_Status *sts) noexcept
3239 {
3240   if (handle_MPI_PROC_NULL(s, comm, sts)) return 1;
3241
3242   MPI_Status tmpStatus;
3243   AmpiMsg* msg = unexpectedMsgs.probe(t, s, (sts == MPI_STATUS_IGNORE) ? (int*)&tmpStatus : (int*)sts);
3244   if (msg) {
3245     msg->setComm(comm);
3246     if (sts != MPI_STATUS_IGNORE) {
3247       sts->MPI_SOURCE = msg->getSrcRank();
3248       sts->MPI_TAG    = msg->getTag();
3249       sts->MPI_COMM   = msg->getComm();
3250       sts->MPI_LENGTH = msg->getLength();
3251       sts->MPI_CANCEL = 0;
3252     }
3253     return 1;
3254   }
3255 #if CMK_BIGSIM_CHARM
3256   void *curLog; // store current log in timeline
3257   _TRACE_BG_TLINE_END(&curLog);
3258 #endif
3259   thread->schedule();
3260 #if CMK_BIGSIM_CHARM
3261   _TRACE_BG_SET_INFO(NULL, "IPROBE_RESUME",  &curLog, 1);
3262 #endif
3263   return 0;
3264 }
3265
3266 int ampi::improbe(int tag, int source, MPI_Comm comm, MPI_Status *sts,
3267                   MPI_Message *message) noexcept
3268 {
3269   if (handle_MPI_PROC_NULL(source, comm, sts)) {
3270     *message = MPI_MESSAGE_NO_PROC;
3271     return 1;
3272   }
3273
3274   MPI_Status tmpStatus;
3275   // We call get() rather than probe() here because we want to remove this msg
3276   // from ampi::unexpectedMsgs and then insert it into ampiParent::matchedMsgs
3277   AmpiMsg* msg = unexpectedMsgs.get(tag, source, (sts == MPI_STATUS_IGNORE) ? (int*)&tmpStatus : (int*)sts);
3278   if (msg) {
3279     msg->setComm(comm);
3280     *message = parent->putMatchedMsg(msg);
3281     if (sts != MPI_STATUS_IGNORE) {
3282       sts->MPI_SOURCE = msg->getSrcRank();
3283       sts->MPI_TAG    = msg->getTag();
3284       sts->MPI_COMM   = comm;
3285       sts->MPI_LENGTH = msg->getLength();
3286       sts->MPI_CANCEL = 0;
3287     }
3288     return 1;
3289   }
3290
3291 #if CMK_BIGSIM_CHARM
3292   void *curLog; // store current log in timeline
3293   _TRACE_BG_TLINE_END(&curLog);
3294 #endif
3295   thread->schedule();
3296 #if CMK_BIGSIM_CHARM
3297   _TRACE_BG_SET_INFO(NULL, "IMPROBE_RESUME",  &curLog, 1);
3298 #endif
3299   return 0;
3300 }
3301
3302 void ampi::bcast(int root, void* buf, int count, MPI_Datatype type, MPI_Comm destcomm) noexcept
3303 {
3304   if (root==getRank()) {
3305 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
3306     CpvAccess(_currentObj) = this;
3307 #endif
3308     thisProxy.generic(makeBcastMsg(buf, count, type, destcomm));
3309   }
3310   else { // Non-root ranks need to increment the outgoing sequence number for collectives
3311     oorder.incCollSeqOutgoing();
3312   }
3313
3314   if (-1==recv(MPI_BCAST_TAG, root, buf, count, type, destcomm)) CkAbort("AMPI> Error in broadcast");
3315 }
3316
3317 int ampi::intercomm_bcast(int root, void* buf, int count, MPI_Datatype type, MPI_Comm intercomm) noexcept
3318 {
3319   if (root==MPI_ROOT) {
3320 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
3321     CpvAccess(_currentObj) = this;
3322 #endif
3323     remoteProxy.generic(makeBcastMsg(buf, count, type, intercomm));
3324   }
3325   else { // Non-root ranks need to increment the outgoing sequence number for collectives
3326     oorder.incCollSeqOutgoing();
3327   }
3328
3329   if (root!=MPI_PROC_NULL && root!=MPI_ROOT) {
3330     // remote group ranks
3331     if (-1==recv(MPI_BCAST_TAG, root, buf, count, type, intercomm)) CkAbort("AMPI> Error in intercomm broadcast");
3332   }
3333   return MPI_SUCCESS;
3334 }
3335
3336 void ampi::ibcast(int root, void* buf, int count, MPI_Datatype type, MPI_Comm destcomm, MPI_Request* request) noexcept
3337 {
3338   if (root==getRank()) {
3339 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
3340     CpvAccess(_currentObj) = this;
3341 #endif
3342     thisProxy.generic(makeAmpiMsg(AMPI_COLL_DEST, MPI_BCAST_TAG, root, buf, count, type, destcomm));
3343   }
3344   else { // Non-root ranks need to increment the outgoing sequence number for collectives
3345     oorder.incCollSeqOutgoing();
3346   }
3347
3348   // call irecv to post an IReq and check for any pending messages
3349   irecv(buf, count, type, root, MPI_BCAST_TAG, destcomm, request);
3350 }
3351
3352 int ampi::intercomm_ibcast(int root, void* buf, int count, MPI_Datatype type, MPI_Comm intercomm, MPI_Request *request) noexcept
3353 {
3354   if (root==MPI_ROOT) {
3355 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
3356     CpvAccess(_currentObj) = this;
3357 #endif
3358     remoteProxy.generic(makeAmpiMsg(AMPI_COLL_DEST, MPI_BCAST_TAG, getRank(), buf, count, type, intercomm));
3359   }
3360   else { // Non-root ranks need to increment the outgoing sequence number for collectives
3361     oorder.incCollSeqOutgoing();
3362   }
3363
3364   if (root!=MPI_PROC_NULL && root!=MPI_ROOT) {
3365     // call irecv to post IReq and process pending messages
3366     irecv(buf, count, type, root, MPI_BCAST_TAG, intercomm, request);
3367   }
3368   return MPI_SUCCESS;
3369 }
3370
3371 void ampi::bcastraw(void* buf, int len, CkArrayID aid) noexcept
3372 {
3373   AmpiMsg *msg = new (len, 0) AmpiMsg(0, 0, MPI_BCAST_TAG, 0, len);
3374   memcpy(msg->getData(), buf, len);
3375   CProxy_ampi pa(aid);
3376   pa.generic(msg);
3377 }
3378
3379 int ampi::intercomm_scatter(int root, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
3380                             void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm intercomm) noexcept
3381 {
3382   if (root == MPI_ROOT) {
3383     int remote_size = getRemoteIndices().size();
3384
3385     CkDDT_DataType* dttype = getDDT()->getType(sendtype) ;
3386     int itemsize = dttype->getSize(sendcount) ;
3387     for(int i = 0; i < remote_size; i++) {
3388         send(MPI_SCATTER_TAG, getRank(), ((char*)sendbuf)+(itemsize*i),
3389              sendcount, sendtype, i, intercomm);
3390     }
3391   }
3392
3393   if (root!=MPI_PROC_NULL && root!=MPI_ROOT) { //remote group ranks
3394     if(-1==recv(MPI_SCATTER_TAG, root, recvbuf, recvcount, recvtype, intercomm))
3395       CkAbort("AMPI> Error in intercomm MPI_Scatter recv");
3396   }
3397
3398   return MPI_SUCCESS;
3399 }
3400
3401 int ampi::intercomm_iscatter(int root, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
3402                              void *recvbuf, int recvcount, MPI_Datatype recvtype,
3403                              MPI_Comm intercomm, MPI_Request *request) noexcept
3404 {
3405   if (root == MPI_ROOT) {
3406     int remote_size = getRemoteIndices().size();
3407
3408     CkDDT_DataType* dttype = getDDT()->getType(sendtype) ;
3409     int itemsize = dttype->getSize(sendcount) ;
3410     // use an ATAReq to non-block the caller and get a request ptr
3411     ATAReq *newreq = new ATAReq(remote_size);
3412     for(int i = 0; i < remote_size; i++) {
3413       newreq->reqs[i] = send(MPI_SCATTER_TAG, getRank(), ((char*)sendbuf)+(itemsize*i),
3414                              sendcount, sendtype, i, intercomm, 0, I_SEND);
3415     }
3416     *request = postReq(newreq);
3417   }
3418
3419   if (root!=MPI_PROC_NULL && root!=MPI_ROOT) { //remote group ranks
3420     // call irecv to post an IReq and process any pending messages
3421     irecv(recvbuf,recvcount,recvtype,root,MPI_SCATTER_TAG,intercomm,request);
3422   }
3423
3424   return MPI_SUCCESS;
3425 }
3426
3427 int ampi::intercomm_scatterv(int root, const void* sendbuf, const int* sendcounts, const int* displs,
3428                              MPI_Datatype sendtype, void* recvbuf, int recvcount,
3429                              MPI_Datatype recvtype, MPI_Comm intercomm) noexcept
3430 {
3431   if (root == MPI_ROOT) {
3432     int remote_size = getRemoteIndices().size();
3433
3434     CkDDT_DataType* dttype = getDDT()->getType(sendtype);
3435     int itemsize = dttype->getSize();
3436     for (int i = 0; i < remote_size; i++) {
3437         send(MPI_SCATTER_TAG, getRank(), ((char*)sendbuf)+(itemsize*displs[i]),
3438              sendcounts[i], sendtype, i, intercomm);
3439     }
3440   }
3441
3442   if (root != MPI_PROC_NULL && root != MPI_ROOT) { // remote group ranks
3443     if (-1 == recv(MPI_SCATTER_TAG, root, recvbuf, recvcount, recvtype, intercomm))
3444       CkAbort("AMPI> Error in intercomm MPI_Scatterv recv");
3445   }
3446
3447   return MPI_SUCCESS;
3448 }
3449
3450 int ampi::intercomm_iscatterv(int root, const void* sendbuf, const int* sendcounts, const int* displs,
3451                               MPI_Datatype sendtype, void* recvbuf, int recvcount,
3452                               MPI_Datatype recvtype, MPI_Comm intercomm, MPI_Request* request) noexcept
3453 {
3454   if (root == MPI_ROOT) {
3455     int remote_size = getRemoteIndices().size();
3456
3457     CkDDT_DataType* dttype = getDDT()->getType(sendtype);
3458     int itemsize = dttype->getSize();
3459     // use an ATAReq to non-block the caller and get a request ptr
3460     ATAReq *newreq = new ATAReq(remote_size);
3461     for (int i = 0; i < remote_size; i++) {
3462       newreq->reqs[i] = send(MPI_SCATTER_TAG, getRank(), ((char*)sendbuf)+(itemsize*displs[i]),
3463                              sendcounts[i], sendtype, i, intercomm, 0, I_SEND);
3464     }
3465     *request = postReq(newreq);
3466   }
3467
3468   if (root != MPI_PROC_NULL && root != MPI_ROOT) { // remote group ranks
3469     // call irecv to post an IReq and process any pending messages
3470     irecv(recvbuf, recvcount, recvtype, root, MPI_SCATTER_TAG, intercomm, request);
3471   }
3472
3473   return MPI_SUCCESS;
3474 }
3475
3476 int MPI_comm_null_copy_fn(MPI_Comm comm, int keyval, void *extra_state,
3477                           void *attr_in, void *attr_out, int *flag){
3478   (*flag) = 0;
3479   return (MPI_SUCCESS);
3480 }
3481
3482 int MPI_comm_dup_fn(MPI_Comm comm, int keyval, void *extra_state,
3483                     void *attr_in, void *attr_out, int *flag){
3484   (*(void **)attr_out) = attr_in;
3485   (*flag) = 1;
3486   return (MPI_SUCCESS);
3487 }
3488
3489 int MPI_comm_null_delete_fn(MPI_Comm comm, int keyval, void *attr, void *extra_state){
3490   return (MPI_SUCCESS);
3491 }
3492
3493 int MPI_type_null_copy_fn(MPI_Datatype type, int keyval, void *extra_state,
3494                           void *attr_in, void *attr_out, int *flag){
3495   (*flag) = 0;
3496   return (MPI_SUCCESS);
3497 }
3498
3499 int MPI_type_dup_fn(MPI_Datatype type, int keyval, void *extra_state,
3500                     void *attr_in, void *attr_out, int *flag){
3501   (*(void **)attr_out) = attr_in;
3502   (*flag) = 1;
3503   return (MPI_SUCCESS);
3504 }
3505
3506 int MPI_type_null_delete_fn(MPI_Datatype type, int keyval, void *attr, void *extra_state){
3507   return (MPI_SUCCESS);
3508 }
3509
3510 void AmpiSeqQ::pup(PUP::er &p) noexcept {
3511   p|out;
3512   p|elements;
3513 }
3514
3515 void AmpiSeqQ::putOutOfOrder(int seqIdx, AmpiMsg *msg) noexcept
3516 {
3517   AmpiOtherElement &el=elements[seqIdx];
3518 #if CMK_ERROR_CHECKING
3519   if (msg->getSeq() < el.getSeqIncoming())
3520     CkAbort("AMPI Logic error: received late out-of-order message!\n");
3521 #endif
3522   out.enq(msg);
3523   el.incNumOutOfOrder(); // We have another message in the out-of-order queue
3524 }
3525
3526 AmpiMsg *AmpiSeqQ::getOutOfOrder(int seqIdx) noexcept
3527 {
3528   AmpiOtherElement &el=elements[seqIdx];
3529   if (el.getNumOutOfOrder()==0) return 0; // No more out-of-order left.
3530   // Walk through our out-of-order queue, searching for our next message:
3531   for (int i=0;i<out.length();i++) {
3532     AmpiMsg *msg=out.deq();
3533     if (msg->getSeqIdx()==seqIdx && msg->getSeq()==el.getSeqIncoming()) {
3534       el.incSeqIncoming();
3535       el.decNumOutOfOrder(); // We have one less message out-of-order
3536       return msg;
3537     }
3538     else
3539       out.enq(msg);
3540   }
3541   // We walked the whole queue-- ours is not there.
3542   return 0;
3543 }
3544
3545 void AmpiRequest::print() const noexcept {
3546   CkPrintf("In AmpiRequest: buf=%p, count=%d, type=%d, src=%d, tag=%d, comm=%d, reqIdx=%d, complete=%d, blocked=%d\n",
3547            buf, count, type, src, tag, comm, reqIdx, (int)complete, (int)blocked);
3548 }
3549
3550 void IReq::print() const noexcept {
3551   AmpiRequest::print();
3552   CkPrintf("In IReq: this=%p, length=%d, cancelled=%d, persistent=%d\n", this, length, (int)cancelled, (int)persistent);
3553 }
3554
3555 void RednReq::print() const noexcept {
3556   AmpiRequest::print();
3557   CkPrintf("In RednReq: this=%p, op=%d\n", this, op);
3558 }
3559
3560 void GatherReq::print() const noexcept {
3561   AmpiRequest::print();
3562   CkPrintf("In GatherReq: this=%p\n", this);
3563 }
3564
3565 void GathervReq::print() const noexcept {
3566   AmpiRequest::print();
3567   CkPrintf("In GathervReq: this=%p\n", this);
3568 }
3569
3570 void ATAReq::print() const noexcept { //not complete for reqs
3571   AmpiRequest::print();
3572   CkPrintf("In ATAReq: num_reqs=%d\n", reqs.size());
3573 }
3574
3575 void GReq::print() const noexcept {
3576   AmpiRequest::print();
3577   CkPrintf("In GReq: this=%p\n", this);
3578 }
3579
3580 void SendReq::print() const noexcept {
3581   AmpiRequest::print();
3582   CkPrintf("In SendReq: this=%p, persistent=%d\n", this, (int)persistent);
3583 }
3584
3585 void SsendReq::print() const noexcept {
3586   AmpiRequest::print();
3587   CkPrintf("In SsendReq: this=%p, persistent=%d\n", this, (int)persistent);
3588 }
3589
3590 void AmpiRequestList::pup(PUP::er &p, AmpiRequestPool* pool) noexcept {
3591   if (p.isUnpacking()) {
3592     CkAssert(pool);
3593     reqPool = pool;
3594   }
3595   if(!CmiMemoryIs(CMI_MEMORY_IS_ISOMALLOC)){
3596     return;
3597   }
3598
3599   p|startIdx;
3600   int size;
3601   if(!p.isUnpacking()){
3602     size = reqs.size();
3603   }
3604   p|size;
3605   if(p.isUnpacking()){
3606     reqs.resize(size);
3607   }
3608   // Must preserve indices in 'block' so that MPI_Request's remain the same, so keep NULL entries:
3609   for(int i=0;i<size;i++){
3610     AmpiReqType reqType;
3611     if(!p.isUnpacking()){
3612       if(reqs[i] == NULL){
3613         reqType = AMPI_INVALID_REQ;
3614       }else{
3615         reqType = reqs[i]->getType();
3616       }
3617     }
3618     p|reqType;
3619     if(reqType != AMPI_INVALID_REQ){
3620       if(p.isUnpacking()){
3621         switch(reqType){
3622           case AMPI_I_REQ:
3623             reqs[i] = reqPool->newIReq();
3624             break;
3625           case AMPI_REDN_REQ:
3626             reqs[i] = new RednReq;
3627             break;
3628           case AMPI_GATHER_REQ:
3629             reqs[i] = new GatherReq;
3630             break;
3631           case AMPI_GATHERV_REQ:
3632             reqs[i] = new GathervReq;
3633             break;
3634           case AMPI_SEND_REQ:
3635             reqs[i] = reqPool->newSendReq();
3636             break;
3637           case AMPI_SSEND_REQ:
3638             reqs[i] = reqPool->newSsendReq();
3639             break;
3640           case AMPI_ATA_REQ:
3641             reqs[i] = new ATAReq;
3642             break;
3643           case AMPI_G_REQ:
3644             reqs[i] = new GReq;
3645             break;
3646           case AMPI_INVALID_REQ:
3647             CkAbort("AMPI> error trying to PUP an invalid request!");
3648             break;
3649         }
3650       }
3651       reqs[i]->pup(p);
3652     }else{
3653       reqs[i] = NULL;
3654     }
3655   }
3656   if(p.isDeleting()){
3657     reqs.clear();
3658   }
3659 }
3660
3661 //------------------ External Interface -----------------
3662 ampiParent *getAmpiParent() noexcept {
3663   ampiParent *p = CtvAccess(ampiPtr);
3664 #if CMK_ERROR_CHECKING
3665   if (p==NULL) CkAbort("Cannot call MPI routines before AMPI is initialized.\n");
3666 #endif
3667   return p;
3668 }
3669
3670 ampi *getAmpiInstance(MPI_Comm comm) noexcept {
3671   ampi *ptr=getAmpiParent()->comm2ampi(comm);
3672 #if CMK_ERROR_CHECKING
3673   if (ptr==NULL) CkAbort("AMPI's getAmpiInstance> null pointer\n");
3674 #endif
3675   return ptr;
3676 }
3677
3678 bool isAmpiThread() noexcept {
3679   return (CtvAccess(ampiPtr) != NULL);
3680 }
3681
3682 inline static AmpiRequestList &getReqs() noexcept {
3683   return getAmpiParent()->ampiReqs;
3684 }
3685
3686 inline void checkComm(MPI_Comm comm) noexcept {
3687 #if AMPI_ERROR_CHECKING
3688   getAmpiParent()->checkComm(comm);
3689 #endif
3690 }
3691
3692 inline void checkRequest(MPI_Request req) noexcept {
3693 #if AMPI_ERROR_CHECKING
3694   getReqs().checkRequest(req);
3695 #endif
3696 }
3697
3698 inline void checkRequests(int n, MPI_Request* reqs) noexcept {
3699 #if AMPI_ERROR_CHECKING
3700   AmpiRequestList& reqlist = getReqs();
3701   for(int i=0;i<n;i++)
3702     reqlist.checkRequest(reqs[i]);
3703 #endif
3704 }
3705
3706 int testRequest(MPI_Request *reqIdx, int *flag, MPI_Status *sts) noexcept {
3707   if(*reqIdx==MPI_REQUEST_NULL){
3708     *flag = 1;
3709     clearStatus(sts);
3710     return MPI_SUCCESS;
3711   }
3712   checkRequest(*reqIdx);
3713   ampiParent* pptr = getAmpiParent();
3714   AmpiRequestList& reqList = pptr->getReqs();
3715   AmpiRequest& req = *reqList[*reqIdx];
3716   if(1 == (*flag = req.test())){
3717     req.wait(sts);
3718     reqList.freeNonPersReq(*reqIdx);
3719   }
3720   return MPI_SUCCESS;
3721 }
3722
3723 int testRequestNoFree(MPI_Request *reqIdx, int *flag, MPI_Status *sts) noexcept {
3724   if(*reqIdx==MPI_REQUEST_NULL){
3725     *flag = 1;
3726     clearStatus(sts);
3727     return MPI_SUCCESS;
3728   }
3729   checkRequest(*reqIdx);
3730   AmpiRequestList& reqList = getReqs();
3731   AmpiRequest& req = *reqList[*reqIdx];
3732   *flag = req.test();
3733   if(*flag)
3734     req.wait(sts);
3735   return MPI_SUCCESS;
3736 }
3737
3738 AMPI_API_IMPL(int, MPI_Is_thread_main, int *flag)
3739 {
3740   AMPI_API_INIT("AMPI_Is_thread_main");
3741   if (isAmpiThread()) {
3742     *flag = 1;
3743   } else {
3744     *flag = 0;
3745   }
3746   return MPI_SUCCESS;
3747 }
3748
3749 AMPI_API_IMPL(int, MPI_Query_thread, int *provided)
3750 {
3751   AMPI_API("AMPI_Query_thread");
3752   *provided = CkpvAccess(ampiThreadLevel);
3753   return MPI_SUCCESS;
3754 }
3755
3756 AMPI_API_IMPL(int, MPI_Init_thread, int *p_argc, char*** p_argv, int required, int *provided)
3757 {
3758   if (nodeinit_has_been_called) {
3759     AMPI_API_INIT("AMPI_Init_thread");
3760
3761 #if AMPI_ERROR_CHECKING
3762     if (required < MPI_THREAD_SINGLE || required > MPI_THREAD_MULTIPLE) {
3763       return ampiErrhandler("AMPI_Init_thread", MPI_ERR_ARG);
3764     }
3765 #endif
3766
3767     if (required == MPI_THREAD_SINGLE) {
3768       CkpvAccess(ampiThreadLevel) = MPI_THREAD_SINGLE;
3769     }
3770     else {
3771       CkpvAccess(ampiThreadLevel) = MPI_THREAD_FUNNELED;
3772     }
3773     // AMPI does not support MPI_THREAD_SERIALIZED or MPI_THREAD_MULTIPLE
3774
3775     *provided = CkpvAccess(ampiThreadLevel);
3776     return MPI_Init(p_argc, p_argv);
3777   }
3778   else
3779   { /* Charm hasn't been started yet! */
3780     CkAbort("MPI_Init_thread> AMPI has not been initialized! Possibly due to AMPI requiring '#include \"mpi.h\" be in the same file as main() in C/C++ programs and \'program main\' be renamed to \'subroutine mpi_main\' in Fortran programs!");
3781     return MPI_SUCCESS;
3782   }
3783 }
3784
3785 AMPI_API_IMPL(int, MPI_Init, int *p_argc, char*** p_argv)
3786 {
3787   if (nodeinit_has_been_called) {
3788     AMPI_API_INIT("AMPI_Init");
3789     char **argv;
3790     if (p_argv) argv=*p_argv;
3791     else argv=CkGetArgv();
3792     ampiInit(argv);
3793     if (p_argc) *p_argc=CmiGetArgc(argv);
3794   }
3795   else
3796   { /* Charm hasn't been started yet! */
3797     CkAbort("MPI_Init> AMPI has not been initialized! Possibly due to AMPI requiring '#include \"mpi.h\" be in the same file as main() in C/C++ programs and \'program main\' be renamed to \'subroutine mpi_main\' in Fortran programs!");
3798   }
3799
3800   return MPI_SUCCESS;
3801 }
3802
3803 AMPI_API_IMPL(int, MPI_Initialized, int *isInit)
3804 {
3805   if (nodeinit_has_been_called) {
3806     AMPI_API_INIT("AMPI_Initialized");     /* in case charm init not called */
3807     *isInit=CtvAccess(ampiInitDone);
3808   }
3809   else {
3810     *isInit=0;
3811   }
3812   return MPI_SUCCESS;
3813 }
3814
3815 AMPI_API_IMPL(int, MPI_Finalized, int *isFinalized)
3816 {
3817   AMPI_API_INIT("AMPI_Finalized");     /* in case charm init not called */
3818   *isFinalized=(CtvAccess(ampiFinalized)) ? 1 : 0;
3819   return MPI_SUCCESS;
3820 }
3821
3822 AMPI_API_IMPL(int, MPI_Comm_rank, MPI_Comm comm, int *rank)
3823 {
3824   AMPI_API("AMPI_Comm_rank");
3825
3826 #if AMPI_ERROR_CHECKING
3827   int ret = checkCommunicator("AMPI_Comm_rank", comm);
3828   if(ret != MPI_SUCCESS)
3829     return ret;
3830 #endif
3831
3832 #if AMPIMSGLOG
3833   ampiParent* pptr = getAmpiParent();
3834   if(msgLogRead){
3835     PUParray(*(pptr->fromPUPer), (char*)rank, sizeof(int));
3836     return MPI_SUCCESS;
3837   }
3838 #endif
3839
3840   *rank = getAmpiInstance(comm)->getRank();
3841
3842 #if AMPIMSGLOG
3843   if(msgLogWrite && record_msglog(pptr->thisIndex)){
3844     PUParray(*(pptr->toPUPer), (char*)rank, sizeof(int));
3845   }
3846 #endif
3847   return MPI_SUCCESS;
3848 }
3849
3850 AMPI_API_IMPL(int, MPI_Comm_size, MPI_Comm comm, int *size)
3851 {
3852   AMPI_API("AMPI_Comm_size");
3853
3854 #if AMPI_ERROR_CHECKING
3855   int ret = checkCommunicator("AMPI_Comm_size", comm);
3856   if(ret != MPI_SUCCESS)
3857     return ret;
3858 #endif
3859
3860 #if AMPIMSGLOG
3861   ampiParent* pptr = getAmpiParent();
3862   if(msgLogRead){
3863     PUParray(*(pptr->fromPUPer), (char*)size, sizeof(int));
3864     return MPI_SUCCESS;
3865   }
3866 #endif
3867
3868   *size = getAmpiInstance(comm)->getSize();
3869
3870 #if AMPIMSGLOG
3871   if(msgLogWrite && record_msglog(pptr->thisIndex)){
3872     PUParray(*(pptr->toPUPer), (char*)size, sizeof(int));
3873   }
3874 #endif
3875
3876   return MPI_SUCCESS;
3877 }
3878
3879 AMPI_API_IMPL(int, MPI_Comm_compare, MPI_Comm comm1, MPI_Comm comm2, int *result)
3880 {
3881   AMPI_API("AMPI_Comm_compare");
3882
3883 #if AMPI_ERROR_CHECKING
3884   int ret;
3885   ret = checkCommunicator("AMPI_Comm_compare", comm1);
3886   if(ret != MPI_SUCCESS)
3887     return ret;
3888   ret = checkCommunicator("AMPI_Comm_compare", comm2);
3889   if(ret != MPI_SUCCESS)
3890     return ret;
3891 #endif
3892
3893   if(comm1==comm2) *result=MPI_IDENT;
3894   else{
3895     int congruent=1;
3896     vector<int> ind1, ind2;
3897     ind1 = getAmpiInstance(comm1)->getIndices();
3898     ind2 = getAmpiInstance(comm2)->getIndices();
3899     if(ind1.size()==ind2.size()){
3900       for(int i=0;i<ind1.size();i++){
3901         int equal=0;
3902         for(int j=0;j<ind2.size();j++){
3903           if(ind1[i]==ind2[j]){
3904             equal=1;
3905             if(i!=j) congruent=0;
3906           }
3907         }
3908         if(!equal){
3909           *result=MPI_UNEQUAL;
3910           return MPI_SUCCESS;
3911         }
3912       }
3913     }
3914     else{
3915       *result=MPI_UNEQUAL;
3916       return MPI_SUCCESS;
3917     }
3918     if(congruent==1) *result=MPI_CONGRUENT;
3919     else *result=MPI_SIMILAR;
3920   }
3921   return MPI_SUCCESS;
3922 }
3923
3924 static bool atexit_called = false;
3925
3926 CLINKAGE
3927 void ampiMarkAtexit()
3928 {
3929   atexit_called = true;
3930 }
3931
3932 CDECL
3933 void AMPI_Exit(int exitCode)
3934 {
3935   // If we are not actually running AMPI code (e.g., by compiling a serial
3936   // application with ampicc), exit cleanly when the application calls exit().
3937   AMPI_API_INIT("AMPI_Exit");
3938   CkpvAccess(msgPool).clear();
3939
3940   if (!atexit_called)
3941     TCHARM_Done(exitCode);
3942 }
3943
3944 FDECL
3945 void FTN_NAME(MPI_EXIT,mpi_exit)(int *exitCode)
3946 {
3947   AMPI_Exit(*exitCode);
3948 }
3949
3950 AMPI_API_IMPL(int, MPI_Finalize, void)
3951 {
3952   { // This brace is necessary here to make sure the object created on the stack
3953     // by the AMPI_API call gets destroyed before the call to AMPI_Exit(), since
3954     // AMPI_Exit() never returns.
3955   AMPI_API("AMPI_Finalize");
3956
3957 #if AMPI_PRINT_IDLE
3958   CkPrintf("[%d] Idle time %fs.\n", CkMyPe(), totalidle);
3959 #endif
3960   CtvAccess(ampiFinalized)=true;
3961
3962 #if AMPI_PRINT_MSG_SIZES
3963   getAmpiParent()->printMsgSizes();
3964 #endif
3965
3966 #if CMK_BIGSIM_CHARM && CMK_TRACE_IN_CHARM
3967   if(CpvAccess(traceOn)) traceSuspend();
3968 #endif
3969   }
3970
3971   AMPI_Exit(0); // Never returns
3972   return MPI_SUCCESS;
3973 }
3974
3975 MPI_Request ampi::postReq(AmpiRequest* newreq) noexcept
3976 {
3977   // All valid requests must be inserted into the AmpiRequestList
3978   MPI_Request request = getReqs().insert(newreq);
3979   // Completed requests should not be inserted into the postedReqs queue.
3980   // All types of send requests are matched by their request number,
3981   // not by (tag, src, comm), so they should not be inserted either.
3982   if (newreq->isUnmatched()) {
3983     postedReqs.put(newreq);
3984   }
3985   return request;
3986 }
3987
3988 AMPI_API_IMPL(int, MPI_Send, const void *msg, int count, MPI_Datatype type,
3989                              int dest, int tag, MPI_Comm comm)
3990 {
3991   AMPI_API("AMPI_Send");
3992
3993   handle_MPI_BOTTOM((void*&)msg, type);
3994
3995 #if AMPI_ERROR_CHECKING
3996   int ret;
3997   ret = errorCheck("AMPI_Send", comm, 1, count, 1, type, 1, tag, 1, dest, 1, msg, 1);
3998   if(ret != MPI_SUCCESS)
3999     return ret;
4000 #endif
4001
4002 #if AMPIMSGLOG
4003   if(msgLogRead){
4004     return MPI_SUCCESS;
4005   }
4006 #endif
4007
4008   ampi *ptr = getAmpiInstance(comm);
4009   ptr->send(tag, ptr->getRank(), msg, count, type, dest, comm);
4010
4011   return MPI_SUCCESS;
4012 }
4013
4014 AMPI_API_IMPL(int, MPI_Bsend, const void *buf, int count, MPI_Datatype datatype,
4015                               int dest, int tag, MPI_Comm comm)
4016 {
4017   AMPI_API("AMPI_Bsend");
4018   // FIXME: we don't actually use the buffer set in MPI_Buffer_attach
4019   //        for buffering of messages sent via MPI_Bsend
4020   return MPI_Send(buf, count, datatype, dest, tag, comm);
4021 }
4022
4023 AMPI_API_IMPL(int, MPI_Buffer_attach, void *buffer, int size)
4024 {
4025   AMPI_API("AMPI_Buffer_attach");
4026 #if AMPI_ERROR_CHECKING
4027   if (size < 0) {
4028     return ampiErrhandler("AMPI_Buffer_attach", MPI_ERR_ARG);
4029   }
4030 #endif
4031   // NOTE: we don't really use this buffer for Bsend's,
4032   //       we only keep track of it so that it can be
4033   //       returned by MPI_Buffer_detach.
4034   getAmpiParent()->attachBuffer(buffer, size);
4035   return MPI_SUCCESS;
4036 }
4037
4038 AMPI_API_IMPL(int, MPI_Buffer_detach, void *buffer, int *size)
4039 {
4040   AMPI_API("AMPI_Buffer_detach");
4041   getAmpiParent()->detachBuffer(buffer, size);
4042   return MPI_SUCCESS;
4043 }
4044
4045 AMPI_API_IMPL(int, MPI_Rsend, const void *buf, int count, MPI_Datatype datatype,
4046                               int dest, int tag, MPI_Comm comm)
4047 {
4048   /* FIXME: MPI_Rsend can be posted only after recv */
4049   AMPI_API("AMPI_Rsend");
4050   return MPI_Send(buf, count, datatype, dest, tag, comm);
4051 }
4052
4053 AMPI_API_IMPL(int, MPI_Ssend, const void *msg, int count, MPI_Datatype type,
4054                               int dest, int tag, MPI_Comm comm)
4055 {
4056   AMPI_API("AMPI_Ssend");
4057
4058   handle_MPI_BOTTOM((void*&)msg, type);
4059
4060 #if AMPI_ERROR_CHECKING
4061   int ret = errorCheck("AMPI_Ssend", comm, 1, count, 1, type, 1, tag, 1, dest, 1, msg, 1);
4062   if(ret != MPI_SUCCESS)
4063     return ret;
4064 #endif
4065
4066 #if AMPIMSGLOG
4067   if(msgLogRead){
4068     return MPI_SUCCESS;
4069   }
4070 #endif
4071
4072   ampi *ptr = getAmpiInstance(comm);
4073   ptr->send(tag, ptr->getRank(), msg, count, type, dest, comm, 1);
4074
4075   return MPI_SUCCESS;
4076 }
4077
4078 AMPI_API_IMPL(int, MPI_Issend, const void *buf, int count, MPI_Datatype type, int dest,
4079                                int tag, MPI_Comm comm, MPI_Request *request)
4080 {
4081   AMPI_API("AMPI_Issend");
4082
4083   handle_MPI_BOTTOM((void*&)buf, type);
4084
4085 #if AMPI_ERROR_CHECKING
4086   int ret = errorCheck("AMPI_Issend", comm, 1, count, 1, type, 1, tag, 1, dest, 1, buf, 1);
4087   if(ret != MPI_SUCCESS){
4088     *request = MPI_REQUEST_NULL;
4089     return ret;
4090   }
4091 #endif
4092
4093 #if AMPIMSGLOG
4094   ampiParent* pptr = getAmpiParent();
4095   if(msgLogRead){
4096     PUParray(*(pptr->fromPUPer), (char *)request, sizeof(MPI_Request));
4097     return MPI_SUCCESS;
4098   }
4099 #endif
4100
4101   USER_CALL_DEBUG("AMPI_Issend("<<type<<","<<dest<<","<<tag<<","<<comm<<")");
4102   ampiParent* pptr = getAmpiParent();
4103   ampi *ptr = getAmpiInstance(comm);
4104   *request = ptr->postReq(pptr->reqPool.newSsendReq(type, comm, pptr->getDDT()));
4105   // 1:  blocking now  - used by MPI_Ssend
4106   // >=2:  the index of the requests - used by MPI_Issend
4107   ptr->send(tag, ptr->getRank(), buf, count, type, dest, comm, *request+2, I_SEND);
4108
4109 #if AMPIMSGLOG
4110   if(msgLogWrite && record_msglog(pptr->thisIndex)){
4111     PUParray(*(pptr->toPUPer), (char *)request, sizeof(MPI_Request));
4112   }
4113 #endif
4114
4115   return MPI_SUCCESS;
4116 }
4117
4118 AMPI_API_IMPL(int, MPI_Recv, void *msg, int count, MPI_Datatype type, int src, int tag,
4119                              MPI_Comm comm, MPI_Status *status)
4120 {
4121   AMPI_API("AMPI_Recv");
4122
4123   handle_MPI_BOTTOM(msg, type);
4124
4125 #if AMPI_ERROR_CHECKING
4126   int ret = errorCheck("AMPI_Recv", comm, 1, count, 1, type, 1, tag, 1, src, 1, msg, 1);
4127   if(ret != MPI_SUCCESS)
4128     return ret;
4129 #endif
4130
4131 #if AMPIMSGLOG
4132   ampiParent* pptr = getAmpiParent();
4133   if(msgLogRead){
4134     (*(pptr->fromPUPer))|(pptr->pupBytes);
4135     PUParray(*(pptr->fromPUPer), (char *)msg, (pptr->pupBytes));
4136     PUParray(*(pptr->fromPUPer), (char *)status, sizeof(MPI_Status));
4137     return MPI_SUCCESS;
4138   }
4139 #endif
4140
4141   ampi *ptr = getAmpiInstance(comm);
4142   if(-1==ptr->recv(tag,src,msg,count,type,comm,status)) CkAbort("AMPI> Error in MPI_Recv");
4143
4144 #if AMPIMSGLOG
4145   if(msgLogWrite && record_msglog(pptr->thisIndex)){
4146     (pptr->pupBytes) = getDDT()->getSize(type) * count;
4147     (*(pptr->toPUPer))|(pptr->pupBytes);
4148     PUParray(*(pptr->toPUPer), (char *)msg, (pptr->pupBytes));
4149     PUParray(*(pptr->toPUPer), (char *)status, sizeof(MPI_Status));
4150   }
4151 #endif
4152
4153   return MPI_SUCCESS;
4154 }
4155
4156 AMPI_API_IMPL(int, MPI_Probe, int src, int tag, MPI_Comm comm, MPI_Status *status)
4157 {
4158   AMPI_API("AMPI_Probe");
4159
4160 #if AMPI_ERROR_CHECKING
4161   int ret = errorCheck("AMPI_Probe", comm, 1, 0, 0, 0, 0, tag, 1, src, 1, 0, 0);
4162   if(ret != MPI_SUCCESS)
4163     return ret;
4164 #endif
4165
4166   ampi *ptr = getAmpiInstance(comm);
4167   ptr->probe(tag, src, comm, status);
4168   return MPI_SUCCESS;
4169 }
4170
4171 AMPI_API_IMPL(int, MPI_Iprobe, int src, int tag, MPI_Comm comm, int *flag, MPI_Status *status)
4172 {
4173   AMPI_API("AMPI_Iprobe");
4174
4175 #if AMPI_ERROR_CHECKING
4176   int ret = errorCheck("AMPI_Iprobe", comm, 1, 0, 0, 0, 0, tag, 1, src, 1, 0, 0);
4177   if(ret != MPI_SUCCESS)
4178     return ret;
4179 #endif
4180
4181   ampi *ptr = getAmpiInstance(comm);
4182   *flag = ptr->iprobe(tag, src, comm, status);
4183   return MPI_SUCCESS;
4184 }
4185
4186 AMPI_API_IMPL(int, MPI_Improbe, int source, int tag, MPI_Comm comm, int *flag,
4187                                 MPI_Message *message, MPI_Status *status)
4188 {
4189   AMPI_API("AMPI_Improbe");
4190
4191 #if AMPI_ERROR_CHECKING
4192   int ret = errorCheck("AMPI_Improbe", comm, 1, 0, 0, 0, 0, tag, 1, source, 1, 0, 0);
4193   if(ret != MPI_SUCCESS)
4194     return ret;
4195 #endif
4196
4197   ampi *ptr = getAmpiInstance(comm);
4198   *flag = ptr->improbe(tag, source, comm, status, message);
4199
4200   return MPI_SUCCESS;
4201 }
4202
4203 AMPI_API_IMPL(int, MPI_Imrecv, void* buf, int count, MPI_Datatype datatype, MPI_Message *message,
4204                                MPI_Request *request)
4205 {
4206   AMPI_API("AMPI_Imrecv");
4207
4208 #if AMPI_ERROR_CHECKING
4209   if (*message == MPI_MESSAGE_NULL) {
4210     return ampiErrhandler("AMPI_Imrecv", MPI_ERR_REQUEST);
4211   }
4212 #endif
4213
4214   if (*message == MPI_MESSAGE_NO_PROC) {
4215     *message = MPI_MESSAGE_NULL;
4216     IReq *newreq = getAmpiParent()->reqPool.newIReq(buf, count, datatype, MPI_PROC_NULL, MPI_ANY_TAG,
4217                                                     MPI_COMM_NULL, getDDT(), AMPI_REQ_COMPLETED);
4218     *request = getReqs().insert(newreq);
4219     return MPI_SUCCESS;
4220   }
4221
4222   handle_MPI_BOTTOM(buf, datatype);
4223
4224 #if AMPI_ERROR_CHECKING
4225   int ret = errorCheck("AMPI_Imrecv", 0, 0, count, 1, datatype, 1, 0, 0, 0, 0, buf, 1);
4226   if(ret != MPI_SUCCESS){
4227     *request = MPI_REQUEST_NULL;
4228     return ret;
4229   }
4230 #endif
4231
4232   USER_CALL_DEBUG("AMPI_Imrecv("<<datatype<<","<<src<<","<<tag<<","<<comm<<")");
4233   ampiParent* parent = getAmpiParent();
4234   AmpiMsg* msg = parent->getMatchedMsg(*message);
4235   CkAssert(msg);
4236   MPI_Comm comm = msg->getComm();
4237   int tag = msg->getTag();
4238   int src = msg->getSrcRank();
4239
4240   ampi *ptr = getAmpiInstance(comm);
4241   AmpiRequestList& reqs = getReqs();
4242   IReq *newreq = parent->reqPool.newIReq(buf, count, datatype, src, tag, comm, parent->getDDT());
4243   *request = reqs.insert(newreq);
4244
4245   newreq->receive(ptr, msg);
4246   *message = MPI_MESSAGE_NULL;
4247
4248   return MPI_SUCCESS;
4249 }
4250
4251 AMPI_API_IMPL(int, MPI_Mprobe, int source, int tag, MPI_Comm comm, MPI_Message *message,
4252                                MPI_Status *status)
4253 {
4254   AMPI_API("AMPI_Mprobe");
4255
4256 #if AMPI_ERROR_CHECKING
4257   int ret = errorCheck("AMPI_Mprobe", comm, 1, 0, 0, 0, 0, tag, 1, source, 1, 0, 0);
4258   if(ret != MPI_SUCCESS)
4259     return ret;
4260 #endif
4261
4262   ampi *ptr = getAmpiInstance(comm);
4263   ptr->mprobe(tag, source, comm, status, message);
4264
4265   return MPI_SUCCESS;
4266 }
4267
4268 AMPI_API_IMPL(int, MPI_Mrecv, void* buf, int count, MPI_Datatype datatype, MPI_Message *message,
4269                               MPI_Status *status)
4270 {
4271   AMPI_API("AMPI_Mrecv");
4272
4273 #if AMPI_ERROR_CHECKING
4274   if (*message == MPI_MESSAGE_NULL) {
4275     return ampiErrhandler("AMPI_Mrecv", MPI_ERR_REQUEST);
4276   }
4277 #endif
4278
4279   if (*message == MPI_MESSAGE_NO_PROC) {
4280     if (status != MPI_STATUS_IGNORE) {
4281       status->MPI_SOURCE = MPI_PROC_NULL;
4282       status->MPI_TAG = MPI_ANY_TAG;
4283       status->MPI_LENGTH = 0;
4284     }
4285     *message = MPI_MESSAGE_NULL;
4286     return MPI_SUCCESS;
4287   }
4288
4289 #if AMPI_ERROR_CHECKING
4290   int ret = errorCheck("AMPI_Mrecv", 0, 0, count, 1, datatype, 1, 0, 0, 0, 0, buf, 1);
4291   if(ret != MPI_SUCCESS)
4292     return ret;
4293 #endif
4294
4295   handle_MPI_BOTTOM(buf, datatype);
4296
4297   ampiParent* parent = getAmpiParent();
4298   AmpiMsg *msg = parent->getMatchedMsg(*message);
4299   CkAssert(msg); // the matching message has already arrived
4300   MPI_Comm comm = msg->getComm();
4301   int src = msg->getSrcRank();
4302   int tag = msg->getTag();
4303
4304 #if AMPIMSGLOG
4305   ampiParent* pptr = getAmpiParent();
4306   if(msgLogRead){
4307     (*(pptr->fromPUPer))|(pptr->pupBytes);
4308     PUParray(*(pptr->fromPUPer), (char *)buf, (pptr->pupBytes));
4309     PUParray(*(pptr->fromPUPer), (char *)status, sizeof(MPI_Status));
4310     return MPI_SUCCESS;
4311   }
4312 #endif
4313
4314   ampi *ptr = getAmpiInstance(comm);
4315   if (status != MPI_STATUS_IGNORE) {
4316     status->MPI_SOURCE = msg->getSrcRank();
4317     status->MPI_TAG    = msg->getTag();
4318     status->MPI_COMM   = comm;
4319     status->MPI_LENGTH = msg->getLength();
4320     status->MPI_CANCEL = 0;
4321   }
4322   ptr->processAmpiMsg(msg, buf, datatype, count);
4323   CkpvAccess(msgPool).deleteAmpiMsg(msg);
4324   *message = MPI_MESSAGE_NULL;
4325
4326 #if AMPIMSGLOG
4327   if(msgLogWrite && record_msglog(pptr->thisIndex)){
4328     (pptr->pupBytes) = getDDT()->getSize(datatype) * count;
4329     (*(pptr->toPUPer))|(pptr->pupBytes);
4330     PUParray(*(pptr->toPUPer), (char *)buf, (pptr->pupBytes));
4331     PUParray(*(pptr->toPUPer), (char *)status, sizeof(MPI_Status));
4332   }
4333 #endif
4334
4335   return MPI_SUCCESS;
4336 }
4337
4338 void ampi::sendrecv(const void *sbuf, int scount, MPI_Datatype stype, int dest, int stag,
4339                     void *rbuf, int rcount, MPI_Datatype rtype, int src, int rtag,
4340                     MPI_Comm comm, MPI_Status *sts) noexcept
4341 {
4342   MPI_Request reqs[2];
4343   irecv(rbuf, rcount, rtype, src, rtag, comm, &reqs[0]);
4344
4345   reqs[1] = send(stag, getRank(), sbuf, scount, stype, dest, comm, 0, I_SEND);
4346
4347   if (sts == MPI_STATUS_IGNORE) {
4348     MPI_Waitall(2, reqs, MPI_STATUSES_IGNORE);
4349   }
4350   else {
4351     MPI_Status statuses[2];
4352     MPI_Waitall(2, reqs, statuses);
4353     *sts = statuses[0];
4354   }
4355 }
4356
4357 AMPI_API_IMPL(int, MPI_Sendrecv, const void *sbuf, int scount, MPI_Datatype stype, int dest,
4358                                  int stag, void *rbuf, int rcount, MPI_Datatype rtype,
4359                                  int src, int rtag, MPI_Comm comm, MPI_Status *sts)
4360 {
4361   AMPI_API("AMPI_Sendrecv");
4362
4363   handle_MPI_BOTTOM((void*&)sbuf, stype, rbuf, rtype);
4364
4365 #if AMPI_ERROR_CHECKING
4366   if(sbuf == MPI_IN_PLACE || rbuf == MPI_IN_PLACE)
4367     CkAbort("MPI_sendrecv does not accept MPI_IN_PLACE; use MPI_Sendrecv_replace instead.");
4368   int ret;
4369   ret = errorCheck("AMPI_Sendrecv", comm, 1, scount, 1, stype, 1, stag, 1, dest, 1, sbuf, 1);
4370   if(ret != MPI_SUCCESS)
4371     return ret;
4372   ret = errorCheck("AMPI_Sendrecv", comm, 1, rcount, 1, rtype, 1, rtag, 1, src, 1, rbuf, 1);
4373   if(ret != MPI_SUCCESS)
4374     return ret;
4375 #endif
4376
4377   ampi *ptr = getAmpiInstance(comm);
4378
4379   ptr->sendrecv(sbuf, scount, stype, dest, stag,
4380                 rbuf, rcount, rtype, src, rtag,
4381                 comm, sts);
4382
4383   return MPI_SUCCESS;
4384 }
4385
4386 void ampi::sendrecv_replace(void* buf, int count, MPI_Datatype datatype,
4387                             int dest, int sendtag, int source, int recvtag,
4388                             MPI_Comm comm, MPI_Status *status) noexcept
4389 {
4390   CkDDT_DataType* ddt = getDDT()->getType(datatype);
4391   vector<char> tmpBuf(ddt->getSize(count));
4392   ddt->serialize((char*)buf, tmpBuf.data(), count, ddt->getSize(count), PACK);
4393
4394   MPI_Request reqs[2];
4395   irecv(buf, count, datatype, source, recvtag, comm, &reqs[0]);
4396
4397   // FIXME: this send may do a copy internally! If we knew now that it would, we could avoid double copying:
4398   reqs[1] = send(sendtag, getRank(), tmpBuf.data(), count, datatype, dest, comm, 0, I_SEND);
4399
4400   if (status == MPI_STATUS_IGNORE) {
4401     MPI_Waitall(2, reqs, MPI_STATUSES_IGNORE);
4402   }
4403   else {
4404     MPI_Status statuses[2];
4405     MPI_Waitall(2, reqs, statuses);
4406     *status = statuses[0];
4407   }
4408 }
4409
4410 AMPI_API_IMPL(int, MPI_Sendrecv_replace, void* buf, int count, MPI_Datatype datatype,
4411                                          int dest, int sendtag, int source, int recvtag,
4412                                          MPI_Comm comm, MPI_Status *status)
4413 {
4414   AMPI_API("AMPI_Sendrecv_replace");
4415
4416   handle_MPI_BOTTOM(buf, datatype);
4417
4418 #if AMPI_ERROR_CHECKING
4419   int ret;
4420   ret = errorCheck("AMPI_Sendrecv_replace", comm, 1, count, 1, datatype, 1, sendtag, 1, dest, 1, buf, 1);
4421   if(ret != MPI_SUCCESS)
4422     return ret;
4423   ret = errorCheck("AMPI_Sendrecv_replace", comm, 1, count, 1, datatype, 1, recvtag, 1, source, 1, buf, 1);
4424   if(ret != MPI_SUCCESS)
4425     return ret;
4426 #endif
4427
4428   ampi* ptr = getAmpiInstance(comm);
4429
4430   ptr->sendrecv_replace(buf, count, datatype, dest, sendtag, source, recvtag, comm, status);
4431
4432   return MPI_SUCCESS;
4433 }
4434
4435 void ampi::barrier() noexcept
4436 {
4437   CkCallback barrierCB(CkReductionTarget(ampi, barrierResult), getProxy());
4438   contribute(barrierCB);
4439   thread->suspend(); //Resumed by ampi::barrierResult
4440 }
4441
4442 void ampi::barrierResult() noexcept
4443 {
4444   MSG_ORDER_DEBUG(CkPrintf("[%d] barrierResult called\n", thisIndex));
4445   thread->resume();
4446 }
4447
4448 AMPI_API_IMPL(int, MPI_Barrier, MPI_Comm comm)
4449 {
4450   AMPI_API("AMPI_Barrier");
4451
4452 #if AMPI_ERROR_CHECKING
4453   int ret = checkCommunicator("AMPI_Barrier", comm);
4454   if(ret != MPI_SUCCESS)
4455     return ret;
4456 #endif
4457
4458 #if CMK_BIGSIM_CHARM
4459   TRACE_BG_AMPI_LOG(MPI_BARRIER, 0);
4460 #endif
4461
4462   ampi *ptr = getAmpiInstance(comm);
4463   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Barrier called on comm %d\n", ptr->thisIndex, comm));
4464
4465   if (ptr->getSize() == 1 && !getAmpiParent()->isInter(comm))
4466     return MPI_SUCCESS;
4467
4468   // implementation of intercomm barrier is equivalent to that for intracomm barrier
4469
4470   ptr->barrier();
4471
4472   return MPI_SUCCESS;
4473 }
4474
4475 void ampi::ibarrier(MPI_Request *request) noexcept
4476 {
4477   CkCallback ibarrierCB(CkReductionTarget(ampi, ibarrierResult), getProxy());
4478   contribute(ibarrierCB);
4479
4480   // use an IReq to non-block the caller and get a request ptr
4481   *request = postReq(parent->reqPool.newIReq(NULL, 0, MPI_INT, AMPI_COLL_SOURCE, MPI_ATA_TAG, myComm.getComm(), getDDT()));
4482 }
4483
4484 void ampi::ibarrierResult() noexcept
4485 {
4486   MSG_ORDER_DEBUG(CkPrintf("[%d] ibarrierResult called\n", thisIndex));
4487   ampi::sendraw(MPI_ATA_TAG, AMPI_COLL_SOURCE, NULL, 0, thisArrayID, thisIndex);
4488 }
4489
4490 AMPI_API_IMPL(int, MPI_Ibarrier, MPI_Comm comm, MPI_Request *request)
4491 {
4492   AMPI_API("AMPI_Ibarrier");
4493
4494 #if AMPI_ERROR_CHECKING
4495   int ret = checkCommunicator("AMPI_Ibarrier", comm);
4496   if(ret != MPI_SUCCESS){
4497     *request = MPI_REQUEST_NULL;
4498     return ret;
4499   }
4500 #endif
4501
4502   ampi *ptr = getAmpiInstance(comm);
4503
4504   if (ptr->getSize() == 1 && !getAmpiParent()->isInter(comm)) {
4505     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(NULL, 0, MPI_INT, AMPI_COLL_SOURCE, MPI_ATA_TAG, AMPI_COLL_COMM,
4506                             getDDT(), AMPI_REQ_COMPLETED));
4507     return MPI_SUCCESS;
4508   }
4509
4510   // implementation of intercomm ibarrier is equivalent to that for intracomm ibarrier
4511
4512 #if CMK_BIGSIM_CHARM
4513   TRACE_BG_AMPI_LOG(MPI_BARRIER, 0);
4514 #endif
4515
4516   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Ibarrier called on comm %d\n", ptr->thisIndex, comm));
4517
4518   ptr->ibarrier(request);
4519
4520   return MPI_SUCCESS;
4521 }
4522
4523 AMPI_API_IMPL(int, MPI_Bcast, void *buf, int count, MPI_Datatype type, int root, MPI_Comm comm)
4524 {
4525   AMPI_API("AMPI_Bcast");
4526
4527   handle_MPI_BOTTOM(buf, type);
4528
4529 #if AMPI_ERROR_CHECKING
4530   int validateBuf = 1;
4531   if (getAmpiParent()->isInter(comm)) {
4532     //if comm is an intercomm, then only root and remote ranks need to have a valid buf
4533     //local ranks need not validate it
4534     if (root==MPI_PROC_NULL) validateBuf = 0;
4535   }
4536   int ret = errorCheck("AMPI_Bcast", comm, 1, count, 1, type, 1, 0, 0, root, 1, buf, validateBuf);
4537
4538   if(ret != MPI_SUCCESS)
4539     return ret;
4540 #endif
4541
4542   ampi* ptr = getAmpiInstance(comm);
4543
4544   if(getAmpiParent()->isInter(comm)) {
4545     return ptr->intercomm_bcast(root, buf, count, type, comm);
4546   }
4547   if(ptr->getSize() == 1)
4548     return MPI_SUCCESS;
4549
4550 #if AMPIMSGLOG
4551   ampiParent* pptr = getAmpiParent();
4552   if(msgLogRead){
4553     (*(pptr->fromPUPer))|(pptr->pupBytes);
4554     PUParray(*(pptr->fromPUPer), (char *)buf, (pptr->pupBytes));
4555     return MPI_SUCCESS;
4556   }
4557 #endif
4558
4559   ptr->bcast(root, buf, count, type,comm);
4560
4561 #if AMPIMSGLOG
4562   if(msgLogWrite && record_msglog(pptr->thisIndex)) {
4563     (pptr->pupBytes) = getDDT()->getSize(type) * count;
4564     (*(pptr->toPUPer))|(pptr->pupBytes);
4565     PUParray(*(pptr->toPUPer), (char *)buf, (pptr->pupBytes));
4566   }
4567 #endif
4568
4569   return MPI_SUCCESS;
4570 }
4571
4572 AMPI_API_IMPL(int, MPI_Ibcast, void *buf, int count, MPI_Datatype type, int root,
4573                                MPI_Comm comm, MPI_Request *request)
4574 {
4575   AMPI_API("AMPI_Ibcast");
4576
4577   handle_MPI_BOTTOM(buf, type);
4578
4579 #if AMPI_ERROR_CHECKING
4580   int validateBuf = 1;
4581   if (getAmpiParent()->isInter(comm)) {
4582     //if comm is an intercomm, then only root and remote ranks need to have a valid buf
4583     //local ranks need not validate it
4584     if (root==MPI_PROC_NULL) validateBuf = 0;
4585   }
4586   int ret = errorCheck("AMPI_Ibcast", comm, 1, count, 1, type, 1, 0, 0, root, 1, buf, validateBuf);
4587
4588   if(ret != MPI_SUCCESS){
4589     *request = MPI_REQUEST_NULL;
4590     return ret;
4591   }
4592 #endif
4593
4594   ampi* ptr = getAmpiInstance(comm);
4595
4596   if(getAmpiParent()->isInter(comm)) {
4597     return ptr->intercomm_ibcast(root, buf, count, type, comm, request);
4598   }
4599   if(ptr->getSize() == 1){
4600     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(buf, count, type, root, MPI_BCAST_TAG, comm,
4601                             getDDT(), AMPI_REQ_COMPLETED));
4602     return MPI_SUCCESS;
4603   }
4604
4605 #if AMPIMSGLOG
4606   ampiParent* pptr = getAmpiParent();
4607   if(msgLogRead){
4608     (*(pptr->fromPUPer))|(pptr->pupBytes);
4609     PUParray(*(pptr->fromPUPer), (char *)buf, (pptr->pupBytes));
4610     return MPI_SUCCESS;
4611   }
4612 #endif
4613
4614   ptr->ibcast(root, buf, count, type, comm, request);
4615
4616 #if AMPIMSGLOG
4617   if(msgLogWrite && record_msglog(pptr->thisIndex)) {
4618     (pptr->pupBytes) = getDDT()->getSize(type) * count;
4619     (*(pptr->toPUPer))|(pptr->pupBytes);
4620     PUParray(*(pptr->toPUPer), (char *)buf, (pptr->pupBytes));
4621   }
4622 #endif
4623
4624   return MPI_SUCCESS;
4625 }
4626
4627 // This routine is called with the results of an (All)Reduce or (All)Gather(v)
4628 void ampi::rednResult(CkReductionMsg *msg) noexcept
4629 {
4630   MSG_ORDER_DEBUG(CkPrintf("[%d] rednResult called on comm %d\n", thisIndex, myComm.getComm()));
4631
4632   if (blockingReq == NULL) {
4633     CkAbort("AMPI> recv'ed a blocking reduction unexpectedly!\n");
4634   }
4635
4636 #if CMK_BIGSIM_CHARM
4637   TRACE_BG_ADD_TAG("AMPI_generic");
4638   msg->event = NULL;
4639   _TRACE_BG_TLINE_END(&msg->event); // store current log
4640   msg->eventPe = CkMyPe();
4641 #endif
4642
4643   blockingReq->receive(this, msg);
4644
4645   if (parent->resumeOnColl) {
4646     thread->resume();
4647   }
4648   // [nokeep] entry method, so do not delete msg
4649 }
4650
4651 // This routine is called with the results of an I(all)reduce or I(all)gather(v)
4652 void ampi::irednResult(CkReductionMsg *msg) noexcept
4653 {
4654   MSG_ORDER_DEBUG(CkPrintf("[%d] irednResult called on comm %d\n", thisIndex, myComm.getComm()));
4655
4656   AmpiRequest* req = postedReqs.get(MPI_REDN_TAG, AMPI_COLL_SOURCE);
4657   if (req == NULL)
4658     CkAbort("AMPI> recv'ed a non-blocking reduction unexpectedly!\n");
4659
4660 #if CMK_BIGSIM_CHARM
4661   TRACE_BG_ADD_TAG("AMPI_generic");
4662   msg->event = NULL;
4663   _TRACE_BG_TLINE_END(&msg->event); // store current log
4664   msg->eventPe = CkMyPe();
4665 #endif
4666 #if AMPIMSGLOG
4667   if(msgLogRead){
4668     PUParray(*(getAmpiParent()->fromPUPer), (char *)req, sizeof(int));
4669     return;
4670   }
4671 #endif
4672
4673   handleBlockedReq(req);
4674   req->receive(this, msg);
4675
4676 #if AMPIMSGLOG
4677   if(msgLogWrite && record_msglog(getAmpiParent()->thisIndex)){
4678     PUParray(*(getAmpiParent()->toPUPer), (char *)reqnReq, sizeof(int));
4679   }
4680 #endif
4681
4682   if (parent->resumeOnColl && parent->numBlockedReqs==0) {
4683     thread->resume();
4684   }
4685   // [nokeep] entry method, so do not delete msg
4686 }
4687
4688 static CkReductionMsg *makeRednMsg(CkDDT_DataType *ddt,const void *inbuf,int count,int type,int rank,MPI_Op op) noexcept
4689 {
4690   CkReductionMsg *msg;
4691   ampiParent *parent = getAmpiParent();
4692   int szdata = ddt->getSize(count);
4693   CkReduction::reducerType reducer = getBuiltinReducerType(type, op);
4694
4695   if (reducer != CkReduction::invalid) {
4696     // MPI predefined op matches a Charm++ builtin reducer type
4697     AMPI_DEBUG("[%d] In makeRednMsg, using Charm++ built-in reducer type for a predefined op\n", parent->thisIndex);
4698     msg = CkReductionMsg::buildNew(szdata, NULL, reducer);
4699     ddt->serialize((char*)inbuf, (char*)msg->getData(), count, msg->getLength(), PACK);
4700   }
4701   else if (parent->opIsCommutative(op) && ddt->isContig()) {
4702     // Either an MPI predefined reducer operation with no Charm++ builtin reducer type equivalent, or
4703     // a commutative user-defined reducer operation on a contiguous datatype
4704     AMPI_DEBUG("[%d] In makeRednMsg, using custom AmpiReducer type for a commutative op\n", parent->thisIndex);
4705     AmpiOpHeader newhdr = parent->op2AmpiOpHeader(op, type, count);
4706     int szhdr = sizeof(AmpiOpHeader);
4707     msg = CkReductionMsg::buildNew(szdata+szhdr, NULL, AmpiReducer);
4708     memcpy(msg->getData(), &newhdr, szhdr);
4709     ddt->serialize((char*)inbuf, (char*)msg->getData()+szhdr, count, msg->getLength()-szhdr, PACK);
4710   }
4711   else {
4712     // Non-commutative user-defined reducer operation, or
4713     // a commutative user-defined reduction on a non-contiguous datatype
4714     AMPI_DEBUG("[%d] In makeRednMsg, using a non-commutative user-defined operation\n", parent->thisIndex);
4715     const int tupleSize = 2;
4716     CkReduction::tupleElement tupleRedn[tupleSize];
4717     tupleRedn[0] = CkReduction::tupleElement(sizeof(int), &rank, CkReduction::set);
4718     if (!ddt->isContig()) {
4719       vector<char> sbuf(szdata);
4720       ddt->serialize((char*)inbuf, sbuf.data(), count, szdata, PACK);
4721       tupleRedn[1] = CkReduction::tupleElement(szdata, sbuf.data(), CkReduction::set);
4722     }
4723     else {
4724       tupleRedn[1] = CkReduction::tupleElement(szdata, (void*)inbuf, CkReduction::set);
4725     }
4726     msg = CkReductionMsg::buildFromTuple(tupleRedn, tupleSize);
4727   }
4728   return msg;
4729 }
4730
4731 // Copy the MPI datatype "type" from inbuf to outbuf
4732 static int copyDatatype(MPI_Datatype sendtype, int sendcount, MPI_Datatype recvtype,
4733                         int recvcount, const void *inbuf, void *outbuf) noexcept
4734 {
4735   if (inbuf == outbuf) return MPI_SUCCESS; // handle MPI_IN_PLACE
4736
4737   CkDDT_DataType *sddt = getDDT()->getType(sendtype);
4738   CkDDT_DataType *rddt = getDDT()->getType(recvtype);
4739
4740   if (sddt->isContig() && rddt->isContig()) {
4741     int slen = sddt->getSize(sendcount);
4742     memcpy(outbuf, inbuf, slen);
4743   } else if (sddt->isContig()) {
4744     rddt->serialize((char*)outbuf, (char*)inbuf, recvcount, sddt->getSize(sendcount), UNPACK);
4745   } else if (rddt->isContig()) {
4746     sddt->serialize((char*)inbuf, (char*)outbuf, sendcount, rddt->getSize(recvcount), PACK);
4747   } else {
4748     // ddts don't have "copy", so fake it by serializing into a temp buffer, then
4749     //  deserializing into the output.
4750     int slen = sddt->getSize(sendcount);
4751     vector<char> serialized(slen);
4752     sddt->serialize((char*)inbuf, serialized.data(), sendcount, rddt->getSize(recvcount), PACK);
4753     rddt->serialize((char*)outbuf, serialized.data(), recvcount, sddt->getSize(sendcount), UNPACK);
4754   }
4755
4756   return MPI_SUCCESS;
4757 }
4758
4759 static void handle_MPI_IN_PLACE(void* &inbuf, void* &outbuf) noexcept
4760 {
4761   if (inbuf == MPI_IN_PLACE) inbuf = outbuf;
4762   if (outbuf == MPI_IN_PLACE) outbuf = inbuf;
4763   CkAssert(inbuf != MPI_IN_PLACE && outbuf != MPI_IN_PLACE);
4764 }
4765
4766 static void handle_MPI_IN_PLACE_gather(void* &sendbuf, void* recvbuf, int &sendcount,
4767                                        MPI_Datatype &sendtype, int recvdispl,
4768                                        int recvcount, MPI_Datatype recvtype) noexcept
4769 {
4770   if (sendbuf == MPI_IN_PLACE) {
4771     // The MPI standard says that when MPI_IN_PLACE is passed to any of the gather
4772     // variants, the contribution of the root to the gathered vector is assumed
4773     // to be already in the correct place in the receive buffer.
4774     sendbuf   = (char*)recvbuf + (recvdispl * getDDT()->getExtent(recvtype));
4775     sendcount = recvcount;
4776     sendtype  = recvtype;
4777   }
4778   CkAssert(recvbuf != MPI_IN_PLACE);
4779 }
4780
4781 static void handle_MPI_IN_PLACE_gatherv(void* &sendbuf, void* recvbuf, int &sendcount,
4782                                         MPI_Datatype &sendtype, const int recvdispls[],
4783                                         const int recvcounts[], int rank,
4784                                         MPI_Datatype recvtype) noexcept
4785 {
4786   if (sendbuf == MPI_IN_PLACE) {
4787     // The MPI standard says that when MPI_IN_PLACE is passed to any of the gather
4788     // variants, the contribution of the root to the gathered vector is assumed
4789     // to be already in the correct place in the receive buffer.
4790     CkAssert(recvbuf != NULL && recvdispls != NULL && recvcounts != NULL);
4791     sendbuf   = (char*)recvbuf + (recvdispls[rank] * getDDT()->getExtent(recvtype));
4792     sendcount = recvcounts[rank];
4793     sendtype  = recvtype;
4794   }
4795   CkAssert(recvbuf != MPI_IN_PLACE);
4796 }
4797
4798 static void handle_MPI_IN_PLACE_alltoall(void* &sendbuf, void* recvbuf, int &sendcount,
4799                                          MPI_Datatype &sendtype, int recvcount,
4800                                          MPI_Datatype recvtype) noexcept
4801 {
4802   if (sendbuf == MPI_IN_PLACE) {
4803     sendbuf   = recvbuf;
4804     sendcount = recvcount;
4805     sendtype  = recvtype;
4806   }
4807   CkAssert(recvbuf != MPI_IN_PLACE);
4808 }
4809
4810 static void handle_MPI_IN_PLACE_alltoallv(void* &sendbuf, void* recvbuf, int* &sendcounts,
4811                                           MPI_Datatype &sendtype, int* &sdispls,
4812                                           const int* recvcounts, MPI_Datatype recvtype,
4813                                           const int* rdispls) noexcept
4814 {
4815   if (sendbuf == MPI_IN_PLACE) {
4816     sendbuf    = recvbuf;
4817     sendcounts = (int*)recvcounts;
4818     sendtype   = recvtype;
4819     sdispls    = (int*)rdispls;
4820   }
4821   CkAssert(recvbuf != MPI_IN_PLACE);
4822 }
4823
4824 static void handle_MPI_IN_PLACE_alltoallw(void* &sendbuf, void* recvbuf, int* &sendcounts,
4825                                           MPI_Datatype* &sendtypes, int* &sdispls,
4826                                           const int* recvcounts, const MPI_Datatype* recvtypes,
4827                                           const int* rdispls) noexcept
4828 {
4829   if (sendbuf == MPI_IN_PLACE) {
4830     sendbuf    = recvbuf;
4831     sendcounts = (int*)recvcounts;
4832     sendtypes  = (MPI_Datatype*)recvtypes;
4833     sdispls    = (int*)rdispls;
4834   }
4835   CkAssert(recvbuf != MPI_IN_PLACE);
4836 }
4837
4838 #define AMPI_SYNC_REDUCE 0
4839
4840 AMPI_API_IMPL(int, MPI_Reduce, const void *inbuf, void *outbuf, int count, MPI_Datatype type,
4841                                MPI_Op op, int root, MPI_Comm comm)
4842 {
4843   AMPI_API("AMPI_Reduce");
4844
4845   handle_MPI_BOTTOM((void*&)inbuf, type, outbuf, type);
4846   handle_MPI_IN_PLACE((void*&)inbuf, outbuf);
4847
4848 #if AMPI_ERROR_CHECKING
4849   if(op == MPI_OP_NULL)
4850     return ampiErrhandler("AMPI_Reduce", MPI_ERR_OP);
4851   int ret = errorCheck("AMPI_Reduce", comm, 1, count, 1, type, 1, 0, 0, root, 1, inbuf, 1,
4852                        outbuf, getAmpiInstance(comm)->getRank() == root);
4853   if(ret != MPI_SUCCESS)
4854     return ret;
4855 #endif
4856
4857   ampi *ptr = getAmpiInstance(comm);
4858
4859   if(getAmpiParent()->isInter(comm))
4860     CkAbort("AMPI does not implement MPI_Reduce for Inter-communicators!");
4861   if(ptr->getSize() == 1)
4862     return copyDatatype(type,count,type,count,inbuf,outbuf);
4863
4864 #if AMPIMSGLOG
4865   ampiParent* pptr = getAmpiParent();
4866   if(msgLogRead){
4867     (*(pptr->fromPUPer))|(pptr->pupBytes);
4868     PUParray(*(pptr->fromPUPer), (char *)outbuf, (pptr->pupBytes));
4869     return MPI_SUCCESS;
4870   }
4871 #endif
4872
4873   int rootIdx=ptr->comm2CommStruct(comm).getIndexForRank(root);
4874   CkReductionMsg *msg=makeRednMsg(ptr->getDDT()->getType(type),inbuf,count,type,ptr->getRank(),op);
4875
4876   CkCallback reduceCB(CkIndex_ampi::rednResult(0),CkArrayIndex1D(rootIdx),ptr->getProxy());
4877   msg->setCallback(reduceCB);
4878   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Reduce called on comm %d root %d \n",ptr->thisIndex,comm,rootIdx));
4879   ptr->contribute(msg);
4880
4881   if (ptr->thisIndex == rootIdx){
4882     ptr = ptr->blockOnRedn(new RednReq(outbuf, count, type, comm, op, getDDT()));
4883
4884 #if AMPI_SYNC_REDUCE
4885     AmpiMsg *msg = new (0, 0) AmpiMsg(0, 0, MPI_REDN_TAG, -1, rootIdx, 0);
4886     CProxy_ampi pa(ptr->getProxy());
4887     pa.generic(msg);
4888 #endif
4889   }
4890 #if AMPI_SYNC_REDUCE
4891   ptr->recv(MPI_REDN_TAG, AMPI_COLL_SOURCE, NULL, 0, type, comm);
4892 #endif
4893
4894 #if AMPIMSGLOG
4895   if(msgLogWrite && record_msglog(pptr->thisIndex)){
4896     (pptr->pupBytes) = getDDT()->getSize(type) * count;
4897     (*(pptr->toPUPer))|(pptr->pupBytes);
4898     PUParray(*(pptr->toPUPer), (char *)outbuf, (pptr->pupBytes));
4899   }
4900 #endif
4901
4902   return MPI_SUCCESS;
4903 }
4904
4905 AMPI_API_IMPL(int, MPI_Allreduce, const void *inbuf, void *outbuf, int count, MPI_Datatype type,
4906                                   MPI_Op op, MPI_Comm comm)
4907 {
4908   AMPI_API("AMPI_Allreduce");
4909
4910   handle_MPI_BOTTOM((void*&)inbuf, type, outbuf, type);
4911   handle_MPI_IN_PLACE((void*&)inbuf, outbuf);
4912
4913 #if AMPI_ERROR_CHECKING
4914   if(op == MPI_OP_NULL)
4915     return ampiErrhandler("AMPI_Allreduce", MPI_ERR_OP);
4916   int ret = errorCheck("AMPI_Allreduce", comm, 1, count, 1, type, 1, 0, 0, 0, 0, inbuf, 1, outbuf, 1);
4917   if(ret != MPI_SUCCESS)
4918     return ret;
4919 #endif
4920
4921   ampi *ptr = getAmpiInstance(comm);
4922
4923   if(getAmpiParent()->isInter(comm))
4924     CkAbort("AMPI does not implement MPI_Allreduce for Inter-communicators!");
4925   if(ptr->getSize() == 1)
4926     return copyDatatype(type,count,type,count,inbuf,outbuf);
4927
4928 #if CMK_BIGSIM_CHARM
4929   TRACE_BG_AMPI_LOG(MPI_ALLREDUCE, getAmpiInstance(comm)->getDDT()->getType(type)->getSize(count));
4930 #endif
4931
4932 #if AMPIMSGLOG
4933   ampiParent* pptr = getAmpiParent();
4934   if(msgLogRead){
4935     (*(pptr->fromPUPer))|(pptr->pupBytes);
4936     PUParray(*(pptr->fromPUPer), (char *)outbuf, (pptr->pupBytes));
4937     return MPI_SUCCESS;
4938   }
4939 #endif
4940
4941   CkReductionMsg *msg=makeRednMsg(ptr->getDDT()->getType(type), inbuf, count, type, ptr->getRank(), op);
4942   CkCallback allreduceCB(CkIndex_ampi::rednResult(0),ptr->getProxy());
4943   msg->setCallback(allreduceCB);
4944   ptr->contribute(msg);
4945
4946   ptr->blockOnRedn(new RednReq(outbuf, count, type, comm, op, getDDT()));
4947
4948 #if AMPIMSGLOG
4949   if(msgLogWrite && record_msglog(pptr->thisIndex)){
4950     (pptr->pupBytes) = getDDT()->getSize(type) * count;
4951     (*(pptr->toPUPer))|(pptr->pupBytes);
4952     PUParray(*(pptr->toPUPer), (char *)outbuf, (pptr->pupBytes));
4953   }
4954 #endif
4955
4956   return MPI_SUCCESS;
4957 }
4958
4959 AMPI_API_IMPL(int, MPI_Iallreduce, const void *inbuf, void *outbuf, int count, MPI_Datatype type,
4960                                    MPI_Op op, MPI_Comm comm, MPI_Request* request)
4961 {
4962   AMPI_API("AMPI_Iallreduce");
4963
4964   handle_MPI_BOTTOM((void*&)inbuf, type, outbuf, type);
4965   handle_MPI_IN_PLACE((void*&)inbuf, outbuf);
4966
4967 #if AMPI_ERROR_CHECKING
4968   if(op == MPI_OP_NULL)
4969     return ampiErrhandler("AMPI_Iallreduce", MPI_ERR_OP);
4970   int ret = errorCheck("AMPI_Iallreduce", comm, 1, count, 1, type, 1, 0, 0, 0, 0, inbuf, 1, outbuf, 1);
4971   if(ret != MPI_SUCCESS){
4972     *request = MPI_REQUEST_NULL;
4973     return ret;
4974   }
4975 #endif
4976
4977   ampi *ptr = getAmpiInstance(comm);
4978
4979   if(getAmpiParent()->isInter(comm))
4980     CkAbort("AMPI does not implement MPI_Iallreduce for Inter-communicators!");
4981   if(ptr->getSize() == 1){
4982     *request = ptr->postReq(new RednReq(outbuf,count,type,comm,op,getDDT(),AMPI_REQ_COMPLETED));
4983     return copyDatatype(type,count,type,count,inbuf,outbuf);
4984   }
4985
4986   CkReductionMsg *msg=makeRednMsg(ptr->getDDT()->getType(type),inbuf,count,type,ptr->getRank(),op);
4987   CkCallback allreduceCB(CkIndex_ampi::irednResult(0),ptr->getProxy());
4988   msg->setCallback(allreduceCB);
4989   ptr->contribute(msg);
4990
4991   // use a RednReq to non-block the caller and get a request ptr
4992   *request = ptr->postReq(new RednReq(outbuf,count,type,comm,op,getDDT()));
4993
4994   return MPI_SUCCESS;
4995 }
4996
4997 AMPI_API_IMPL(int, MPI_Reduce_local, const void *inbuf, void *outbuf, int count,
4998                                      MPI_Datatype type, MPI_Op op)
4999 {
5000   AMPI_API("AMPI_Reduce_local");
5001
5002   handle_MPI_BOTTOM((void*&)inbuf, type, outbuf, type);
5003
5004 #if AMPI_ERROR_CHECKING
5005   if(op == MPI_OP_NULL)
5006     return ampiErrhandler("AMPI_Reduce_local", MPI_ERR_OP);
5007   if(inbuf == MPI_IN_PLACE || outbuf == MPI_IN_PLACE)
5008     CkAbort("MPI_Reduce_local does not accept MPI_IN_PLACE!");
5009   int ret = errorCheck("AMPI_Reduce_local", MPI_COMM_SELF, 1, count, 1, type, 1, 0, 0, 0, 1, inbuf, 1, outbuf, 1);
5010   if(ret != MPI_SUCCESS)
5011     return ret;
5012 #endif
5013
5014   getAmpiParent()->applyOp(type, op, count, inbuf, outbuf);
5015   return MPI_SUCCESS;
5016 }
5017
5018 AMPI_API_IMPL(int, MPI_Reduce_scatter_block, const void* sendbuf, void* recvbuf, int count,
5019                                              MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
5020 {
5021   AMPI_API("AMPI_Reduce_scatter_block");
5022
5023   handle_MPI_BOTTOM((void*&)sendbuf, datatype, recvbuf, datatype);
5024   handle_MPI_IN_PLACE((void*&)sendbuf, recvbuf);
5025
5026 #if AMPI_ERROR_CHECKING
5027   if(op == MPI_OP_NULL)
5028     return ampiErrhandler("AMPI_Reduce_scatter_block", MPI_ERR_OP);
5029   int ret = errorCheck("AMPI_Reduce_scatter_block", comm, 1, 0, 0, datatype, 1, 0, 0, 0, 0, sendbuf, 1, recvbuf, 1);
5030   if(ret != MPI_SUCCESS)
5031     return ret;
5032 #endif
5033
5034   ampi *ptr = getAmpiInstance(comm);
5035   int size = ptr->getSize();
5036
5037   if(getAmpiParent()->isInter(comm))
5038     CkAbort("AMPI does not implement MPI_Reduce_scatter_block for Inter-communicators!");
5039   if(size == 1)
5040     return copyDatatype(datatype, count, datatype, count, sendbuf, recvbuf);
5041
5042   vector<char> tmpbuf(ptr->getDDT()->getType(datatype)->getSize(count)*size);
5043
5044   MPI_Reduce(sendbuf, &tmpbuf[0], count*size, datatype, op, AMPI_COLL_SOURCE, comm);
5045   MPI_Scatter(&tmpbuf[0], count, datatype, recvbuf, count, datatype, AMPI_COLL_SOURCE, comm);
5046
5047   return MPI_SUCCESS;
5048 }
5049
5050 AMPI_API_IMPL(int, MPI_Ireduce_scatter_block, const void* sendbuf, void* recvbuf, int count,
5051                                               MPI_Datatype datatype, MPI_Op op, MPI_Comm comm,
5052                                               MPI_Request* request)
5053 {
5054   AMPI_API("AMPI_Ireduce_scatter_block");
5055   // FIXME: implement non-blocking reduce_scatter_block
5056   int ret = MPI_Reduce_scatter_block(sendbuf, recvbuf, count, datatype, op, comm);
5057   *request = MPI_REQUEST_NULL;
5058   return ret;
5059 }
5060
5061 AMPI_API_IMPL(int, MPI_Reduce_scatter, const void* sendbuf, void* recvbuf, const int *recvcounts,
5062                                        MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
5063 {
5064   AMPI_API("AMPI_Reduce_scatter");
5065
5066   handle_MPI_BOTTOM((void*&)sendbuf, datatype, recvbuf, datatype);
5067   handle_MPI_IN_PLACE((void*&)sendbuf, recvbuf);
5068
5069 #if AMPI_ERROR_CHECKING
5070   if(op == MPI_OP_NULL)
5071     return ampiErrhandler("AMPI_Reduce_scatter", MPI_ERR_OP);
5072   int ret = errorCheck("AMPI_Reduce_scatter", comm, 1, 0, 0, datatype, 1, 0, 0, 0, 0, sendbuf, 1, recvbuf, 1);
5073   if(ret != MPI_SUCCESS)
5074     return ret;
5075 #endif
5076
5077   ampi *ptr = getAmpiInstance(comm);
5078   int size = ptr->getSize();
5079
5080   if(getAmpiParent()->isInter(comm))
5081     CkAbort("AMPI does not implement MPI_Reduce_scatter for Inter-communicators!");
5082   if(size == 1)
5083     return copyDatatype(datatype,recvcounts[0],datatype,recvcounts[0],sendbuf,recvbuf);
5084
5085   int count=0;
5086   vector<int> displs(size);
5087   int len;
5088
5089   //under construction
5090   for(int i=0;i<size;i++){
5091     displs[i] = count;
5092     count+= recvcounts[i];
5093   }
5094   vector<char> tmpbuf(ptr->getDDT()->getType(datatype)->getSize(count));
5095   MPI_Reduce(sendbuf, tmpbuf.data(), count, datatype, op, AMPI_COLL_SOURCE, comm);
5096   MPI_Scatterv(tmpbuf.data(), recvcounts, displs.data(), datatype,
5097                           recvbuf, recvcounts[ptr->getRank()], datatype, AMPI_COLL_SOURCE, comm);
5098   return MPI_SUCCESS;
5099 }
5100
5101 AMPI_API_IMPL(int, MPI_Ireduce_scatter, const void* sendbuf, void* recvbuf, const int *recvcounts,
5102                                         MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request* request)
5103 {
5104   AMPI_API("AMPI_Ireduce_scatter");
5105   // FIXME: implement non-blocking reduce_scatter
5106   int ret = MPI_Reduce_scatter(sendbuf, recvbuf, recvcounts, datatype, op, comm);
5107   *request = MPI_REQUEST_NULL;
5108   return ret;
5109 }
5110
5111 AMPI_API_IMPL(int, MPI_Scan, const void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype,
5112                              MPI_Op op, MPI_Comm comm)
5113 {
5114   AMPI_API("AMPI_Scan");
5115
5116   handle_MPI_BOTTOM((void*&)sendbuf, datatype, recvbuf, datatype);
5117   handle_MPI_IN_PLACE((void*&)sendbuf,recvbuf);
5118
5119 #if AMPI_ERROR_CHECKING
5120   if(op == MPI_OP_NULL)
5121     return ampiErrhandler("AMPI_Scan", MPI_ERR_OP);
5122   int ret = errorCheck("AMPI_Scan", comm, 1, count, 1, datatype, 1, 0, 0, 0, 0, sendbuf, 1, recvbuf, 1);
5123   if(ret != MPI_SUCCESS)
5124     return ret;
5125 #endif
5126
5127   ampi *ptr = getAmpiInstance(comm);
5128   int size = ptr->getSize();
5129
5130   if (size == 1 && !getAmpiParent()->isInter(comm))
5131     return copyDatatype(datatype, count, datatype, count, sendbuf, recvbuf);
5132
5133   int blklen = ptr->getDDT()->getType(datatype)->getSize(count);
5134   int rank = ptr->getRank();
5135   int mask = 0x1;
5136   int dst;
5137   vector<char> tmp_buf(blklen);
5138   vector<char> partial_scan(blklen);
5139
5140   memcpy(recvbuf, sendbuf, blklen);
5141   memcpy(partial_scan.data(), sendbuf, blklen);
5142   while(mask < size){
5143     dst = rank^mask;
5144     if(dst < size){
5145       ptr->sendrecv(partial_scan.data(), count, datatype, dst, MPI_SCAN_TAG,
5146                     tmp_buf.data(), count, datatype, dst, MPI_SCAN_TAG, comm, MPI_STATUS_IGNORE);
5147       if(rank > dst){
5148         getAmpiParent()->applyOp(datatype, op, count, tmp_buf.data(), partial_scan.data());
5149         getAmpiParent()->applyOp(datatype, op, count, tmp_buf.data(), recvbuf);
5150       }else {
5151         getAmpiParent()->applyOp(datatype, op, count, partial_scan.data(), tmp_buf.data());
5152         memcpy(partial_scan.data(), tmp_buf.data(), blklen);
5153       }
5154     }
5155     mask <<= 1;
5156   }
5157
5158   return MPI_SUCCESS;
5159 }
5160
5161 AMPI_API_IMPL(int, MPI_Iscan, const void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype,
5162                               MPI_Op op, MPI_Comm comm, MPI_Request* request)
5163 {
5164   AMPI_API("AMPI_Iscan");
5165   // FIXME: implement non-blocking scan
5166   int ret = MPI_Scan(sendbuf, recvbuf, count, datatype, op, comm);
5167   *request = MPI_REQUEST_NULL;
5168   return ret;
5169 }
5170
5171 AMPI_API_IMPL(int, MPI_Exscan, const void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype,
5172                                MPI_Op op, MPI_Comm comm)
5173 {
5174   AMPI_API("AMPI_Exscan");
5175
5176   handle_MPI_BOTTOM((void*&)sendbuf, datatype, recvbuf, datatype);
5177   handle_MPI_IN_PLACE((void*&)sendbuf,recvbuf);
5178
5179 #if AMPI_ERROR_CHECKING
5180   if(op == MPI_OP_NULL)
5181     return ampiErrhandler("AMPI_Exscan", MPI_ERR_OP);
5182   int ret = errorCheck("AMPI_Excan", comm, 1, count, 1, datatype, 1, 0, 0, 0, 0, sendbuf, 1, recvbuf, 1);
5183   if(ret != MPI_SUCCESS)
5184     return ret;
5185 #endif
5186
5187   ampi *ptr = getAmpiInstance(comm);
5188   int size = ptr->getSize();
5189
5190   if (size == 1 && !getAmpiParent()->isInter(comm))
5191     return MPI_SUCCESS;
5192
5193   int blklen = ptr->getDDT()->getType(datatype)->getSize(count);
5194   int rank = ptr->getRank();
5195   int mask = 0x1;
5196   int dst, flag;
5197   vector<char> tmp_buf(blklen);
5198   vector<char> partial_scan(blklen);
5199
5200   if (rank > 0) memcpy(recvbuf, sendbuf, blklen);
5201   memcpy(partial_scan.data(), sendbuf, blklen);
5202   flag = 0;
5203   mask = 0x1;
5204   while(mask < size){
5205     dst = rank^mask;
5206     if(dst < size){
5207       ptr->sendrecv(partial_scan.data(), count, datatype, dst, MPI_EXSCAN_TAG,
5208                     tmp_buf.data(), count, datatype, dst, MPI_EXSCAN_TAG, comm, MPI_STATUS_IGNORE);
5209       if(rank > dst){
5210         getAmpiParent()->applyOp(datatype, op, count, tmp_buf.data(), partial_scan.data());
5211         if(rank != 0){
5212           if(flag == 0){
5213             memcpy(recvbuf, tmp_buf.data(), blklen);
5214             flag = 1;
5215           }
5216           else{
5217             getAmpiParent()->applyOp(datatype, op, count, tmp_buf.data(), recvbuf);
5218           }
5219         }
5220       }
5221       else{
5222         getAmpiParent()->applyOp(datatype, op, count, partial_scan.data(), tmp_buf.data());
5223         memcpy(partial_scan.data(), tmp_buf.data(), blklen);
5224       }
5225       mask <<= 1;
5226     }
5227   }
5228
5229   return MPI_SUCCESS;
5230 }
5231
5232 AMPI_API_IMPL(int, MPI_Iexscan, const void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype,
5233                                 MPI_Op op, MPI_Comm comm, MPI_Request* request)
5234 {
5235   AMPI_API("AMPI_Iexscan");
5236   // FIXME: implement non-blocking exscan
5237   int ret = MPI_Exscan(sendbuf, recvbuf, count, datatype, op, comm);
5238   *request = MPI_REQUEST_NULL;
5239   return ret;
5240 }
5241
5242 AMPI_API_IMPL(int, MPI_Op_create, MPI_User_function *function, int commute, MPI_Op *op)
5243 {
5244   AMPI_API("AMPI_Op_create");
5245   *op = getAmpiParent()->createOp(function, commute);
5246   return MPI_SUCCESS;
5247 }
5248
5249 AMPI_API_IMPL(int, MPI_Op_free, MPI_Op *op)
5250 {
5251   AMPI_API("AMPI_Op_free");
5252   getAmpiParent()->freeOp(*op);
5253   *op = MPI_OP_NULL;
5254   return MPI_SUCCESS;
5255 }
5256
5257 AMPI_API_IMPL(int, MPI_Op_commutative, MPI_Op op, int *commute)
5258 {
5259   AMPI_API("AMPI_Op_commutative");
5260   if (op == MPI_OP_NULL)
5261     return ampiErrhandler("AMPI_Op_commutative", MPI_ERR_OP);
5262   *commute = (int)getAmpiParent()->opIsCommutative(op);
5263   return MPI_SUCCESS;
5264 }
5265
5266 AMPI_API_IMPL(double, MPI_Wtime, void)
5267 {
5268   //AMPI_API("AMPI_Wtime");
5269
5270 #if AMPIMSGLOG
5271   double ret=TCHARM_Wall_timer();
5272   ampiParent* pptr = getAmpiParent();
5273   if(msgLogRead){
5274     (*(pptr->fromPUPer))|ret;
5275     return ret;
5276   }
5277
5278   if(msgLogWrite && record_msglog(pptr->thisIndex)){
5279     (*(pptr->toPUPer))|ret;
5280   }
5281 #endif
5282
5283 #if CMK_BIGSIM_CHARM
5284   return BgGetTime();
5285 #else
5286   return TCHARM_Wall_timer();
5287 #endif
5288 }
5289
5290 AMPI_API_IMPL(double, MPI_Wtick, void)
5291 {
5292   //AMPI_API("AMPI_Wtick");
5293   return 1e-6;
5294 }
5295
5296 AMPI_API_IMPL(int, MPI_Start, MPI_Request *request)
5297 {
5298   AMPI_API("AMPI_Start");
5299   checkRequest(*request);
5300   AmpiRequestList& reqs = getReqs();
5301 #if AMPI_ERROR_CHECKING
5302   if (!reqs[*request]->isPersistent())
5303     return ampiErrhandler("AMPI_Start", MPI_ERR_REQUEST);
5304 #endif
5305   reqs[*request]->start(*request);
5306   return MPI_SUCCESS;
5307 }
5308
5309 AMPI_API_IMPL(int, MPI_Startall, int count, MPI_Request *requests)
5310 {
5311   AMPI_API("AMPI_Startall");
5312   checkRequests(count,requests);
5313   AmpiRequestList& reqs = getReqs();
5314   for(int i=0;i<count;i++){
5315 #if AMPI_ERROR_CHECKING
5316     if (!reqs[requests[i]]->isPersistent())
5317       return ampiErrhandler("MPI_Startall", MPI_ERR_REQUEST);
5318 #endif
5319     reqs[requests[i]]->start(requests[i]);
5320   }
5321   return MPI_SUCCESS;
5322 }
5323
5324 void IReq::start(MPI_Request reqIdx) noexcept {
5325   CkAssert(persistent);
5326   complete = false;
5327   ampi* ptr = getAmpiInstance(comm);
5328   AmpiMsg* msg = ptr->unexpectedMsgs.get(tag, src);
5329   if (msg) { // if msg has already arrived, do the receive right away
5330     receive(ptr, msg);
5331   }
5332   else { // ... otherwise post the receive
5333     ptr->postedReqs.put(this);
5334   }
5335 }
5336
5337 void SendReq::start(MPI_Request reqIdx) noexcept {
5338   CkAssert(persistent);
5339   complete = false;
5340   ampi* ptr = getAmpiInstance(comm);
5341   ptr->send(tag, ptr->getRank(), buf, count, type, src /*really, the destination*/, comm);
5342   complete = true;
5343 }
5344
5345 void SsendReq::start(MPI_Request reqIdx) noexcept {
5346   CkAssert(persistent);
5347   complete = false;
5348   ampi* ptr = getAmpiInstance(comm);
5349   ptr->send(tag, ptr->getRank(), buf, count, type, src /*really, the destination*/, comm, reqIdx+2, I_SEND);
5350 }
5351
5352 int IReq::wait(MPI_Status *sts) noexcept {
5353   // ampi::generic() writes directly to the buffer, so the only thing we do here is wait
5354   ampiParent *parent = getAmpiParent();
5355
5356   while (!complete) {
5357     // parent is updated in case an ampi thread is migrated while waiting for a message
5358     parent->resumeOnRecv = true;
5359     parent->numBlockedReqs = 1;
5360     setBlocked(true);
5361     parent->block();
5362     setBlocked(false);
5363     parent = getAmpiParent();
5364
5365     if (cancelled) {
5366       if (sts != MPI_STATUS_IGNORE) sts->MPI_CANCEL = 1;
5367       complete = true;
5368       parent->resumeOnRecv = false;
5369       return 0;
5370     }
5371
5372 #if CMK_BIGSIM_CHARM
5373     //Because of the out-of-core emulation, this pointer is changed after in-out
5374     //memory operation. So we need to return from this function and do the while loop
5375     //in the outer function call.
5376     if(_BgInOutOfCoreMode)
5377       return -1;
5378 #endif
5379   } // end of while
5380   parent->resumeOnRecv = false;
5381
5382   AMPI_DEBUG("IReq::wait has resumed\n");
5383
5384   if(sts!=MPI_STATUS_IGNORE) {
5385     AMPI_DEBUG("Setting sts->MPI_TAG to this->tag=%d in IReq::wait  this=%p\n", (int)this->tag, this);
5386     sts->MPI_TAG = tag;
5387     sts->MPI_SOURCE = src;
5388     sts->MPI_COMM = comm;
5389     sts->MPI_LENGTH = length;
5390     sts->MPI_CANCEL = 0;
5391   }
5392
5393   return 0;
5394 }
5395
5396 int RednReq::wait(MPI_Status *sts) noexcept {
5397   // ampi::irednResult() writes directly to the buffer, so the only thing we do here is wait
5398   ampiParent *parent = getAmpiParent();
5399
5400   while (!complete) {
5401     parent->resumeOnColl = true;
5402     parent->numBlockedReqs = 1;
5403     setBlocked(true);
5404     parent->block();
5405     setBlocked(false);
5406     parent = getAmpiParent();
5407
5408 #if CMK_BIGSIM_CHARM
5409     //Because of the out-of-core emulation, this pointer is changed after in-out
5410     //memory operation. So we need to return from this function and do the while loop
5411     //in the outer function call.
5412     if (_BgInOutOfCoreMode)
5413       return -1;
5414 #endif
5415   }
5416   parent->resumeOnColl = false;
5417
5418   AMPI_DEBUG("RednReq::wait has resumed\n");
5419
5420   if (sts != MPI_STATUS_IGNORE) {
5421     sts->MPI_TAG = tag;
5422     sts->MPI_SOURCE = src;
5423     sts->MPI_COMM = comm;
5424     sts->MPI_CANCEL = 0;
5425   }
5426   return 0;
5427 }
5428
5429 int GatherReq::wait(MPI_Status *sts) noexcept {
5430   // ampi::irednResult() writes directly to the buffer, so the only thing we do here is wait
5431   ampiParent *parent = getAmpiParent();
5432
5433   while (!complete) {
5434     parent->resumeOnColl = true;
5435     parent->numBlockedReqs = 1;
5436     setBlocked(true);
5437     parent->block();
5438     setBlocked(false);
5439     parent = getAmpiParent();
5440
5441 #if CMK_BIGSIM_CHARM
5442     //Because of the out-of-core emulation, this pointer is changed after in-out
5443     //memory operation. So we need to return from this function and do the while loop
5444     //in the outer function call.
5445     if (_BgInOutOfCoreMode)
5446       return -1;
5447 #endif
5448   }
5449   parent->resumeOnColl = false;
5450
5451   AMPI_DEBUG("GatherReq::wait has resumed\n");
5452
5453   if (sts != MPI_STATUS_IGNORE) {
5454     sts->MPI_TAG = tag;
5455     sts->MPI_SOURCE = src;
5456     sts->MPI_COMM = comm;
5457     sts->MPI_CANCEL = 0;
5458   }
5459   return 0;
5460 }
5461
5462 int GathervReq::wait(MPI_Status *sts) noexcept {
5463   // ampi::irednResult writes directly to the buffer, so the only thing we do here is wait
5464   ampiParent *parent = getAmpiParent();
5465
5466   while (!complete) {
5467     parent->resumeOnColl = true;
5468     parent->numBlockedReqs = 1;
5469     setBlocked(true);
5470     parent->block();
5471     setBlocked(false);
5472     parent = getAmpiParent();
5473
5474 #if CMK_BIGSIM_CHARM
5475     //Because of the out-of-core emulation, this pointer is changed after in-out
5476     //memory operation. So we need to return from this function and do the while loop
5477     //in the outer function call.
5478     if (_BgInOutOfCoreMode)
5479       return -1;
5480 #endif
5481   }
5482   parent->resumeOnColl = false;
5483
5484   AMPI_DEBUG("GathervReq::wait has resumed\n");
5485
5486   if (sts != MPI_STATUS_IGNORE) {
5487     sts->MPI_TAG = tag;
5488     sts->MPI_SOURCE = src;
5489     sts->MPI_COMM = comm;
5490     sts->MPI_CANCEL = 0;
5491   }
5492   return 0;
5493 }
5494
5495 int SendReq::wait(MPI_Status *sts) noexcept {
5496   ampiParent *parent = getAmpiParent();
5497   while (!complete) {
5498     parent->resumeOnRecv = true;
5499     parent->numBlockedReqs = 1;
5500     setBlocked(true);
5501     parent->block();
5502     setBlocked(false);
5503     // "dis" is updated in case an ampi thread is migrated while waiting for a message
5504     parent = getAmpiParent();
5505   }
5506   parent->resumeOnRecv = false;
5507   AMPI_DEBUG("SendReq::wait has resumed\n");
5508   if (sts != MPI_STATUS_IGNORE) {
5509     sts->MPI_COMM = comm;
5510     sts->MPI_CANCEL = 0;
5511   }
5512   return 0;
5513 }
5514
5515 int SsendReq::wait(MPI_Status *sts) noexcept {
5516   ampiParent *parent = getAmpiParent();
5517   while (!complete) {
5518     // "dis" is updated in case an ampi thread is migrated while waiting for a message
5519     parent = parent->blockOnRecv();
5520   }
5521   if (sts != MPI_STATUS_IGNORE) {
5522     sts->MPI_COMM = comm;
5523     sts->MPI_CANCEL = 0;
5524   }
5525   return 0;
5526 }
5527
5528 int ATAReq::wait(MPI_Status *sts) noexcept {
5529   MPI_Waitall(reqs.size(), reqs.data(), MPI_STATUSES_IGNORE);
5530   reqs.clear();
5531   complete = true;
5532   return 0;
5533 }
5534
5535 int GReq::wait(MPI_Status *sts) noexcept {
5536   MPI_Status tmpStatus;
5537   if (pollFn)
5538     (*pollFn)(extraState, (sts == MPI_STATUS_IGNORE || sts == MPI_STATUSES_IGNORE) ? &tmpStatus : sts);
5539   (*queryFn)(extraState, (sts == MPI_STATUS_IGNORE || sts == MPI_STATUSES_IGNORE) ? &tmpStatus : sts);
5540   complete = true;
5541   return 0;
5542 }
5543
5544 AMPI_API_IMPL(int, MPI_Wait, MPI_Request *request, MPI_Status *sts)
5545 {
5546   AMPI_API("AMPI_Wait");
5547
5548   if(*request == MPI_REQUEST_NULL){
5549     clearStatus(sts);
5550     return MPI_SUCCESS;
5551   }
5552   checkRequest(*request);
5553   ampiParent* pptr = getAmpiParent();
5554   AmpiRequestList& reqs = pptr->getReqs();
5555
5556 #if AMPIMSGLOG
5557   if(msgLogRead){
5558     (*(pptr->fromPUPer))|(pptr->pupBytes);
5559     PUParray(*(pptr->fromPUPer), (char *)(reqs[*request]->buf), (pptr->pupBytes));
5560     PUParray(*(pptr->fromPUPer), (char *)sts, sizeof(MPI_Status));
5561     return MPI_SUCCESS;
5562   }
5563 #endif
5564
5565 #if CMK_BIGSIM_CHARM
5566   void *curLog; // store current log in timeline
5567   _TRACE_BG_TLINE_END(&curLog);
5568 #endif
5569
5570   AMPI_DEBUG("AMPI_Wait request=%d reqs[*request]=%p reqs[*request]->tag=%d\n",
5571              *request, reqs[*request], (int)(reqs[*request]->tag));
5572   AMPI_DEBUG("MPI_Wait: request=%d, reqs.size=%d, &reqs=%d\n",
5573              *request, reqs.size(), reqs);
5574   CkAssert(pptr->numBlockedReqs == 0);
5575   int waitResult = -1;
5576   do{
5577     AmpiRequest& waitReq = *reqs[*request];
5578     waitResult = waitReq.wait(sts);
5579 #if CMK_BIGSIM_CHARM
5580     if(_BgInOutOfCoreMode){
5581       reqs = getReqs();
5582     }
5583 #endif
5584   }while(waitResult==-1);
5585
5586   CkAssert(pptr->numBlockedReqs == 0);
5587   AMPI_DEBUG("AMPI_Wait after calling wait, request=%d reqs[*request]=%p reqs[*request]->tag=%d\n",
5588              *request, reqs[*request], (int)(reqs[*request]->tag));
5589
5590 #if AMPIMSGLOG
5591   if(msgLogWrite && record_msglog(pptr->thisIndex)){
5592     (pptr->pupBytes) = getDDT()->getSize(reqs[*request]->type) * (reqs[*request]->count);
5593     (*(pptr->toPUPer))|(pptr->pupBytes);
5594     PUParray(*(pptr->toPUPer), (char *)(reqs[*request]->buf), (pptr->pupBytes));
5595     PUParray(*(pptr->toPUPer), (char *)sts, sizeof(MPI_Status));
5596   }
5597 #endif
5598
5599 #if CMK_BIGSIM_CHARM
5600   TRACE_BG_AMPI_WAIT(&reqs); // setup forward and backward dependence
5601 #endif
5602
5603   reqs.freeNonPersReq(*request);
5604
5605   AMPI_DEBUG("End of AMPI_Wait\n");
5606
5607   return MPI_SUCCESS;
5608 }
5609
5610 AMPI_API_IMPL(int, MPI_Waitall, int count, MPI_Request request[], MPI_Status sts[])
5611 {
5612   AMPI_API("AMPI_Waitall");
5613
5614   checkRequests(count, request);
5615   if (count == 0) return MPI_SUCCESS;
5616
5617   ampiParent* pptr = getAmpiParent();
5618   AmpiRequestList& reqs = pptr->getReqs();
5619   CkAssert(pptr->numBlockedReqs == 0);
5620
5621 #if AMPIMSGLOG
5622   if(msgLogRead){
5623     for(int i=0;i<count;i++){
5624       if(request[i] == MPI_REQUEST_NULL){
5625         clearStatus(sts, i);
5626         continue;
5627       }
5628       AmpiRequest *waitReq = reqs[request[i]];
5629       (*(pptr->fromPUPer))|(pptr->pupBytes);
5630       PUParray(*(pptr->fromPUPer), (char *)(waitReq->buf), pptr->pupBytes);
5631       PUParray(*(pptr->fromPUPer), (char *)(&sts[i]), sizeof(MPI_Status));
5632     }
5633     return MPI_SUCCESS;
5634   }
5635 #endif
5636 #if CMK_BIGSIM_CHARM
5637   void *curLog; // store current log in timeline
5638   _TRACE_BG_TLINE_END(&curLog);
5639 #endif
5640
5641   // First check for any incomplete requests
5642   for (int i=0; i<count; i++) {
5643     if (request[i] == MPI_REQUEST_NULL) {
5644       clearStatus(sts, i);
5645       continue;
5646     }
5647     AmpiRequest& req = *reqs[request[i]];
5648     if (req.test()) {
5649       req.wait((sts == MPI_STATUSES_IGNORE) ? MPI_STATUS_IGNORE : &sts[i]);
5650       req.setBlocked(false);
5651 #if AMPIMSGLOG
5652       if(msgLogWrite && record_msglog(pptr->thisIndex)){
5653         (pptr->pupBytes) = getDDT()->getSize(req.type) * req.count;
5654         (*(pptr->toPUPer))|(pptr->pupBytes);
5655         PUParray(*(pptr->toPUPer), (char *)(req.buf), pptr->pupBytes);
5656         PUParray(*(pptr->toPUPer), (char *)(&sts[i]), sizeof(MPI_Status));
5657       }
5658 #endif
5659       reqs.freeNonPersReq(request[i]);
5660     }
5661     else {
5662       req.setBlocked(true);
5663       pptr->numBlockedReqs++;
5664     }
5665   }
5666
5667   // If any requests are incomplete, block until all have been completed
5668   if (pptr->numBlockedReqs > 0) {
5669     getAmpiParent()->blockOnRecv();
5670     pptr = getAmpiParent();
5671     reqs = pptr->getReqs(); //update pointer in case of migration while suspended
5672
5673     for (int i=0; i<count; i++) {
5674       if (request[i] == MPI_REQUEST_NULL) {
5675         continue;
5676       }
5677       AmpiRequest& req = *reqs[request[i]];
5678 #if CMK_ERROR_CHECKING
5679       if (!req.test())
5680         CkAbort("In AMPI_Waitall, all requests should have completed by now!");
5681 #endif
5682       req.wait((sts == MPI_STATUSES_IGNORE) ? MPI_STATUS_IGNORE : &sts[i]);
5683       req.setBlocked(false);
5684 #if AMPIMSGLOG
5685       if(msgLogWrite && record_msglog(pptr->thisIndex)){
5686         (pptr->pupBytes) = getDDT()->getSize(req.type) * req.count;
5687         (*(pptr->toPUPer))|(pptr->pupBytes);
5688         PUParray(*(pptr->toPUPer), (char *)(req.buf), pptr->pupBytes);
5689         PUParray(*(pptr->toPUPer), (char *)(&sts[i]), sizeof(MPI_Status));
5690       }
5691 #endif
5692       reqs.freeNonPersReq(request[i]);
5693     }
5694   }
5695
5696   CkAssert(getAmpiParent()->numBlockedReqs == 0);
5697
5698 #if CMK_BIGSIM_CHARM
5699   TRACE_BG_AMPI_WAITALL(&reqs); // setup forward and backward dependence
5700 #endif
5701
5702   return MPI_SUCCESS;
5703 }
5704
5705 AMPI_API_IMPL(int, MPI_Waitany, int count, MPI_Request *request, int *idx, MPI_Status *sts)
5706 {
5707   AMPI_API("AMPI_Waitany");
5708
5709   checkRequests(count, request);
5710   if (count == 0) {
5711     *idx = MPI_UNDEFINED;
5712     return MPI_SUCCESS;
5713   }
5714
5715   ampiParent* pptr = getAmpiParent();
5716   CkAssert(pptr->numBlockedReqs == 0);
5717   AmpiRequestList& reqs = pptr->getReqs();
5718   int nullReqs = 0;
5719
5720   // First check for an already complete request
5721   for (int i=0; i<count; i++) {
5722     if (request[i] == MPI_REQUEST_NULL) {
5723       nullReqs++;
5724       continue;
5725     }
5726     AmpiRequest& req = *reqs[request[i]];
5727     if (req.test()) {
5728       req.wait(sts);
5729       reqs.unblockReqs(&request[0], i);
5730       reqs.freeNonPersReq(request[i]);
5731       *idx = i;
5732       CkAssert(pptr->numBlockedReqs == 0);
5733       return MPI_SUCCESS;
5734     }
5735
5736     req.setBlocked(true);
5737   }
5738
5739   if (nullReqs == count) {
5740     clearStatus(sts);
5741     *idx = MPI_UNDEFINED;
5742     CkAssert(pptr->numBlockedReqs == 0);
5743     return MPI_SUCCESS;
5744   }
5745
5746   // block until one of the requests is completed
5747   pptr->numBlockedReqs = 1;
5748   pptr = pptr->blockOnRecv();
5749   reqs = pptr->getReqs(); // update pointer in case of migration while suspended
5750
5751   for (int i=0; i<count; i++) {
5752     if (request[i] == MPI_REQUEST_NULL) {
5753       continue;
5754     }
5755     AmpiRequest& req = *reqs[request[i]];
5756     if (req.test()) {
5757       req.wait(sts);
5758       reqs.unblockReqs(&request[i], count-i);
5759       reqs.freeNonPersReq(request[i]);
5760       *idx = i;
5761       CkAssert(pptr->numBlockedReqs == 0);
5762       return MPI_SUCCESS;
5763     }
5764
5765     req.setBlocked(false);
5766   }
5767 #if CMK_ERROR_CHECKING
5768   CkAbort("In AMPI_Waitany, a request should have completed by now!");
5769 #endif
5770   return MPI_SUCCESS;
5771 }
5772
5773 AMPI_API_IMPL(int, MPI_Waitsome, int incount, MPI_Request *array_of_requests, int *outcount,
5774                                  int *array_of_indices, MPI_Status *array_of_statuses)
5775 {
5776   AMPI_API("AMPI_Waitsome");
5777
5778   checkRequests(incount, array_of_requests);
5779   if (incount == 0) {
5780     *outcount = MPI_UNDEFINED;
5781     return MPI_SUCCESS;
5782   }
5783
5784   ampiParent* pptr = getAmpiParent();
5785   CkAssert(pptr->numBlockedReqs == 0);
5786   AmpiRequestList& reqs = pptr->getReqs();
5787   MPI_Status sts;
5788   int nullReqs = 0;
5789   *outcount = 0;
5790
5791   for (int i=0; i<incount; i++) {
5792     if (array_of_requests[i] == MPI_REQUEST_NULL) {
5793       clearStatus(array_of_statuses, i);
5794       nullReqs++;
5795       continue;
5796     }
5797     AmpiRequest& req = *reqs[array_of_requests[i]];
5798     if (req.test()) {
5799       req.wait(&sts);
5800       array_of_indices[(*outcount)] = i;
5801       (*outcount)++;
5802       if (array_of_statuses != MPI_STATUSES_IGNORE)
5803         array_of_statuses[(*outcount)] = sts;
5804       reqs.freeNonPersReq(array_of_requests[i]);
5805     }
5806     else {
5807       req.setBlocked(true);
5808     }
5809   }
5810
5811   if (*outcount > 0) {
5812     reqs.unblockReqs(&array_of_requests[0], incount);
5813     CkAssert(pptr->numBlockedReqs == 0);
5814     return MPI_SUCCESS;
5815   }
5816   else if (nullReqs == incount) {
5817     *outcount = MPI_UNDEFINED;
5818     CkAssert(pptr->numBlockedReqs == 0);
5819     return MPI_SUCCESS;
5820   }
5821   else { // block until one of the requests is completed
5822     pptr->numBlockedReqs = 1;
5823     pptr = pptr->blockOnRecv();
5824     reqs = pptr->getReqs(); // update pointer in case of migration while suspended
5825
5826     for (int i=0; i<incount; i++) {
5827       if (array_of_requests[i] == MPI_REQUEST_NULL) {
5828         continue;
5829       }
5830       AmpiRequest& req = *reqs[array_of_requests[i]];
5831       if (req.test()) {
5832         req.wait(&sts);
5833         array_of_indices[(*outcount)] = i;
5834         (*outcount)++;
5835         if (array_of_statuses != MPI_STATUSES_IGNORE)
5836           array_of_statuses[(*outcount)] = sts;
5837         reqs.unblockReqs(&array_of_requests[i], incount-i);
5838         reqs.freeNonPersReq(array_of_requests[i]);
5839         CkAssert(pptr->numBlockedReqs == 0);
5840         return MPI_SUCCESS;
5841       }
5842       else {
5843         req.setBlocked(false);
5844       }
5845     }
5846 #if CMK_ERROR_CHECKING
5847     CkAbort("In AMPI_Waitsome, a request should have completed by now!");
5848 #endif
5849     return MPI_SUCCESS;
5850   }
5851 }
5852
5853 bool IReq::test(MPI_Status *sts/*=MPI_STATUS_IGNORE*/) noexcept {
5854   if (sts != MPI_STATUS_IGNORE) {
5855     if (cancelled) {
5856       sts->MPI_CANCEL = 1;
5857       complete = true;
5858     }
5859     else if (complete) {
5860       sts->MPI_SOURCE = src;
5861       sts->MPI_TAG    = tag;
5862       sts->MPI_COMM   = comm;
5863       sts->MPI_LENGTH = length;
5864       sts->MPI_CANCEL = 0;
5865     }
5866   }
5867   else if (cancelled) {
5868     complete = true;
5869   }
5870   return complete;
5871 }
5872
5873 bool RednReq::test(MPI_Status *sts/*=MPI_STATUS_IGNORE*/) noexcept {
5874   return complete;
5875 }
5876
5877 bool GatherReq::test(MPI_Status *sts/*=MPI_STATUS_IGNORE*/) noexcept {
5878   return complete;
5879 }
5880
5881 bool GathervReq::test(MPI_Status *sts/*=MPI_STATUS_IGNORE*/) noexcept {
5882   return complete;
5883 }
5884
5885 bool SendReq::test(MPI_Status *sts/*=MPI_STATUS_IGNORE*/) noexcept {
5886   return complete;
5887 }
5888
5889 bool SsendReq::test(MPI_Status *sts/*=MPI_STATUS_IGNORE*/) noexcept {
5890   return complete;
5891 }
5892
5893 bool GReq::test(MPI_Status *sts/*=MPI_STATUS_IGNORE*/) noexcept {
5894   MPI_Status tmpStatus;
5895   if (pollFn)
5896     (*pollFn)(extraState, (sts == MPI_STATUS_IGNORE || sts == MPI_STATUSES_IGNORE) ? &tmpStatus : sts);
5897   (*queryFn)(extraState, (sts == MPI_STATUS_IGNORE || sts == MPI_STATUSES_IGNORE) ? &tmpStatus : sts);
5898   return complete;
5899 }
5900
5901 bool ATAReq::test(MPI_Status *sts/*=MPI_STATUS_IGNORE*/) noexcept {
5902   AmpiRequestList& reqList = getReqs();
5903   int i = 0;
5904   while (i < reqs.size()) {
5905     if (reqs[i] == MPI_REQUEST_NULL) {
5906       std::swap(reqs[i], reqs.back());
5907       reqs.pop_back();
5908       continue;
5909     }
5910     AmpiRequest& req = *reqList[reqs[i]];
5911     if (req.test()) {
5912       req.wait(sts);
5913       reqList.freeNonPersReq(reqs[i]);
5914       std::swap(reqs[i], reqs.back());
5915       reqs.pop_back();
5916       continue;
5917     }
5918     i++;
5919   }
5920   complete = reqs.empty();
5921   return complete;
5922 }
5923
5924 void IReq::receive(ampi *ptr, AmpiMsg *msg) noexcept
5925 {
5926   ptr->processAmpiMsg(msg, buf, type, count);
5927   complete = true;
5928   length = msg->getLength();
5929   this->tag = msg->getTag(); // Although not required, we also extract tag from msg
5930   src = msg->getSrcRank();   // Although not required, we also extract src from msg
5931   comm = ptr->getComm();
5932   AMPI_DEBUG("Setting this->tag to %d in IReq::receive this=%p\n", tag, this);
5933 #if CMK_BIGSIM_CHARM
5934   event = msg->event;
5935   eventPe = msg->eventPe;
5936 #endif
5937   CkpvAccess(msgPool).deleteAmpiMsg(msg);
5938 }
5939
5940 void IReq::receiveRdma(ampi *ptr, char *sbuf, int slength, int ssendReq, int srcRank, MPI_Comm scomm) noexcept
5941 {
5942   ptr->processRdmaMsg(sbuf, slength, ssendReq, srcRank, buf, count, type, scomm);
5943   complete = true;
5944   length = slength;
5945   comm = scomm;
5946   // ampi::genericRdma is parameter marshalled, so there is no msg to delete
5947 }
5948
5949 void RednReq::receive(ampi *ptr, CkReductionMsg *msg) noexcept
5950 {
5951   if (ptr->opIsCommutative(op) && ptr->getDDT()->isContig(type)) {
5952     ptr->processRednMsg(msg, buf, type, count);
5953   } else {
5954     MPI_User_function* func = ptr->op2User_function(op);
5955     ptr->processNoncommutativeRednMsg(msg, const_cast<void*>(buf), type, count, func);
5956   }
5957   complete = true;
5958   comm = ptr->getComm();
5959 #if CMK_BIGSIM_CHARM
5960   event = msg->event;
5961   eventPe = msg->eventPe;
5962 #endif
5963   // ampi::rednResult is a [nokeep] entry method, so do not delete msg
5964 }
5965
5966 void GatherReq::receive(ampi *ptr, CkReductionMsg *msg) noexcept
5967 {
5968   ptr->processGatherMsg(msg, buf, type, count);
5969   complete = true;
5970   comm = ptr->getComm();
5971 #if CMK_BIGSIM_CHARM
5972   event = msg->event;
5973   eventPe = msg->eventPe;
5974 #endif
5975   // ampi::rednResult is a [nokeep] entry method, so do not delete msg
5976 }
5977
5978 void GathervReq::receive(ampi *ptr, CkReductionMsg *msg) noexcept
5979 {
5980   ptr->processGathervMsg(msg, buf, type, recvCounts.data(), displs.data());
5981   complete = true;
5982   comm = ptr->getComm();
5983 #if CMK_BIGSIM_CHARM
5984   event = msg->event;
5985   eventPe = msg->eventPe;
5986 #endif
5987   // ampi::rednResult is a [nokeep] entry method, so do not delete msg
5988 }
5989
5990 AMPI_API_IMPL(int, MPI_Request_get_status, MPI_Request request, int *flag, MPI_Status *sts)
5991 {
5992   AMPI_API("AMPI_Request_get_status");
5993   testRequestNoFree(&request, flag, sts);
5994   if(*flag != 1)
5995     getAmpiParent()->yield();
5996   return MPI_SUCCESS;
5997 }
5998
5999 AMPI_API_IMPL(int, MPI_Test, MPI_Request *request, int *flag, MPI_Status *sts)
6000 {
6001   AMPI_API("AMPI_Test");
6002   testRequest(request, flag, sts);
6003   if(*flag != 1)
6004     getAmpiParent()->yield();
6005   return MPI_SUCCESS;
6006 }
6007
6008 AMPI_API_IMPL(int, MPI_Testany, int count, MPI_Request *request, int *index, int *flag, MPI_Status *sts)
6009 {
6010   AMPI_API("AMPI_Testany");
6011
6012   checkRequests(count, request);
6013
6014   if (count == 0) {
6015     *flag = 1;
6016     *index = MPI_UNDEFINED;
6017     clearStatus(sts);
6018     return MPI_SUCCESS;
6019   }
6020
6021   int nullReqs = 0;
6022   *flag = 0;
6023
6024   for (int i=0; i<count; i++) {
6025     if (request[i] == MPI_REQUEST_NULL) {
6026       nullReqs++;
6027       continue;
6028     }
6029     testRequest(&request[i], flag, sts);
6030     if (*flag) {
6031       *index = i;
6032       return MPI_SUCCESS;
6033     }
6034   }
6035
6036   *index = MPI_UNDEFINED;
6037   if (nullReqs == count) {
6038     *flag = 1;
6039     clearStatus(sts);
6040   }
6041   else {
6042     getAmpiParent()->yield();
6043   }
6044
6045   return MPI_SUCCESS;
6046 }
6047
6048 AMPI_API_IMPL(int, MPI_Testall, int count, MPI_Request *request, int *flag, MPI_Status *sts)
6049 {
6050   AMPI_API("AMPI_Testall");
6051
6052   checkRequests(count, request);
6053   if (count == 0) {
6054     *flag = 1;
6055     return MPI_SUCCESS;
6056   }
6057
6058   ampiParent* pptr = getAmpiParent();
6059   AmpiRequestList& reqs = pptr->getReqs();
6060   int nullReqs = 0;
6061   *flag = 1;
6062
6063   for (int i=0; i<count; i++) {
6064     if (request[i] == MPI_REQUEST_NULL) {
6065       clearStatus(sts, i);
6066       nullReqs++;
6067       continue;
6068     }
6069     if (!reqs[request[i]]->test()) {
6070       *flag = 0;
6071       pptr->yield();
6072       return MPI_SUCCESS;
6073     }
6074   }
6075
6076   if (nullReqs != count) {
6077     for (int i=0; i<count; i++) {
6078       int reqIdx = request[i];
6079       if (reqIdx != MPI_REQUEST_NULL) {
6080         AmpiRequest& req = *reqs[reqIdx];
6081         req.wait((sts == MPI_STATUSES_IGNORE) ? MPI_STATUS_IGNORE : &sts[i]);
6082         reqs.freeNonPersReq(request[i]);
6083       }
6084     }
6085   }
6086
6087   return MPI_SUCCESS;
6088 }
6089
6090 AMPI_API_IMPL(int, MPI_Testsome, int incount, MPI_Request *array_of_requests, int *outcount,
6091                                  int *array_of_indices, MPI_Status *array_of_statuses)
6092 {
6093   AMPI_API("AMPI_Testsome");
6094
6095   checkRequests(incount, array_of_requests);
6096   if (incount == 0) {
6097     *outcount = MPI_UNDEFINED;
6098     return MPI_SUCCESS;
6099   }
6100
6101   MPI_Status sts;
6102   int flag = 0, nullReqs = 0;
6103   *outcount = 0;
6104
6105   for (int i=0; i<incount; i++) {
6106     if (array_of_requests[i] == MPI_REQUEST_NULL) {
6107       clearStatus(array_of_statuses, i);
6108       nullReqs++;
6109       continue;
6110     }
6111     testRequest(&array_of_requests[i], &flag, &sts);
6112     if (flag) {
6113       array_of_indices[(*outcount)] = i;
6114       (*outcount)++;
6115       if (array_of_statuses != MPI_STATUSES_IGNORE)
6116         array_of_statuses[(*outcount)] = sts;
6117     }
6118   }
6119
6120   if (nullReqs == incount) {
6121     *outcount = MPI_UNDEFINED;
6122   }
6123   else if (*outcount == 0) {
6124     getAmpiParent()->yield();
6125   }
6126
6127   return MPI_SUCCESS;
6128 }
6129
6130 AMPI_API_IMPL(int, MPI_Request_free, MPI_Request *request)
6131 {
6132   AMPI_API("AMPI_Request_free");
6133   if(*request==MPI_REQUEST_NULL) return MPI_SUCCESS;
6134   checkRequest(*request);
6135   ampiParent* pptr = getAmpiParent();
6136   AmpiRequestList& reqs = pptr->getReqs();
6137   reqs.free(pptr->reqPool, *request, pptr->getDDT());
6138   *request = MPI_REQUEST_NULL;
6139   return MPI_SUCCESS;
6140 }
6141
6142 AMPI_API_IMPL(int, MPI_Grequest_start, MPI_Grequest_query_function *query_fn, MPI_Grequest_free_function *free_fn,
6143                                        MPI_Grequest_cancel_function *cancel_fn, void *extra_state, MPI_Request *request)
6144 {
6145   AMPI_API("AMPI_Grequest_start");
6146
6147   ampi* ptr = getAmpiInstance(MPI_COMM_SELF); // All GReq's are posted to MPI_COMM_SELF
6148   GReq *newreq = new GReq(query_fn, free_fn, cancel_fn, extra_state);
6149   *request = ptr->postReq(newreq);
6150
6151   return MPI_SUCCESS;
6152 }
6153
6154 AMPI_API_IMPL(int, MPI_Grequest_complete, MPI_Request request)
6155 {
6156   AMPI_API("AMPI_Grequest_complete");
6157
6158 #if AMPI_ERROR_CHECKING
6159   if (request == MPI_REQUEST_NULL) {
6160     return ampiErrhandler("AMPI_Grequest_complete", MPI_ERR_REQUEST);
6161   }
6162   if (getReqs()[request]->getType() != AMPI_G_REQ) {
6163     return ampiErrhandler("AMPI_Grequest_complete", MPI_ERR_REQUEST);
6164   }
6165 #endif
6166
6167   ampiParent* parent = getAmpiParent();
6168   AmpiRequestList& reqs = parent->getReqs();
6169   reqs[request]->complete = true;
6170
6171   return MPI_SUCCESS;
6172 }
6173
6174 AMPI_API_IMPL(int, MPI_Cancel, MPI_Request *request)
6175 {
6176   AMPI_API("AMPI_Cancel");
6177   if(*request == MPI_REQUEST_NULL) return MPI_SUCCESS;
6178   checkRequest(*request);
6179   AmpiRequestList& reqs = getReqs();
6180   AmpiRequest& req = *reqs[*request];
6181   if(req.getType() == AMPI_I_REQ || req.getType() == AMPI_G_REQ) {
6182     req.cancel();
6183     return MPI_SUCCESS;
6184   }
6185   else {
6186     return ampiErrhandler("AMPI_Cancel", MPI_ERR_REQUEST);
6187   }
6188 }
6189
6190 AMPI_API_IMPL(int, MPI_Test_cancelled, const MPI_Status* status, int* flag)
6191 {
6192   AMPI_API("AMPI_Test_cancelled");
6193   // NOTE : current implementation requires AMPI_{Wait,Test}{any,some,all}
6194   // to be invoked before AMPI_Test_cancelled
6195   *flag = status->MPI_CANCEL;
6196   return MPI_SUCCESS;
6197 }
6198
6199 AMPI_API_IMPL(int, MPI_Status_set_cancelled, MPI_Status *status, int flag)
6200 {
6201   AMPI_API("AMPI_Status_set_cancelled");
6202   status->MPI_CANCEL = flag;
6203   return MPI_SUCCESS;
6204 }
6205
6206 AMPI_API_IMPL(int, MPI_Recv_init, void *buf, int count, MPI_Datatype type, int src,
6207                                   int tag, MPI_Comm comm, MPI_Request *req)
6208 {
6209   AMPI_API("AMPI_Recv_init");
6210
6211   handle_MPI_BOTTOM(buf, type);
6212
6213 #if AMPI_ERROR_CHECKING
6214   int ret = errorCheck("AMPI_Recv_init", comm, 1, count, 1, type, 1, tag, 1, src, 1, buf, 1);
6215   if(ret != MPI_SUCCESS){
6216     *req = MPI_REQUEST_NULL;
6217     return ret;
6218   }
6219 #endif
6220
6221   IReq* ireq = getAmpiParent()->reqPool.newIReq(buf,count,type,src,tag,comm,getDDT());
6222   ireq->setPersistent(true);
6223   *req = getAmpiInstance(comm)->postReq(ireq);
6224   return MPI_SUCCESS;
6225 }
6226
6227 AMPI_API_IMPL(int, MPI_Send_init, const void *buf, int count, MPI_Datatype type, int dest,
6228                                   int tag, MPI_Comm comm, MPI_Request *req)
6229 {
6230   AMPI_API("AMPI_Send_init");
6231
6232   handle_MPI_BOTTOM((void*&)buf, type);
6233
6234 #if AMPI_ERROR_CHECKING
6235   int ret = errorCheck("AMPI_Send_init", comm, 1, count, 1, type, 1, tag, 1, dest, 1, buf, 1);
6236   if(ret != MPI_SUCCESS){
6237     *req = MPI_REQUEST_NULL;
6238     return ret;
6239   }
6240 #endif
6241
6242   SendReq* sreq = getAmpiParent()->reqPool.newSendReq(buf, count, type, dest, tag, comm, getDDT());
6243   sreq->setPersistent(true);
6244   *req = getAmpiInstance(comm)->postReq(sreq);
6245   return MPI_SUCCESS;
6246 }
6247
6248 AMPI_API_IMPL(int, MPI_Rsend_init, const void *buf, int count, MPI_Datatype type, int dest,
6249                                    int tag, MPI_Comm comm, MPI_Request *req)
6250 {
6251   AMPI_API("AMPI_Rsend_init");
6252   return MPI_Send_init(buf, count, type, dest, tag, comm, req);
6253 }
6254
6255 AMPI_API_IMPL(int, MPI_Bsend_init, const void *buf, int count, MPI_Datatype type, int dest,
6256                                    int tag, MPI_Comm comm, MPI_Request *req)
6257 {
6258   AMPI_API("AMPI_Bsend_init");
6259   return MPI_Send_init(buf, count, type, dest, tag, comm, req);
6260 }
6261
6262 AMPI_API_IMPL(int, MPI_Ssend_init, const void *buf, int count, MPI_Datatype type, int dest,
6263                                    int tag, MPI_Comm comm, MPI_Request *req)
6264 {
6265   AMPI_API("AMPI_Ssend_init");
6266
6267   handle_MPI_BOTTOM((void*&)buf, type);
6268
6269 #if AMPI_ERROR_CHECKING
6270   int ret = errorCheck("AMPI_Ssend_init", comm, 1, count, 1, type, 1, tag, 1, dest, 1, buf, 1);
6271   if(ret != MPI_SUCCESS){
6272     *req = MPI_REQUEST_NULL;
6273     return ret;
6274   }
6275 #endif
6276
6277   ampi* ptr = getAmpiInstance(comm);
6278   SsendReq* sreq = getAmpiParent()->reqPool.newSsendReq(buf, count, type, dest, tag, comm, ptr->getRank(), getDDT());
6279   sreq->setPersistent(true);
6280   *req = ptr->postReq(sreq);
6281   return MPI_SUCCESS;
6282 }
6283
6284 AMPI_API_IMPL(int, MPI_Type_contiguous, int count, MPI_Datatype oldtype, MPI_Datatype *newtype)
6285 {
6286   AMPI_API("AMPI_Type_contiguous");
6287
6288 #if AMPI_ERROR_CHECKING
6289   int ret = checkData("MPI_Type_contiguous", oldtype);
6290   if (ret!=MPI_SUCCESS)
6291     return ret;
6292 #endif
6293
6294   getDDT()->newContiguous(count, oldtype, newtype);
6295   return MPI_SUCCESS;
6296 }
6297
6298 AMPI_API_IMPL(int, MPI_Type_vector, int count, int blocklength, int stride,
6299                                     MPI_Datatype oldtype, MPI_Datatype* newtype)
6300 {
6301   AMPI_API("AMPI_Type_vector");
6302
6303 #if AMPI_ERROR_CHECKING
6304   int ret = checkData("AMPI_Type_vector", oldtype);
6305   if (ret!=MPI_SUCCESS)
6306     return ret;
6307 #endif
6308
6309   getDDT()->newVector(count, blocklength, stride, oldtype, newtype);
6310   return MPI_SUCCESS;
6311 }
6312
6313 AMPI_API_IMPL(int, MPI_Type_create_hvector, int count, int blocklength, MPI_Aint stride,
6314                                             MPI_Datatype oldtype, MPI_Datatype* newtype)
6315 {
6316   AMPI_API("AMPI_Type_create_hvector");
6317
6318 #if AMPI_ERROR_CHECKING
6319   int ret = checkData("AMPI_Type_create_hvector", oldtype);
6320   if (ret!=MPI_SUCCESS)
6321     return ret;
6322 #endif
6323
6324   getDDT()->newHVector(count, blocklength, stride, oldtype, newtype);
6325   return MPI_SUCCESS;
6326 }
6327
6328 AMPI_API_IMPL(int, MPI_Type_hvector, int count, int blocklength, MPI_Aint stride,
6329                                      MPI_Datatype oldtype, MPI_Datatype* newtype)
6330 {
6331   AMPI_API("AMPI_Type_hvector");
6332
6333 #if AMPI_ERROR_CHECKING
6334   int ret = checkData("AMPI_Type_hvector", oldtype);
6335   if (ret!=MPI_SUCCESS)
6336     return ret;
6337 #endif
6338
6339   return MPI_Type_create_hvector(count, blocklength, stride, oldtype, newtype);
6340 }
6341
6342 AMPI_API_IMPL(int, MPI_Type_indexed, int count, const int* arrBlength, const int* arrDisp,
6343                                      MPI_Datatype oldtype, MPI_Datatype* newtype)
6344 {
6345   AMPI_API("AMPI_Type_indexed");
6346
6347 #if AMPI_ERROR_CHECKING
6348   int ret = checkData("AMPI_Type_indexed", oldtype);
6349   if (ret!=MPI_SUCCESS)
6350     return ret;
6351 #endif
6352
6353   /*CkDDT_Indexed's arrDisp has type MPI_Aint* (not int*). */
6354   vector<MPI_Aint> arrDispAint(count);
6355   for(int i=0; i<count; i++)
6356     arrDispAint[i] = (MPI_Aint)(arrDisp[i]);
6357   getDDT()->newIndexed(count, arrBlength, arrDispAint.data(), oldtype, newtype);
6358   return MPI_SUCCESS;
6359 }
6360
6361 AMPI_API_IMPL(int, MPI_Type_create_hindexed, int count, const int* arrBlength, const MPI_Aint* arrDisp,
6362                                              MPI_Datatype oldtype, MPI_Datatype* newtype)
6363 {
6364   AMPI_API("AMPI_Type_create_hindexed");
6365
6366 #if AMPI_ERROR_CHECKING
6367   int ret = checkData("AMPI_Type_create_hindexed", oldtype);
6368   if (ret!=MPI_SUCCESS)
6369     return ret;
6370 #endif
6371
6372   getDDT()->newHIndexed(count, arrBlength, arrDisp, oldtype, newtype);
6373   return MPI_SUCCESS;
6374 }
6375
6376 AMPI_API_IMPL(int, MPI_Type_hindexed, int count, int* arrBlength, MPI_Aint* arrDisp,
6377                                       MPI_Datatype oldtype, MPI_Datatype* newtype)
6378 {
6379   AMPI_API("AMPI_Type_hindexed");
6380
6381 #if AMPI_ERROR_CHECKING
6382   int ret = checkData("AMPI_Type_hindexed", oldtype);
6383   if (ret!=MPI_SUCCESS)
6384     return ret;
6385 #endif
6386
6387   return MPI_Type_create_hindexed(count, arrBlength, arrDisp, oldtype, newtype);
6388 }
6389
6390 AMPI_API_IMPL(int, MPI_Type_create_indexed_block, int count, int Blength, const int *arr,
6391                                                   MPI_Datatype oldtype, MPI_Datatype *newtype)
6392 {
6393   AMPI_API("AMPI_Type_create_indexed_block");
6394
6395 #if AMPI_ERROR_CHECKING
6396   int ret = checkData("AMPI_Type_create_indexed_block", oldtype);
6397   if (ret!=MPI_SUCCESS)
6398     return ret;
6399 #endif
6400
6401   getDDT()->newIndexedBlock(count,Blength, arr, oldtype, newtype);
6402   return MPI_SUCCESS;
6403 }
6404
6405 AMPI_API_IMPL(int, MPI_Type_create_hindexed_block, int count, int Blength, const MPI_Aint *arr,
6406                                                    MPI_Datatype oldtype, MPI_Datatype *newtype)
6407 {
6408   AMPI_API("AMPI_Type_create_hindexed_block");
6409
6410 #if AMPI_ERROR_CHECKING
6411   int ret = checkData("AMPI_Type_create_hindexed_block", oldtype);
6412   if (ret!=MPI_SUCCESS)
6413     return ret;
6414 #endif
6415
6416   getDDT()->newHIndexedBlock(count,Blength, arr, oldtype, newtype);
6417   return MPI_SUCCESS;
6418 }
6419
6420 AMPI_API_IMPL(int, MPI_Type_create_struct, int count, const int* arrBlength, const MPI_Aint* arrDisp,
6421                                            const MPI_Datatype* oldtype, MPI_Datatype*  newtype)
6422 {
6423   AMPI_API("AMPI_Type_create_struct");
6424   getDDT()->newStruct(count, arrBlength, arrDisp, oldtype, newtype);
6425   return MPI_SUCCESS;
6426 }
6427
6428 AMPI_API_IMPL(int, MPI_Type_struct, int count, int* arrBlength, MPI_Aint* arrDisp,
6429                                     MPI_Datatype* oldtype, MPI_Datatype* newtype)
6430 {
6431   AMPI_API("AMPI_Type_struct");
6432   return MPI_Type_create_struct(count, arrBlength, arrDisp, oldtype, newtype);
6433 }
6434
6435 AMPI_API_IMPL(int, MPI_Type_commit, MPI_Datatype *datatype)
6436 {
6437   AMPI_API("AMPI_Type_commit");
6438
6439 #if AMPI_ERROR_CHECKING
6440   int ret = checkData("MPI_Type_commit", *datatype);
6441   if (ret!=MPI_SUCCESS)
6442     return ret;
6443 #endif
6444
6445   return MPI_SUCCESS;
6446 }
6447
6448 AMPI_API_IMPL(int, MPI_Type_free, MPI_Datatype *datatype)
6449 {
6450   AMPI_API("AMPI_Type_free");
6451
6452 #if AMPI_ERROR_CHECKING
6453   int ret = checkData("AMPI_Type_free", *datatype);
6454   if (ret!=MPI_SUCCESS)
6455     return ret;
6456
6457   if (datatype == nullptr) {
6458     return ampiErrhandler("AMPI_Type_free", MPI_ERR_ARG);
6459   } else if (*datatype <= CkDDT_MAX_PRIMITIVE_TYPE) {
6460     return ampiErrhandler("AMPI_Type_free", MPI_ERR_TYPE);
6461   }
6462 #endif
6463   getDDT()->freeType(*datatype);
6464   *datatype = MPI_DATATYPE_NULL;
6465   return MPI_SUCCESS;
6466 }
6467
6468 AMPI_API_IMPL(int, MPI_Type_get_extent, MPI_Datatype datatype, MPI_Aint *lb, MPI_Aint *extent)
6469 {
6470   AMPI_API("AMPI_Type_get_extent");
6471
6472 #if AMPI_ERROR_CHECKING
6473   int ret = checkData("AMPI_Type_get_extent", datatype);
6474   if (ret!=MPI_SUCCESS)
6475     return(ret);
6476 #endif
6477
6478   *lb = getDDT()->getLB(datatype);
6479   *extent = getDDT()->getExtent(datatype);
6480   return MPI_SUCCESS;
6481 }
6482
6483 AMPI_API_IMPL(int, MPI_Type_get_extent_x, MPI_Datatype datatype, MPI_Count *lb, MPI_Count *extent)
6484 {
6485   AMPI_API("AMPI_Type_get_extent_x");
6486
6487 #if AMPI_ERROR_CHECKING
6488   int ret = checkData("AMPI_Type_get_extent_x", datatype);
6489   if (ret!=MPI_SUCCESS)
6490     return(ret);
6491 #endif
6492
6493   *lb = getDDT()->getLB(datatype);
6494   *extent = getDDT()->getExtent(datatype);
6495   return MPI_SUCCESS;
6496 }
6497
6498 AMPI_API_IMPL(int, MPI_Type_extent, MPI_Datatype datatype, MPI_Aint *extent)
6499 {
6500   AMPI_API("AMPI_Type_extent");
6501
6502 #if AMPI_ERROR_CHECKING
6503   int ret = checkData("AMPI_Type_extent", datatype);
6504   if (ret!=MPI_SUCCESS)
6505     return ret;
6506 #endif
6507
6508   MPI_Aint tmpLB;
6509   return MPI_Type_get_extent(datatype, &tmpLB, extent);
6510 }
6511
6512 AMPI_API_IMPL(int, MPI_Type_get_true_extent, MPI_Datatype datatype, MPI_Aint *true_lb, MPI_Aint *true_extent)
6513 {
6514   AMPI_API("AMPI_Type_get_true_extent");
6515
6516 #if AMPI_ERROR_CHECKING
6517   int ret = checkData("AMPI_Type_get_true_extent", datatype);
6518   if (ret!=MPI_SUCCESS)
6519     return(ret);
6520 #endif
6521
6522   *true_lb = getDDT()->getTrueLB(datatype);
6523   *true_extent = getDDT()->getTrueExtent(datatype);
6524   return MPI_SUCCESS;
6525 }
6526
6527 AMPI_API_IMPL(int, MPI_Type_get_true_extent_x, MPI_Datatype datatype, MPI_Count *true_lb, MPI_Count *true_extent)
6528 {
6529   AMPI_API("AMPI_Type_get_true_extent_x");
6530
6531 #if AMPI_ERROR_CHECKING
6532   int ret = checkData("AMPI_Type_get_true_extent_x", datatype);
6533   if (ret!=MPI_SUCCESS)
6534     return(ret);
6535 #endif
6536
6537   *true_lb = getDDT()->getTrueLB(datatype);
6538   *true_extent = getDDT()->getTrueExtent(datatype);
6539   return MPI_SUCCESS;
6540 }
6541
6542 AMPI_API_IMPL(int, MPI_Type_size, MPI_Datatype datatype, int *size)
6543 {
6544   AMPI_API("AMPI_Type_size");
6545
6546 #if AMPI_ERROR_CHECKING
6547   int ret = checkData("AMPI_Type_size", datatype);
6548   if (ret!=MPI_SUCCESS)
6549     return ret;
6550 #endif
6551
6552   *size=getDDT()->getSize(datatype);
6553   return MPI_SUCCESS;
6554 }
6555
6556 AMPI_API_IMPL(int, MPI_Type_size_x, MPI_Datatype datatype, MPI_Count *size)
6557 {
6558   AMPI_API("AMPI_Type_size_x");
6559
6560 #if AMPI_ERROR_CHECKING
6561   int ret = checkData("AMPI_Type_size_x", datatype);
6562   if (ret!=MPI_SUCCESS)
6563     return ret;
6564 #endif
6565
6566   *size=getDDT()->getSize(datatype);
6567   return MPI_SUCCESS;
6568 }
6569
6570 AMPI_API_IMPL(int, MPI_Type_set_name, MPI_Datatype datatype, const char *name)
6571 {
6572   AMPI_API("AMPI_Type_set_name");
6573
6574 #if AMPI_ERROR_CHECKING
6575   int ret = checkData("MPI_Type_set_name", datatype);
6576   if (ret!=MPI_SUCCESS)
6577     return ret;
6578 #endif
6579
6580   getDDT()->setName(datatype, name);
6581   return MPI_SUCCESS;
6582 }
6583
6584 AMPI_API_IMPL(int, MPI_Type_get_name, MPI_Datatype datatype, char *name, int *resultlen)
6585 {
6586   AMPI_API("AMPI_Type_get_name");
6587
6588 #if AMPI_ERROR_CHECKING
6589   int ret = checkData("AMPI_Type_get_name", datatype);
6590   if (ret!=MPI_SUCCESS)
6591     return ret;
6592 #endif
6593
6594   getDDT()->getName(datatype, name, resultlen);
6595   return MPI_SUCCESS;
6596 }
6597
6598 AMPI_API_IMPL(int, MPI_Type_create_resized, MPI_Datatype oldtype, MPI_Aint lb,
6599                                             MPI_Aint extent, MPI_Datatype *newtype)
6600 {
6601   AMPI_API("AMPI_Type_create_resized");
6602
6603 #if AMPI_ERROR_CHECKING
6604   int ret = checkData("AMPI_Type_create_resized", oldtype);
6605   if (ret!=MPI_SUCCESS)
6606     return ret;
6607 #endif
6608
6609   getDDT()->createResized(oldtype, lb, extent, newtype);
6610   return MPI_SUCCESS;
6611 }
6612
6613 AMPI_API_IMPL(int, MPI_Type_dup, MPI_Datatype oldtype, MPI_Datatype *newtype)
6614 {
6615   AMPI_API("AMPI_Type_dup");
6616
6617 #if AMPI_ERROR_CHECKING
6618   int ret = checkData("AMPI_Type_dup", oldtype);
6619   if (ret!=MPI_SUCCESS)
6620     return ret;
6621 #endif
6622
6623   getDDT()->createDup(oldtype, newtype);
6624   return MPI_SUCCESS;
6625 }
6626
6627 AMPI_API_IMPL(int, MPI_Type_set_attr, MPI_Datatype datatype, int keyval, void *attribute_val)
6628 {
6629   AMPI_API("AMPI_Type_set_attr");
6630
6631 #if AMPI_ERROR_CHECKING
6632   int ret = checkData("AMPI_Type_set_attr", datatype);
6633   if (ret!=MPI_SUCCESS)
6634     return ret;
6635 #endif
6636
6637   ampiParent *parent = getAmpiParent();
6638   vector<int>& keyvals = parent->getDDT()->getType(datatype)->getKeyvals();
6639   int err = parent->setAttr(datatype, keyvals, keyval, attribute_val);
6640   return ampiErrhandler("AMPI_Type_set_attr", err);
6641 }
6642
6643 AMPI_API_IMPL(int, MPI_Type_get_attr, MPI_Datatype datatype, int keyval,
6644                                       void *attribute_val, int *flag)
6645 {
6646   AMPI_API("AMPI_Type_get_attr");
6647
6648 #if AMPI_ERROR_CHECKING
6649   int ret = checkData("AMPI_Type_get_attr", datatype);
6650   if (ret!=MPI_SUCCESS)
6651     return ret;
6652 #endif
6653
6654   ampiParent *parent = getAmpiParent();
6655   vector<int>& keyvals = parent->getDDT()->getType(datatype)->getKeyvals();
6656   int err = parent->getAttr(datatype, keyvals, keyval, attribute_val, flag);
6657   return ampiErrhandler("AMPI_Type_get_attr", err);
6658 }
6659
6660 AMPI_API_IMPL(int, MPI_Type_delete_attr, MPI_Datatype datatype, int keyval)
6661 {
6662   AMPI_API("AMPI_Type_delete_attr");
6663
6664 #if AMPI_ERROR_CHECKING
6665   int ret = checkData("AMPI_Type_delete_attr", datatype);
6666   if (ret!=MPI_SUCCESS)
6667     return ret;
6668 #endif
6669
6670   ampiParent *parent = getAmpiParent();
6671   vector<int>& keyvals = parent->getDDT()->getType(datatype)->getKeyvals();
6672   int err = parent->deleteAttr(datatype, keyvals, keyval);
6673   return ampiErrhandler("AMPI_Type_delete_attr", err);
6674 }
6675
6676 AMPI_API_IMPL(int, MPI_Type_create_keyval, MPI_Type_copy_attr_function *copy_fn,
6677                                            MPI_Type_delete_attr_function *delete_fn,
6678                                            int *keyval, void *extra_state)
6679 {
6680   AMPI_API("AMPI_Type_create_keyval");
6681   return MPI_Comm_create_keyval(copy_fn, delete_fn, keyval, extra_state);
6682 }
6683
6684 AMPI_API_IMPL(int, MPI_Type_free_keyval, int *keyval)
6685 {
6686   AMPI_API("AMPI_Type_free_keyval");
6687   return MPI_Comm_free_keyval(keyval);
6688 }
6689
6690 AMPI_API_IMPL(int, MPI_Isend, const void *buf, int count, MPI_Datatype type, int dest,
6691                               int tag, MPI_Comm comm, MPI_Request *request)
6692 {
6693   AMPI_API("AMPI_Isend");
6694
6695   handle_MPI_BOTTOM((void*&)buf, type);
6696
6697 #if AMPI_ERROR_CHECKING
6698   int ret = errorCheck("AMPI_Isend", comm, 1, count, 1, type, 1, tag, 1, dest, 1, buf, 1);
6699   if(ret != MPI_SUCCESS){
6700     *request = MPI_REQUEST_NULL;
6701     return ret;
6702   }
6703 #endif
6704
6705 #if AMPIMSGLOG
6706   ampiParent* pptr = getAmpiParent();
6707   if(msgLogRead){
6708     PUParray(*(pptr->fromPUPer), (char *)request, sizeof(MPI_Request));
6709     return MPI_SUCCESS;
6710   }
6711 #endif
6712
6713   USER_CALL_DEBUG("AMPI_Isend("<<type<<","<<dest<<","<<tag<<","<<comm<<")");
6714
6715   ampi *ptr = getAmpiInstance(comm);
6716   *request = ptr->send(tag, ptr->getRank(), buf, count, type, dest, comm, 0, I_SEND);
6717
6718 #if AMPIMSGLOG
6719   if(msgLogWrite && record_msglog(pptr->thisIndex)){
6720     PUParray(*(pptr->toPUPer), (char *)request, sizeof(MPI_Request));
6721   }
6722 #endif
6723
6724   return MPI_SUCCESS;
6725 }
6726
6727 AMPI_API_IMPL(int, MPI_Ibsend, const void *buf, int count, MPI_Datatype type, int dest,
6728                                int tag, MPI_Comm comm, MPI_Request *request)
6729 {
6730   AMPI_API("AMPI_Ibsend");
6731   return MPI_Isend(buf, count, type, dest, tag, comm, request);
6732 }
6733
6734 AMPI_API_IMPL(int, MPI_Irsend, const void *buf, int count, MPI_Datatype type, int dest,
6735                                int tag, MPI_Comm comm, MPI_Request *request)
6736 {
6737   AMPI_API("AMPI_Irsend");
6738   return MPI_Isend(buf, count, type, dest, tag, comm, request);
6739 }
6740
6741 void ampi::irecv(void *buf, int count, MPI_Datatype type, int src,
6742                  int tag, MPI_Comm comm, MPI_Request *request) noexcept
6743 {
6744   if (src==MPI_PROC_NULL) {
6745     *request = MPI_REQUEST_NULL;
6746     return;
6747   }
6748
6749   if (isInter()) {
6750     src = myComm.getIndexForRemoteRank(src);
6751   }
6752
6753   AmpiRequestList& reqs = getReqs();
6754   IReq *newreq = parent->reqPool.newIReq(buf, count, type, src, tag, comm, getDDT());
6755   *request = reqs.insert(newreq);
6756
6757 #if AMPIMSGLOG
6758   ampiParent* pptr = getAmpiParent();
6759   if(msgLogRead){
6760     PUParray(*(pptr->fromPUPer), (char *)request, sizeof(MPI_Request));
6761     return MPI_SUCCESS;
6762   }
6763 #endif
6764
6765   AmpiMsg* msg = unexpectedMsgs.get(tag, src);
6766   // if msg has already arrived, do the receive right away
6767   if (msg) {
6768     newreq->receive(this, msg);
6769   }
6770   else { // ... otherwise post the receive
6771     postedReqs.put(newreq);
6772   }
6773
6774 #if AMPIMSGLOG
6775   if(msgLogWrite && record_msglog(pptr->thisIndex)){
6776     PUParray(*(pptr->toPUPer), (char *)request, sizeof(MPI_Request));
6777   }
6778 #endif
6779 }
6780
6781 AMPI_API_IMPL(int, MPI_Irecv, void *buf, int count, MPI_Datatype type, int src,
6782                               int tag, MPI_Comm comm, MPI_Request *request)
6783 {
6784   AMPI_API("AMPI_Irecv");
6785
6786   handle_MPI_BOTTOM(buf, type);
6787
6788 #if AMPI_ERROR_CHECKING
6789   int ret = errorCheck("AMPI_Irecv", comm, 1, count, 1, type, 1, tag, 1, src, 1, buf, 1);
6790   if(ret != MPI_SUCCESS){
6791     *request = MPI_REQUEST_NULL;
6792     return ret;
6793   }
6794 #endif
6795
6796   USER_CALL_DEBUG("AMPI_Irecv("<<type<<","<<src<<","<<tag<<","<<comm<<")");
6797   ampi *ptr = getAmpiInstance(comm);
6798
6799   ptr->irecv(buf, count, type, src, tag, comm, request);
6800
6801   return MPI_SUCCESS;
6802 }
6803
6804 AMPI_API_IMPL(int, MPI_Ireduce, const void *sendbuf, void *recvbuf, int count,
6805                                 MPI_Datatype type, MPI_Op op, int root,
6806                                 MPI_Comm comm, MPI_Request *request)
6807 {
6808   AMPI_API("AMPI_Ireduce");
6809
6810   handle_MPI_BOTTOM((void*&)sendbuf, type, recvbuf, type);
6811   handle_MPI_IN_PLACE((void*&)sendbuf, recvbuf);
6812
6813 #if AMPI_ERROR_CHECKING
6814   if(op == MPI_OP_NULL)
6815     return ampiErrhandler("AMPI_Ireduce", MPI_ERR_OP);
6816   int ret = errorCheck("AMPI_Ireduce", comm, 1, count, 1, type, 1, 0, 0, root, 1, sendbuf, 1,
6817                        recvbuf, getAmpiInstance(comm)->getRank() == root);
6818   if(ret != MPI_SUCCESS){
6819     *request = MPI_REQUEST_NULL;
6820     return ret;
6821   }
6822 #endif
6823
6824   ampi *ptr = getAmpiInstance(comm);
6825
6826   if(getAmpiParent()->isInter(comm))
6827     CkAbort("AMPI does not implement MPI_Ireduce for Inter-communicators!");
6828   if(ptr->getSize() == 1){
6829     *request = ptr->postReq(new RednReq(recvbuf, count, type, comm, op, getDDT(), AMPI_REQ_COMPLETED));
6830     return copyDatatype(type,count,type,count,sendbuf,recvbuf);
6831   }
6832
6833   CkReductionMsg *msg=makeRednMsg(ptr->getDDT()->getType(type),sendbuf,count,type,ptr->getRank(),op);
6834   int rootIdx=ptr->comm2CommStruct(comm).getIndexForRank(root);
6835
6836   CkCallback reduceCB(CkIndex_ampi::irednResult(0),CkArrayIndex1D(rootIdx),ptr->getProxy());
6837   msg->setCallback(reduceCB);
6838   ptr->contribute(msg);
6839
6840   if (ptr->thisIndex == rootIdx){
6841     // use a RednReq to non-block the caller and get a request ptr
6842     *request = ptr->postReq(new RednReq(recvbuf,count,type,comm,op,getDDT()));
6843   }
6844   else {
6845     *request = ptr->postReq(new RednReq(recvbuf,count,type,comm,op,getDDT(),AMPI_REQ_COMPLETED));
6846   }
6847
6848   return MPI_SUCCESS;
6849 }
6850
6851 static CkReductionMsg *makeGatherMsg(const void *inbuf, int count, MPI_Datatype type, int rank) noexcept
6852 {
6853   CkDDT_DataType* ddt = getDDT()->getType(type);
6854   int szdata = ddt->getSize(count);
6855   const int tupleSize = 2;
6856   CkReduction::tupleElement tupleRedn[tupleSize];
6857   tupleRedn[0] = CkReduction::tupleElement(sizeof(int), &rank, CkReduction::set);
6858
6859   if (ddt->isContig()) {
6860     tupleRedn[1] = CkReduction::tupleElement(szdata, (void*)inbuf, CkReduction::set);
6861   } else {
6862     vector<char> sbuf(szdata);
6863     ddt->serialize((char*)inbuf, sbuf.data(), count, szdata, PACK);
6864     tupleRedn[1] = CkReduction::tupleElement(szdata, sbuf.data(), CkReduction::set);
6865   }
6866
6867   return CkReductionMsg::buildFromTuple(tupleRedn, tupleSize);
6868 }
6869
6870 AMPI_API_IMPL(int, MPI_Allgather, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
6871                                   void *recvbuf, int recvcount, MPI_Datatype recvtype,
6872                                   MPI_Comm comm)
6873 {
6874   AMPI_API("AMPI_Allgather");
6875
6876   ampi *ptr = getAmpiInstance(comm);
6877   int rank = ptr->getRank();
6878
6879   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
6880   handle_MPI_IN_PLACE_gather((void*&)sendbuf, recvbuf, sendcount, sendtype,
6881                              rank*recvcount, recvcount, recvtype);
6882
6883 #if AMPI_ERROR_CHECKING
6884   int ret;
6885   if (sendbuf != recvbuf) {
6886     ret = errorCheck("AMPI_Allgather", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
6887     if(ret != MPI_SUCCESS)
6888       return ret;
6889   }
6890   ret = errorCheck("AMPI_Allgather", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
6891   if(ret != MPI_SUCCESS)
6892     return ret;
6893 #endif
6894
6895   if(getAmpiParent()->isInter(comm))
6896     CkAbort("AMPI does not implement MPI_Allgather for Inter-communicators!");
6897   if(ptr->getSize() == 1)
6898     return copyDatatype(sendtype,sendcount,recvtype,recvcount,sendbuf,recvbuf);
6899
6900   CkReductionMsg* msg = makeGatherMsg(sendbuf, sendcount, sendtype, rank);
6901   CkCallback allgatherCB(CkIndex_ampi::rednResult(0), ptr->getProxy());
6902   msg->setCallback(allgatherCB);
6903   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Allgather called on comm %d\n", ptr->thisIndex, comm));
6904   ptr->contribute(msg);
6905
6906   ptr->blockOnRedn(new GatherReq(recvbuf, recvcount, recvtype, comm, getDDT()));
6907
6908   return MPI_SUCCESS;
6909 }
6910
6911 AMPI_API_IMPL(int, MPI_Iallgather, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
6912                                    void *recvbuf, int recvcount, MPI_Datatype recvtype,
6913                                    MPI_Comm comm, MPI_Request* request)
6914 {
6915   AMPI_API("AMPI_Iallgather");
6916
6917   ampi *ptr = getAmpiInstance(comm);
6918   int rank = ptr->getRank();
6919
6920   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
6921   handle_MPI_IN_PLACE_gather((void*&)sendbuf, recvbuf, sendcount, sendtype,
6922                              rank*recvcount, recvcount, recvtype);
6923
6924 #if AMPI_ERROR_CHECKING
6925   int ret;
6926   if (sendbuf != recvbuf) {
6927     ret = errorCheck("AMPI_Iallgather", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
6928     if(ret != MPI_SUCCESS){
6929       *request = MPI_REQUEST_NULL;
6930       return ret;
6931     }
6932   }
6933   ret = errorCheck("AMPI_Iallgather", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
6934   if(ret != MPI_SUCCESS){
6935     *request = MPI_REQUEST_NULL;
6936     return ret;
6937   }
6938 #endif
6939
6940   if(getAmpiParent()->isInter(comm))
6941     CkAbort("AMPI does not implement MPI_Iallgather for Inter-communicators!");
6942   if(ptr->getSize() == 1){
6943     *request = ptr->postReq(new GatherReq(recvbuf, recvcount, recvtype, comm, getDDT(), AMPI_REQ_COMPLETED));
6944     return copyDatatype(sendtype,sendcount,recvtype,recvcount,sendbuf,recvbuf);
6945   }
6946
6947   CkReductionMsg* msg = makeGatherMsg(sendbuf, sendcount, sendtype, rank);
6948   CkCallback allgatherCB(CkIndex_ampi::irednResult(0), ptr->getProxy());
6949   msg->setCallback(allgatherCB);
6950   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Iallgather called on comm %d\n", ptr->thisIndex, comm));
6951   ptr->contribute(msg);
6952
6953   // use a RednReq to non-block the caller and get a request ptr
6954   *request = ptr->postReq(new GatherReq(recvbuf, recvcount, recvtype, comm, getDDT()));
6955
6956   return MPI_SUCCESS;
6957 }
6958
6959 AMPI_API_IMPL(int, MPI_Allgatherv, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
6960                                    void *recvbuf, const int *recvcounts, const int *displs,
6961                                    MPI_Datatype recvtype, MPI_Comm comm)
6962 {
6963   AMPI_API("AMPI_Allgatherv");
6964
6965   ampi *ptr = getAmpiInstance(comm);
6966   int rank = ptr->getRank();
6967
6968   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
6969   handle_MPI_IN_PLACE_gatherv((void*&)sendbuf, recvbuf, sendcount, sendtype,
6970                               displs, recvcounts, rank, recvtype);
6971
6972 #if AMPI_ERROR_CHECKING
6973   int ret;
6974   if (sendbuf != recvbuf) {
6975     ret = errorCheck("AMPI_Allgatherv", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
6976     if(ret != MPI_SUCCESS)
6977       return ret;
6978   }
6979   ret = errorCheck("AMPI_Allgatherv", comm, 1, recvcounts[0], 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
6980   if(ret != MPI_SUCCESS)
6981     return ret;
6982 #endif
6983
6984   if(getAmpiParent()->isInter(comm))
6985     CkAbort("AMPI does not implement MPI_Allgatherv for Inter-communicators!");
6986   if(ptr->getSize() == 1)
6987     return copyDatatype(sendtype,sendcount,recvtype,recvcounts[0],sendbuf,recvbuf);
6988
6989   CkReductionMsg* msg = makeGatherMsg(sendbuf, sendcount, sendtype, rank);
6990   CkCallback allgathervCB(CkIndex_ampi::rednResult(0), ptr->getProxy());
6991   msg->setCallback(allgathervCB);
6992   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Allgatherv called on comm %d\n", ptr->thisIndex, comm));
6993   ptr->contribute(msg);
6994
6995   ptr->blockOnRedn(new GathervReq(recvbuf, ptr->getSize(), recvtype, comm, recvcounts, displs, getDDT()));
6996
6997   return MPI_SUCCESS;
6998 }
6999
7000 AMPI_API_IMPL(int, MPI_Iallgatherv, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
7001                                     void *recvbuf, const int *recvcounts, const int *displs,
7002                                     MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request)
7003 {
7004   AMPI_API("AMPI_Iallgatherv");
7005
7006   ampi *ptr = getAmpiInstance(comm);
7007   int rank = ptr->getRank();
7008
7009   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7010   handle_MPI_IN_PLACE_gatherv((void*&)sendbuf, recvbuf, sendcount, sendtype,
7011                               displs, recvcounts, rank, recvtype);
7012
7013 #if AMPI_ERROR_CHECKING
7014   int ret;
7015   if (sendbuf != recvbuf) {
7016     ret = errorCheck("AMPI_Iallgatherv", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7017     if(ret != MPI_SUCCESS){
7018       *request = MPI_REQUEST_NULL;
7019       return ret;
7020     }
7021   }
7022   ret = errorCheck("AMPI_Iallgatherv", comm, 1, recvcounts[0], 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7023   if(ret != MPI_SUCCESS){
7024     *request = MPI_REQUEST_NULL;
7025     return ret;
7026   }
7027 #endif
7028
7029   if(getAmpiParent()->isInter(comm))
7030     CkAbort("AMPI does not implement MPI_Iallgatherv for Inter-communicators!");
7031   if(ptr->getSize() == 1){
7032     *request = ptr->postReq(new GathervReq(recvbuf, rank, recvtype, comm, recvcounts, displs,
7033                             getDDT(), AMPI_REQ_COMPLETED));
7034     return copyDatatype(sendtype,sendcount,recvtype,recvcounts[0],sendbuf,recvbuf);
7035   }
7036
7037   CkReductionMsg* msg = makeGatherMsg(sendbuf, sendcount, sendtype, rank);
7038   CkCallback allgathervCB(CkIndex_ampi::irednResult(0), ptr->getProxy());
7039   msg->setCallback(allgathervCB);
7040   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Iallgatherv called on comm %d\n", ptr->thisIndex, comm));
7041   ptr->contribute(msg);
7042
7043   // use a GathervReq to non-block the caller and get a request ptr
7044   *request = ptr->postReq(new GathervReq(recvbuf, ptr->getSize(), recvtype,
7045                                          comm, recvcounts, displs, getDDT()));
7046
7047   return MPI_SUCCESS;
7048 }
7049
7050 AMPI_API_IMPL(int, MPI_Gather, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
7051                                void *recvbuf, int recvcount, MPI_Datatype recvtype,
7052                                int root, MPI_Comm comm)
7053 {
7054   AMPI_API("AMPI_Gather");
7055
7056   ampi *ptr = getAmpiInstance(comm);
7057   int rank = ptr->getRank();
7058
7059   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7060   handle_MPI_IN_PLACE_gather((void*&)sendbuf, recvbuf, sendcount, sendtype,
7061                              rank*recvcount, recvcount, recvtype);
7062
7063 #if AMPI_ERROR_CHECKING
7064   int ret;
7065   if (sendbuf != recvbuf) {
7066     ret = errorCheck("AMPI_Gather", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7067     if(ret != MPI_SUCCESS)
7068       return ret;
7069   }
7070   if (getAmpiInstance(comm)->getRank() == root) {
7071     ret = errorCheck("AMPI_Gather", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7072     if(ret != MPI_SUCCESS)
7073       return ret;
7074   }
7075 #endif
7076
7077   if(getAmpiParent()->isInter(comm))
7078     CkAbort("AMPI does not implement MPI_Gather for Inter-communicators!");
7079   if(ptr->getSize() == 1)
7080     return copyDatatype(sendtype,sendcount,recvtype,recvcount,sendbuf,recvbuf);
7081
7082 #if AMPIMSGLOG
7083   ampiParent* pptr = getAmpiParent();
7084   if(msgLogRead){
7085     (*(pptr->fromPUPer))|(pptr->pupBytes);
7086     PUParray(*(pptr->fromPUPer), (char *)recvbuf, (pptr->pupBytes));
7087     return MPI_SUCCESS;
7088   }
7089 #endif
7090
7091   int rootIdx = ptr->comm2CommStruct(comm).getIndexForRank(root);
7092   CkReductionMsg* msg = makeGatherMsg(sendbuf, sendcount, sendtype, rank);
7093   CkCallback gatherCB(CkIndex_ampi::rednResult(0), CkArrayIndex1D(rootIdx), ptr->getProxy());
7094   msg->setCallback(gatherCB);
7095   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Gather called on comm %d root %d \n", ptr->thisIndex, comm, rootIdx));
7096   ptr->contribute(msg);
7097
7098   if(rank==root) {
7099     ptr->blockOnRedn(new GatherReq(recvbuf, recvcount, recvtype, comm, getDDT()));
7100   }
7101
7102 #if AMPIMSGLOG
7103   if(msgLogWrite && record_msglog(pptr->thisIndex)){
7104     (pptr->pupBytes) = getDDT()->getSize(recvtype) * recvcount * size;
7105     (*(pptr->toPUPer))|(pptr->pupBytes);
7106     PUParray(*(pptr->toPUPer), (char *)recvbuf, (pptr->pupBytes));
7107   }
7108 #endif
7109
7110   return MPI_SUCCESS;
7111 }
7112
7113 AMPI_API_IMPL(int, MPI_Igather, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
7114                                 void *recvbuf, int recvcount, MPI_Datatype recvtype,
7115                                 int root, MPI_Comm comm, MPI_Request *request)
7116 {
7117   AMPI_API("AMPI_Igather");
7118
7119   ampi *ptr = getAmpiInstance(comm);
7120   int rank = ptr->getRank();
7121
7122   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7123   handle_MPI_IN_PLACE_gather((void*&)sendbuf, recvbuf, sendcount, sendtype,
7124                              rank*recvcount, recvcount, recvtype);
7125
7126 #if AMPI_ERROR_CHECKING
7127   int ret;
7128   if (sendbuf != recvbuf) {
7129     ret = errorCheck("AMPI_Igather", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7130     if(ret != MPI_SUCCESS){
7131       *request = MPI_REQUEST_NULL;
7132       return ret;
7133     }
7134   }
7135   if (getAmpiInstance(comm)->getRank() == root) {
7136     ret = errorCheck("AMPI_Igather", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7137     if(ret != MPI_SUCCESS){
7138       *request = MPI_REQUEST_NULL;
7139       return ret;
7140     }
7141   }
7142 #endif
7143
7144   if(getAmpiParent()->isInter(comm))
7145     CkAbort("AMPI does not implement MPI_Igather for Inter-communicators!");
7146   if(ptr->getSize() == 1){
7147     *request = ptr->postReq(new GatherReq(recvbuf, recvcount, recvtype, comm, getDDT(), AMPI_REQ_COMPLETED));
7148     return copyDatatype(sendtype,sendcount,recvtype,recvcount,sendbuf,recvbuf);
7149   }
7150
7151 #if AMPIMSGLOG
7152   ampiParent* pptr = getAmpiParent();
7153   if(msgLogRead){
7154     (*(pptr->fromPUPer))|(pptr->pupBytes);
7155     PUParray(*(pptr->fromPUPer), (char *)recvbuf, (pptr->pupBytes));
7156     return MPI_SUCCESS;
7157   }
7158 #endif
7159
7160   int rootIdx = ptr->comm2CommStruct(comm).getIndexForRank(root);
7161   CkReductionMsg* msg = makeGatherMsg(sendbuf, sendcount, sendtype, rank);
7162   CkCallback gatherCB(CkIndex_ampi::irednResult(0), CkArrayIndex1D(rootIdx), ptr->getProxy());
7163   msg->setCallback(gatherCB);
7164   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Igather called on comm %d root %d \n", ptr->thisIndex, comm, rootIdx));
7165   ptr->contribute(msg);
7166
7167   if(rank==root) {
7168     // use a GatherReq to non-block the caller and get a request ptr
7169     *request = ptr->postReq(new GatherReq(recvbuf, recvcount, recvtype, comm, getDDT()));
7170   }
7171   else {
7172     *request = ptr->postReq(new GatherReq(recvbuf, recvcount, recvtype, comm, getDDT(), AMPI_REQ_COMPLETED));
7173   }
7174
7175 #if AMPIMSGLOG
7176   if(msgLogWrite && record_msglog(pptr->thisIndex)){
7177     (pptr->pupBytes) = getDDT()->getSize(recvtype) * recvcount * size;
7178     (*(pptr->toPUPer))|(pptr->pupBytes);
7179     PUParray(*(pptr->toPUPer), (char *)recvbuf, (pptr->pupBytes));
7180   }
7181 #endif
7182
7183   return MPI_SUCCESS;
7184 }
7185
7186 AMPI_API_IMPL(int, MPI_Gatherv, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
7187                                 void *recvbuf, const int *recvcounts, const int *displs,
7188                                 MPI_Datatype recvtype, int root, MPI_Comm comm)
7189 {
7190   AMPI_API("AMPI_Gatherv");
7191
7192   ampi *ptr = getAmpiInstance(comm);
7193   int rank = ptr->getRank();
7194
7195   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7196   handle_MPI_IN_PLACE_gatherv((void*&)sendbuf, recvbuf, sendcount, sendtype,
7197                               displs, recvcounts, rank, recvtype);
7198
7199 #if AMPI_ERROR_CHECKING
7200   int ret;
7201   if (sendbuf != recvbuf) {
7202     ret = errorCheck("AMPI_Gatherv", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7203     if(ret != MPI_SUCCESS)
7204       return ret;
7205   }
7206   if (getAmpiInstance(comm)->getRank() == root) {
7207     ret = errorCheck("AMPI_Gatherv", comm, 1, recvcounts[0], 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7208     if(ret != MPI_SUCCESS)
7209       return ret;
7210   }
7211 #endif
7212
7213   if(getAmpiParent()->isInter(comm))
7214     CkAbort("AMPI does not implement MPI_Gatherv for Inter-communicators!");
7215   if(ptr->getSize() == 1)
7216     return copyDatatype(sendtype,sendcount,recvtype,recvcounts[0],sendbuf,recvbuf);
7217
7218 #if AMPIMSGLOG
7219   ampiParent* pptr = getAmpiParent();
7220   if(msgLogRead){
7221     int commsize;
7222     int itemsize = getDDT()->getSize(recvtype);
7223     (*(pptr->fromPUPer))|commsize;
7224     for(int i=0;i<commsize;i++){
7225       (*(pptr->fromPUPer))|(pptr->pupBytes);
7226       PUParray(*(pptr->fromPUPer), (char *)(((char*)recvbuf)+(itemsize*displs[i])), (pptr->pupBytes));
7227     }
7228     return MPI_SUCCESS;
7229   }
7230 #endif
7231
7232   int rootIdx = ptr->comm2CommStruct(comm).getIndexForRank(root);
7233   CkReductionMsg* msg = makeGatherMsg(sendbuf, sendcount, sendtype, rank);
7234   CkCallback gathervCB(CkIndex_ampi::rednResult(0), CkArrayIndex1D(rootIdx), ptr->getProxy());
7235   msg->setCallback(gathervCB);
7236   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Gatherv called on comm %d root %d \n", ptr->thisIndex, comm, rootIdx));
7237   ptr->contribute(msg);
7238
7239   if(rank==root) {
7240     ptr->blockOnRedn(new GathervReq(recvbuf, ptr->getSize(), recvtype, comm, recvcounts, displs, getDDT()));
7241   }
7242
7243 #if AMPIMSGLOG
7244   if(msgLogWrite && record_msglog(pptr->thisIndex)){
7245     for(int i=0;i<size;i++){
7246       (pptr->pupBytes) = getDDT()->getSize(recvtype) * recvcounts[i];
7247       (*(pptr->toPUPer))|(pptr->pupBytes);
7248       PUParray(*(pptr->toPUPer), (char *)(((char*)recvbuf)+(itemsize*displs[i])), (pptr->pupBytes));
7249     }
7250   }
7251 #endif
7252
7253   return MPI_SUCCESS;
7254 }
7255
7256 AMPI_API_IMPL(int, MPI_Igatherv, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
7257                                  void *recvbuf, const int *recvcounts, const int *displs,
7258                                  MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request)
7259 {
7260   AMPI_API("AMPI_Igatherv");
7261
7262   ampi *ptr = getAmpiInstance(comm);
7263   int rank = ptr->getRank();
7264
7265   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7266   handle_MPI_IN_PLACE_gatherv((void*&)sendbuf, recvbuf, sendcount, sendtype,
7267                               displs, recvcounts, rank, recvtype);
7268
7269 #if AMPI_ERROR_CHECKING
7270   int ret;
7271   if (sendbuf != recvbuf) {
7272     ret = errorCheck("AMPI_Igatherv", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7273     if(ret != MPI_SUCCESS){
7274       *request = MPI_REQUEST_NULL;
7275       return ret;
7276     }
7277   }
7278   if (getAmpiInstance(comm)->getRank() == root) {
7279     ret = errorCheck("AMPI_Igatherv", comm, 1, recvcounts[0], 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7280     if(ret != MPI_SUCCESS){
7281       *request = MPI_REQUEST_NULL;
7282       return ret;
7283     }
7284   }
7285 #endif
7286
7287   if(getAmpiParent()->isInter(comm))
7288     CkAbort("AMPI does not implement MPI_Igatherv for Inter-communicators!");
7289   if(ptr->getSize() == 1){
7290     *request = ptr->postReq(new GathervReq(recvbuf, rank, recvtype, comm, recvcounts, displs,
7291                             getDDT(), AMPI_REQ_COMPLETED));
7292     return copyDatatype(sendtype,sendcount,recvtype,recvcounts[0],sendbuf,recvbuf);
7293   }
7294
7295 #if AMPIMSGLOG
7296   ampiParent* pptr = getAmpiParent();
7297   if(msgLogRead){
7298     int commsize;
7299     int itemsize = getDDT()->getSize(recvtype);
7300     (*(pptr->fromPUPer))|commsize;
7301     for(int i=0;i<commsize;i++){
7302       (*(pptr->fromPUPer))|(pptr->pupBytes);
7303       PUParray(*(pptr->fromPUPer), (char *)(((char*)recvbuf)+(itemsize*displs[i])), (pptr->pupBytes));
7304     }
7305     return MPI_SUCCESS;
7306   }
7307 #endif
7308
7309   int rootIdx = ptr->comm2CommStruct(comm).getIndexForRank(root);
7310
7311   CkReductionMsg* msg = makeGatherMsg(sendbuf, sendcount, sendtype, rank);
7312   CkCallback gathervCB(CkIndex_ampi::irednResult(0), CkArrayIndex1D(rootIdx), ptr->getProxy());
7313   msg->setCallback(gathervCB);
7314   MSG_ORDER_DEBUG(CkPrintf("[%d] AMPI_Igatherv called on comm %d root %d \n", ptr->thisIndex, comm, rootIdx));
7315   ptr->contribute(msg);
7316
7317   if(rank==root) {
7318     // use a GathervReq to non-block the caller and get a request ptr
7319     *request = ptr->postReq(new GathervReq(recvbuf, ptr->getSize(), recvtype,
7320                                            comm, recvcounts, displs, getDDT()));
7321   }
7322   else {
7323     *request = ptr->postReq(new GathervReq(recvbuf, ptr->getSize(), recvtype,
7324                                            comm, recvcounts, displs, getDDT(), AMPI_REQ_COMPLETED));
7325   }
7326
7327 #if AMPIMSGLOG
7328   if(msgLogWrite && record_msglog(pptr->thisIndex)){
7329     for(int i=0;i<size;i++){
7330       (pptr->pupBytes) = getDDT()->getSize(recvtype) * recvcounts[i];
7331       (*(pptr->toPUPer))|(pptr->pupBytes);
7332       PUParray(*(pptr->toPUPer), (char *)(((char*)recvbuf)+(itemsize*displs[i])), (pptr->pupBytes));
7333     }
7334   }
7335 #endif
7336
7337   return MPI_SUCCESS;
7338 }
7339
7340 AMPI_API_IMPL(int, MPI_Scatter, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
7341                                 void *recvbuf, int recvcount, MPI_Datatype recvtype,
7342                                 int root, MPI_Comm comm)
7343 {
7344   AMPI_API("AMPI_Scatter");
7345
7346   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7347   handle_MPI_IN_PLACE((void*&)sendbuf,recvbuf);
7348
7349 #if AMPI_ERROR_CHECKING
7350   int ret;
7351   if (getAmpiInstance(comm)->getRank() == root) {
7352     ret = errorCheck("AMPI_Scatter", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7353     if(ret != MPI_SUCCESS)
7354       return ret;
7355   }
7356   if (sendbuf != recvbuf || getAmpiInstance(comm)->getRank() != root) {
7357     ret = errorCheck("AMPI_Scatter", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7358     if(ret != MPI_SUCCESS)
7359       return ret;
7360   }
7361 #endif
7362
7363   ampi *ptr = getAmpiInstance(comm);
7364
7365   if(getAmpiParent()->isInter(comm)) {
7366     return ptr->intercomm_scatter(root,sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype,comm);
7367   }
7368   if(ptr->getSize() == 1)
7369     return copyDatatype(sendtype,sendcount,recvtype,recvcount,sendbuf,recvbuf);
7370
7371 #if AMPIMSGLOG
7372   ampiParent* pptr = getAmpiParent();
7373   if(msgLogRead){
7374     (*(pptr->fromPUPer))|(pptr->pupBytes);
7375     PUParray(*(pptr->fromPUPer), (char *)recvbuf, (pptr->pupBytes));
7376     return MPI_SUCCESS;
7377   }
7378 #endif
7379
7380   int size = ptr->getSize();
7381   int rank = ptr->getRank();
7382   int i;
7383
7384   if(rank==root) {
7385     CkDDT_DataType* dttype = ptr->getDDT()->getType(sendtype) ;
7386     int itemextent = dttype->getExtent() * sendcount;
7387     for(i=0;i<size;i++) {
7388       if (i != rank) {
7389         ptr->send(MPI_SCATTER_TAG, rank, ((char*)sendbuf)+(itemextent*i),
7390                   sendcount, sendtype, i, comm);
7391       }
7392     }
7393     if (sendbuf != recvbuf) {
7394       copyDatatype(sendtype,sendcount,recvtype,recvcount,(char*)sendbuf+(itemextent*rank),recvbuf);
7395     }
7396   }
7397   else {
7398     if(-1==ptr->recv(MPI_SCATTER_TAG, root, recvbuf, recvcount, recvtype, comm))
7399       CkAbort("AMPI> Error in MPI_Scatter recv");
7400   }
7401
7402 #if AMPIMSGLOG
7403   if(msgLogWrite && record_msglog(pptr->thisIndex)){
7404     (pptr->pupBytes) = getDDT()->getSize(recvtype) * recvcount;
7405     (*(pptr->toPUPer))|(pptr->pupBytes);
7406     PUParray(*(pptr->toPUPer), (char *)recvbuf, (pptr->pupBytes));
7407   }
7408 #endif
7409
7410   return MPI_SUCCESS;
7411 }
7412
7413 AMPI_API_IMPL(int, MPI_Iscatter, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
7414                                  void *recvbuf, int recvcount, MPI_Datatype recvtype,
7415                                  int root, MPI_Comm comm, MPI_Request *request)
7416 {
7417   AMPI_API("AMPI_Iscatter");
7418
7419   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7420   handle_MPI_IN_PLACE((void*&)sendbuf,recvbuf);
7421
7422 #if AMPI_ERROR_CHECKING
7423   int ret;
7424   if (getAmpiInstance(comm)->getRank() == root) {
7425     ret = errorCheck("AMPI_Iscatter", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7426     if(ret != MPI_SUCCESS){
7427       *request = MPI_REQUEST_NULL;
7428       return ret;
7429     }
7430   }
7431   if (sendbuf != recvbuf || getAmpiInstance(comm)->getRank() != root) {
7432     ret = errorCheck("AMPI_Iscatter", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7433     if(ret != MPI_SUCCESS){
7434       *request = MPI_REQUEST_NULL;
7435       return ret;
7436     }
7437   }
7438 #endif
7439
7440   ampi *ptr = getAmpiInstance(comm);
7441
7442   if(getAmpiParent()->isInter(comm)) {
7443     return ptr->intercomm_iscatter(root,sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype,comm,request);
7444   }
7445   if(ptr->getSize() == 1){
7446     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcount,recvtype,root,MPI_SCATTER_TAG,comm,
7447                             getDDT(), AMPI_REQ_COMPLETED));
7448     return copyDatatype(sendtype,sendcount,recvtype,recvcount,sendbuf,recvbuf);
7449   }
7450
7451 #if AMPIMSGLOG
7452   ampiParent* pptr = getAmpiParent();
7453   if(msgLogRead){
7454     (*(pptr->fromPUPer))|(pptr->pupBytes);
7455     PUParray(*(pptr->fromPUPer), (char *)recvbuf, (pptr->pupBytes));
7456     return MPI_SUCCESS;
7457   }
7458 #endif
7459
7460   int size = ptr->getSize();
7461   int rank = ptr->getRank();
7462   int i;
7463
7464   if(rank==root) {
7465     CkDDT_DataType* dttype = ptr->getDDT()->getType(sendtype) ;
7466     int itemextent = dttype->getExtent() * sendcount;
7467     // use an ATAReq to non-block the caller and get a request ptr
7468     ATAReq *newreq = new ATAReq(size);
7469     for(i=0;i<size;i++) {
7470       if (i != rank) {
7471         newreq->reqs[i] = ptr->send(MPI_SCATTER_TAG, rank, (char*)sendbuf+(itemextent*i),
7472                                     sendcount, sendtype, i, comm, 0, I_SEND);
7473       }
7474     }
7475     newreq->reqs[rank] = MPI_REQUEST_NULL;
7476
7477     if (sendbuf != recvbuf) {
7478       copyDatatype(sendtype,sendcount,recvtype,recvcount,(char*)sendbuf+(itemextent*rank),recvbuf);
7479     }
7480     *request = ptr->postReq(newreq);
7481   }
7482   else {
7483     ptr->irecv(recvbuf,recvcount,recvtype,root,MPI_SCATTER_TAG,comm,request);
7484   }
7485
7486 #if AMPIMSGLOG
7487   if(msgLogWrite && record_msglog(pptr->thisIndex)){
7488     (pptr->pupBytes) = getDDT()->getSize(recvtype) * recvcount;
7489     (*(pptr->toPUPer))|(pptr->pupBytes);
7490     PUParray(*(pptr->toPUPer), (char *)recvbuf, (pptr->pupBytes));
7491   }
7492 #endif
7493
7494   return MPI_SUCCESS;
7495 }
7496
7497 AMPI_API_IMPL(int, MPI_Scatterv, const void *sendbuf, const int *sendcounts, const int *displs,
7498                                  MPI_Datatype sendtype, void *recvbuf, int recvcount,
7499                                  MPI_Datatype recvtype, int root, MPI_Comm comm)
7500 {
7501   AMPI_API("AMPI_Scatterv");
7502
7503   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7504   handle_MPI_IN_PLACE((void*&)sendbuf, recvbuf);
7505
7506 #if AMPI_ERROR_CHECKING
7507   int ret;
7508   if (getAmpiInstance(comm)->getRank() == root) {
7509     ret = errorCheck("AMPI_Scatterv", comm, 1, 0, 0, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7510     if(ret != MPI_SUCCESS)
7511       return ret;
7512   }
7513   if (sendbuf != recvbuf || getAmpiInstance(comm)->getRank() != root) {
7514     ret = errorCheck("AMPI_Scatterv", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7515     if(ret != MPI_SUCCESS)
7516       return ret;
7517   }
7518 #endif
7519
7520   ampi* ptr = getAmpiInstance(comm);
7521
7522   if (getAmpiParent()->isInter(comm)) {
7523     return ptr->intercomm_scatterv(root, sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount, recvtype, comm);
7524   }
7525   if(ptr->getSize() == 1)
7526     return copyDatatype(sendtype,sendcounts[0],recvtype,recvcount,sendbuf,recvbuf);
7527
7528 #if AMPIMSGLOG
7529   ampiParent* pptr = getAmpiParent();
7530   if(msgLogRead){
7531     (*(pptr->fromPUPer))|(pptr->pupBytes);
7532     PUParray(*(pptr->fromPUPer), (char *)recvbuf, (pptr->pupBytes));
7533     return MPI_SUCCESS;
7534   }
7535 #endif
7536
7537   int size = ptr->getSize();
7538   int rank = ptr->getRank();
7539   int i;
7540
7541   if(rank == root) {
7542     CkDDT_DataType* dttype = ptr->getDDT()->getType(sendtype) ;
7543     int itemextent = dttype->getExtent();
7544     for(i=0;i<size;i++) {
7545       if (i != rank) {
7546         ptr->send(MPI_SCATTER_TAG, rank, ((char*)sendbuf)+(itemextent*displs[i]),
7547                   sendcounts[i], sendtype, i, comm);
7548       }
7549     }
7550     if (sendbuf != recvbuf) {
7551       copyDatatype(sendtype,sendcounts[rank],recvtype,recvcount,(char*)sendbuf+(itemextent*displs[rank]),recvbuf);
7552     }
7553   }
7554   else {
7555     if(-1==ptr->recv(MPI_SCATTER_TAG, root, recvbuf, recvcount, recvtype, comm))
7556       CkAbort("AMPI> Error in MPI_Scatterv recv");
7557   }
7558
7559 #if AMPIMSGLOG
7560   if(msgLogWrite && record_msglog(pptr->thisIndex)){
7561     (pptr->pupBytes) = getDDT()->getSize(recvtype) * recvcount;
7562     (*(pptr->toPUPer))|(pptr->pupBytes);
7563     PUParray(*(pptr->toPUPer), (char *)recvbuf, (pptr->pupBytes));
7564   }
7565 #endif
7566
7567   return MPI_SUCCESS;
7568 }
7569
7570 AMPI_API_IMPL(int, MPI_Iscatterv, const void *sendbuf, const int *sendcounts, const int *displs,
7571                                   MPI_Datatype sendtype, void *recvbuf, int recvcount,
7572                                   MPI_Datatype recvtype, int root, MPI_Comm comm,
7573                                   MPI_Request *request)
7574 {
7575   AMPI_API("AMPI_Iscatterv");
7576
7577   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7578   handle_MPI_IN_PLACE((void*&)sendbuf,recvbuf);
7579
7580 #if AMPI_ERROR_CHECKING
7581   int ret;
7582   if (getAmpiInstance(comm)->getRank() == root) {
7583     ret = errorCheck("AMPI_Iscatterv", comm, 1, 0, 0, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7584     if(ret != MPI_SUCCESS){
7585       *request = MPI_REQUEST_NULL;
7586       return ret;
7587     }
7588   }
7589   if (sendbuf != recvbuf || getAmpiInstance(comm)->getRank() != root) {
7590     ret = errorCheck("AMPI_Iscatterv", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7591     if(ret != MPI_SUCCESS){
7592       *request = MPI_REQUEST_NULL;
7593       return ret;
7594     }
7595   }
7596 #endif
7597
7598   ampi* ptr = getAmpiInstance(comm);
7599
7600   if (getAmpiParent()->isInter(comm)) {
7601     return ptr->intercomm_iscatterv(root, sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount, recvtype, comm, request);
7602   }
7603   if(ptr->getSize() == 1){
7604     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcount,recvtype,root,MPI_SCATTER_TAG,comm,
7605                             getDDT(), AMPI_REQ_COMPLETED));
7606     return copyDatatype(sendtype,sendcounts[0],recvtype,recvcount,sendbuf,recvbuf);
7607   }
7608
7609 #if AMPIMSGLOG
7610   ampiParent* pptr = getAmpiParent();
7611   if(msgLogRead){
7612     (*(pptr->fromPUPer))|(pptr->pupBytes);
7613     PUParray(*(pptr->fromPUPer), (char *)recvbuf, (pptr->pupBytes));
7614     return MPI_SUCCESS;
7615   }
7616 #endif
7617
7618   int size = ptr->getSize();
7619   int rank = ptr->getRank();
7620   int i;
7621
7622   if(rank == root) {
7623     CkDDT_DataType* dttype = ptr->getDDT()->getType(sendtype) ;
7624     int itemextent = dttype->getExtent();
7625     // use an ATAReq to non-block the caller and get a request ptr
7626     ATAReq *newreq = new ATAReq(size);
7627     for(i=0;i<size;i++) {
7628       if (i != rank) {
7629         newreq->reqs[i] = ptr->send(MPI_SCATTER_TAG, rank, ((char*)sendbuf)+(itemextent*displs[i]),
7630                                     sendcounts[i], sendtype, i, comm, 0, I_SEND);
7631       }
7632     }
7633     newreq->reqs[rank] = MPI_REQUEST_NULL;
7634
7635     if (sendbuf != recvbuf) {
7636       copyDatatype(sendtype,sendcounts[rank],recvtype,recvcount,(char*)sendbuf+(itemextent*displs[rank]),recvbuf);
7637     }
7638     *request = ptr->postReq(newreq);
7639   }
7640   else {
7641     // call irecv to post an IReq and process any pending messages
7642     ptr->irecv(recvbuf,recvcount,recvtype,root,MPI_SCATTER_TAG,comm,request);
7643   }
7644
7645 #if AMPIMSGLOG
7646   if(msgLogWrite && record_msglog(pptr->thisIndex)){
7647     (pptr->pupBytes) = getDDT()->getSize(recvtype) * recvcount;
7648     (*(pptr->toPUPer))|(pptr->pupBytes);
7649     PUParray(*(pptr->toPUPer), (char *)recvbuf, (pptr->pupBytes));
7650   }
7651 #endif
7652
7653   return MPI_SUCCESS;
7654 }
7655
7656 AMPI_API_IMPL(int, MPI_Alltoall, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
7657                                  void *recvbuf, int recvcount, MPI_Datatype recvtype,
7658                                  MPI_Comm comm)
7659 {
7660   AMPI_API("AMPI_Alltoall");
7661
7662   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7663   handle_MPI_IN_PLACE_alltoall((void*&)sendbuf, recvbuf, sendcount, sendtype, recvcount, recvtype);
7664
7665 #if AMPI_ERROR_CHECKING
7666   int ret;
7667   if (sendbuf != recvbuf) {
7668     ret = errorCheck("AMPI_Alltoall", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7669     if(ret != MPI_SUCCESS)
7670       return ret;
7671   }
7672   ret = errorCheck("AMPI_Alltoall", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7673   if(ret != MPI_SUCCESS)
7674     return ret;
7675 #endif
7676
7677   ampi *ptr = getAmpiInstance(comm);
7678
7679   if(getAmpiParent()->isInter(comm))
7680     CkAbort("AMPI does not implement MPI_Alltoall for Inter-communicators!");
7681   if(ptr->getSize() == 1)
7682     return copyDatatype(sendtype,sendcount,recvtype,recvcount,sendbuf,recvbuf);
7683
7684   int itemsize = getDDT()->getSize(sendtype) * sendcount;
7685   int itemextent = getDDT()->getExtent(sendtype) * sendcount;
7686   int extent = getDDT()->getExtent(recvtype) * recvcount;
7687   int size = ptr->getSize();
7688   int rank = ptr->getRank();
7689
7690 #if CMK_BIGSIM_CHARM
7691   TRACE_BG_AMPI_LOG(MPI_ALLTOALL, itemextent);
7692 #endif
7693
7694   /* For MPI_IN_PLACE (sendbuf==recvbuf), prevent using the algorithm for
7695    * large message sizes, since it might lead to overwriting data before
7696    * it gets sent in the non-power-of-two communicator size case. */
7697   if (recvbuf == sendbuf) {
7698     for (int i=0; i<size; i++) {
7699       for (int j=i; j<size; j++) {
7700         if (rank == i) {
7701           ptr->sendrecv_replace(((char *)recvbuf + j*extent),
7702                                 recvcount, recvtype, j, MPI_ATA_TAG, j,
7703                                 MPI_ATA_TAG, comm, MPI_STATUS_IGNORE);
7704         }
7705         else if (rank == j) {
7706           ptr->sendrecv_replace(((char *)recvbuf + i*extent),
7707                                 recvcount, recvtype, i, MPI_ATA_TAG, i,
7708                                 MPI_ATA_TAG, comm, MPI_STATUS_IGNORE);
7709         }
7710       }
7711     }
7712   }
7713   else if (itemsize <= AMPI_ALLTOALL_SHORT_MSG && size <= AMPI_ALLTOALL_THROTTLE) {
7714     vector<MPI_Request> reqs(size*2);
7715     for (int i=0; i<size; i++) {
7716       int src = (rank+i) % size;
7717       ptr->irecv(((char*)recvbuf)+(extent*src), recvcount, recvtype,
7718                  src, MPI_ATA_TAG, comm, &reqs[i]);
7719     }
7720     for (int i=0; i<size; i++) {
7721       int dst = (rank+i) % size;
7722       reqs[size+i] = ptr->send(MPI_ATA_TAG, rank, ((char*)sendbuf)+(itemextent*dst),
7723                                sendcount, sendtype, dst, comm, 0, I_SEND);
7724     }
7725     MPI_Waitall(reqs.size(), reqs.data(), MPI_STATUSES_IGNORE);
7726   }
7727   else if (itemsize <= AMPI_ALLTOALL_LONG_MSG) {
7728     /* Don't post all sends and recvs at once. Instead do N sends/recvs at a time. */
7729     vector<MPI_Request> reqs(AMPI_ALLTOALL_THROTTLE*2);
7730     for (int j=0; j<size; j+=AMPI_ALLTOALL_THROTTLE) {
7731       int blockSize = std::min(size - j, AMPI_ALLTOALL_THROTTLE);
7732       for (int i=0; i<blockSize; i++) {
7733         int src = (rank + j + i) % size;
7734         ptr->irecv(((char*)recvbuf)+(extent*src), recvcount, recvtype,
7735                    src, MPI_ATA_TAG, comm, &reqs[i]);
7736       }
7737       for (int i=0; i<blockSize; i++) {
7738         int dst = (rank - j - i + size) % size;
7739         reqs[blockSize+i] = ptr->send(MPI_ATA_TAG, rank, ((char*)sendbuf)+(itemextent*dst),
7740                                       sendcount, sendtype, dst, comm, I_SEND);
7741       }
7742       MPI_Waitall(blockSize*2, reqs.data(), MPI_STATUSES_IGNORE);
7743     }
7744   }
7745   else {
7746     /* Long message. Use pairwise exchange. If comm_size is a
7747        power-of-two, use exclusive-or to create pairs. Else send
7748        to rank+i, receive from rank-i. */
7749     int src, dst;
7750
7751     /* Is comm_size a power-of-two? */
7752     int pof2 = 1;
7753     while (pof2 < size)
7754       pof2 *= 2;
7755     bool isPof2 = (pof2 == size);
7756
7757     /* The i=0 case takes care of moving local data into recvbuf */
7758     for (int i=0; i<size; i++) {
7759       if (isPof2) {
7760         /* use exclusive-or algorithm */
7761         src = dst = rank ^ i;
7762       }
7763       else {
7764         src = (rank - i + size) % size;
7765         dst = (rank + i) % size;
7766       }
7767
7768       ptr->sendrecv(((char *)sendbuf + dst*itemextent), sendcount, sendtype, dst, MPI_ATA_TAG,
7769                     ((char *)recvbuf + src*extent), recvcount, recvtype, src, MPI_ATA_TAG,
7770                     comm, MPI_STATUS_IGNORE);
7771     } // end of large message
7772   }
7773
7774   return MPI_SUCCESS;
7775 }
7776
7777 AMPI_API_IMPL(int, MPI_Ialltoall, const void *sendbuf, int sendcount, MPI_Datatype sendtype,
7778                                   void *recvbuf, int recvcount, MPI_Datatype recvtype,
7779                                   MPI_Comm comm, MPI_Request *request)
7780 {
7781   AMPI_API("AMPI_Ialltoall");
7782
7783   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7784   handle_MPI_IN_PLACE_alltoall((void*&)sendbuf, recvbuf, sendcount, sendtype, recvcount, recvtype);
7785
7786 #if AMPI_ERROR_CHECKING
7787   int ret;
7788   if (sendbuf != recvbuf) {
7789     ret = errorCheck("AMPI_Ialltoall", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7790     if(ret != MPI_SUCCESS){
7791       *request = MPI_REQUEST_NULL;
7792       return ret;
7793     }
7794   }
7795   ret = errorCheck("AMPI_Ialltoall", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7796   if(ret != MPI_SUCCESS){
7797     *request = MPI_REQUEST_NULL;
7798     return ret;
7799   }
7800 #endif
7801
7802   ampi *ptr = getAmpiInstance(comm);
7803   int size = ptr->getSize();
7804
7805   if(getAmpiParent()->isInter(comm))
7806     CkAbort("AMPI does not implement MPI_Ialltoall for Inter-communicators!");
7807   if(size == 1){
7808     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcount,recvtype,ptr->getRank(),MPI_ATA_TAG,comm,
7809                             getDDT(), AMPI_REQ_COMPLETED));
7810     return copyDatatype(sendtype,sendcount,recvtype,recvcount,sendbuf,recvbuf);
7811   }
7812
7813   int rank = ptr->getRank();
7814   int itemsize = getDDT()->getSize(sendtype) * sendcount;
7815   int extent = getDDT()->getExtent(recvtype) * recvcount;
7816
7817   // use an ATAReq to non-block the caller and get a request ptr
7818   ATAReq *newreq = new ATAReq(size*2);
7819   for (int i=0; i<size; i++) {
7820     ptr->irecv((char*)recvbuf+(extent*i), recvcount, recvtype, i, MPI_ATA_TAG, comm, &newreq->reqs[i]);
7821   }
7822
7823   for (int i=0; i<size; i++) {
7824     int dst = (rank+i) % size;
7825     newreq->reqs[size+i] = ptr->send(MPI_ATA_TAG, rank, ((char*)sendbuf)+(itemsize*dst), sendcount,
7826                                      sendtype, dst, comm, 0, I_SEND);
7827   }
7828   *request = ptr->postReq(newreq);
7829
7830   AMPI_DEBUG("MPI_Ialltoall: request=%d, reqs.size=%d, &reqs=%d\n",*request,reqs->size(),reqs);
7831   return MPI_SUCCESS;
7832 }
7833
7834 AMPI_API_IMPL(int, MPI_Alltoallv, const void *sendbuf, const int *sendcounts, const int *sdispls,
7835                                   MPI_Datatype sendtype, void *recvbuf, const int *recvcounts,
7836                                   const int *rdispls, MPI_Datatype recvtype, MPI_Comm comm)
7837 {
7838   AMPI_API("AMPI_Alltoallv");
7839
7840   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
7841   handle_MPI_IN_PLACE_alltoallv((void*&)sendbuf, recvbuf, (int*&)sendcounts, sendtype,
7842                                 (int*&)sdispls, recvcounts, recvtype, rdispls);
7843
7844 #if AMPI_ERROR_CHECKING
7845   int ret;
7846   if (sendbuf != recvbuf) {
7847     ret = errorCheck("AMPI_Alltoallv", comm, 1, 0, 0, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7848     if(ret != MPI_SUCCESS)
7849       return ret;
7850   }
7851   ret = errorCheck("AMPI_Alltoallv", comm, 1, 0, 0, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7852   if(ret != MPI_SUCCESS)
7853     return ret;
7854 #endif
7855
7856   ampi *ptr = getAmpiInstance(comm);
7857   int size = ptr->getSize();
7858
7859   if(getAmpiParent()->isInter(comm))
7860     CkAbort("AMPI does not implement MPI_Alltoallv for Inter-communicators!");
7861   if(size == 1)
7862     return copyDatatype(sendtype,sendcounts[0],recvtype,recvcounts[0],sendbuf,recvbuf);
7863
7864   int rank = ptr->getRank();
7865   int itemextent = getDDT()->getExtent(sendtype);
7866   int extent = getDDT()->getExtent(recvtype);
7867
7868   if (recvbuf == sendbuf) {
7869     for (int i=0; i<size; i++) {
7870       for (int j=i; j<size; j++) {
7871         if (rank == i) {
7872           ptr->sendrecv_replace(((char *)recvbuf + (extent*rdispls[j])),
7873                                 recvcounts[j], recvtype, j, MPI_ATA_TAG, j,
7874                                 MPI_ATA_TAG, comm, MPI_STATUS_IGNORE);
7875         }
7876         else if (rank == j) {
7877           ptr->sendrecv_replace(((char *)recvbuf + (extent*rdispls[i])),
7878                                 recvcounts[i], recvtype, i, MPI_ATA_TAG, i,
7879                                 MPI_ATA_TAG, comm, MPI_STATUS_IGNORE);
7880         }
7881       }
7882     }
7883   }
7884   else if (size <= AMPI_ALLTOALL_THROTTLE) {
7885     vector<MPI_Request> reqs(size*2);
7886     for (int i=0; i<size; i++) {
7887       int src = (rank+i) % size;
7888       ptr->irecv(((char*)recvbuf)+(extent*rdispls[src]), recvcounts[src], recvtype,
7889                  src, MPI_ATA_TAG, comm, &reqs[i]);
7890     }
7891     for (int i=0; i<size; i++) {
7892       int dst = (rank+i) % size;
7893       reqs[size+i] = ptr->send(MPI_ATA_TAG, rank, ((char*)sendbuf)+(itemextent*sdispls[dst]),
7894                                sendcounts[dst], sendtype, dst, comm, 0, I_SEND);
7895     }
7896     MPI_Waitall(size*2, reqs.data(), MPI_STATUSES_IGNORE);
7897   }
7898   else {
7899     /* Don't post all sends and recvs at once. Instead do N sends/recvs at a time. */
7900     vector<MPI_Request> reqs(AMPI_ALLTOALL_THROTTLE*2);
7901     for (int j=0; j<size; j+=AMPI_ALLTOALL_THROTTLE) {
7902       int blockSize = std::min(size - j, AMPI_ALLTOALL_THROTTLE);
7903       for (int i=0; i<blockSize; i++) {
7904         int src = (rank + j + i) % size;
7905         ptr->irecv(((char*)recvbuf)+(extent*rdispls[src]), recvcounts[src], recvtype,
7906                    src, MPI_ATA_TAG, comm, &reqs[i]);
7907       }
7908       for (int i=0; i<blockSize; i++) {
7909         int dst = (rank - j - i + size) % size;
7910         reqs[blockSize+i] = ptr->send(MPI_ATA_TAG, rank, ((char*)sendbuf)+(itemextent*sdispls[dst]),
7911                                       sendcounts[dst], sendtype, dst, comm);
7912       }
7913       MPI_Waitall(blockSize*2, reqs.data(), MPI_STATUSES_IGNORE);
7914     }
7915   }
7916
7917   return MPI_SUCCESS;
7918 }
7919
7920 AMPI_API_IMPL(int, MPI_Ialltoallv, void *sendbuf, int *sendcounts, int *sdispls, MPI_Datatype sendtype,
7921                                    void *recvbuf, int *recvcounts, int *rdispls, MPI_Datatype recvtype,
7922                                    MPI_Comm comm, MPI_Request *request)
7923 {
7924   AMPI_API("AMPI_Ialltoallv");
7925
7926   handle_MPI_BOTTOM(sendbuf, sendtype, recvbuf, recvtype);
7927   handle_MPI_IN_PLACE_alltoallv((void*&)sendbuf, recvbuf, (int*&)sendcounts, sendtype,
7928                                 (int*&)sdispls, recvcounts, recvtype, rdispls);
7929
7930 #if AMPI_ERROR_CHECKING
7931   int ret;
7932   if (sendbuf != recvbuf) {
7933     ret = errorCheck("AMPI_Ialltoallv", comm, 1, 0, 0, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
7934     if(ret != MPI_SUCCESS){
7935       *request = MPI_REQUEST_NULL;
7936       return ret;
7937     }
7938   }
7939   ret = errorCheck("AMPI_Ialltoallv", comm, 1, 0, 0, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
7940   if(ret != MPI_SUCCESS){
7941     *request = MPI_REQUEST_NULL;
7942     return ret;
7943   }
7944 #endif
7945
7946   ampi *ptr = getAmpiInstance(comm);
7947   int size = ptr->getSize();
7948
7949   if(getAmpiParent()->isInter(comm))
7950     CkAbort("AMPI does not implement MPI_Ialltoallv for Inter-communicators!");
7951   if(size == 1){
7952     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcounts[0],recvtype,ptr->getRank(),MPI_ATA_TAG,comm,
7953                             getDDT(), AMPI_REQ_COMPLETED));
7954     return copyDatatype(sendtype,sendcounts[0],recvtype,recvcounts[0],sendbuf,recvbuf);
7955   }
7956
7957   int rank = ptr->getRank();
7958   int itemextent = getDDT()->getExtent(sendtype);
7959   int extent = getDDT()->getExtent(recvtype);
7960
7961   // use an ATAReq to non-block the caller and get a request ptr
7962   ATAReq *newreq = new ATAReq(size*2);
7963   for (int i=0; i<size; i++) {
7964     ptr->irecv((char*)recvbuf+(extent*rdispls[i]), recvcounts[i],
7965                recvtype, i, MPI_ATA_TAG, comm, &newreq->reqs[i]);
7966   }
7967
7968   for (int i=0; i<size; i++) {
7969     int dst = (rank+i) % size;
7970     newreq->reqs[size+i] = ptr->send(MPI_ATA_TAG, rank, ((char*)sendbuf)+(itemextent*sdispls[dst]),
7971                                      sendcounts[dst], sendtype, dst, comm, 0, I_SEND);
7972   }
7973   *request = ptr->postReq(newreq);
7974
7975   AMPI_DEBUG("MPI_Ialltoallv: request=%d, reqs.size=%d, &reqs=%d\n",*request,reqs->size(),reqs);
7976
7977   return MPI_SUCCESS;
7978 }
7979
7980 AMPI_API_IMPL(int, MPI_Alltoallw, const void *sendbuf, const int *sendcounts, const int *sdispls,
7981                                   const MPI_Datatype *sendtypes, void *recvbuf, const int *recvcounts,
7982                                   const int *rdispls, const MPI_Datatype *recvtypes, MPI_Comm comm)
7983 {
7984   AMPI_API("AMPI_Alltoallw");
7985
7986   if (sendbuf == MPI_IN_PLACE) {
7987     handle_MPI_BOTTOM(recvbuf, recvtypes[0]);
7988   } else {
7989     handle_MPI_BOTTOM((void*&)sendbuf, sendtypes[0], recvbuf, recvtypes[0]);
7990   }
7991   handle_MPI_IN_PLACE_alltoallw((void*&)sendbuf, recvbuf, (int*&)sendcounts,
7992                                 (MPI_Datatype*&)sendtypes, (int*&)sdispls,
7993                                 recvcounts, recvtypes, rdispls);
7994
7995 #if AMPI_ERROR_CHECKING
7996   int ret;
7997   if (sendbuf != recvbuf) {
7998     ret = errorCheck("AMPI_Alltoallw", comm, 1, 0, 0, sendtypes[0], 1, 0, 0, 0, 0, sendbuf, 1);
7999     if(ret != MPI_SUCCESS)
8000       return ret;
8001   }
8002   ret = errorCheck("AMPI_Alltoallw", comm, 1, 0, 0, recvtypes[0], 1, 0, 0, 0, 0, recvbuf, 1);
8003   if(ret != MPI_SUCCESS)
8004     return ret;
8005 #endif
8006
8007   ampi *ptr = getAmpiInstance(comm);
8008   int size = ptr->getSize();
8009   int rank = ptr->getRank();
8010
8011   if(getAmpiParent()->isInter(comm))
8012     CkAbort("AMPI does not implement MPI_Alltoallw for Inter-communicators!");
8013   if(size == 1)
8014     return copyDatatype(sendtypes[0],sendcounts[0],recvtypes[0],recvcounts[0],sendbuf,recvbuf);
8015
8016   /* displs are in terms of bytes for Alltoallw (unlike Alltoallv) */
8017   if (recvbuf == sendbuf) {
8018     for (int i=0; i<size; i++) {
8019       for (int j=i; j<size; j++) {
8020         if (rank == i) {
8021           ptr->sendrecv_replace(((char *)recvbuf + rdispls[j]),
8022                                 recvcounts[j], recvtypes[j], j, MPI_ATA_TAG, j,
8023                                 MPI_ATA_TAG, comm, MPI_STATUS_IGNORE);
8024         }
8025         else if (rank == j) {
8026           ptr->sendrecv_replace(((char *)recvbuf + rdispls[i]),
8027                                 recvcounts[i], recvtypes[i], i, MPI_ATA_TAG, i,
8028                                 MPI_ATA_TAG, comm, MPI_STATUS_IGNORE);
8029         }
8030       }
8031     }
8032   }
8033   else if (size <= AMPI_ALLTOALL_THROTTLE) {
8034     vector<MPI_Request> reqs(size*2);
8035     for (int i=0; i<size; i++) {
8036       int src = (rank+i) % size;
8037       ptr->irecv(((char*)recvbuf)+rdispls[src], recvcounts[src], recvtypes[src],
8038                  src, MPI_ATA_TAG, comm, &reqs[i]);
8039     }
8040     for (int i=0; i<size; i++) {
8041       int dst = (rank+i) % size;
8042       reqs[size+i] = ptr->send(MPI_ATA_TAG, rank, ((char*)sendbuf)+sdispls[dst],
8043                                sendcounts[dst], sendtypes[dst], dst, comm, 0, I_SEND);
8044     }
8045     MPI_Waitall(size*2, reqs.data(), MPI_STATUSES_IGNORE);
8046   }
8047   else {
8048     /* Don't post all sends and recvs at once. Instead do N sends/recvs at a time. */
8049     vector<MPI_Request> reqs(AMPI_ALLTOALL_THROTTLE*2);
8050     for (int j=0; j<size; j+=AMPI_ALLTOALL_THROTTLE) {
8051       int blockSize = std::min(size - j, AMPI_ALLTOALL_THROTTLE);
8052       for (int i=0; i<blockSize; i++) {
8053         int src = (rank + j + i) % size;
8054         ptr->irecv(((char*)recvbuf)+rdispls[src], recvcounts[src], recvtypes[src],
8055                    src, MPI_ATA_TAG, comm, &reqs[i]);
8056       }
8057       for (int i=0; i<blockSize; i++) {
8058         int dst = (rank - j - i + size) % size;
8059         reqs[blockSize+i] = ptr->send(MPI_ATA_TAG, rank, ((char*)sendbuf)+sdispls[dst],
8060                                       sendcounts[dst], sendtypes[dst], dst, comm);
8061       }
8062       MPI_Waitall(blockSize*2, reqs.data(), MPI_STATUSES_IGNORE);
8063     }
8064   }
8065
8066   return MPI_SUCCESS;
8067 }
8068
8069 AMPI_API_IMPL(int, MPI_Ialltoallw, const void *sendbuf, const int *sendcounts, const int *sdispls,
8070                                    const MPI_Datatype *sendtypes, void *recvbuf, const int *recvcounts,
8071                                    const int *rdispls, const MPI_Datatype *recvtypes, MPI_Comm comm,
8072                                    MPI_Request *request)
8073 {
8074   AMPI_API("AMPI_Ialltoallw");
8075
8076   if (sendbuf == MPI_IN_PLACE) {
8077     handle_MPI_BOTTOM(recvbuf, recvtypes[0]);
8078   } else {
8079     handle_MPI_BOTTOM((void*&)sendbuf, sendtypes[0], recvbuf, recvtypes[0]);
8080   }
8081   handle_MPI_IN_PLACE_alltoallw((void*&)sendbuf, recvbuf, (int*&)sendcounts,
8082                                 (MPI_Datatype*&)sendtypes, (int*&)sdispls,
8083                                 recvcounts, recvtypes, rdispls);
8084
8085 #if AMPI_ERROR_CHECKING
8086   int ret;
8087   if (sendbuf != recvbuf) {
8088     ret = errorCheck("AMPI_Ialltoallw", comm, 1, 0, 0, sendtypes[0], 1, 0, 0, 0, 0, sendbuf, 1);
8089     if(ret != MPI_SUCCESS){
8090       *request = MPI_REQUEST_NULL;
8091       return ret;
8092     }
8093   }
8094   ret = errorCheck("AMPI_Ialltoallw", comm, 1, 0, 0, recvtypes[0], 1, 0, 0, 0, 0, recvbuf, 1);
8095   if(ret != MPI_SUCCESS){
8096     *request = MPI_REQUEST_NULL;
8097     return ret;
8098   }
8099 #endif
8100
8101   ampi *ptr = getAmpiInstance(comm);
8102   int size = ptr->getSize();
8103   int rank = ptr->getRank();
8104
8105   if(getAmpiParent()->isInter(comm))
8106     CkAbort("AMPI does not implement MPI_Ialltoallw for Inter-communicators!");
8107   if(size == 1){
8108     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcounts[0],recvtypes[0],ptr->getRank(),MPI_ATA_TAG,comm,
8109                             getDDT(), AMPI_REQ_COMPLETED));
8110     return copyDatatype(sendtypes[0],sendcounts[0],recvtypes[0],recvcounts[0],sendbuf,recvbuf);
8111   }
8112
8113   /* displs are in terms of bytes for Alltoallw (unlike Alltoallv) */
8114
8115   // use an ATAReq to non-block the caller and get a request ptr
8116   ATAReq *newreq = new ATAReq(size*2);
8117   for (int i=0; i<size; i++) {
8118     ptr->irecv((char*)recvbuf+rdispls[i], recvcounts[i], recvtypes[i],
8119                i, MPI_ATA_TAG, comm, &newreq->reqs[i]);
8120   }
8121
8122   for (int i=0; i<size; i++) {
8123     int dst = (rank+i) % size;
8124     newreq->reqs[i] = ptr->send(MPI_ATA_TAG, rank, (char*)sendbuf+sdispls[dst],
8125                                 sendcounts[dst], sendtypes[dst], dst, comm, 0, I_SEND);
8126   }
8127   *request = ptr->postReq(newreq);
8128
8129   return MPI_SUCCESS;
8130 }
8131
8132 AMPI_API_IMPL(int, MPI_Neighbor_alltoall, const void* sendbuf, int sendcount, MPI_Datatype sendtype,
8133                                           void* recvbuf, int recvcount, MPI_Datatype recvtype,
8134                                           MPI_Comm comm)
8135 {
8136   AMPI_API("AMPI_Neighbor_alltoall");
8137
8138   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
8139
8140 #if AMPI_ERROR_CHECKING
8141   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8142     CkAbort("MPI_Neighbor_alltoall does not accept MPI_IN_PLACE!");
8143   if (getAmpiParent()->isInter(comm))
8144     CkAbort("MPI_Neighbor_alltoall is not defined for Inter-communicators!");
8145   int ret;
8146   ret = errorCheck("AMPI_Neighbor_alltoall", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
8147   if(ret != MPI_SUCCESS)
8148     return ret;
8149   ret = errorCheck("AMPI_Neighbor_alltoall", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
8150   if(ret != MPI_SUCCESS)
8151     return ret;
8152 #endif
8153
8154   ampi *ptr = getAmpiInstance(comm);
8155   int rank_in_comm = ptr->getRank();
8156
8157   if (ptr->getSize() == 1)
8158     return copyDatatype(sendtype, sendcount, recvtype, recvcount, sendbuf, recvbuf);
8159
8160   const vector<int>& neighbors = ptr->getNeighbors();
8161   int num_neighbors = neighbors.size();
8162   int itemsize = getDDT()->getSize(sendtype) * sendcount;
8163   int extent = getDDT()->getExtent(recvtype) * recvcount;
8164
8165   vector<MPI_Request> reqs(num_neighbors*2);
8166   for (int j=0; j<num_neighbors; j++) {
8167     ptr->irecv(((char*)recvbuf)+(extent*j), recvcount, recvtype,
8168                neighbors[j], MPI_NBOR_TAG, comm, &reqs[j]);
8169   }
8170
8171   for (int i=0; i<num_neighbors; i++) {
8172     reqs[num_neighbors+i] = ptr->send(MPI_NBOR_TAG, rank_in_comm, (void*)((char*)sendbuf+(itemsize*i)),
8173                                       sendcount, sendtype, neighbors[i], comm, 0, I_SEND);
8174   }
8175
8176   MPI_Waitall(reqs.size(), reqs.data(), MPI_STATUSES_IGNORE);
8177
8178   return MPI_SUCCESS;
8179 }
8180
8181 AMPI_API_IMPL(int, MPI_Ineighbor_alltoall, const void* sendbuf, int sendcount, MPI_Datatype sendtype,
8182                                            void* recvbuf, int recvcount, MPI_Datatype recvtype,
8183                                            MPI_Comm comm, MPI_Request *request)
8184 {
8185   AMPI_API("AMPI_Ineighbor_alltoall");
8186
8187   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
8188
8189 #if AMPI_ERROR_CHECKING
8190   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8191     CkAbort("MPI_Ineighbor_alltoall does not accept MPI_IN_PLACE!");
8192   if (getAmpiParent()->isInter(comm))
8193     CkAbort("MPI_Ineighbor_alltoall is not defined for Inter-communicators!");
8194   int ret;
8195   ret = errorCheck("AMPI_Ineighbor_alltoall", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
8196   if(ret != MPI_SUCCESS){
8197     *request = MPI_REQUEST_NULL;
8198     return ret;
8199   }
8200   ret = errorCheck("AMPI_Ineighbor_alltoall", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
8201   if(ret != MPI_SUCCESS){
8202     *request = MPI_REQUEST_NULL;
8203     return ret;
8204   }
8205 #endif
8206
8207   ampi *ptr = getAmpiInstance(comm);
8208   int rank_in_comm = ptr->getRank();
8209
8210   if (ptr->getSize() == 1) {
8211     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcount,recvtype,rank_in_comm,MPI_NBOR_TAG,comm,
8212                             getDDT(), AMPI_REQ_COMPLETED));
8213     return copyDatatype(sendtype, sendcount, recvtype, recvcount, sendbuf, recvbuf);
8214   }
8215
8216   const vector<int>& neighbors = ptr->getNeighbors();
8217   int num_neighbors = neighbors.size();
8218   int itemsize = getDDT()->getSize(sendtype) * sendcount;
8219   int extent = getDDT()->getExtent(recvtype) * recvcount;
8220
8221   // use an ATAReq to non-block the caller and get a request ptr
8222   ATAReq *newreq = new ATAReq(num_neighbors*2);
8223   for (int j=0; j<num_neighbors; j++) {
8224     ptr->irecv((char*)recvbuf+(extent*j), recvcount, recvtype,
8225                neighbors[j], MPI_NBOR_TAG, comm, &newreq->reqs[j]);
8226   }
8227
8228   for (int i=0; i<num_neighbors; i++) {
8229     newreq->reqs[num_neighbors+i] = ptr->send(MPI_ATA_TAG, rank_in_comm, ((char*)sendbuf)+(i*itemsize),
8230                                               sendcount, sendtype, neighbors[i], comm, 0, I_SEND);
8231   }
8232   *request = ptr->postReq(newreq);
8233
8234   return MPI_SUCCESS;
8235 }
8236
8237 AMPI_API_IMPL(int, MPI_Neighbor_alltoallv, const void* sendbuf, const int *sendcounts, const int *sdispls,
8238                                            MPI_Datatype sendtype, void* recvbuf, const int *recvcounts,
8239                                            const int *rdispls, MPI_Datatype recvtype, MPI_Comm comm)
8240 {
8241   AMPI_API("AMPI_Neighbor_alltoallv");
8242
8243   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
8244
8245 #if AMPI_ERROR_CHECKING
8246   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8247     CkAbort("MPI_Neighbor_alltoallv does not accept MPI_IN_PLACE!");
8248   if (getAmpiParent()->isInter(comm))
8249     CkAbort("MPI_Neighbor_alltoallv is not defined for Inter-communicators!");
8250   int ret;
8251   ret = errorCheck("AMPI_Neighbor_alltoallv", comm, 1, sendcounts[0], 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
8252   if(ret != MPI_SUCCESS)
8253     return ret;
8254   ret = errorCheck("AMPI_Neighbor_alltoallv", comm, 1, recvcounts[0], 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
8255   if(ret != MPI_SUCCESS)
8256     return ret;
8257 #endif
8258
8259   ampi *ptr = getAmpiInstance(comm);
8260   int rank_in_comm = ptr->getRank();
8261
8262   if (ptr->getSize() == 1)
8263     return copyDatatype(sendtype, sendcounts[0], recvtype, recvcounts[0], sendbuf, recvbuf);
8264
8265   const vector<int>& neighbors = ptr->getNeighbors();
8266   int num_neighbors = neighbors.size();
8267   int itemsize = getDDT()->getSize(sendtype);
8268   int extent = getDDT()->getExtent(recvtype);
8269
8270   vector<MPI_Request> reqs(num_neighbors*2);
8271   for (int j=0; j<num_neighbors; j++) {
8272     ptr->irecv(((char*)recvbuf)+(extent*rdispls[j]), recvcounts[j], recvtype,
8273                neighbors[j], MPI_NBOR_TAG, comm, &reqs[j]);
8274   }
8275
8276   for (int i=0; i<num_neighbors; i++) {
8277     reqs[num_neighbors+i] = ptr->send(MPI_NBOR_TAG, rank_in_comm, (void*)((char*)sendbuf+(itemsize*sdispls[i])),
8278                                       sendcounts[i], sendtype, neighbors[i], comm, 0, I_SEND);
8279   }
8280
8281   MPI_Waitall(reqs.size(), reqs.data(), MPI_STATUSES_IGNORE);
8282
8283   return MPI_SUCCESS;
8284 }
8285
8286 AMPI_API_IMPL(int, MPI_Ineighbor_alltoallv, const void* sendbuf, const int *sendcounts, const int *sdispls,
8287                                             MPI_Datatype sendtype, void* recvbuf, const int *recvcounts,
8288                                             const int *rdispls, MPI_Datatype recvtype, MPI_Comm comm,
8289                                             MPI_Request *request)
8290 {
8291   AMPI_API("AMPI_Ineighbor_alltoallv");
8292
8293   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
8294
8295 #if AMPI_ERROR_CHECKING
8296   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8297     CkAbort("MPI_Ineighbor_alltoallv does not accept MPI_IN_PLACE!");
8298   if (getAmpiParent()->isInter(comm))
8299     CkAbort("MPI_Ineighbor_alltoallv is not defined for Inter-communicators!");
8300   int ret;
8301   ret = errorCheck("AMPI_Ineighbor_alltoallv", comm, 1, sendcounts[0], 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
8302   if(ret != MPI_SUCCESS){
8303     *request = MPI_REQUEST_NULL;
8304     return ret;
8305   }
8306   ret = errorCheck("AMPI_Ineighbor_alltoallv", comm, 1, recvcounts[0], 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
8307   if(ret != MPI_SUCCESS){
8308     *request = MPI_REQUEST_NULL;
8309     return ret;
8310   }
8311 #endif
8312
8313   ampi *ptr = getAmpiInstance(comm);
8314   int rank_in_comm = ptr->getRank();
8315
8316   if (ptr->getSize() == 1) {
8317     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcounts[0],recvtype,rank_in_comm,MPI_NBOR_TAG,comm,
8318                             getDDT(), AMPI_REQ_COMPLETED));
8319     return copyDatatype(sendtype, sendcounts[0], recvtype, recvcounts[0], sendbuf, recvbuf);
8320   }
8321
8322   const vector<int>& neighbors = ptr->getNeighbors();
8323   int num_neighbors = neighbors.size();
8324   int itemsize = getDDT()->getSize(sendtype);
8325   int extent = getDDT()->getExtent(recvtype);
8326
8327   // use an ATAReq to non-block the caller and get a request ptr
8328   ATAReq *newreq = new ATAReq(num_neighbors*2);
8329   for (int j=0; j<num_neighbors; j++) {
8330     ptr->irecv((char*)recvbuf+(extent*rdispls[j]), recvcounts[j], recvtype,
8331                neighbors[j], MPI_NBOR_TAG, comm, &newreq->reqs[j]);
8332   }
8333
8334   for (int i=0; i<num_neighbors; i++) {
8335     newreq->reqs[num_neighbors+i] = ptr->send(MPI_NBOR_TAG, rank_in_comm, (char*)sendbuf+(itemsize*sdispls[i]),
8336                                               sendcounts[i], sendtype, neighbors[i], comm, 0, I_SEND);
8337   }
8338   *request = ptr->postReq(newreq);
8339
8340   return MPI_SUCCESS;
8341 }
8342
8343 AMPI_API_IMPL(int, MPI_Neighbor_alltoallw, const void* sendbuf, const int *sendcounts, const MPI_Aint *sdispls,
8344                                            const MPI_Datatype *sendtypes, void* recvbuf, const int *recvcounts,
8345                                            const MPI_Aint *rdispls, const MPI_Datatype *recvtypes, MPI_Comm comm)
8346 {
8347   AMPI_API("AMPI_Neighbor_alltoallw");
8348
8349   handle_MPI_BOTTOM((void*&)sendbuf, sendtypes[0], recvbuf, recvtypes[0]);
8350
8351 #if AMPI_ERROR_CHECKING
8352   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8353     CkAbort("MPI_Neighbor_alltoallw does not accept MPI_IN_PLACE!");
8354   if (getAmpiParent()->isInter(comm))
8355     CkAbort("MPI_Neighbor_alltoallw is not defined for Inter-communicators!");
8356   int ret;
8357   ret = errorCheck("AMPI_Neighbor_alltoallw", comm, 1, sendcounts[0], 1, sendtypes[0], 1, 0, 0, 0, 0, sendbuf, 1);
8358   if(ret != MPI_SUCCESS)
8359     return ret;
8360   ret = errorCheck("AMPI_Neighbor_alltoallw", comm, 1, recvcounts[0], 1, recvtypes[0], 1, 0, 0, 0, 0, recvbuf, 1);
8361   if(ret != MPI_SUCCESS)
8362     return ret;
8363 #endif
8364
8365   ampi *ptr = getAmpiInstance(comm);
8366   int rank_in_comm = ptr->getRank();
8367
8368   if (ptr->getSize() == 1)
8369     return copyDatatype(sendtypes[0], sendcounts[0], recvtypes[0], recvcounts[0], sendbuf, recvbuf);
8370
8371   const vector<int>& neighbors = ptr->getNeighbors();
8372   int num_neighbors = neighbors.size();
8373
8374   vector<MPI_Request> reqs(num_neighbors*2);
8375   for (int j=0; j<num_neighbors; j++) {
8376     ptr->irecv(((char*)recvbuf)+rdispls[j], recvcounts[j], recvtypes[j],
8377                neighbors[j], MPI_NBOR_TAG, comm, &reqs[j]);
8378   }
8379
8380   for (int i=0; i<num_neighbors; i++) {
8381     reqs[num_neighbors+i] = ptr->send(MPI_NBOR_TAG, rank_in_comm, (void*)((char*)sendbuf+sdispls[i]),
8382                                       sendcounts[i], sendtypes[i], neighbors[i], comm, 0, I_SEND);
8383   }
8384
8385   MPI_Waitall(reqs.size(), reqs.data(), MPI_STATUSES_IGNORE);
8386
8387   return MPI_SUCCESS;
8388 }
8389
8390 AMPI_API_IMPL(int, MPI_Ineighbor_alltoallw, const void* sendbuf, const int *sendcounts, const MPI_Aint *sdispls,
8391                                             const MPI_Datatype *sendtypes, void* recvbuf, const int *recvcounts,
8392                                             const MPI_Aint *rdispls, const MPI_Datatype *recvtypes, MPI_Comm comm,
8393                                             MPI_Request *request)
8394 {
8395   AMPI_API("AMPI_Ineighbor_alltoallw");
8396
8397   handle_MPI_BOTTOM((void*&)sendbuf, sendtypes[0], recvbuf, recvtypes[0]);
8398
8399 #if AMPI_ERROR_CHECKING
8400   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8401     CkAbort("MPI_Ineighbor_alltoallw does not accept MPI_IN_PLACE!");
8402   if (getAmpiParent()->isInter(comm))
8403     CkAbort("MPI_Ineighbor_alltoallw is not defined for Inter-communicators!");
8404   int ret;
8405   ret = errorCheck("AMPI_Ineighbor_alltoallw", comm, 1, sendcounts[0], 1, sendtypes[0], 1, 0, 0, 0, 0, sendbuf, 1);
8406   if(ret != MPI_SUCCESS){
8407     *request = MPI_REQUEST_NULL;
8408     return ret;
8409   }
8410   ret = errorCheck("AMPI_Ineighbor_alltoallw", comm, 1, recvcounts[0], 1, recvtypes[0], 1, 0, 0, 0, 0, recvbuf, 1);
8411   if(ret != MPI_SUCCESS){
8412     *request = MPI_REQUEST_NULL;
8413     return ret;
8414   }
8415 #endif
8416
8417   ampi *ptr = getAmpiInstance(comm);
8418   int rank_in_comm = ptr->getRank();
8419
8420   if (ptr->getSize() == 1) {
8421     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcounts[0],recvtypes[0],rank_in_comm,MPI_NBOR_TAG,comm,
8422                             getDDT(), AMPI_REQ_COMPLETED));
8423     return copyDatatype(sendtypes[0], sendcounts[0], recvtypes[0], recvcounts[0], sendbuf, recvbuf);
8424   }
8425
8426   const vector<int>& neighbors = ptr->getNeighbors();
8427   int num_neighbors = neighbors.size();
8428
8429   // use an ATAReq to non-block the caller and get a request ptr
8430   ATAReq *newreq = new ATAReq(num_neighbors*2);
8431   for (int j=0; j<num_neighbors; j++) {
8432     ptr->irecv((char*)recvbuf+rdispls[j], recvcounts[j], recvtypes[j],
8433                neighbors[j], MPI_NBOR_TAG, comm, &newreq->reqs[j]);
8434   }
8435
8436   for (int i=0; i<num_neighbors; i++) {
8437     newreq->reqs[num_neighbors+i] = ptr->send(MPI_NBOR_TAG, rank_in_comm, (void*)((char*)sendbuf+sdispls[i]),
8438                                               sendcounts[i], sendtypes[i], neighbors[i], comm, 0, I_SEND);
8439   }
8440   *request = ptr->postReq(newreq);
8441
8442   return MPI_SUCCESS;
8443 }
8444
8445 AMPI_API_IMPL(int, MPI_Neighbor_allgather, const void* sendbuf, int sendcount, MPI_Datatype sendtype,
8446                                            void* recvbuf, int recvcount, MPI_Datatype recvtype,
8447                                            MPI_Comm comm)
8448 {
8449   AMPI_API("AMPI_Neighbor_allgather");
8450
8451   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
8452
8453 #if AMPI_ERROR_CHECKING
8454   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8455     CkAbort("MPI_Neighbor_allgather does not accept MPI_IN_PLACE!");
8456   if (getAmpiParent()->isInter(comm))
8457     CkAbort("MPI_Neighbor_allgather is not defined for Inter-communicators!");
8458   int ret;
8459   ret = errorCheck("AMPI_Neighbor_allgather", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
8460   if(ret != MPI_SUCCESS)
8461     return ret;
8462   ret = errorCheck("AMPI_Neighbor_allgather", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
8463   if(ret != MPI_SUCCESS)
8464     return ret;
8465 #endif
8466
8467   ampi *ptr = getAmpiInstance(comm);
8468   int rank_in_comm = ptr->getRank();
8469
8470   if (ptr->getSize() == 1)
8471     return copyDatatype(sendtype, sendcount, recvtype, recvcount, sendbuf, recvbuf);
8472
8473   const vector<int>& neighbors = ptr->getNeighbors();
8474   int num_neighbors = neighbors.size();
8475
8476   int extent = getDDT()->getExtent(recvtype) * recvcount;
8477   vector<MPI_Request> reqs(num_neighbors*2);
8478   for (int j=0; j<num_neighbors; j++) {
8479     ptr->irecv(((char*)recvbuf)+(extent*j), recvcount, recvtype,
8480                neighbors[j], MPI_NBOR_TAG, comm, &reqs[j]);
8481   }
8482
8483   for (int i=0; i<num_neighbors; i++) {
8484     reqs[num_neighbors+i] = ptr->send(MPI_NBOR_TAG, rank_in_comm, sendbuf, sendcount,
8485                                       sendtype, neighbors[i], comm, 0, I_SEND);
8486   }
8487
8488   MPI_Waitall(reqs.size(), reqs.data(), MPI_STATUSES_IGNORE);
8489
8490   return MPI_SUCCESS;
8491 }
8492
8493 AMPI_API_IMPL(int, MPI_Ineighbor_allgather, const void* sendbuf, int sendcount, MPI_Datatype sendtype,
8494                                             void* recvbuf, int recvcount, MPI_Datatype recvtype,
8495                                             MPI_Comm comm, MPI_Request *request)
8496 {
8497   AMPI_API("AMPI_Ineighbor_allgather");
8498
8499   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
8500
8501 #if AMPI_ERROR_CHECKING
8502   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8503     CkAbort("MPI_Ineighbor_allgather does not accept MPI_IN_PLACE!");
8504   if (getAmpiParent()->isInter(comm))
8505     CkAbort("MPI_Ineighbor_allgather is not defined for Inter-communicators!");
8506   int ret;
8507   ret = errorCheck("AMPI_Ineighbor_allgather", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
8508   if(ret != MPI_SUCCESS){
8509     *request = MPI_REQUEST_NULL;
8510     return ret;
8511   }
8512   ret = errorCheck("AMPI_Ineighbor_allgather", comm, 1, recvcount, 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
8513   if(ret != MPI_SUCCESS){
8514     *request = MPI_REQUEST_NULL;
8515     return ret;
8516   }
8517 #endif
8518
8519   ampi *ptr = getAmpiInstance(comm);
8520   int rank_in_comm = ptr->getRank();
8521
8522   if (ptr->getSize() == 1) {
8523     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcount,recvtype,rank_in_comm,MPI_NBOR_TAG,comm,
8524                             getDDT(), AMPI_REQ_COMPLETED));
8525     return copyDatatype(sendtype, sendcount, recvtype, recvcount, sendbuf, recvbuf);
8526   }
8527
8528   const vector<int>& neighbors = ptr->getNeighbors();
8529   int num_neighbors = neighbors.size();
8530
8531   // use an ATAReq to non-block the caller and get a request ptr
8532   ATAReq *newreq = new ATAReq(num_neighbors*2);
8533   int extent = getDDT()->getExtent(recvtype) * recvcount;
8534   for (int j=0; j<num_neighbors; j++) {
8535     ptr->irecv((char*)recvbuf+(extent*j), recvcount, recvtype,
8536                neighbors[j], MPI_NBOR_TAG, comm, &newreq->reqs[j]);
8537   }
8538
8539   for (int i=0; i<num_neighbors; i++) {
8540     newreq->reqs[num_neighbors+i] = ptr->send(MPI_NBOR_TAG, rank_in_comm, sendbuf, sendcount,
8541                                               sendtype, neighbors[i], comm, 0, I_SEND);
8542   }
8543   *request = ptr->postReq(newreq);
8544
8545   return MPI_SUCCESS;
8546 }
8547
8548 AMPI_API_IMPL(int, MPI_Neighbor_allgatherv, const void* sendbuf, int sendcount, MPI_Datatype sendtype,
8549                                             void* recvbuf, const int *recvcounts, const int *displs,
8550                                             MPI_Datatype recvtype, MPI_Comm comm)
8551 {
8552   AMPI_API("AMPI_Neighbor_allgatherv");
8553
8554   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
8555
8556 #if AMPI_ERROR_CHECKING
8557   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8558     CkAbort("MPI_Neighbor_allgatherv does not accept MPI_IN_PLACE!");
8559   if (getAmpiParent()->isInter(comm))
8560     CkAbort("MPI_Neighbor_allgatherv is not defined for Inter-communicators!");
8561   int ret;
8562   ret = errorCheck("AMPI_Neighbor_allgatherv", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
8563   if(ret != MPI_SUCCESS)
8564     return ret;
8565   ret = errorCheck("AMPI_Neighbor_allgatherv", comm, 1, recvcounts[0], 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
8566   if(ret != MPI_SUCCESS)
8567     return ret;
8568 #endif
8569
8570   ampi *ptr = getAmpiInstance(comm);
8571   int rank_in_comm = ptr->getRank();
8572
8573   if (ptr->getSize() == 1)
8574     return copyDatatype(sendtype, sendcount, recvtype, recvcounts[0], sendbuf, recvbuf);
8575
8576   const vector<int>& neighbors = ptr->getNeighbors();
8577   int num_neighbors = neighbors.size();
8578   int extent = getDDT()->getExtent(recvtype);
8579   vector<MPI_Request> reqs(num_neighbors*2);
8580   for (int j=0; j<num_neighbors; j++) {
8581     ptr->irecv(((char*)recvbuf)+(extent*displs[j]), recvcounts[j], recvtype,
8582                neighbors[j], MPI_NBOR_TAG, comm, &reqs[j]);
8583   }
8584   for (int i=0; i<num_neighbors; i++) {
8585     reqs[num_neighbors+i] = ptr->send(MPI_NBOR_TAG, rank_in_comm, sendbuf, sendcount,
8586                                       sendtype, neighbors[i], comm, 0, I_SEND);
8587   }
8588
8589   MPI_Waitall(reqs.size(), reqs.data(), MPI_STATUSES_IGNORE);
8590
8591   return MPI_SUCCESS;
8592 }
8593
8594 AMPI_API_IMPL(int, MPI_Ineighbor_allgatherv, const void* sendbuf, int sendcount, MPI_Datatype sendtype,
8595                                              void* recvbuf, const int* recvcounts, const int* displs,
8596                                              MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request)
8597 {
8598   AMPI_API("AMPI_Ineighbor_allgatherv");
8599
8600   handle_MPI_BOTTOM((void*&)sendbuf, sendtype, recvbuf, recvtype);
8601
8602 #if AMPI_ERROR_CHECKING
8603   if (sendbuf == MPI_IN_PLACE || recvbuf == MPI_IN_PLACE)
8604     CkAbort("MPI_Ineighbor_allgatherv does not accept MPI_IN_PLACE!");
8605   if (getAmpiParent()->isInter(comm))
8606     CkAbort("MPI_Ineighbor_allgatherv is not defined for Inter-communicators!");
8607   int ret;
8608   ret = errorCheck("AMPI_Ineighbor_allgatherv", comm, 1, sendcount, 1, sendtype, 1, 0, 0, 0, 0, sendbuf, 1);
8609   if(ret != MPI_SUCCESS){
8610     *request = MPI_REQUEST_NULL;
8611     return ret;
8612   }
8613   ret = errorCheck("AMPI_Ineighbor_allgatherv", comm, 1, recvcounts[0], 1, recvtype, 1, 0, 0, 0, 0, recvbuf, 1);
8614   if(ret != MPI_SUCCESS){
8615     *request = MPI_REQUEST_NULL;
8616     return ret;
8617   }
8618 #endif
8619
8620   ampi *ptr = getAmpiInstance(comm);
8621   int rank_in_comm = ptr->getRank();
8622
8623   if (ptr->getSize() == 1) {
8624     *request = ptr->postReq(getAmpiParent()->reqPool.newIReq(recvbuf,recvcounts[0],recvtype,rank_in_comm,MPI_NBOR_TAG,comm,
8625                             getDDT(), AMPI_REQ_COMPLETED));
8626     return copyDatatype(sendtype, sendcount, recvtype, recvcounts[0], sendbuf, recvbuf);
8627   }
8628
8629   const vector<int>& neighbors = ptr->getNeighbors();
8630   int num_neighbors = neighbors.size();
8631
8632   // use an ATAReq to non-block the caller and get a request ptr
8633   ATAReq *newreq = new ATAReq(num_neighbors*2);
8634   int extent = getDDT()->getExtent(recvtype);
8635   for (int j=0; j<num_neighbors; j++) {
8636     ptr->irecv((char*)recvbuf+(extent*displs[j]), recvcounts[j], recvtype,
8637                neighbors[j], MPI_NBOR_TAG, comm, &newreq->reqs[j]);
8638   }
8639
8640   for (int i=0; i<num_neighbors; i++) {
8641     newreq->reqs[num_neighbors+i] = ptr->send(MPI_NBOR_TAG, rank_in_comm, sendbuf, sendcount,
8642                                               sendtype, neighbors[i], comm, 0, I_SEND);
8643   }
8644   *request = ptr->postReq(newreq);
8645
8646   return MPI_SUCCESS;
8647 }
8648
8649 AMPI_API_IMPL(int, MPI_Comm_dup, MPI_Comm comm, MPI_Comm *newcomm)
8650 {
8651   AMPI_API("AMPI_Comm_dup");
8652   ampi *ptr = getAmpiInstance(comm);
8653   int topoType, rank = ptr->getRank();
8654   MPI_Topo_test(comm, &topoType);
8655   ptr->topoDup(topoType, rank, comm, newcomm);
8656   int ret = getAmpiParent()->dupUserKeyvals(comm, *newcomm);
8657   ptr->barrier();
8658
8659 #if AMPIMSGLOG
8660   ampiParent* pptr = getAmpiParent();
8661   if(msgLogRead){
8662     PUParray(*(pptr->fromPUPer), (char *)newcomm, sizeof(int));
8663     return MPI_SUCCESS;
8664   }
8665   else if(msgLogWrite && record_msglog(pptr->thisIndex)){
8666     PUParray(*(pptr->toPUPer), (char *)newcomm, sizeof(int));
8667   }
8668 #endif
8669   return ampiErrhandler("AMPI_Comm_dup", ret);
8670 }
8671
8672 AMPI_API_IMPL(int, MPI_Comm_idup, MPI_Comm comm, MPI_Comm *newcomm, MPI_Request *request)
8673 {
8674   AMPI_API("AMPI_Comm_idup");
8675   // FIXME: implement non-blocking comm_dup
8676   *request = MPI_REQUEST_NULL;
8677   return MPI_Comm_dup(comm, newcomm);
8678 }
8679
8680 AMPI_API_IMPL(int, MPI_Comm_dup_with_info, MPI_Comm comm, MPI_Info info, MPI_Comm *dest)
8681 {
8682   AMPI_API("AMPI_Comm_dup_with_info");
8683   MPI_Comm_dup(comm, dest);
8684   MPI_Comm_set_info(*dest, info);
8685   return MPI_SUCCESS;
8686 }
8687
8688 AMPI_API_IMPL(int, MPI_Comm_idup_with_info, MPI_Comm comm, MPI_Info info, MPI_Comm *dest, MPI_Request *request)
8689 {
8690   AMPI_API("AMPI_Comm_idup_with_info");
8691   // FIXME: implement non-blocking comm_dup_with_info
8692   *request = MPI_REQUEST_NULL;
8693   return MPI_Comm_dup_with_info(comm, info, dest);
8694 }
8695
8696 AMPI_API_IMPL(int, MPI_Comm_split, MPI_Comm src, int color, int key, MPI_Comm *dest)
8697 {
8698   AMPI_API("AMPI_Comm_split");
8699   {
8700     ampi *ptr = getAmpiInstance(src);
8701     if (getAmpiParent()->isInter(src)) {
8702       ptr->split(color, key, dest, MPI_INTER);
8703     }
8704     else if (getAmpiParent()->isCart(src)) {
8705       ptr->split(color, key, dest, MPI_CART);
8706     }
8707     else if (getAmpiParent()->isGraph(src)) {
8708       ptr->split(color, key, dest, MPI_GRAPH);
8709     }
8710     else {
8711       ptr->split(color, key, dest, MPI_UNDEFINED);
8712     }
8713   }
8714   if (color == MPI_UNDEFINED) *dest = MPI_COMM_NULL;
8715
8716 #if AMPIMSGLOG
8717   ampiParent* pptr = getAmpiParent();
8718   if(msgLogRead){
8719     PUParray(*(pptr->fromPUPer), (char *)dest, sizeof(int));
8720     return MPI_SUCCESS;
8721   }
8722   else if(msgLogWrite && record_msglog(pptr->thisIndex)){
8723     PUParray(*(pptr->toPUPer), (char *)dest, sizeof(int));
8724   }
8725 #endif
8726
8727   return MPI_SUCCESS;
8728 }
8729
8730 AMPI_API_IMPL(int, MPI_Comm_split_type, MPI_Comm src, int split_type, int key,
8731                                         MPI_Info info, MPI_Comm *dest)
8732 {
8733   AMPI_API("AMPI_Comm_split_type");
8734
8735   if (src == MPI_COMM_SELF && split_type == MPI_UNDEFINED) {
8736     *dest = MPI_COMM_NULL;
8737     return MPI_SUCCESS;
8738   }
8739
8740   int color = MPI_UNDEFINED;
8741
8742   if (split_type == MPI_COMM_TYPE_SHARED || split_type == AMPI_COMM_TYPE_HOST) {
8743     color = CmiPhysicalNodeID(CkMyPe());
8744   }
8745   else if (split_type == AMPI_COMM_TYPE_PROCESS) {
8746     color = CkMyNode();
8747   }
8748   else if (split_type == AMPI_COMM_TYPE_WTH) {
8749     color = CkMyPe();
8750   }
8751
8752   return MPI_Comm_split(src, color, key, dest);
8753 }
8754
8755 AMPI_API_IMPL(int, MPI_Comm_free, MPI_Comm *comm)
8756 {
8757   AMPI_API("AMPI_Comm_free");
8758   ampiParent* parent = getAmpiParent();
8759   int ret;
8760   if (*comm != MPI_COMM_NULL) {
8761     ret = parent->freeUserKeyvals(*comm, parent->getKeyvals(*comm));
8762     if (*comm != MPI_COMM_WORLD && *comm != MPI_COMM_SELF) {
8763       ampi* ptr = getAmpiInstance(*comm);
8764       ptr->barrier();
8765       if (ptr->getRank() == 0) {
8766         CProxy_CkArray(ptr->ckGetArrayID()).ckDestroy();
8767       }
8768     }
8769     *comm = MPI_COMM_NULL;
8770   }
8771   return ampiErrhandler("AMPI_Comm_free", ret);
8772 }
8773
8774 AMPI_API_IMPL(int, MPI_Comm_test_inter, MPI_Comm comm, int *flag)
8775 {
8776   AMPI_API("AMPI_Comm_test_inter");
8777   *flag = getAmpiParent()->isInter(comm);
8778   return MPI_SUCCESS;
8779 }
8780
8781 AMPI_API_IMPL(int, MPI_Comm_remote_size, MPI_Comm comm, int *size)
8782 {
8783   AMPI_API("AMPI_Comm_remote_size");
8784   *size = getAmpiParent()->getRemoteSize(comm);
8785   return MPI_SUCCESS;
8786 }
8787
8788 AMPI_API_IMPL(int, MPI_Comm_remote_group, MPI_Comm comm, MPI_Group *group)
8789 {
8790   AMPI_API("AMPI_Comm_remote_group");
8791   *group = getAmpiParent()->getRemoteGroup(comm);
8792   return MPI_SUCCESS;
8793 }
8794
8795 AMPI_API_IMPL(int, MPI_Intercomm_create, MPI_Comm localComm, int localLeader, MPI_Comm peerComm,
8796                                          int remoteLeader, int tag, MPI_Comm *newintercomm)
8797 {
8798   AMPI_API("AMPI_Intercomm_create");
8799
8800 #if AMPI_ERROR_CHECKING
8801   if (getAmpiParent()->isInter(localComm) || getAmpiParent()->isInter(peerComm))
8802     return ampiErrhandler("AMPI_Intercomm_create", MPI_ERR_COMM);
8803 #endif
8804
8805   ampi *localPtr = getAmpiInstance(localComm);
8806   ampi *peerPtr = getAmpiInstance(peerComm);
8807   int rootIndex = localPtr->getIndexForRank(localLeader);
8808   int localSize, localRank;
8809
8810   localSize = localPtr->getSize();
8811   localRank = localPtr->getRank();
8812
8813   vector<int> remoteVec;
8814
8815   if (localRank == localLeader) {
8816     int remoteSize;
8817     MPI_Status sts;
8818     vector<int> localVec;
8819     localVec = localPtr->getIndices();
8820     // local leader exchanges groupStruct with remote leader
8821     peerPtr->send(tag, peerPtr->getRank(), localVec.data(), localVec.size(), MPI_INT, remoteLeader, peerComm);
8822     peerPtr->probe(tag, remoteLeader, peerComm, &sts);
8823     MPI_Get_count(&sts, MPI_INT, &remoteSize);
8824     remoteVec.resize(remoteSize);
8825     if (-1==peerPtr->recv(tag, remoteLeader, remoteVec.data(), remoteSize, MPI_INT, peerComm))
8826       CkAbort("AMPI> Error in MPI_Intercomm_create");
8827
8828     if (remoteSize==0) {
8829       AMPI_DEBUG("AMPI> In MPI_Intercomm_create, creating an empty communicator\n");
8830       *newintercomm = MPI_COMM_NULL;
8831       return MPI_SUCCESS;
8832     }
8833   }
8834
8835   localPtr->intercommCreate(remoteVec,rootIndex,localComm,newintercomm);
8836
8837   return MPI_SUCCESS;
8838 }
8839
8840 AMPI_API_IMPL(int, MPI_Intercomm_merge, MPI_Comm intercomm, int high, MPI_Comm *newintracomm)
8841 {
8842   AMPI_API("AMPI_Intercomm_merge");
8843
8844 #if AMPI_ERROR_CHECKING
8845   if (!getAmpiParent()->isInter(intercomm))
8846     return ampiErrhandler("AMPI_Intercomm_merge", MPI_ERR_COMM);
8847 #endif
8848
8849   ampi *ptr = getAmpiInstance(intercomm);
8850   int lroot, rroot, lrank, lhigh, rhigh, first;
8851   lroot = ptr->getIndexForRank(0);
8852   rroot = ptr->getIndexForRemoteRank(0);
8853   lhigh = high;
8854   lrank = ptr->getRank();
8855   first = 0;
8856
8857   if(lrank==0){
8858     MPI_Request req = ptr->send(MPI_ATA_TAG, ptr->getRank(), &lhigh, 1, MPI_INT, 0, intercomm, 0, I_SEND);
8859     if(-1==ptr->recv(MPI_ATA_TAG,0,&rhigh,1,MPI_INT,intercomm))
8860       CkAbort("AMPI> Error in MPI_Intercomm_create");
8861     MPI_Wait(&req, MPI_STATUS_IGNORE);
8862
8863     if((lhigh && rhigh) || (!lhigh && !rhigh)){ // same value: smaller root goes first (first=1 if local goes first)
8864       first = (lroot < rroot);
8865     }else{ // different values, then high=false goes first
8866       first = (lhigh == false);
8867     }
8868   }
8869
8870   ptr->intercommMerge(first, newintracomm);
8871   return MPI_SUCCESS;
8872 }
8873
8874 AMPI_API_IMPL(int, MPI_Abort, MPI_Comm comm, int errorcode)
8875 {
8876   AMPI_API_INIT("AMPI_Abort");
8877   CkAbort("AMPI: Application called MPI_Abort()!\n");
8878   return errorcode;
8879 }
8880
8881 AMPI_API_IMPL(int, MPI_Get_count, const MPI_Status *sts, MPI_Datatype dtype, int *count)
8882 {
8883   AMPI_API("AMPI_Get_count");
8884   CkDDT_DataType* dttype = getDDT()->getType(dtype);
8885   int itemsize = dttype->getSize() ;
8886   if (itemsize == 0) {
8887     *count = 0;
8888   } else {
8889     if (sts->MPI_LENGTH%itemsize == 0) {
8890       *count = sts->MPI_LENGTH/itemsize;
8891     } else {
8892       *count = MPI_UNDEFINED;
8893     }
8894   }
8895   return MPI_SUCCESS;
8896 }
8897
8898 AMPI_API_IMPL(int, MPI_Type_lb, MPI_Datatype dtype, MPI_Aint* displacement)
8899 {
8900   AMPI_API("AMPI_Type_lb");
8901
8902 #if AMPI_ERROR_CHECKING
8903   int ret = checkData("AMPI_Type_lb", dtype);
8904   if (ret!=MPI_SUCCESS)
8905     return ret;
8906 #endif
8907
8908   *displacement = getDDT()->getLB(dtype);
8909   return MPI_SUCCESS;
8910 }
8911
8912 AMPI_API_IMPL(int, MPI_Type_ub, MPI_Datatype dtype, MPI_Aint* displacement)
8913 {
8914   AMPI_API("AMPI_Type_ub");
8915
8916 #if AMPI_ERROR_CHECKING
8917   int ret = checkData("AMPI_Type_ub", dtype);
8918   if (ret!=MPI_SUCCESS)
8919     return ret;
8920 #endif
8921
8922   *displacement = getDDT()->getUB(dtype);
8923   return MPI_SUCCESS;
8924 }
8925
8926 AMPI_API_IMPL(int, MPI_Get_address, const void* location, MPI_Aint *address)
8927 {
8928   AMPI_API("AMPI_Get_address");
8929   *address = (MPI_Aint)location;
8930   return MPI_SUCCESS;
8931 }
8932
8933 AMPI_API_IMPL(int, MPI_Address, void* location, MPI_Aint *address)
8934 {
8935   AMPI_API("AMPI_Address");
8936   return MPI_Get_address(location, address);
8937 }
8938
8939 AMPI_API_IMPL(int, MPI_Status_set_elements, MPI_Status *sts, MPI_Datatype dtype, int count)
8940 {
8941   AMPI_API("AMPI_Status_set_elements");
8942   if(sts == MPI_STATUS_IGNORE || sts == MPI_STATUSES_IGNORE)
8943     return MPI_SUCCESS;
8944
8945 #if AMPI_ERROR_CHECKING
8946   int ret = checkData("AMPI_Status_set_elements", dtype);
8947   if (ret!=MPI_SUCCESS)
8948     return(ret);
8949 #endif
8950
8951   CkDDT_DataType* dttype = getDDT()->getType(dtype);
8952   int basesize = dttype->getBaseSize();
8953   if(basesize==0) basesize = dttype->getSize();
8954   sts->MPI_LENGTH = basesize * count;
8955   return MPI_SUCCESS;
8956 }
8957
8958 AMPI_API_IMPL(int, MPI_Status_set_elements_x, MPI_Status *sts, MPI_Datatype dtype, MPI_Count count)
8959 {
8960   AMPI_API("AMPI_Status_set_elements_x");
8961   if(sts == MPI_STATUS_IGNORE || sts == MPI_STATUSES_IGNORE)
8962     return MPI_SUCCESS;
8963
8964 #if AMPI_ERROR_CHECKING
8965   int ret = checkData("AMPI_Status_set_elements_x", dtype);
8966   if (ret!=MPI_SUCCESS)
8967     return(ret);
8968 #endif
8969
8970   CkDDT_DataType* dttype = getDDT()->getType(dtype);
8971   int basesize = dttype->getBaseSize();
8972   if(basesize==0) basesize = dttype->getSize();
8973   sts->MPI_LENGTH = basesize * count;
8974   return MPI_SUCCESS;
8975 }
8976
8977 AMPI_API_IMPL(int, MPI_Get_elements, const MPI_Status *sts, MPI_Datatype dtype, int *count)
8978 {
8979   AMPI_API("AMPI_Get_elements");
8980
8981 #if AMPI_ERROR_CHECKING
8982     int ret = checkData("AMPI_Type_create_keyval", dtype);
8983     if (ret!=MPI_SUCCESS)
8984       return ret;
8985 #endif
8986
8987   *count = getDDT()->getType(dtype)->getNumBasicElements(sts->MPI_LENGTH);
8988   return MPI_SUCCESS;
8989 }
8990
8991 AMPI_API_IMPL(int, MPI_Get_elements_x, const MPI_Status *sts, MPI_Datatype dtype, MPI_Count *count)
8992 {
8993   AMPI_API("AMPI_Get_elements_x");
8994   *count = getDDT()->getType(dtype)->getNumBasicElements(sts->MPI_LENGTH);
8995   return MPI_SUCCESS;
8996 }
8997
8998 AMPI_API_IMPL(int, MPI_Pack, const void *inbuf, int incount, MPI_Datatype dtype,
8999                              void *outbuf, int outsize, int *position, MPI_Comm comm)
9000 {
9001   AMPI_API("AMPI_Pack");
9002   CkDDT_DataType* dttype = getDDT()->getType(dtype) ;
9003   int itemsize = dttype->getSize();
9004   dttype->serialize((char*)inbuf, ((char*)outbuf)+(*position), incount, outsize, PACK);
9005   *position += (itemsize*incount);
9006   return MPI_SUCCESS;
9007 }
9008
9009 AMPI_API_IMPL(int, MPI_Unpack, const void *inbuf, int insize, int *position, void *outbuf,
9010                                int outcount, MPI_Datatype dtype, MPI_Comm comm)
9011 {
9012   AMPI_API("AMPI_Unpack");
9013   CkDDT_DataType* dttype = getDDT()->getType(dtype) ;
9014   int itemsize = dttype->getSize();
9015   dttype->serialize((char*)outbuf, ((char*)inbuf+(*position)), outcount, insize, UNPACK);
9016   *position += (itemsize*outcount);
9017   return MPI_SUCCESS;
9018 }
9019
9020 AMPI_API_IMPL(int, MPI_Pack_size, int incount, MPI_Datatype datatype, MPI_Comm comm, int *sz)
9021 {
9022   AMPI_API("AMPI_Pack_size");
9023   CkDDT_DataType* dttype = getDDT()->getType(datatype) ;
9024   *sz = incount*dttype->getSize() ;
9025   return MPI_SUCCESS;
9026 }
9027
9028 AMPI_API_IMPL(int, MPI_Get_version, int *version, int *subversion)
9029 {
9030   AMPI_API_INIT("AMPI_Get_version");
9031   *version = MPI_VERSION;
9032   *subversion = MPI_SUBVERSION;
9033   return MPI_SUCCESS;
9034 }
9035
9036 AMPI_API_IMPL(int, MPI_Get_library_version, char *version, int *resultlen)
9037 {
9038   AMPI_API_INIT("AMPI_Get_library_version");
9039   const char *ampiNameStr = "Adaptive MPI ";
9040   strncpy(version, ampiNameStr, MPI_MAX_LIBRARY_VERSION_STRING);
9041   strncat(version, CmiCommitID, MPI_MAX_LIBRARY_VERSION_STRING - strlen(version));
9042   *resultlen = strlen(version);
9043   return MPI_SUCCESS;
9044 }
9045
9046 AMPI_API_IMPL(int, MPI_Get_processor_name, char *name, int *resultlen)
9047 {
9048   AMPI_API_INIT("AMPI_Get_processor_name");
9049   ampiParent *ptr = getAmpiParent();
9050   sprintf(name,"AMPI_RANK[%d]_WTH[%d]",ptr->thisIndex,ptr->getMyPe());
9051   *resultlen = strlen(name);
9052   return MPI_SUCCESS;
9053 }
9054
9055 /* Error handling */
9056 #if defined(USE_STDARG)
9057 void error_handler(MPI_Comm *, int *, ...);
9058 #else
9059 void error_handler ( MPI_Comm *, int * );
9060 #endif
9061
9062 AMPI_API_IMPL(int, MPI_Comm_call_errhandler, MPI_Comm comm, int errorcode)
9063 {
9064   AMPI_API("AMPI_Comm_call_errhandler");
9065   return MPI_SUCCESS;
9066 }
9067
9068 AMPI_API_IMPL(int, MPI_Comm_create_errhandler, MPI_Comm_errhandler_fn *function, MPI_Errhandler *errhandler)
9069 {
9070   AMPI_API("AMPI_Comm_create_errhandler");
9071   return MPI_SUCCESS;
9072 }
9073
9074 AMPI_API_IMPL(int, MPI_Comm_set_errhandler, MPI_Comm comm, MPI_Errhandler errhandler)
9075 {
9076   AMPI_API("AMPI_Comm_set_errhandler");
9077   return MPI_SUCCESS;
9078 }
9079
9080 AMPI_API_IMPL(int, MPI_Comm_get_errhandler, MPI_Comm comm, MPI_Errhandler *errhandler)
9081 {
9082   AMPI_API("AMPI_Comm_get_errhandler");
9083   return MPI_SUCCESS;
9084 }
9085
9086 AMPI_API_IMPL(int, MPI_Comm_free_errhandler, MPI_Errhandler *errhandler)
9087 {
9088   AMPI_API("AMPI_Comm_free_errhandler");
9089   *errhandler = MPI_ERRHANDLER_NULL;
9090   return MPI_SUCCESS;
9091 }
9092
9093 AMPI_API_IMPL(int, MPI_Errhandler_create, MPI_Handler_function *function, MPI_Errhandler *errhandler)
9094 {
9095   AMPI_API("AMPI_Errhandler_create");
9096   return MPI_Comm_create_errhandler(function, errhandler);
9097 }
9098
9099 AMPI_API_IMPL(int, MPI_Errhandler_set, MPI_Comm comm, MPI_Errhandler errhandler)
9100 {
9101   AMPI_API("AMPI_Errhandler_set");
9102   return MPI_Comm_set_errhandler(comm, errhandler);
9103 }
9104
9105 AMPI_API_IMPL(int, MPI_Errhandler_get, MPI_Comm comm, MPI_Errhandler *errhandler)
9106 {
9107   AMPI_API("AMPI_Errhandler_get");
9108   return MPI_Comm_get_errhandler(comm, errhandler);
9109 }
9110
9111 AMPI_API_IMPL(int, MPI_Errhandler_free, MPI_Errhandler *errhandler)
9112 {
9113   AMPI_API("AMPI_Errhandler_free");
9114   return MPI_Comm_free_errhandler(errhandler);
9115 }
9116
9117 AMPI_API_IMPL(int, MPI_Add_error_code, int errorclass, int *errorcode)
9118 {
9119   AMPI_API("AMPI_Add_error_code");
9120   return MPI_SUCCESS;
9121 }
9122
9123 AMPI_API_IMPL(int, MPI_Add_error_class, int *errorclass)
9124 {
9125   AMPI_API("AMPI_Add_error_class");
9126   return MPI_SUCCESS;
9127 }
9128
9129 AMPI_API_IMPL(int, MPI_Add_error_string, int errorcode, const char *errorstring)
9130 {
9131   AMPI_API("AMPI_Add_error_string");
9132   return MPI_SUCCESS;
9133 }
9134
9135 AMPI_API_IMPL(int, MPI_Error_class, int errorcode, int *errorclass)
9136 {
9137   AMPI_API("AMPI_Error_class");
9138   *errorclass = errorcode;
9139   return MPI_SUCCESS;
9140 }
9141
9142 AMPI_API_IMPL(int, MPI_Error_string, int errorcode, char *errorstring, int *resultlen)
9143 {
9144   AMPI_API("AMPI_Error_string");
9145   const char *r="";
9146   switch(errorcode) {
9147     case MPI_SUCCESS:
9148       r="MPI_SUCCESS: no errors"; break;
9149     case MPI_ERR_BUFFER:
9150       r="MPI_ERR_BUFFER: invalid buffer pointer"; break;
9151     case MPI_ERR_COUNT:
9152       r="MPI_ERR_COUNT: invalid count argument"; break;
9153     case MPI_ERR_TYPE:
9154       r="MPI_ERR_TYPE: invalid datatype"; break;
9155     case MPI_ERR_TAG:
9156       r="MPI_ERR_TAG: invalid tag"; break;
9157     case MPI_ERR_COMM:
9158       r="MPI_ERR_COMM: invalid communicator"; break;
9159     case MPI_ERR_RANK:
9160       r="MPI_ERR_RANK: invalid rank"; break;
9161     case MPI_ERR_REQUEST:
9162       r="MPI_ERR_REQUEST: invalid request (handle)"; break;
9163     case MPI_ERR_ROOT:
9164       r="MPI_ERR_ROOT: invalid root"; break;
9165     case MPI_ERR_GROUP:
9166       r="MPI_ERR_GROUP: invalid group"; break;
9167     case MPI_ERR_OP:
9168       r="MPI_ERR_OP: invalid operation"; break;
9169     case MPI_ERR_TOPOLOGY:
9170       r="MPI_ERR_TOPOLOGY: invalid communicator topology"; break;
9171     case MPI_ERR_DIMS:
9172       r="MPI_ERR_DIMS: invalid dimension argument"; break;
9173     case MPI_ERR_ARG:
9174       r="MPI_ERR_ARG: invalid argument of some other kind"; break;
9175     case MPI_ERR_TRUNCATE:
9176       r="MPI_ERR_TRUNCATE: message truncated in receive"; break;
9177     case MPI_ERR_OTHER:
9178       r="MPI_ERR_OTHER: known error not in this list"; break;
9179     case MPI_ERR_INTERN:
9180       r="MPI_ERR_INTERN: internal MPI (implementation) error"; break;
9181     case MPI_ERR_IN_STATUS:
9182       r="MPI_ERR_IN_STATUS: error code in status"; break;
9183     case MPI_ERR_PENDING:
9184       r="MPI_ERR_PENDING: pending request"; break;
9185     case MPI_ERR_ACCESS:
9186       r="MPI_ERR_ACCESS: invalid access mode"; break;
9187     case MPI_ERR_AMODE:
9188       r="MPI_ERR_AMODE: invalid amode argument"; break;
9189     case MPI_ERR_ASSERT:
9190       r="MPI_ERR_ASSERT: invalid assert argument"; break;
9191     case MPI_ERR_BAD_FILE:
9192       r="MPI_ERR_BAD_FILE: bad file"; break;
9193     case MPI_ERR_BASE:
9194       r="MPI_ERR_BASE: invalid base"; break;
9195     case MPI_ERR_CONVERSION:
9196       r="MPI_ERR_CONVERSION: error in data conversion"; break;
9197     case MPI_ERR_DISP:
9198       r="MPI_ERR_DISP: invalid displacement"; break;
9199     case MPI_ERR_DUP_DATAREP:
9200       r="MPI_ERR_DUP_DATAREP: error duplicating data representation"; break;
9201     case MPI_ERR_FILE_EXISTS:
9202       r="MPI_ERR_FILE_EXISTS: file exists already"; break;
9203     case MPI_ERR_FILE_IN_USE:
9204       r="MPI_ERR_FILE_IN_USE: file in use already"; break;
9205     case MPI_ERR_FILE:
9206       r="MPI_ERR_FILE: invalid file"; break;
9207     case MPI_ERR_INFO_KEY:
9208       r="MPI_ERR_INFO_KEY: invalid key argument for info object"; break;
9209     case MPI_ERR_INFO_NOKEY:
9210       r="MPI_ERR_INFO_NOKEY: unknown key for info object"; break;
9211     case MPI_ERR_INFO_VALUE:
9212       r="MPI_ERR_INFO_VALUE: invalid value argument for info object"; break;
9213     case MPI_ERR_INFO:
9214       r="MPI_ERR_INFO: invalid info object"; break;
9215     case MPI_ERR_IO:
9216       r="MPI_ERR_IO: input/output error"; break;
9217     case MPI_ERR_KEYVAL:
9218       r="MPI_ERR_KEYVAL: invalid keyval"; break;
9219     case MPI_ERR_LOCKTYPE:
9220       r="MPI_ERR_LOCKTYPE: invalid locktype argument"; break;
9221     case MPI_ERR_NAME:
9222       r="MPI_ERR_NAME: invalid name argument"; break;
9223     case MPI_ERR_NO_MEM:
9224       r="MPI_ERR_NO_MEM: out of memory"; break;
9225     case MPI_ERR_NOT_SAME:
9226       r="MPI_ERR_NOT_SAME: objects are not identical"; break;
9227     case MPI_ERR_NO_SPACE:
9228       r="MPI_ERR_NO_SPACE: no space left on device"; break;
9229     case MPI_ERR_NO_SUCH_FILE:
9230       r="MPI_ERR_NO_SUCH_FILE: no such file or directory"; break;
9231     case MPI_ERR_PORT:
9232       r="MPI_ERR_PORT: invalid port"; break;
9233     case MPI_ERR_QUOTA:
9234       r="MPI_ERR_QUOTA: out of quota"; break;
9235     case MPI_ERR_READ_ONLY:
9236       r="MPI_ERR_READ_ONLY: file is read only"; break;
9237     case MPI_ERR_RMA_CONFLICT:
9238       r="MPI_ERR_RMA_CONFLICT: rma conflict during operation"; break;
9239     case MPI_ERR_RMA_SYNC:
9240       r="MPI_ERR_RMA_SYNC: error executing rma sync"; break;
9241     case MPI_ERR_SERVICE:
9242       r="MPI_ERR_SERVICE: unknown service name"; break;
9243     case MPI_ERR_SIZE:
9244       r="MPI_ERR_SIZE: invalid size argument"; break;
9245     case MPI_ERR_SPAWN:
9246       r="MPI_ERR_SPAWN: error in spawning processes"; break;
9247     case MPI_ERR_UNSUPPORTED_DATAREP:
9248       r="MPI_ERR_UNSUPPORTED_DATAREP: data representation not supported"; break;
9249     case MPI_ERR_UNSUPPORTED_OPERATION:
9250       r="MPI_ERR_UNSUPPORTED_OPERATION: operation not supported"; break;
9251     case MPI_ERR_WIN:
9252       r="MPI_ERR_WIN: invalid win argument"; break;
9253     default:
9254       r="unknown error";
9255       *resultlen=strlen(r);
9256       strcpy(errorstring,r);
9257       return MPI_ERR_UNKNOWN;
9258   };
9259   *resultlen=strlen(r);
9260   strcpy(errorstring,r);
9261   return MPI_SUCCESS;
9262 }
9263
9264 /* Group operations */
9265 AMPI_API_IMPL(int, MPI_Comm_group, MPI_Comm comm, MPI_Group *group)
9266 {
9267   AMPI_API("AMPI_Comm_Group");
9268   *group = getAmpiParent()->comm2group(comm);
9269   return MPI_SUCCESS;
9270 }
9271
9272 AMPI_API_IMPL(int, MPI_Group_union, MPI_Group group1, MPI_Group group2, MPI_Group *newgroup)
9273 {
9274   AMPI_API("AMPI_Group_union");
9275   groupStruct vec1, vec2, newvec;
9276   ampiParent *ptr = getAmpiParent();
9277   vec1 = ptr->group2vec(group1);
9278   vec2 = ptr->group2vec(group2);
9279   newvec = unionOp(vec1,vec2);
9280   *newgroup = ptr->saveGroupStruct(newvec);
9281   return MPI_SUCCESS;
9282 }
9283
9284 AMPI_API_IMPL(int, MPI_Group_intersection, MPI_Group group1, MPI_Group group2, MPI_Group *newgroup)
9285 {
9286   AMPI_API("AMPI_Group_intersection");
9287   groupStruct vec1, vec2, newvec;
9288   ampiParent *ptr = getAmpiParent();
9289   vec1 = ptr->group2vec(group1);
9290   vec2 = ptr->group2vec(group2);
9291   newvec = intersectOp(vec1,vec2);
9292   *newgroup = ptr->saveGroupStruct(newvec);
9293   return MPI_SUCCESS;
9294 }
9295
9296 AMPI_API_IMPL(int, MPI_Group_difference, MPI_Group group1, MPI_Group group2, MPI_Group *newgroup)
9297 {
9298   AMPI_API("AMPI_Group_difference");
9299   groupStruct vec1, vec2, newvec;
9300   ampiParent *ptr = getAmpiParent();
9301   vec1 = ptr->group2vec(group1);
9302   vec2 = ptr->group2vec(group2);
9303   newvec = diffOp(vec1,vec2);
9304   *newgroup = ptr->saveGroupStruct(newvec);
9305   return MPI_SUCCESS;
9306 }
9307
9308 AMPI_API_IMPL(int, MPI_Group_size, MPI_Group group, int *size)
9309 {
9310   AMPI_API("AMPI_Group_size");
9311   *size = (getAmpiParent()->group2vec(group)).size();
9312   return MPI_SUCCESS;
9313 }
9314
9315 AMPI_API_IMPL(int, MPI_Group_rank, MPI_Group group, int *rank)
9316 {
9317   AMPI_API("AMPI_Group_rank");
9318   *rank = getAmpiParent()->getRank(group);
9319   return MPI_SUCCESS;
9320 }
9321
9322 AMPI_API_IMPL(int, MPI_Group_translate_ranks, MPI_Group group1, int n, const int *ranks1,
9323                                               MPI_Group group2, int *ranks2)
9324 {
9325   AMPI_API("AMPI_Group_translate_ranks");
9326   ampiParent *ptr = getAmpiParent();
9327   groupStruct vec1, vec2;
9328   vec1 = ptr->group2vec(group1);
9329   vec2 = ptr->group2vec(group2);
9330   translateRanksOp(n, vec1, ranks1, vec2, ranks2);
9331   return MPI_SUCCESS;
9332 }
9333
9334 AMPI_API_IMPL(int, MPI_Group_compare, MPI_Group group1,MPI_Group group2, int *result)
9335 {
9336   AMPI_API("AMPI_Group_compare");
9337   ampiParent *ptr = getAmpiParent();
9338   groupStruct vec1, vec2;
9339   vec1 = ptr->group2vec(group1);
9340   vec2 = ptr->group2vec(group2);
9341   *result = compareVecOp(vec1, vec2);
9342   return MPI_SUCCESS;
9343 }
9344
9345 AMPI_API_IMPL(int, MPI_Group_incl, MPI_Group group, int n, const int *ranks, MPI_Group *newgroup)
9346 {
9347   AMPI_API("AMPI_Group_incl");
9348   groupStruct vec, newvec;
9349   ampiParent *ptr = getAmpiParent();
9350   vec = ptr->group2vec(group);
9351   newvec = inclOp(n,ranks,vec);
9352   *newgroup = ptr->saveGroupStruct(newvec);
9353   return MPI_SUCCESS;
9354 }
9355
9356 AMPI_API_IMPL(int, MPI_Group_excl, MPI_Group group, int n, const int *ranks, MPI_Group *newgroup)
9357 {
9358   AMPI_API("AMPI_Group_excl");
9359   groupStruct vec, newvec;
9360   ampiParent *ptr = getAmpiParent();
9361   vec = ptr->group2vec(group);
9362   newvec = exclOp(n,ranks,vec);
9363   *newgroup = ptr->saveGroupStruct(newvec);
9364   return MPI_SUCCESS;
9365 }
9366
9367 AMPI_API_IMPL(int, MPI_Group_range_incl, MPI_Group group, int n, int ranges[][3], MPI_Group *newgroup)
9368 {
9369   AMPI_API("AMPI_Group_range_incl");
9370   groupStruct vec, newvec;
9371   int ret;
9372   ampiParent *ptr = getAmpiParent();
9373   vec = ptr->group2vec(group);
9374   newvec = rangeInclOp(n,ranges,vec,&ret);
9375   if(ret != MPI_SUCCESS){
9376     *newgroup = MPI_GROUP_EMPTY;
9377     return ampiErrhandler("AMPI_Group_range_incl", ret);
9378   }else{
9379     *newgroup = ptr->saveGroupStruct(newvec);
9380     return MPI_SUCCESS;
9381   }
9382 }
9383
9384 AMPI_API_IMPL(int, MPI_Group_range_excl, MPI_Group group, int n, int ranges[][3], MPI_Group *newgroup)
9385 {
9386   AMPI_API("AMPI_Group_range_excl");
9387   groupStruct vec, newvec;
9388   int ret;
9389   ampiParent *ptr = getAmpiParent();
9390   vec = ptr->group2vec(group);
9391   newvec = rangeExclOp(n,ranges,vec,&ret);
9392   if(ret != MPI_SUCCESS){
9393     *newgroup = MPI_GROUP_EMPTY;
9394     return ampiErrhandler("AMPI_Group_range_excl", ret);
9395   }else{
9396     *newgroup = ptr->saveGroupStruct(newvec);
9397     return MPI_SUCCESS;
9398   }
9399 }
9400
9401 AMPI_API_IMPL(int, MPI_Group_free, MPI_Group *group)
9402 {
9403   AMPI_API("AMPI_Group_free");
9404   return MPI_SUCCESS;
9405 }
9406
9407 AMPI_API_IMPL(int, MPI_Comm_create, MPI_Comm comm, MPI_Group group, MPI_Comm* newcomm)
9408 {
9409   AMPI_API("AMPI_Comm_create");
9410   int rank_in_group, key, color, zero;
9411   MPI_Group group_of_comm;
9412
9413   groupStruct vec = getAmpiParent()->group2vec(group);
9414   if(vec.size()==0){
9415     AMPI_DEBUG("AMPI> In MPI_Comm_create, creating an empty communicator");
9416     *newcomm = MPI_COMM_NULL;
9417     return MPI_SUCCESS;
9418   }
9419
9420   if(getAmpiParent()->isInter(comm)){
9421     /* inter-communicator: create a single new comm. */
9422     ampi *ptr = getAmpiInstance(comm);
9423     ptr->commCreate(vec, newcomm);
9424     ptr->barrier();
9425   }
9426   else{
9427     /* intra-communicator: create comm's for disjoint subgroups,
9428      * by calculating (color, key) and splitting comm. */
9429     MPI_Group_rank(group, &rank_in_group);
9430     if(rank_in_group == MPI_UNDEFINED){
9431       color = MPI_UNDEFINED;
9432       key = 0;
9433     }
9434     else{
9435       /* use rank in 'comm' of the 0th rank in 'group'
9436        * as identical 'color' of all ranks in 'group' */
9437       MPI_Comm_group(comm, &group_of_comm);
9438       zero = 0;
9439       MPI_Group_translate_ranks(group, 1, &zero, group_of_comm, &color);
9440       key = rank_in_group;
9441     }
9442     return MPI_Comm_split(comm, color, key, newcomm);
9443   }
9444   return MPI_SUCCESS;
9445 }
9446
9447 AMPI_API_IMPL(int, MPI_Comm_create_group, MPI_Comm comm, MPI_Group group, int tag, MPI_Comm *newcomm)
9448 {
9449   AMPI_API("AMPI_Comm_create_group");
9450
9451   if (group == MPI_GROUP_NULL) {
9452     *newcomm = MPI_COMM_NULL;
9453     return MPI_SUCCESS;
9454   }
9455
9456 #if AMPI_ERROR_CHECKING
9457   if (!getAmpiParent()->isIntra(comm)) {
9458     *newcomm = MPI_COMM_NULL;
9459     return ampiErrhandler("AMPI_Comm_create_group", MPI_ERR_COMM);
9460   }
9461   int ret = checkTag("AMPI_Comm_create_group", tag);
9462   if (ret != MPI_SUCCESS) {
9463      *newcomm = MPI_COMM_NULL;
9464      return ampiErrhandler("AMPI_Comm_create_group", ret);
9465   }
9466 #endif
9467
9468   int rank, groupRank, groupSize;
9469   MPI_Group parentGroup;
9470   MPI_Comm_rank(comm, &rank);
9471   MPI_Group_rank(group, &groupRank);
9472   MPI_Group_size(group, &groupSize);
9473   if (groupRank == MPI_UNDEFINED) {
9474     *newcomm = MPI_COMM_NULL;
9475     return MPI_SUCCESS;
9476   }
9477   MPI_Comm_dup(MPI_COMM_SELF, newcomm);
9478
9479   vector<int> groupPids(groupSize), pids(groupSize, 0);
9480   std::iota(groupPids.begin(), groupPids.end(), 0);
9481   MPI_Comm_group(comm, &parentGroup);
9482   MPI_Group_translate_ranks(group, groupSize, groupPids.data(), parentGroup, pids.data());
9483   MPI_Group_free(&parentGroup);
9484
9485   MPI_Comm commOld, tmpInter;
9486   for (int i=0; i<groupSize; i*=2) {
9487     int groupId = groupRank/i;
9488     commOld = *newcomm;
9489
9490     if (groupId % 2 == 0) {
9491       if ((groupId+1)*i < groupSize) {
9492         MPI_Intercomm_create(*newcomm, 0, comm, pids[(groupId+1)*i], tag, &tmpInter);
9493         MPI_Intercomm_merge(tmpInter, 0, newcomm);
9494       }
9495     }
9496     else {
9497       MPI_Intercomm_create(*newcomm, 0, comm, pids[(groupId+1)*i], tag, &tmpInter);
9498       MPI_Intercomm_merge(tmpInter, 1, newcomm);
9499     }
9500
9501     if (*newcomm != commOld) {
9502       MPI_Comm_free(&tmpInter);
9503       MPI_Comm_free(&commOld);
9504     }
9505   }
9506
9507   return MPI_SUCCESS;
9508 }
9509
9510 AMPI_API_IMPL(int, MPI_Comm_set_name, MPI_Comm comm, const char *comm_name)
9511 {
9512   AMPI_API("AMPI_Comm_set_name");
9513   getAmpiInstance(comm)->setCommName(comm_name);
9514   return MPI_SUCCESS;
9515 }
9516
9517 AMPI_API_IMPL(int, MPI_Comm_get_name, MPI_Comm comm, char *comm_name, int *resultlen)
9518 {
9519   AMPI_API("AMPI_Comm_get_name");
9520   getAmpiInstance(comm)->getCommName(comm_name, resultlen);
9521   return MPI_SUCCESS;
9522 }
9523
9524 AMPI_API_IMPL(int, MPI_Comm_set_info, MPI_Comm comm, MPI_Info info)
9525 {
9526   AMPI_API("AMPI_Comm_set_info");
9527   /* FIXME: no-op implementation */
9528   return MPI_SUCCESS;
9529 }
9530
9531 AMPI_API_IMPL(int, MPI_Comm_get_info, MPI_Comm comm, MPI_Info *info)
9532 {
9533   AMPI_API("AMPI_Comm_get_info");
9534   /* FIXME: no-op implementation */
9535   *info = MPI_INFO_NULL;
9536   return MPI_SUCCESS;
9537 }
9538
9539 AMPI_API_IMPL(int, MPI_Comm_create_keyval, MPI_Comm_copy_attr_function *copy_fn,
9540                                            MPI_Comm_delete_attr_function *delete_fn,
9541                                            int *keyval, void* extra_state)
9542 {
9543   AMPI_API("AMPI_Comm_create_keyval");
9544   int ret = getAmpiParent()->createKeyval(copy_fn,delete_fn,keyval,extra_state);
9545   return ampiErrhandler("AMPI_Comm_create_keyval", ret);
9546 }
9547
9548 AMPI_API_IMPL(int, MPI_Comm_free_keyval, int *keyval)
9549 {
9550   AMPI_API("AMPI_Comm_free_keyval");
9551   vector<int>& keyvals = getAmpiParent()->getKeyvals(MPI_COMM_WORLD);
9552   int ret = getAmpiParent()->freeUserKeyval(MPI_COMM_WORLD, keyvals, keyval);
9553   return ampiErrhandler("AMPI_Comm_free_keyval", ret);
9554 }
9555
9556 AMPI_API_IMPL(int, MPI_Comm_set_attr, MPI_Comm comm, int keyval, void* attribute_val)
9557 {
9558   AMPI_API("AMPI_Comm_set_attr");
9559   ampiParent *parent = getAmpiParent();
9560   ampiCommStruct &cs = const_cast<ampiCommStruct &>(parent->comm2CommStruct(comm));
9561   vector<int>& keyvals = cs.getKeyvals();
9562   int ret = parent->setAttr(comm, keyvals, keyval, attribute_val);
9563   return ampiErrhandler("AMPI_Comm_set_attr", ret);
9564 }
9565
9566 AMPI_API_IMPL(int, MPI_Comm_get_attr, MPI_Comm comm, int keyval, void *attribute_val, int *flag)
9567 {
9568   AMPI_API("AMPI_Comm_get_attr");
9569   ampiParent *parent = getAmpiParent();
9570   ampiCommStruct &cs = const_cast<ampiCommStruct &>(parent->comm2CommStruct(comm));
9571   vector<int>& keyvals = cs.getKeyvals();
9572   int ret = parent->getAttr(comm, keyvals, keyval, attribute_val, flag);
9573   return ampiErrhandler("AMPI_Comm_get_attr", ret);
9574 }
9575
9576 AMPI_API_IMPL(int, MPI_Comm_delete_attr, MPI_Comm comm, int keyval)
9577 {
9578   AMPI_API("AMPI_Comm_delete_attr");
9579   ampiParent *parent = getAmpiParent();
9580   ampiCommStruct &cs = const_cast<ampiCommStruct &>(parent->comm2CommStruct(comm));
9581   vector<int>& keyvals = cs.getKeyvals();
9582   int ret = parent->deleteAttr(comm, keyvals, keyval);
9583   return ampiErrhandler("AMPI_Comm_delete_attr", ret);
9584 }
9585
9586 AMPI_API_IMPL(int, MPI_Keyval_create, MPI_Copy_function *copy_fn, MPI_Delete_function *delete_fn,
9587                                       int *keyval, void* extra_state)
9588 {
9589   AMPI_API("AMPI_Keyval_create");
9590   return MPI_Comm_create_keyval(copy_fn, delete_fn, keyval, extra_state);
9591 }
9592
9593 AMPI_API_IMPL(int, MPI_Keyval_free, int *keyval)
9594 {
9595   AMPI_API("AMPI_Keyval_free");
9596   return MPI_Comm_free_keyval(keyval);
9597 }
9598
9599 AMPI_API_IMPL(int, MPI_Attr_put, MPI_Comm comm, int keyval, void* attribute_val)
9600 {
9601   AMPI_API("AMPI_Attr_put");
9602   return MPI_Comm_set_attr(comm, keyval, attribute_val);
9603 }
9604
9605 AMPI_API_IMPL(int, MPI_Attr_get, MPI_Comm comm, int keyval, void *attribute_val, int *flag)
9606 {
9607   AMPI_API("AMPI_Attr_get");
9608   return MPI_Comm_get_attr(comm, keyval, attribute_val, flag);
9609 }
9610
9611 AMPI_API_IMPL(int, MPI_Attr_delete, MPI_Comm comm, int keyval)
9612 {
9613   AMPI_API("AMPI_Attr_delete");
9614   return MPI_Comm_delete_attr(comm, keyval);
9615 }
9616
9617 AMPI_API_IMPL(int, MPI_Cart_map, MPI_Comm comm, int ndims, const int *dims,
9618                                  const int *periods, int *newrank)
9619 {
9620   AMPI_API("AMPI_Cart_map");
9621
9622   ampi* ptr = getAmpiInstance(comm);
9623   int nranks;
9624
9625   if (ndims == 0) {
9626     nranks = 1;
9627   } else {
9628     nranks = dims[0];
9629     for (int i=1; i<ndims; i++) {
9630       nranks *= dims[i];
9631     }
9632   }
9633
9634   int rank = ptr->getRank();
9635   if (rank < nranks) {
9636     *newrank = rank;
9637   } else {
9638     *newrank = MPI_UNDEFINED;
9639   }
9640   return MPI_SUCCESS;
9641 }
9642
9643 AMPI_API_IMPL(int, MPI_Graph_map, MPI_Comm comm, int nnodes, const int *index,
9644                                   const int *edges, int *newrank)
9645 {
9646   AMPI_API("AMPI_Graph_map");
9647
9648   ampi* ptr = getAmpiInstance(comm);
9649
9650   if (ptr->getRank() < nnodes) {
9651     *newrank = ptr->getRank();
9652   } else {
9653     *newrank = MPI_UNDEFINED;
9654   }
9655   return MPI_SUCCESS;
9656 }
9657
9658 AMPI_API_IMPL(int, MPI_Cart_create, MPI_Comm comm_old, int ndims, const int *dims,
9659                                     const int *periods, int reorder, MPI_Comm *comm_cart)
9660 {
9661   AMPI_API("AMPI_Cart_create");
9662
9663   /* Create new cartesian communicator. No attention is being paid to mapping
9664      virtual processes to processors, which ideally should be handled by the
9665      load balancer with input from virtual topology information.
9666
9667      No reorder done here. reorder input is ignored, but still stored in the
9668      communicator with other VT info.
9669    */
9670
9671   int newrank;
9672   MPI_Cart_map(comm_old, ndims, dims, periods, &newrank);//no change in rank
9673
9674   ampiParent *ptr = getAmpiParent();
9675   groupStruct vec = ptr->group2vec(ptr->comm2group(comm_old));
9676   *comm_cart = getAmpiInstance(comm_old)->cartCreate(vec, ndims, dims);
9677
9678   if (*comm_cart != MPI_COMM_NULL) {
9679     ampiCommStruct &c = getAmpiParent()->getCart(*comm_cart);
9680     ampiTopology *topo = c.getTopology();
9681     topo->setndims(ndims);
9682     vector<int> dimsv(dims, dims+ndims), periodsv(periods, periods+ndims), nborsv;
9683     topo->setdims(dimsv);
9684     topo->setperiods(periodsv);
9685     getAmpiInstance(*comm_cart)->findNeighbors(*comm_cart, newrank, nborsv);
9686     topo->setnbors(nborsv);
9687   }
9688
9689   return MPI_SUCCESS;
9690 }
9691
9692 AMPI_API_IMPL(int, MPI_Graph_create, MPI_Comm comm_old, int nnodes, const int *index,
9693                                      const int *edges, int reorder, MPI_Comm *comm_graph)
9694 {
9695   AMPI_API("AMPI_Graph_create");
9696
9697   if (nnodes == 0) {
9698     *comm_graph = MPI_COMM_NULL;
9699     return MPI_SUCCESS;
9700   }
9701
9702   /* No mapping done */
9703   int newrank;
9704   MPI_Graph_map(comm_old, nnodes, index, edges, &newrank);
9705
9706   ampiParent *ptr = getAmpiParent();
9707   groupStruct vec = ptr->group2vec(ptr->comm2group(comm_old));
9708   getAmpiInstance(comm_old)->graphCreate(vec, comm_graph);
9709   ampiTopology &topo = *ptr->getGraph(*comm_graph).getTopology();
9710
9711   vector<int> index_(index, index+nnodes), edges_, nborsv;
9712   topo.setnvertices(nnodes);
9713   topo.setindex(index_);
9714
9715   for (int i = 0; i < index[nnodes - 1]; i++)
9716     edges_.push_back(edges[i]);
9717   topo.setedges(edges_);
9718
9719   getAmpiInstance(*comm_graph)->findNeighbors(*comm_graph, newrank, nborsv);
9720   topo.setnbors(nborsv);
9721
9722   return MPI_SUCCESS;
9723 }
9724
9725 AMPI_API_IMPL(int, MPI_Dist_graph_create_adjacent, MPI_Comm comm_old, int indegree, const int sources[],
9726                                                    const int sourceweights[], int outdegree,
9727                                                    const int destinations[], const int destweights[],
9728                                                    MPI_Info info, int reorder, MPI_Comm *comm_dist_graph)
9729 {
9730   AMPI_API("AMPI_Dist_graph_create_adjacent");
9731
9732 #if AMPI_ERROR_CHECKING
9733   if (indegree < 0 || outdegree < 0) {
9734     return ampiErrhandler("AMPI_Dist_graph_create_adjacent", MPI_ERR_TOPOLOGY);
9735   }
9736   for (int i=0; i<indegree; i++) {
9737     if (sources[i] < 0) {
9738       return ampiErrhandler("AMPI_Dist_graph_create_adjacent", MPI_ERR_TOPOLOGY);
9739     }
9740   }
9741   for (int i=0; i<outdegree; i++) {
9742     if (destinations[i] < 0) {
9743       return ampiErrhandler("AMPI_Dist_graph_create_adjacent", MPI_ERR_TOPOLOGY);
9744     }
9745   }
9746 #endif
9747
9748   ampiParent *ptr = getAmpiParent();
9749   groupStruct vec = ptr->group2vec(ptr->comm2group(comm_old));
9750   getAmpiInstance(comm_old)->distGraphCreate(vec,comm_dist_graph);
9751   ampiCommStruct &c = ptr->getDistGraph(*comm_dist_graph);
9752   ampiTopology *topo = c.getTopology();
9753
9754   topo->setInDegree(indegree);
9755   topo->setOutDegree(outdegree);
9756
9757   topo->setAreSourcesWeighted(sourceweights != MPI_UNWEIGHTED);
9758   if (topo->areSourcesWeighted()) {
9759     vector<int> tmpSourceWeights(sourceweights, sourceweights+indegree);
9760     topo->setSourceWeights(tmpSourceWeights);
9761   }
9762
9763   topo->setAreDestsWeighted(destweights != MPI_UNWEIGHTED);
9764   if (topo->areDestsWeighted()) {
9765     vector<int> tmpDestWeights(destweights, destweights+outdegree);
9766     topo->setDestWeights(tmpDestWeights);
9767   }
9768
9769   vector<int> tmpSources(sources, sources+indegree);
9770   topo->setSources(tmpSources);
9771
9772   vector<int> tmpDestinations(destinations, destinations+outdegree);
9773   topo->setDestinations(tmpDestinations);
9774
9775   return MPI_SUCCESS;
9776 }
9777
9778 AMPI_API_IMPL(int, MPI_Dist_graph_create, MPI_Comm comm_old, int n, const int sources[], const int degrees[],
9779                                           const int destinations[], const int weights[], MPI_Info info,
9780                                           int reorder, MPI_Comm *comm_dist_graph)
9781 {
9782   AMPI_API("AMPI_Dist_graph_create");
9783
9784 #if AMPI_ERROR_CHECKING
9785     if (n < 0) {
9786       return ampiErrhandler("AMPI_Dist_graph_create", MPI_ERR_TOPOLOGY);
9787     }
9788     int counter = 0;
9789     for (int i=0; i<n; i++) {
9790       if ((sources[i] < 0) || (degrees[i] < 0)) {
9791         return ampiErrhandler("AMPI_Dist_graph_create", MPI_ERR_TOPOLOGY);
9792       }
9793       for (int j=0; j<degrees[i]; j++) {
9794         if ((destinations[counter] < 0) || (weights != MPI_UNWEIGHTED && weights[counter] < 0)) {
9795           return ampiErrhandler("AMPI_Dist_graph_create", MPI_ERR_TOPOLOGY);
9796         }
9797         counter++;
9798       }
9799     }
9800 #endif
9801
9802   ampiParent *ptr = getAmpiParent();
9803   groupStruct vec = ptr->group2vec(ptr->comm2group(comm_old));
9804   getAmpiInstance(comm_old)->distGraphCreate(vec,comm_dist_graph);
9805   ampiCommStruct &c = ptr->getDistGraph(*comm_dist_graph);
9806   ampiTopology *topo = c.getTopology();
9807
9808   int p = c.getSize();
9809
9810   vector<int> edgeListIn(p, 0);
9811   vector<int> edgeListOut(p, 0);
9812   vector<vector<int> > edgeMatrixIn(p);
9813   vector<vector<int> > edgeMatrixOut(p);
9814
9815   for (int i=0; i<p; i++) {
9816     vector<int> tmpVector(p, 0);
9817     edgeMatrixIn[i] = tmpVector;
9818     edgeMatrixOut[i] = tmpVector;
9819   }
9820
9821   int index = 0;
9822   for (int i=0; i<n; i++) {
9823     for (int j=0; j<degrees[i]; j++) {
9824       edgeMatrixOut[ sources[i] ][ edgeListOut[sources[i]]++ ] = destinations[index];
9825       edgeMatrixIn[ destinations[index] ][ edgeListIn[destinations[index]]++ ] = sources[i];
9826       index++;
9827     }
9828   }
9829
9830   vector<int> edgeCount(2*p);
9831   vector<int> totalcount(2);
9832   int sends = 0;
9833   for (int i=0; i<p; i++) {
9834     if (edgeListIn[i] > 0) {
9835       edgeCount[2*i] = 1;
9836       sends++;
9837     }
9838     else {
9839       edgeCount[2*i] = 0;
9840     }
9841     if (edgeListOut[i] > 0) {
9842       edgeCount[2*i+1] = 1;
9843       sends++;
9844     }
9845     else {
9846       edgeCount[2*i+1] = 0;
9847     }
9848   }
9849
9850   // Compute total number of ranks with incoming or outgoing edges for each rank
9851   MPI_Reduce_scatter_block(edgeCount.data(), totalcount.data(), 2, MPI_INT, MPI_SUM, comm_old);
9852
9853   vector<MPI_Request> requests(sends, MPI_REQUEST_NULL);
9854   int count = 0;
9855   for (int i=0; i<p; i++) {
9856     if (edgeListIn[i] > 0) {
9857       if (edgeListIn[i] == p) {
9858         edgeMatrixIn[i].push_back(1);
9859       }
9860       else {
9861         edgeMatrixIn[i][edgeListIn[i]] = 1;
9862       }
9863       MPI_Isend(edgeMatrixIn[i].data(), edgeListIn[i]+1, MPI_INT, i, 0, comm_old, &requests[count++]);
9864     }
9865     if (edgeListOut[i] > 0) {
9866       if (edgeListOut[i] == p) {
9867         edgeMatrixOut[i].push_back(-1);
9868       }
9869       else {
9870         edgeMatrixOut[i][edgeListOut[i]] = -1;
9871       }
9872       MPI_Isend(edgeMatrixOut[i].data(), edgeListOut[i]+1, MPI_INT, i, 0, comm_old, &requests[count++]);
9873     }
9874   }
9875
9876   // Receive all non-local incoming and outgoing edges
9877   int numEdges;
9878   MPI_Status status;
9879   vector<int> saveSources, saveDestinations;
9880   for (int i=0; i<2; i++) {
9881     for (int j=0; j<totalcount[i]; j++) {
9882       MPI_Probe(MPI_ANY_SOURCE, MPI_ANY_TAG, comm_old, &status);
9883       MPI_Get_count(&status, MPI_INT, &numEdges);
9884       vector<int> saveEdges(numEdges);
9885       MPI_Recv(saveEdges.data(), numEdges, MPI_INT, status.MPI_SOURCE, 0, comm_old, MPI_STATUS_IGNORE);
9886
9887       if (saveEdges[numEdges-1] > 0) {
9888         for (int k=0; k<numEdges-1; k++) {
9889           saveSources.push_back(saveEdges[k]);
9890         }
9891       }
9892       else {
9893         for (int k=0; k<numEdges-1; k++) {
9894           saveDestinations.push_back(saveEdges[k]);
9895         }
9896       }
9897     }
9898   }
9899
9900   topo->setDestinations(saveDestinations);
9901   topo->setSources(saveSources);
9902   topo->setOutDegree(saveDestinations.size());
9903   topo->setInDegree(saveSources.size());
9904
9905   topo->setAreSourcesWeighted(weights != MPI_UNWEIGHTED);
9906   topo->setAreDestsWeighted(weights != MPI_UNWEIGHTED);
9907   if (topo->areSourcesWeighted()) {
9908     vector<int> tmpWeights(weights, weights+n);
9909     topo->setSourceWeights(tmpWeights);
9910     topo->setDestWeights(tmpWeights);
9911   }
9912
9913   MPI_Waitall(sends, requests.data(), MPI_STATUSES_IGNORE);
9914
9915   return MPI_SUCCESS;
9916 }
9917
9918 AMPI_API_IMPL(int, MPI_Topo_test, MPI_Comm comm, int *status)
9919 {
9920   AMPI_API("AMPI_Topo_test");
9921
9922   ampiParent *ptr = getAmpiParent();
9923
9924   if (ptr->isCart(comm))
9925     *status = MPI_CART;
9926   else if (ptr->isGraph(comm))
9927     *status = MPI_GRAPH;
9928   else if (ptr->isDistGraph(comm))
9929     *status = MPI_DIST_GRAPH;
9930   else *status = MPI_UNDEFINED;
9931
9932   return MPI_SUCCESS;
9933 }
9934
9935 AMPI_API_IMPL(int, MPI_Cartdim_get, MPI_Comm comm, int *ndims)
9936 {
9937   AMPI_API("AMPI_Cartdim_get");
9938
9939 #if AMPI_ERROR_CHECKING
9940   if (!getAmpiParent()->isCart(comm))
9941     return ampiErrhandler("AMPI_Cartdim_get", MPI_ERR_TOPOLOGY);
9942 #endif
9943
9944   *ndims = getAmpiParent()->getCart(comm).getTopology()->getndims();
9945
9946   return MPI_SUCCESS;
9947 }
9948
9949 AMPI_API_IMPL(int, MPI_Cart_get, MPI_Comm comm, int maxdims, int *dims, int *periods, int *coords)
9950 {
9951   int i, ndims;
9952
9953   AMPI_API("AMPI_Cart_get");
9954
9955 #if AMPI_ERROR_CHECKING
9956   if (!getAmpiParent()->isCart(comm))
9957     return ampiErrhandler("AMPI_Cart_get", MPI_ERR_TOPOLOGY);
9958 #endif
9959
9960   ampiCommStruct &c = getAmpiParent()->getCart(comm);
9961   ampiTopology *topo = c.getTopology();
9962   ndims = topo->getndims();
9963   int rank = getAmpiInstance(comm)->getRank();
9964
9965   const vector<int> &dims_ = topo->getdims();
9966   const vector<int> &periods_ = topo->getperiods();
9967
9968   for (i = 0; i < maxdims; i++) {
9969     dims[i] = dims_[i];
9970     periods[i] = periods_[i];
9971   }
9972
9973   for (i = ndims - 1; i >= 0; i--) {
9974     if (i < maxdims)
9975       coords[i] = rank % dims_[i];
9976     rank = (int) (rank / dims_[i]);
9977   }
9978
9979   return MPI_SUCCESS;
9980 }
9981
9982 AMPI_API_IMPL(int, MPI_Cart_rank, MPI_Comm comm, const int *coords, int *rank)
9983 {
9984   AMPI_API("AMPI_Cart_rank");
9985
9986 #if AMPI_ERROR_CHECKING
9987   if (!getAmpiParent()->isCart(comm))
9988     return ampiErrhandler("AMPI_Cart_rank", MPI_ERR_TOPOLOGY);
9989 #endif
9990
9991   ampiCommStruct &c = getAmpiParent()->getCart(comm);
9992   ampiTopology *topo = c.getTopology();
9993   int ndims = topo->getndims();
9994   const vector<int> &dims = topo->getdims();
9995   const vector<int> &periods = topo->getperiods();
9996
9997   //create a copy of coords since we are not allowed to modify it
9998   vector<int> ncoords(coords, coords+ndims);
9999
10000   int prod = 1;
10001   int r = 0;
10002
10003   for (int i = ndims - 1; i >= 0; i--) {
10004     if ((ncoords[i] < 0) || (ncoords[i] >= dims[i])) {
10005       if (periods[i] != 0) {
10006         if (ncoords[i] > 0) {
10007           ncoords[i] %= dims[i];
10008         } else {
10009           while (ncoords[i] < 0) ncoords[i]+=dims[i];
10010         }
10011       }
10012     }
10013     r += prod * ncoords[i];
10014     prod *= dims[i];
10015   }
10016
10017   *rank = r;
10018
10019   return MPI_SUCCESS;
10020 }
10021
10022 AMPI_API_IMPL(int, MPI_Cart_coords, MPI_Comm comm, int rank, int maxdims, int *coords)
10023 {
10024   AMPI_API("AMPI_Cart_coords");
10025
10026 #if AMPI_ERROR_CHECKING
10027   if (!getAmpiParent()->isCart(comm))
10028     return ampiErrhandler("AMPI_Cart_coorts", MPI_ERR_TOPOLOGY);
10029 #endif
10030
10031   ampiCommStruct &c = getAmpiParent()->getCart(comm);
10032   ampiTopology *topo = c.getTopology();
10033   int ndims = topo->getndims();
10034   const vector<int> &dims = topo->getdims();
10035
10036   for (int i = ndims - 1; i >= 0; i--) {
10037     if (i < maxdims)
10038       coords[i] = rank % dims[i];
10039     rank = (int) (rank / dims[i]);
10040   }
10041
10042   return MPI_SUCCESS;
10043 }
10044
10045 // Offset coords[direction] by displacement, and set the rank that
10046 // results
10047 static void cart_clamp_coord(MPI_Comm comm, const vector<int> &dims,
10048                              const vector<int> &periodicity, int *coords,
10049                              int direction, int displacement, int *rank_out)
10050 {
10051   int base_coord = coords[direction];
10052   coords[direction] += displacement;
10053
10054   if (periodicity[direction] != 0) {
10055     while (coords[direction] < 0)
10056       coords[direction] += dims[direction];
10057     while (coords[direction] >= dims[direction])
10058       coords[direction] -= dims[direction];
10059   }
10060
10061   if (coords[direction]<0 || coords[direction]>= dims[direction])
10062     *rank_out = MPI_PROC_NULL;
10063   else
10064     MPI_Cart_rank(comm, coords, rank_out);
10065
10066   coords[direction] = base_coord;
10067 }
10068
10069 AMPI_API_IMPL(int, MPI_Cart_shift, MPI_Comm comm, int direction, int disp,
10070                                    int *rank_source, int *rank_dest)
10071 {
10072   AMPI_API("AMPI_Cart_shift");
10073
10074 #if AMPI_ERROR_CHECKING
10075   if (!getAmpiParent()->isCart(comm))
10076     return ampiErrhandler("AMPI_Cart_shift", MPI_ERR_TOPOLOGY);
10077 #endif
10078
10079   ampiCommStruct &c = getAmpiParent()->getCart(comm);
10080   ampiTopology *topo = c.getTopology();
10081   int ndims = topo->getndims();
10082
10083 #if AMPI_ERROR_CHECKING
10084   if ((direction < 0) || (direction >= ndims))
10085     return ampiErrhandler("AMPI_Cart_shift", MPI_ERR_DIMS);
10086 #endif
10087
10088   const vector<int> &dims = topo->getdims();
10089   const vector<int> &periods = topo->getperiods();
10090   vector<int> coords(ndims);
10091
10092   int mype = getAmpiInstance(comm)->getRank();
10093   MPI_Cart_coords(comm, mype, ndims, &coords[0]);
10094
10095   cart_clamp_coord(comm, dims, periods, &coords[0], direction,  disp, rank_dest);
10096   cart_clamp_coord(comm, dims, periods, &coords[0], direction, -disp, rank_source);
10097
10098   return MPI_SUCCESS;
10099 }
10100
10101 AMPI_API_IMPL(int, MPI_Graphdims_get, MPI_Comm comm, int *nnodes, int *nedges)
10102 {
10103   AMPI_API("AMPI_Graphdim_get");
10104
10105   ampiCommStruct &c = getAmpiParent()->getGraph(comm);
10106   ampiTopology *topo = c.getTopology();
10107   *nnodes = topo->getnvertices();
10108   const vector<int> &index = topo->getindex();
10109   *nedges = index[(*nnodes) - 1];
10110
10111   return MPI_SUCCESS;
10112 }
10113
10114 AMPI_API_IMPL(int, MPI_Graph_get, MPI_Comm comm, int maxindex, int maxedges, int *index, int *edges)
10115 {
10116   AMPI_API("AMPI_Graph_get");
10117
10118 #if AMPI_ERROR_CHECKING
10119   if (!getAmpiParent()->isGraph(comm))
10120     return ampiErrhandler("AMPI_Graph_get", MPI_ERR_TOPOLOGY);
10121 #endif
10122
10123   ampiCommStruct &c = getAmpiParent()->getGraph(comm);
10124   ampiTopology *topo = c.getTopology();
10125   const vector<int> &index_ = topo->getindex();
10126   const vector<int> &edges_ = topo->getedges();
10127
10128   if (maxindex > index_.size())
10129     maxindex = index_.size();
10130
10131   int i;
10132   for (i = 0; i < maxindex; i++)
10133     index[i] = index_[i];
10134
10135   for (i = 0; i < maxedges; i++)
10136     edges[i] = edges_[i];
10137
10138   return MPI_SUCCESS;
10139 }
10140
10141 AMPI_API_IMPL(int, MPI_Graph_neighbors_count, MPI_Comm comm, int rank, int *nneighbors)
10142 {
10143   AMPI_API("AMPI_Graph_neighbors_count");
10144
10145 #if AMPI_ERROR_CHECKING
10146   if (!getAmpiParent()->isGraph(comm))
10147     return ampiErrhandler("AMPI_Graph_neighbors_count", MPI_ERR_TOPOLOGY);
10148 #endif
10149
10150   ampiCommStruct &c = getAmpiParent()->getGraph(comm);
10151   ampiTopology *topo = c.getTopology();
10152   const vector<int> &index = topo->getindex();
10153
10154 #if AMPI_ERROR_CHECKING
10155   if ((rank >= index.size()) || (rank < 0))
10156     return ampiErrhandler("AMPI_Graph_neighbors_count", MPI_ERR_RANK);
10157 #endif
10158
10159   if (rank == 0)
10160     *nneighbors = index[rank];
10161   else
10162     *nneighbors = index[rank] - index[rank - 1];
10163
10164   return MPI_SUCCESS;
10165 }
10166
10167 AMPI_API_IMPL(int, MPI_Graph_neighbors, MPI_Comm comm, int rank, int maxneighbors, int *neighbors)
10168 {
10169   AMPI_API("AMPI_Graph_neighbors");
10170
10171 #if AMPI_ERROR_CHECKING
10172   if (!getAmpiParent()->isGraph(comm))
10173     return ampiErrhandler("AMPI_Graph_neighbors", MPI_ERR_TOPOLOGY);
10174 #endif
10175
10176   ampiCommStruct &c = getAmpiParent()->getGraph(comm);
10177   ampiTopology *topo = c.getTopology();
10178   const vector<int> &index = topo->getindex();
10179   const vector<int> &edges = topo->getedges();
10180
10181   int numneighbors = (rank == 0) ? index[rank] : index[rank] - index[rank - 1];
10182   if (maxneighbors > numneighbors)
10183     maxneighbors = numneighbors;
10184
10185 #if AMPI_ERROR_CHECKING
10186   if (maxneighbors < 0)
10187     return ampiErrhandler("AMPI_Graph_neighbors", MPI_ERR_ARG);
10188   if ((rank >= index.size()) || (rank < 0))
10189     return ampiErrhandler("AMPI_Graph_neighbors", MPI_ERR_RANK);
10190 #endif
10191
10192   if (rank == 0) {
10193     for (int i = 0; i < maxneighbors; i++)
10194       neighbors[i] = edges[i];
10195   } else {
10196     for (int i = 0; i < maxneighbors; i++)
10197       neighbors[i] = edges[index[rank - 1] + i];
10198   }
10199   return MPI_SUCCESS;
10200 }
10201
10202 AMPI_API_IMPL(int, MPI_Dist_graph_neighbors_count, MPI_Comm comm, int *indegree, int *outdegree, int *weighted)
10203 {
10204   AMPI_API("AMPI_Dist_graph_neighbors_count");
10205
10206 #if AMPI_ERROR_CHECKING
10207   if (!getAmpiParent()->isDistGraph(comm)) {
10208     return ampiErrhandler("AMPI_Dist_graph_neighbors_count", MPI_ERR_TOPOLOGY);
10209   }
10210 #endif
10211
10212   ampiParent *ptr = getAmpiParent();
10213   ampiCommStruct &c = ptr->getDistGraph(comm);
10214   ampiTopology *topo = c.getTopology();
10215   *indegree = topo->getInDegree();
10216   *outdegree = topo->getOutDegree();
10217   *weighted = topo->areSourcesWeighted() ? 1 : 0;
10218
10219   return MPI_SUCCESS;
10220 }
10221
10222 AMPI_API_IMPL(int, MPI_Dist_graph_neighbors, MPI_Comm comm, int maxindegree, int sources[], int sourceweights[],
10223                                              int maxoutdegree, int destinations[], int destweights[])
10224 {
10225   AMPI_API("AMPI_Dist_graph_neighbors");
10226
10227 #if AMPI_ERROR_CHECKING
10228   if (!getAmpiParent()->isDistGraph(comm)) {
10229     return ampiErrhandler("AMPI_Dist_graph_neighbors", MPI_ERR_TOPOLOGY);
10230   }
10231   if ((maxindegree < 0) || (maxoutdegree < 0)) {
10232     return ampiErrhandler("AMPI_Dist_graph_neighbors", MPI_ERR_TOPOLOGY);
10233   }
10234 #endif
10235
10236   ampiParent *ptr = getAmpiParent();
10237   ampiCommStruct &c = ptr->getDistGraph(comm);
10238   ampiTopology *topo = c.getTopology();
10239
10240   const vector<int> &tmpSources = topo->getSources();
10241   const vector<int> &tmpSourceWeights = topo->getSourceWeights();
10242   const vector<int> &tmpDestinations = topo->getDestinations();
10243   const vector<int> &tmpDestWeights = topo->getDestWeights();
10244
10245   maxindegree = std::min(maxindegree, static_cast<int>(tmpSources.size()));
10246   maxoutdegree = std::min(maxoutdegree, static_cast<int>(tmpDestinations.size()));
10247
10248   for (int i=0; i<maxindegree; i++) {
10249     sources[i] = tmpSources[i];
10250   }
10251   for (int i=0; i<maxoutdegree; i++) {
10252     destinations[i] = tmpDestinations[i];
10253   }
10254
10255   if (topo->areSourcesWeighted()) {
10256     for (int i=0; i<maxindegree; i++) {
10257       sourceweights[i] = tmpSourceWeights[i];
10258     }
10259     for (int i=0; i<maxoutdegree; i++) {
10260       destweights[i] = tmpDestWeights[i];
10261     }
10262   }
10263   else {
10264     sourceweights = NULL;
10265     destweights = NULL;
10266   }
10267
10268   return MPI_SUCCESS;
10269 }
10270
10271 /* Used by MPI_Cart_create & MPI_Graph_create */
10272 void ampi::findNeighbors(MPI_Comm comm, int rank, vector<int>& neighbors) const noexcept {
10273   int max_neighbors = 0;
10274   ampiParent *ptr = getAmpiParent();
10275   if (ptr->isGraph(comm)) {
10276     MPI_Graph_neighbors_count(comm, rank, &max_neighbors);
10277     neighbors.resize(max_neighbors);
10278     MPI_Graph_neighbors(comm, rank, max_neighbors, &neighbors[0]);
10279   }
10280   else if (ptr->isCart(comm)) {
10281     int num_dims;
10282     MPI_Cartdim_get(comm, &num_dims);
10283     max_neighbors = 2*num_dims;
10284     for (int i=0; i<max_neighbors; i++) {
10285       int src, dest;
10286       MPI_Cart_shift(comm, i/2, (i%2==0)?1:-1, &src, &dest);
10287       if (dest != MPI_PROC_NULL)
10288         neighbors.push_back(dest);
10289     }
10290   }
10291 }
10292
10293 /* Factorization code by Orion. Idea thrashed out by Orion and Prakash */
10294
10295 /**
10296   Return the integer "d'th root of n"-- the largest
10297   integer r such that
10298   r^d <= n
10299  */
10300 int integerRoot(int n,int d) noexcept {
10301   double epsilon=0.001; /* prevents roundoff in "floor" */
10302   return (int)floor(pow(n+epsilon,1.0/d));
10303 }
10304
10305 /**
10306   Factorize "n" into "d" factors, stored in "dims[0..d-1]".
10307   All the factors must be greater than or equal to m.
10308   The factors are chosen so that they are all as near together
10309   as possible (technically, chosen so that the increasing-size
10310   ordering is lexicagraphically as large as possible).
10311  */
10312
10313 bool factors(int n, int d, int *dims, int m) noexcept {
10314   if (d==1)
10315   { /* Base case */
10316     if (n>=m) { /* n is an acceptable factor */
10317       dims[0]=n;
10318       return true;
10319     }
10320   }
10321   else { /* induction case */
10322     int k_up=integerRoot(n,d);
10323     for (int k=k_up;k>=m;k--) {
10324       if (n%k==0) { /* k divides n-- try it as a factor */
10325         dims[0]=k;
10326         if (factors(n/k,d-1,&dims[1],k))
10327           return true;
10328       }
10329     }
10330   }
10331   /* If we fall out here, there were no factors available */
10332   return false;
10333 }
10334
10335 AMPI_API_IMPL(int, MPI_Dims_create, int nnodes, int ndims, int *dims)
10336 {
10337   AMPI_API("AMPI_Dims_create");
10338
10339   int i, n, d;
10340
10341   n = nnodes;
10342   d = ndims;
10343
10344   for (i = 0; i < ndims; i++) {
10345     if (dims[i] != 0) {
10346       if (n % dims[i] != 0) {
10347         return ampiErrhandler("AMPI_Dims_create", MPI_ERR_DIMS);
10348       } else {
10349         n = n / dims[i];
10350         d--;
10351       }
10352     }
10353   }
10354
10355   if(d > 0) {
10356     vector<int> pdims(d);
10357
10358     if (!factors(n, d, &pdims[0], 1))
10359       CkAbort("MPI_Dims_create: factorization failed!\n");
10360
10361     int j = 0;
10362     for (i = 0; i < ndims; i++) {
10363       if (dims[i] == 0) {
10364         dims[i] = pdims[j];
10365         j++;
10366       }
10367     }
10368
10369     // Sort the factors in non-increasing order.
10370     // Bubble sort because dims is always small.
10371     for (int i=0; i<d-1; i++) {
10372       for (int j=i+1; j<d; j++) {
10373         if (dims[j] > dims[i]) {
10374           int tmp = dims[i];
10375           dims[i] = dims[j];
10376           dims[j] = tmp;
10377         }
10378       }
10379     }
10380   }
10381
10382   return MPI_SUCCESS;
10383 }
10384
10385 /* Implemented with call to MPI_Comm_Split. Color and key are single integer
10386    encodings of the lost and preserved dimensions, respectively,
10387    of the subgraphs.
10388  */
10389 AMPI_API_IMPL(int, MPI_Cart_sub, MPI_Comm comm, const int *remain_dims, MPI_Comm *newcomm)
10390 {
10391   AMPI_API("AMPI_Cart_sub");
10392
10393   int i, ndims;
10394   int color = 1, key = 1;
10395
10396 #if AMPI_ERROR_CHECKING
10397   if (!getAmpiParent()->isCart(comm))
10398     return ampiErrhandler("AMPI_Cart_sub", MPI_ERR_TOPOLOGY);
10399 #endif
10400
10401   int rank = getAmpiInstance(comm)->getRank();
10402   ampiCommStruct &c = getAmpiParent()->getCart(comm);
10403   ampiTopology *topo = c.getTopology();
10404   ndims = topo->getndims();
10405   const vector<int> &dims = topo->getdims();
10406   int num_remain_dims = 0;
10407
10408   vector<int> coords(ndims);
10409   MPI_Cart_coords(comm, rank, ndims, coords.data());
10410
10411   for (i = 0; i < ndims; i++) {
10412     if (remain_dims[i]) {
10413       /* key single integer encoding*/
10414       key = key * dims[i] + coords[i];
10415       num_remain_dims++;
10416     }
10417     else {
10418       /* color */
10419       color = color * dims[i] + coords[i];
10420     }
10421   }
10422
10423   if (num_remain_dims == 0) {
10424     *newcomm = getAmpiInstance(comm)->cartCreate0D();
10425     return MPI_SUCCESS;
10426   }
10427
10428   getAmpiInstance(comm)->split(color, key, newcomm, MPI_CART);
10429
10430   ampiCommStruct &newc = getAmpiParent()->getCart(*newcomm);
10431   ampiTopology *newtopo = newc.getTopology();
10432   newtopo->setndims(num_remain_dims);
10433   vector<int> dimsv;
10434   const vector<int> &periods = topo->getperiods();
10435   vector<int> periodsv;
10436
10437   for (i = 0; i < ndims; i++) {
10438     if (remain_dims[i]) {
10439       dimsv.push_back(dims[i]);
10440       periodsv.push_back(periods[i]);
10441     }
10442   }
10443   newtopo->setdims(dimsv);
10444   newtopo->setperiods(periodsv);
10445
10446   vector<int> nborsv;
10447   getAmpiInstance(*newcomm)->findNeighbors(*newcomm, getAmpiParent()->getRank(*newcomm), nborsv);
10448   newtopo->setnbors(nborsv);
10449
10450   return MPI_SUCCESS;
10451 }
10452
10453 AMPI_API_IMPL(int, MPI_Type_get_envelope, MPI_Datatype datatype, int *ni, int *na,
10454                                           int *nd, int *combiner)
10455 {
10456   AMPI_API("AMPI_Type_get_envelope");
10457
10458 #if AMPI_ERROR_CHECKING
10459   int ret = checkData("AMPI_Type_get_envelope", datatype);
10460   if (ret!=MPI_SUCCESS)
10461     return ret;
10462 #endif
10463
10464   return getDDT()->getEnvelope(datatype,ni,na,nd,combiner);
10465 }
10466
10467 AMPI_API_IMPL(int, MPI_Type_get_contents, MPI_Datatype datatype, int ni, int na, int nd,
10468                                           int i[], MPI_Aint a[], MPI_Datatype d[])
10469 {
10470   AMPI_API("AMPI_Type_get_contents");
10471
10472 #if AMPI_ERROR_CHECKING
10473   int ret = checkData("AMPI_Type_get_contents", datatype);
10474   if (ret!=MPI_SUCCESS)
10475     return ret;
10476 #endif
10477
10478   return getDDT()->getContents(datatype,ni,na,nd,i,a,d);
10479 }
10480
10481 AMPI_API_IMPL(int, MPI_Pcontrol, const int level, ...)
10482 {
10483 //int AMPI_Pcontrol(const int level, ...) {
10484   //AMPI_API("AMPI_Pcontrol");
10485   return MPI_SUCCESS;
10486 }
10487
10488 /******** AMPI Extensions to the MPI standard *********/
10489
10490 CDECL
10491 int AMPI_Migrate(MPI_Info hints)
10492 {
10493   AMPI_API("AMPI_Migrate");
10494   int nkeys, exists;
10495   char key[MPI_MAX_INFO_KEY], value[MPI_MAX_INFO_VAL];
10496
10497   MPI_Info_get_nkeys(hints, &nkeys);
10498
10499   for (int i=0; i<nkeys; i++) {
10500     MPI_Info_get_nthkey(hints, i, key);
10501     MPI_Info_get(hints, key, MPI_MAX_INFO_VAL, value, &exists);
10502     if (!exists) {
10503       continue;
10504     }
10505     else if (strncmp(key, "ampi_load_balance", MPI_MAX_INFO_KEY) == 0) {
10506
10507       if (strncmp(value, "sync", MPI_MAX_INFO_VAL) == 0) {
10508         TCHARM_Migrate();
10509       }
10510       else if (strncmp(value, "async", MPI_MAX_INFO_VAL) == 0) {
10511         TCHARM_Async_Migrate();
10512       }
10513       else if (strncmp(value, "false", MPI_MAX_INFO_VAL) == 0) {
10514         /* do nothing */
10515       }
10516       else {
10517         CkPrintf("WARNING: Unknown MPI_Info value (%s) given to AMPI_Migrate for key: %s\n", value, key);
10518       }
10519     }
10520     else if (strncmp(key, "ampi_checkpoint", MPI_MAX_INFO_KEY) == 0) {
10521
10522       if (strncmp(value, "true", MPI_MAX_INFO_VAL) == 0) {
10523         CkAbort("AMPI> Error: Value \"true\" is not supported for AMPI_Migrate key \"ampi_checkpoint\"!\n");
10524       }
10525       else if (strncmp(value, "to_file=", strlen("to_file=")) == 0) {
10526         int offset = strlen("to_file=");
10527         int restart_dir_name_len = 0;
10528         MPI_Info_get_valuelen(hints, key, &restart_dir_name_len, &exists);
10529         if (restart_dir_name_len > offset) {
10530           value[restart_dir_name_len] = '\0';
10531         }
10532         else {
10533           CkAbort("AMPI> Error: No checkpoint directory name given to AMPI_Migrate\n");
10534         }
10535         getAmpiInstance(MPI_COMM_WORLD)->barrier();
10536         getAmpiParent()->startCheckpoint(&value[offset]);
10537       }
10538       else if (strncmp(value, "in_memory", MPI_MAX_INFO_VAL) == 0) {
10539 #if CMK_MEM_CHECKPOINT
10540         getAmpiInstance(MPI_COMM_WORLD)->barrier();
10541         getAmpiParent()->startCheckpoint("");
10542 #else
10543         CkPrintf("AMPI> Error: In-memory checkpoint/restart is not enabled!\n");
10544         CkAbort("AMPI> Error: Recompile Charm++/AMPI with CMK_MEM_CHECKPOINT.\n");
10545 #endif
10546       }
10547       else if (strncmp(value, "message_logging", MPI_MAX_INFO_VAL) == 0) {
10548 #if CMK_MESSAGE_LOGGING
10549         TCHARM_Migrate();
10550 #else
10551         CkPrintf("AMPI> Error: Message logging is not enabled!\n");
10552         CkAbort("AMPI> Error: Recompile Charm++/AMPI with CMK_MESSAGE_LOGGING.\n");
10553 #endif
10554       }
10555       else if (strncmp(value, "false", MPI_MAX_INFO_VAL) == 0) {
10556         /* do nothing */
10557       }
10558       else {
10559         CkPrintf("WARNING: Unknown MPI_Info value (%s) given to AMPI_Migrate for key: %s\n", value, key);
10560       }
10561     }
10562     else {
10563       CkPrintf("WARNING: Unknown MPI_Info key given to AMPI_Migrate: %s\n", key);
10564     }
10565   }
10566
10567 #if (defined(_FAULT_MLOG_) || defined(_FAULT_CAUSAL_))
10568   ampi *currentAmpi = getAmpiInstance(MPI_COMM_WORLD);
10569   CpvAccess(_currentObj) = currentAmpi;
10570 #endif
10571
10572 #if CMK_BIGSIM_CHARM
10573   TRACE_BG_ADD_TAG("AMPI_MIGRATE");
10574 #endif
10575   return MPI_SUCCESS;
10576 }
10577
10578 #if CMK_FAULT_EVAC
10579 CDECL
10580 int AMPI_Evacuate(void)
10581 {
10582   //AMPI_API("AMPI_Evacuate");
10583   TCHARM_Evacuate();
10584   return MPI_SUCCESS;
10585 }
10586 #endif
10587
10588 CDECL
10589 int AMPI_Migrate_to_pe(int dest)
10590 {
10591   AMPI_API("AMPI_Migrate_to_pe");
10592   TCHARM_Migrate_to(dest);
10593 #if CMK_BIGSIM_CHARM
10594   TRACE_BG_ADD_TAG("AMPI_MIGRATE_TO_PE");
10595 #endif
10596   return MPI_SUCCESS;
10597 }
10598
10599 CDECL
10600 int AMPI_Set_migratable(int mig)
10601 {
10602   AMPI_API("AMPI_Set_migratable");
10603 #if CMK_LBDB_ON
10604   getAmpiParent()->setMigratable((mig!=0));
10605 #else
10606   CkPrintf("WARNING: MPI_Set_migratable is not supported in this build of Charm++/AMPI.\n");
10607 #endif
10608   return MPI_SUCCESS;
10609 }
10610
10611 CDECL
10612 int AMPI_Load_start_measure(void)
10613 {
10614   AMPI_API("AMPI_Load_start_measure");
10615   LBTurnInstrumentOn();
10616   return MPI_SUCCESS;
10617 }
10618
10619 CDECL
10620 int AMPI_Load_stop_measure(void)
10621 {
10622   AMPI_API("AMPI_Load_stop_measure");
10623   LBTurnInstrumentOff();
10624   return MPI_SUCCESS;
10625 }
10626
10627 CDECL
10628 int AMPI_Load_reset_measure(void)
10629 {
10630   AMPI_API("AMPI_Load_reset_measure");
10631   LBClearLoads();
10632   return MPI_SUCCESS;
10633 }
10634
10635 CDECL
10636 int AMPI_Load_set_value(double value)
10637 {
10638   AMPI_API("AMPI_Load_set_value");
10639   ampiParent *ptr = getAmpiParent();
10640   ptr->setObjTime(value);
10641   return MPI_SUCCESS;
10642 }
10643
10644 void _registerampif(void) {
10645   _registerampi();
10646 }
10647
10648 CDECL
10649 int AMPI_Register_main(MPI_MainFn mainFn,const char *name)
10650 {
10651   AMPI_API("AMPI_Register_main");
10652   if (TCHARM_Element()==0)
10653   { // I'm responsible for building the TCHARM threads:
10654     ampiCreateMain(mainFn,name,strlen(name));
10655   }
10656   return MPI_SUCCESS;
10657 }
10658
10659 FDECL
10660 void FTN_NAME(MPI_REGISTER_MAIN,mpi_register_main)
10661 (MPI_MainFn mainFn,const char *name,int nameLen)
10662 {
10663   AMPI_API("AMPI_register_main");
10664   if (TCHARM_Element()==0)
10665   { // I'm responsible for building the TCHARM threads:
10666     ampiCreateMain(mainFn,name,nameLen);
10667   }
10668 }
10669
10670 CDECL
10671 int AMPI_Register_pup(MPI_PupFn fn, void *data, int *idx)
10672 {
10673   AMPI_API("AMPI_Register_pup");
10674   *idx = TCHARM_Register(data, fn);
10675   return MPI_SUCCESS;
10676 }
10677
10678 CDECL
10679 int AMPI_Register_about_to_migrate(MPI_MigrateFn fn)
10680 {
10681   AMPI_API("AMPI_Register_about_to_migrate");
10682   ampiParent *thisParent = getAmpiParent();
10683   thisParent->setUserAboutToMigrateFn(fn);
10684   return MPI_SUCCESS;
10685 }
10686
10687 CDECL
10688 int AMPI_Register_just_migrated(MPI_MigrateFn fn)
10689 {
10690   AMPI_API("AMPI_Register_just_migrated");
10691   ampiParent *thisParent = getAmpiParent();
10692   thisParent->setUserJustMigratedFn(fn);
10693   return MPI_SUCCESS;
10694 }
10695
10696 CDECL
10697 int AMPI_Get_pup_data(int idx, void *data)
10698 {
10699   AMPI_API("AMPI_Get_pup_data");
10700   data = TCHARM_Get_userdata(idx);
10701   return MPI_SUCCESS;
10702 }
10703
10704 CDECL
10705 int AMPI_Type_is_contiguous(MPI_Datatype datatype, int *flag)
10706 {
10707   AMPI_API("AMPI_Type_is_contiguous");
10708   *flag = getDDT()->isContig(datatype);
10709   return MPI_SUCCESS;
10710 }
10711
10712 CDECL
10713 int AMPI_Print(const char *str)
10714 {
10715   AMPI_API("AMPI_Print");
10716   ampiParent *ptr = getAmpiParent();
10717   CkPrintf("[%d] %s\n", ptr->thisIndex, str);
10718   return MPI_SUCCESS;
10719 }
10720
10721 CDECL
10722 int AMPI_Suspend(void)
10723 {
10724   AMPI_API("AMPI_Suspend");
10725   getAmpiParent()->block();
10726   return MPI_SUCCESS;
10727 }
10728
10729 CDECL
10730 int AMPI_Yield(void)
10731 {
10732   AMPI_API("AMPI_Yield");
10733   getAmpiParent()->yield();
10734   return MPI_SUCCESS;
10735 }
10736
10737 CDECL
10738 int AMPI_Resume(int dest, MPI_Comm comm)
10739 {
10740   AMPI_API("AMPI_Resume");
10741   getAmpiInstance(comm)->getProxy()[dest].unblock();
10742   return MPI_SUCCESS;
10743 }
10744
10745 CDECL
10746 int AMPI_System(const char *cmd)
10747 {
10748   return TCHARM_System(cmd);
10749 }
10750
10751 CDECL
10752 int AMPI_Trace_begin(void)
10753 {
10754   traceBegin();
10755   return MPI_SUCCESS;
10756 }
10757
10758 CDECL
10759 int AMPI_Trace_end(void)
10760 {
10761   traceEnd();
10762   return MPI_SUCCESS;
10763 }
10764
10765 int AMPI_Install_idle_timer(void)
10766 {
10767 #if AMPI_PRINT_IDLE
10768   beginHandle = CcdCallOnConditionKeep(CcdPROCESSOR_BEGIN_IDLE,(CcdVoidFn)BeginIdle,NULL);
10769   endHandle = CcdCallOnConditionKeep(CcdPROCESSOR_END_IDLE,(CcdVoidFn)EndIdle,NULL);
10770 #endif
10771   return MPI_SUCCESS;
10772 }
10773
10774 int AMPI_Uninstall_idle_timer(void)
10775 {
10776 #if AMPI_PRINT_IDLE
10777   CcdCancelCallOnConditionKeep(CcdPROCESSOR_BEGIN_IDLE,beginHandle);
10778   CcdCancelCallOnConditionKeep(CcdPROCESSOR_BEGIN_BUSY,endHandle);
10779 #endif
10780   return MPI_SUCCESS;
10781 }
10782
10783 #if CMK_BIGSIM_CHARM
10784 extern "C" void startCFnCall(void *param,void *msg)
10785 {
10786   BgSetStartEvent();
10787   ampi *ptr = (ampi*)param;
10788   ampi::bcastraw(NULL, 0, ptr->getProxy());
10789   delete (CkReductionMsg*)msg;
10790 }
10791
10792 CDECL
10793 int AMPI_Set_start_event(MPI_Comm comm)
10794 {
10795   AMPI_API("AMPI_Set_start_event");
10796   CkAssert(comm == MPI_COMM_WORLD);
10797
10798   ampi *ptr = getAmpiInstance(comm);
10799
10800   CkDDT_DataType *ddt_type = ptr->getDDT()->getType(MPI_INT);
10801
10802   CkReductionMsg *msg=makeRednMsg(ddt_type, NULL, 0, MPI_INT, ptr->getRank(), MPI_SUM);
10803   if (CkMyPe() == 0) {
10804     CkCallback allreduceCB(startCFnCall, ptr);
10805     msg->setCallback(allreduceCB);
10806   }
10807   ptr->contribute(msg);
10808
10809   /*HACK: Use recv() to block until the reduction data comes back*/
10810   if(-1==ptr->recv(MPI_BCAST_TAG, -1, NULL, 0, MPI_INT, MPI_COMM_WORLD))
10811     CkAbort("AMPI> MPI_Allreduce called with different values on different processors!");
10812
10813   return MPI_SUCCESS;
10814 }
10815
10816 CDECL
10817 int AMPI_Set_end_event(void)
10818 {
10819   AMPI_API("AMPI_Set_end_event");
10820   return MPI_SUCCESS;
10821 }
10822 #endif // CMK_BIGSIM_CHARM
10823
10824 #include "ampi.def.h"
10825