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