uint64_t MPIDI_OFI_mr_key_alloc()
{
uint64_t i;
for (i = mr_key_allocator.last_free_mr_key; i < mr_key_allocator.num_ints; i++) {
if (mr_key_allocator.bitmask[i]) {
register uint64_t val, nval;
val = mr_key_allocator.bitmask[i];
nval = 2;
MPIDI_OFI_INDEX_CALC(val, nval, 32, 0xFFFFFFFFULL);
MPIDI_OFI_INDEX_CALC(val, nval, 16, 0xFFFFULL);
MPIDI_OFI_INDEX_CALC(val, nval, 8, 0xFFULL);
MPIDI_OFI_INDEX_CALC(val, nval, 4, 0xFULL);
MPIDI_OFI_INDEX_CALC(val, nval, 2, 0x3ULL);
nval -= val & 0x1ULL;
mr_key_allocator.bitmask[i] &= ~(0x1ULL << (nval - 1));
mr_key_allocator.last_free_mr_key = i;
return i * sizeof(uint64_t) * 8 + (nval - 1);
}
if (i == mr_key_allocator.num_ints - 1) {
mr_key_allocator.num_ints += mr_key_allocator.chunk_size;
mr_key_allocator.bitmask = MPL_realloc(mr_key_allocator.bitmask,
sizeof(uint64_t) * mr_key_allocator.num_ints,
MPL_MEM_RMA);
MPIR_Assert(mr_key_allocator.bitmask);
memset(&mr_key_allocator.bitmask[i + 1], 0xFF,
sizeof(uint64_t) * mr_key_allocator.chunk_size);
}
}
return -1;
}
/* *slen is the length of the string, including the null terminator. So if the
resulting string is |foo\0bar\0|, then *slen == 8. */
static int connToStringKVS( char **buf_p, int *slen, MPIDI_PG_t *pg )
{
char *string = 0;
char *pg_idStr = (char *)pg->id; /* In the PMI/KVS space,
the pg id is a string */
char buf[MPIDI_MAX_KVS_VALUE_LEN];
int i, j, rc, mpi_errno = MPI_SUCCESS, len;
size_t vallen, curSlen;
/* Make an initial allocation of a string with an estimate of the
needed space */
len = 0;
curSlen = 10 + pg->size * 128;
string = (char *)MPL_malloc( curSlen );
/* Start with the id of the pg */
while (*pg_idStr && len < curSlen)
string[len++] = *pg_idStr++;
string[len++] = 0;
/* Add the size of the pg */
MPL_snprintf( &string[len], curSlen - len, "%d", pg->size );
while (string[len]) len++;
len++;
for (i=0; i<pg->size; i++) {
rc = getConnInfoKVS( i, buf, MPIDI_MAX_KVS_VALUE_LEN, pg );
if (rc) {
MPL_internal_error_printf(
"Panic: getConnInfoKVS failed for %s (rc=%d)\n",
(char *)pg->id, rc );
}
#ifndef USE_PERSISTENT_SHARED_MEMORY
/* FIXME: This is a hack to avoid including shared-memory
queue names in the business card that may be used
by processes that were not part of the same COMM_WORLD.
To fix this, the shared memory channels should look at the
returned connection info and decide whether to use
sockets or shared memory by determining whether the
process is in the same MPI_COMM_WORLD. */
/* FIXME: The more general problem is that the connection information
needs to include some information on the range of validity (e.g.,
all processes, same comm world, particular ranks), and that
representation needs to be scalable */
/* printf( "Adding key %s value %s\n", key, val ); */
{
char *p = strstr( buf, "$shm_host" );
if (p) p[1] = 0;
/* printf( "(fixed) Adding key %s value %s\n", key, val ); */
}
#endif
/* Add the information to the output buffer */
vallen = strlen(buf);
/* Check that this will fix in the remaining space */
if (len + vallen + 1 >= curSlen) {
char *nstring = 0;
curSlen += (pg->size - i) * (vallen + 1 );
nstring = MPL_realloc( string, curSlen );
if (!nstring) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**nomem");
}
string = nstring;
}
/* Append to string */
for (j=0; j<vallen+1; j++) {
string[len++] = buf[j];
}
}
MPIR_Assert(len <= curSlen);
*buf_p = string;
*slen = len;
fn_exit:
return mpi_errno;
fn_fail:
if (string) MPL_free(string);
goto fn_exit;
}
/* MPIR_Find_local -- from the list of processes in comm,
* builds a list of local processes, i.e., processes on this same node.
*
* Note that this will not work correctly for spawned or attached
* processes.
*
* OUT:
* local_size_p - number of processes on this node.
* local_rank_p - rank of this processes among local processes.
* local_ranks_p - (*local_ranks_p)[i] = the rank in comm
* of the process with local rank i.
* This is of size (*local_size_p).
* intranode_table_p - (*intranode_table_p)[i] = the rank in
* (optional) *local_ranks_p of rank i in comm or -1 if not
* applicable. It is of size comm->remote_size.
* No return if NULL is specified.
*/
int MPIR_Find_local(MPIR_Comm * comm, int *local_size_p, int *local_rank_p,
int **local_ranks_p, int **intranode_table_p)
{
int mpi_errno = MPI_SUCCESS;
int i, local_size, local_rank;
int *local_ranks = NULL, *intranode_table = NULL;
int node_id = -1, my_node_id = -1;
MPIR_CHKPMEM_DECL(2);
/* local_ranks will be realloc'ed later to the appropriate size (currently unknown) */
/* FIXME: realloc doesn't guarantee that the allocated area will be
* shrunk - so using realloc is not an appropriate strategy. */
MPIR_CHKPMEM_MALLOC(local_ranks, int *, sizeof(int) * comm->remote_size, mpi_errno,
"local_ranks", MPL_MEM_COMM);
MPIR_CHKPMEM_MALLOC(intranode_table, int *, sizeof(int) * comm->remote_size, mpi_errno,
"intranode_table", MPL_MEM_COMM);
for (i = 0; i < comm->remote_size; ++i)
intranode_table[i] = -1;
mpi_errno = MPID_Get_node_id(comm, comm->rank, &my_node_id);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_Assert(my_node_id >= 0);
local_size = 0;
local_rank = -1;
/* Scan through the list of processes in comm. */
for (i = 0; i < comm->remote_size; ++i) {
mpi_errno = MPID_Get_node_id(comm, i, &node_id);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* The upper level can catch this non-fatal error and should be
* able to recover gracefully. */
MPIR_ERR_CHKANDJUMP(node_id < 0, mpi_errno, MPI_ERR_OTHER, "**dynamic_node_ids");
/* build list of local processes */
if (node_id == my_node_id) {
if (i == comm->rank)
local_rank = local_size;
intranode_table[i] = local_size;
local_ranks[local_size] = i;
++local_size;
}
}
#ifdef ENABLE_DEBUG
printf("------------------------------------------------------------------------\n");
printf("[%d]comm = %p\n", comm->rank, comm);
printf("[%d]comm->size = %d\n", comm->rank, comm->remote_size);
printf("[%d]comm->rank = %d\n", comm->rank, comm->rank);
printf("[%d]local_size = %d\n", comm->rank, local_size);
printf("[%d]local_rank = %d\n", comm->rank, local_rank);
printf("[%d]local_ranks = %p\n", comm->rank, local_ranks);
for (i = 0; i < local_size; ++i)
printf("[%d] local_ranks[%d] = %d\n", comm->rank, i, local_ranks[i]);
printf("[%d]intranode_table = %p\n", comm->rank, intranode_table);
for (i = 0; i < comm->remote_size; ++i)
printf("[%d] intranode_table[%d] = %d\n", comm->rank, i, intranode_table[i]);
#endif
MPIR_CHKPMEM_COMMIT();
*local_size_p = local_size;
*local_rank_p = local_rank;
*local_ranks_p = MPL_realloc(local_ranks, sizeof(int) * local_size, MPL_MEM_COMM);
MPIR_ERR_CHKANDJUMP(*local_ranks_p == NULL, mpi_errno, MPI_ERR_OTHER, "**nomem2");
if (intranode_table_p)
*intranode_table_p = intranode_table; /* no need to realloc */
else
MPL_free(intranode_table); /* free internally if caller passes NULL */
fn_exit:
return mpi_errno;
fn_fail:
MPIR_CHKPMEM_REAP();
goto fn_exit;
}
/* MPIR_Find_external -- from the list of processes in comm,
* builds a list of external processes, i.e., one process from each node.
* You can think of this as the root or master process for each node.
*
* Note that this will not work correctly for spawned or attached
* processes.
*
* OUT:
* external_size_p - number of external processes
* external_rank_p - rank of this process among the external
* processes, or -1 if this process is not external
* external_ranks_p - (*external_ranks_p)[i] = the rank in comm
* of the process with external rank i.
* This is of size (*external_size_p)
* internode_table_p - (*internode_table_p)[i] = the rank in
* (optional) *external_ranks_p of the root of the node
* containing rank i in comm. It is of size
* comm->remote_size. No return if NULL is specified.
*/
int MPIR_Find_external(MPIR_Comm * comm, int *external_size_p, int *external_rank_p,
int **external_ranks_p, int **internode_table_p)
{
int mpi_errno = MPI_SUCCESS;
int *nodes;
int i, external_size, external_rank;
int *external_ranks, *internode_table;
int max_node_id, node_id;
MPIR_CHKLMEM_DECL(1);
MPIR_CHKPMEM_DECL(2);
/* Scan through the list of processes in comm and add one
* process from each node to the list of "external" processes. We
* add the first process we find from each node. nodes[] is an
* array where we keep track of whether we have already added that
* node to the list. */
/* external_ranks will be realloc'ed later to the appropriate size (currently unknown) */
/* FIXME: realloc doesn't guarantee that the allocated area will be
* shrunk - so using realloc is not an appropriate strategy. */
MPIR_CHKPMEM_MALLOC(external_ranks, int *, sizeof(int) * comm->remote_size, mpi_errno,
"external_ranks", MPL_MEM_COMM);
MPIR_CHKPMEM_MALLOC(internode_table, int *, sizeof(int) * comm->remote_size, mpi_errno,
"internode_table", MPL_MEM_COMM);
mpi_errno = MPID_Get_max_node_id(comm, &max_node_id);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIR_Assert(max_node_id >= 0);
MPIR_CHKLMEM_MALLOC(nodes, int *, sizeof(int) * (max_node_id + 1), mpi_errno, "nodes",
MPL_MEM_COMM);
/* nodes maps node_id to rank in external_ranks of leader for that node */
for (i = 0; i < (max_node_id + 1); ++i)
nodes[i] = -1;
external_size = 0;
external_rank = -1;
for (i = 0; i < comm->remote_size; ++i) {
mpi_errno = MPID_Get_node_id(comm, i, &node_id);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* The upper level can catch this non-fatal error and should be
* able to recover gracefully. */
MPIR_ERR_CHKANDJUMP(node_id < 0, mpi_errno, MPI_ERR_OTHER, "**dynamic_node_ids");
MPIR_Assert(node_id <= max_node_id);
/* build list of external processes */
if (nodes[node_id] == -1) {
if (i == comm->rank)
external_rank = external_size;
nodes[node_id] = external_size;
external_ranks[external_size] = i;
++external_size;
}
/* build the map from rank in comm to rank in external_ranks */
internode_table[i] = nodes[node_id];
}
#ifdef ENABLE_DEBUG
printf("------------------------------------------------------------------------\n");
printf("[%d]comm = %p\n", comm->rank, comm);
printf("[%d]comm->size = %d\n", comm->rank, comm->remote_size);
printf("[%d]comm->rank = %d\n", comm->rank, comm->rank);
printf("[%d]external_size = %d\n", comm->rank, external_size);
printf("[%d]external_rank = %d\n", comm->rank, external_rank);
printf("[%d]external_ranks = %p\n", comm->rank, external_ranks);
for (i = 0; i < external_size; ++i)
printf("[%d] external_ranks[%d] = %d\n", comm->rank, i, external_ranks[i]);
printf("[%d]internode_table = %p\n", comm->rank, internode_table);
for (i = 0; i < comm->remote_size; ++i)
printf("[%d] internode_table[%d] = %d\n", comm->rank, i, internode_table[i]);
printf("[%d]nodes = %p\n", comm->rank, nodes);
for (i = 0; i < (max_node_id + 1); ++i)
printf("[%d] nodes[%d] = %d\n", comm->rank, i, nodes[i]);
#endif
MPIR_CHKPMEM_COMMIT();
*external_size_p = external_size;
*external_rank_p = external_rank;
*external_ranks_p = MPL_realloc(external_ranks, sizeof(int) * external_size, MPL_MEM_COMM);
MPIR_ERR_CHKANDJUMP(*external_ranks_p == NULL, mpi_errno, MPI_ERR_OTHER, "**nomem2");
if (internode_table_p)
*internode_table_p = internode_table; /* no need to realloc */
else
MPL_free(internode_table); /* free internally if caller passes NULL */
fn_exit:
MPIR_CHKLMEM_FREEALL();
return mpi_errno;
fn_fail:
MPIR_CHKPMEM_REAP();
goto fn_exit;
}
int MPIR_Comm_spawn_multiple_c(int count, char *array_of_commands_f,
char *array_of_argv_f, const int *array_of_maxprocs,
const MPI_Info * array_of_info, int root, MPI_Comm comm,
MPI_Comm * intercomm, int *array_of_errcodes,
int commands_elem_len, int argv_elem_len)
{
int mpi_errno = MPI_SUCCESS;
char **array_of_commands_c = NULL;
char ***array_of_argv_c = NULL;
int i, j, offset, len, terminate;
char *buf, *newbuf;
/* array_of_commands_f in Fortran has type CHARACTER(LEN=*), INTENT(IN) :: array_of_commands(*).
* It contains commands array_of_commands(1), ..., array_of_commands(count). Each is a Fortran
* string of length commands_elem_len, which equals to len(array_of_commands).
*
* We need to convert array_of_commands_f into array_of_commands_c, which in C has type
* char* array_of_commands_c[count], in other words, each element is a pointer to string.
*/
mpi_errno = MPIR_Fortran_array_of_string_f2c(array_of_commands_f, &array_of_commands_c,
commands_elem_len,
1 /* size of array_of_commands_f is known */ ,
count);
if (mpi_errno != MPI_SUCCESS)
goto fn_fail;
/* array_of_argv_f in Fortran has type CHARACTER(LEN=*), INTENT(IN) :: array_of_argv(count, *).
* For a particular command number K (in the range 1..count), array_of_argv (K, 1) is the first
* argument, array_of_argv(K,2) is the second argument, ... etc., until you get to array_of_argv(K,J)
* being a string of all blank characters. That indicates that command K has J-1 arguments.
* The value of J might be different from each command, but the size of the second dimension of
* array_of_argv is the largest value of J for all the commands. The actual memory layout of
* the array is (arg1 for command 1) (arg1 for command 2) ... (arg1 for command COUNT)
* (arg2 for command 1) ...
*
* We need to convert array_of_argv_f into array_of_argv_c, which in C has type
* char** array_of_argv_c[count], with each element pointing to an array of pointers.
* For example, array_of_argv_c[0] points to an array of pointers to string.
* array_of_argv_c[0][0] points to 1st arg of command 0. array_of_argv_c[0][0] points
* to 2nd arg of command 0, etc. If array_of_argv_c[0][J] is NULL, then command 0
* has J args.
*/
if ((char ***) array_of_argv_f == MPI_ARGVS_NULL) {
array_of_argv_c = MPI_ARGVS_NULL;
} else {
array_of_argv_c = (char ***) MPL_malloc(sizeof(char **) * count, MPL_MEM_BUFFER);
if (!array_of_argv_c)
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
/* Allocate a temp buf to put args of a command */
len = 256; /* length of buf. Initialized with an arbitrary value */
buf = (char *) MPL_malloc(sizeof(char) * len, MPL_MEM_BUFFER);
if (!buf)
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
for (i = 0; i < count; i++) {
/* Extract args of command i, and put them in buf */
char *arg;
offset = 0; /* offset in bytes in buf to put next arg */
arg = array_of_argv_f + argv_elem_len * i; /* Point to 1st arg of command i */
do {
if (offset + argv_elem_len > len) { /* Make sure buf is big enough */
len = offset + argv_elem_len;
newbuf = (char *) MPL_realloc(buf, len, MPL_MEM_BUFFER);
if (!newbuf) {
MPL_free(buf);
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**nomem");
}
buf = newbuf;
}
/* Check if arg is a terminating blank string */
j = 0;
while (arg[j] == ' ' && j < argv_elem_len)
j++;
terminate = (j == argv_elem_len);
strncpy(buf + offset, arg, argv_elem_len); /* Copy it even it is all blank */
arg += argv_elem_len * count; /* Move to next arg of command i */
offset += argv_elem_len;
} while (!terminate);
/* Convert the args into C style. We indicate we don't know the count of strings so
* that a NULL pointer will be appended at the end.
*/
mpi_errno =
MPIR_Fortran_array_of_string_f2c(buf, &(array_of_argv_c[i]), argv_elem_len, 0, 0);
if (mpi_errno != MPI_SUCCESS) {
for (j = i - 1; j >= 0; j--)
MPL_free(array_of_argv_c[j]);
MPL_free(buf);
goto fn_fail;
}
}
MPL_free(buf);
}
mpi_errno = PMPI_Comm_spawn_multiple(count, array_of_commands_c, array_of_argv_c,
array_of_maxprocs, array_of_info, root, comm, intercomm,
array_of_errcodes);
MPL_free(array_of_commands_c);
if (array_of_argv_c != MPI_ARGVS_NULL) {
for (i = 0; i < count; i++)
MPL_free(array_of_argv_c[i]);
MPL_free(array_of_argv_c);
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
