/* -*- Mode: C; c-basic-offset:4 ; -*- */ /* * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana * University Research and Technology * Corporation. All rights reserved. * Copyright (c) 2004-2007 The University of Tennessee and The University * of Tennessee Research Foundation. All rights * reserved. * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, * University of Stuttgart. All rights reserved. * Copyright (c) 2004-2005 The Regents of the University of California. * All rights reserved. * Copyright (c) 2007-2012 Cisco Systems, Inc. All rights reserved. * Copyright (c) 2009 Sun Microsystems, Inc. All rights reserved. * Copyright (c) 2012 Los Alamos National Security, LLC. * All rights reserved. * $COPYRIGHT$ * * Additional copyrights may follow * * $HEADER$ */ #include "ompi_config.h" #include "ompi/constants.h" #ifdef HAVE_STRING_H #include #endif #include #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #include #include #ifdef HAVE_SYS_UTSNAME_H #include #endif #include #include "opal/util/argv.h" #include "opal/util/opal_getcwd.h" #include "opal/util/output.h" #include "opal/util/strncpy.h" #include "ompi/info/info.h" #include "ompi/runtime/mpiruntime.h" #include "ompi/runtime/params.h" /* * Global variables */ ompi_predefined_info_t ompi_mpi_info_null; ompi_predefined_info_t *ompi_mpi_info_null_addr = &ompi_mpi_info_null; ompi_predefined_info_t ompi_mpi_info_env; /* * Local functions */ static void info_constructor(ompi_info_t *info); static void info_destructor(ompi_info_t *info); static void info_entry_constructor(ompi_info_entry_t *entry); static void info_entry_destructor(ompi_info_entry_t *entry); static ompi_info_entry_t *info_find_key (ompi_info_t *info, char *key); /* * ompi_info_t classes */ OBJ_CLASS_INSTANCE(ompi_info_t, opal_list_t, info_constructor, info_destructor); /* * ompi_info_entry_t classes */ OBJ_CLASS_INSTANCE(ompi_info_entry_t, opal_list_item_t, info_entry_constructor, info_entry_destructor); /* * The global fortran <-> C translation table */ opal_pointer_array_t ompi_info_f_to_c_table; /* * This function is called during ompi_init and initializes the * fortran to C translation table. It also fills in the values * for the MPI_INFO_GET_ENV object */ int ompi_info_init(void) { char val[MPI_MAX_INFO_VAL]; char *cptr; /* initialize table */ OBJ_CONSTRUCT(&ompi_info_f_to_c_table, opal_pointer_array_t); if( OPAL_SUCCESS != opal_pointer_array_init(&ompi_info_f_to_c_table, 0, OMPI_FORTRAN_HANDLE_MAX, 64) ) { return OMPI_ERROR; } /* Create MPI_INFO_NULL */ OBJ_CONSTRUCT(&ompi_mpi_info_null.info, ompi_info_t); assert(ompi_mpi_info_null.info.i_f_to_c_index == 0); /* Create MPI_INFO_ENV */ OBJ_CONSTRUCT(&ompi_mpi_info_env.info, ompi_info_t); assert(ompi_mpi_info_env.info.i_f_to_c_index == 1); /* fill the env info object */ /* command for this app_context */ if (NULL != (cptr = getenv("OMPI_COMMAND"))) { ompi_info_set(&ompi_mpi_info_env.info, "command", cptr); } /* space-separated list of argv for this command */ if (NULL != (cptr = getenv("OMPI_ARGV"))) { ompi_info_set(&ompi_mpi_info_env.info, "argv", cptr); } /* max procs for the entire job */ if (NULL != (cptr = getenv("OMPI_MCA_orte_ess_num_procs"))) { ompi_info_set(&ompi_mpi_info_env.info, "maxprocs", cptr); /* Open MPI does not support the "soft" option, so set it to maxprocs */ ompi_info_set(&ompi_mpi_info_env.info, "soft", cptr); } /* local host name */ gethostname(val, MPI_MAX_INFO_VAL); ompi_info_set(&ompi_mpi_info_env.info, "host", val); /* architecture name */ if (NULL != (cptr = getenv("OMPI_MCA_orte_cpu_type"))) { ompi_info_set(&ompi_mpi_info_env.info, "arch", cptr); } #ifdef HAVE_SYS_UTSNAME_H else { struct utsname sysname; uname(&sysname); cptr = sysname.machine; ompi_info_set(&ompi_mpi_info_env.info, "arch", cptr); } #endif /* initial working dir of this process - only set when * run by mpiexec as we otherwise have no reliable way * of determining the value */ if (NULL != (cptr = getenv("OMPI_MCA_initial_wdir"))) { ompi_info_set(&ompi_mpi_info_env.info, "wdir", cptr); } /* provide the REQUESTED thread level - may be different * than the ACTUAL thread level you get. * ugly, but have to do a switch to find the string representation */ switch (ompi_mpi_thread_requested) { case MPI_THREAD_SINGLE: ompi_info_set(&ompi_mpi_info_env.info, "thread_level", "MPI_THREAD_SINGLE"); break; case MPI_THREAD_FUNNELED: ompi_info_set(&ompi_mpi_info_env.info, "thread_level", "MPI_THREAD_FUNNELED"); break; case MPI_THREAD_SERIALIZED: ompi_info_set(&ompi_mpi_info_env.info, "thread_level", "MPI_THREAD_SERIALIZED"); break; case MPI_THREAD_MULTIPLE: ompi_info_set(&ompi_mpi_info_env.info, "thread_level", "MPI_THREAD_MULTIPLE"); break; default: /* do nothing - don't know the value */ break; } /**** now some OMPI-specific values that other MPIs may not provide ****/ /* the number of app_contexts in this job */ if (NULL != (cptr = getenv("OMPI_NUM_APP_CTX"))) { ompi_info_set(&ompi_mpi_info_env.info, "ompi_num_apps", cptr); } /* space-separated list of first MPI rank of each app_context */ if (NULL != (cptr = getenv("OMPI_FIRST_RANKS"))) { ompi_info_set(&ompi_mpi_info_env.info, "ompi_first_rank", cptr); } /* space-separated list of num procs for each app_context */ if (NULL != (cptr = getenv("OMPI_APP_CTX_NUM_PROCS"))) { ompi_info_set(&ompi_mpi_info_env.info, "ompi_np", cptr); } /* location of the directory containing any prepositioned files * the user may have requested */ if (NULL != (cptr = getenv("OMPI_FILE_LOCATION"))) { ompi_info_set(&ompi_mpi_info_env.info, "ompi_positioned_file_dir", cptr); } /* All done */ return OMPI_SUCCESS; } /* * Duplicate an info */ int ompi_info_dup (ompi_info_t *info, ompi_info_t **newinfo) { int err; opal_list_item_t *item; ompi_info_entry_t *iterator; OPAL_THREAD_LOCK(info->i_lock); for (item = opal_list_get_first(&(info->super)); item != opal_list_get_end(&(info->super)); item = opal_list_get_next(iterator)) { iterator = (ompi_info_entry_t *) item; err = ompi_info_set(*newinfo, iterator->ie_key, iterator->ie_value); if (MPI_SUCCESS != err) { OPAL_THREAD_UNLOCK(info->i_lock); return err; } } OPAL_THREAD_UNLOCK(info->i_lock); return MPI_SUCCESS; } /* * Set a value on the info */ int ompi_info_set (ompi_info_t *info, char *key, char *value) { char *new_value; ompi_info_entry_t *new_info; ompi_info_entry_t *old_info; new_value = strdup(value); if (NULL == new_value) { return MPI_ERR_NO_MEM; } OPAL_THREAD_LOCK(info->i_lock); old_info = info_find_key (info, key); if (NULL != old_info) { /* * key already exists. remove the value associated with it */ free(old_info->ie_value); old_info->ie_value = new_value; } else { new_info = OBJ_NEW(ompi_info_entry_t); if (NULL == new_info) { OPAL_THREAD_UNLOCK(info->i_lock); return MPI_ERR_NO_MEM; } strncpy (new_info->ie_key, key, MPI_MAX_INFO_KEY); new_info->ie_value = new_value; opal_list_append (&(info->super), (opal_list_item_t *) new_info); } OPAL_THREAD_UNLOCK(info->i_lock); return MPI_SUCCESS; } /* * Free an info handle and all of its keys and values. */ int ompi_info_free (ompi_info_t **info) { (*info)->i_freed = true; OBJ_RELEASE(*info); *info = MPI_INFO_NULL; return MPI_SUCCESS; } /* * Get a value from an info */ int ompi_info_get (ompi_info_t *info, char *key, int valuelen, char *value, int *flag) { ompi_info_entry_t *search; int value_length; OPAL_THREAD_LOCK(info->i_lock); search = info_find_key (info, key); if (NULL == search){ *flag = 0; } else { /* * We have found the element, so we can return the value * Set the flag, value_length and value */ *flag = 1; value_length = strlen(search->ie_value); /* * If the stored value is shorter than valuelen, then * we can copy the entire value out. Else, we have to * copy ONLY valuelen bytes out */ if (value_length < valuelen ) { strcpy(value, search->ie_value); } else { opal_strncpy(value, search->ie_value, valuelen); if (MPI_MAX_INFO_VAL == valuelen) { value[valuelen-1] = 0; } else { value[valuelen] = 0; } } } OPAL_THREAD_UNLOCK(info->i_lock); return MPI_SUCCESS; } /* * Similar to ompi_info_get(), but cast the result into a boolean * using some well-defined rules. */ int ompi_info_get_bool(ompi_info_t *info, char *key, bool *value, int *flag) { char *ptr; char str[256]; str[sizeof(str) - 1] = '\0'; ompi_info_get(info, key, sizeof(str) - 1, str, flag); if (*flag) { *value = false; /* Trim whitespace */ ptr = str + sizeof(str) - 1; while (ptr >= str && isspace(*ptr)) { *ptr = '\0'; --ptr; } ptr = str; while (ptr < str + sizeof(str) - 1 && *ptr != '\0' && isspace(*ptr)) { ++ptr; } if ('\0' != *ptr) { if (isdigit(*ptr)) { *value = (bool) atoi(ptr); } else if (0 == strcasecmp(ptr, "yes") || 0 == strcasecmp(ptr, "true")) { *value = true; } else if (0 != strcasecmp(ptr, "no") && 0 != strcasecmp(ptr, "false")) { /* RHC unrecognized value -- print a warning? */ } } } return MPI_SUCCESS; } /* * Delete a key from an info */ int ompi_info_delete (ompi_info_t *info, char *key) { ompi_info_entry_t *search; OPAL_THREAD_LOCK(info->i_lock); search = info_find_key (info, key); if (NULL == search){ OPAL_THREAD_UNLOCK(info->i_lock); return MPI_ERR_INFO_NOKEY; } else { /* * An entry with this key value was found. Remove the item * and free the memory allocated to it. * As this key *must* be available, we do not check for errors. */ opal_list_remove_item (&(info->super), (opal_list_item_t *)search); OBJ_RELEASE(search); } OPAL_THREAD_UNLOCK(info->i_lock); return MPI_SUCCESS; } /* * Return the length of a value */ int ompi_info_get_valuelen (ompi_info_t *info, char *key, int *valuelen, int *flag) { ompi_info_entry_t *search; OPAL_THREAD_LOCK(info->i_lock); search = info_find_key (info, key); if (NULL == search){ *flag = 0; } else { /* * We have found the element, so we can return the value * Set the flag, value_length and value */ *flag = 1; *valuelen = strlen(search->ie_value); } OPAL_THREAD_UNLOCK(info->i_lock); return MPI_SUCCESS; } /* * Get the nth key */ int ompi_info_get_nthkey (ompi_info_t *info, int n, char *key) { ompi_info_entry_t *iterator; /* * Iterate over and over till we get to the nth key */ OPAL_THREAD_LOCK(info->i_lock); for (iterator = (ompi_info_entry_t *)opal_list_get_first(&(info->super)); n > 0; --n) { iterator = (ompi_info_entry_t *)opal_list_get_next(iterator); if (opal_list_get_end(&(info->super)) == (opal_list_item_t *) iterator) { OPAL_THREAD_UNLOCK(info->i_lock); return MPI_ERR_ARG; } } /* * iterator is of the type opal_list_item_t. We have to * cast it to ompi_info_entry_t before we can use it to * access the value */ strncpy(key, iterator->ie_key, MPI_MAX_INFO_KEY); OPAL_THREAD_UNLOCK(info->i_lock); return MPI_SUCCESS; } /* * Shut down MPI_Info handling */ int ompi_info_finalize(void) { size_t i, max; ompi_info_t *info; opal_list_item_t *item; ompi_info_entry_t *entry; bool found = false; /* Release MPI_INFO_NULL. Do this so that we don't get a bogus leak report on it. Plus, it's statically allocated, so we don't want to call OBJ_RELEASE on it. */ OBJ_DESTRUCT(&ompi_mpi_info_null.info); opal_pointer_array_set_item(&ompi_info_f_to_c_table, 0, NULL); /* ditto for MPI_INFO_GET_ENV */ OBJ_DESTRUCT(&ompi_mpi_info_env.info); opal_pointer_array_set_item(&ompi_info_f_to_c_table, 1, NULL); /* Go through the f2c table and see if anything is left. Free them all. */ max = opal_pointer_array_get_size(&ompi_info_f_to_c_table); for (i = 2; i < max; ++i) { info = (ompi_info_t *)opal_pointer_array_get_item(&ompi_info_f_to_c_table, i); /* If the info was freed but still exists because the user told us to never free handles, then do an OBJ_RELEASE it and all is well. Then get the value again and see if it's actually been freed. */ if (NULL != info && ompi_debug_no_free_handles && info->i_freed) { OBJ_RELEASE(info); info = (ompi_info_t *)opal_pointer_array_get_item(&ompi_info_f_to_c_table, i); } /* If it still exists here and was never freed, then it's an orphan */ if (NULL != info) { /* If the user wanted warnings about MPI object leaks, print out a message */ if (!info->i_freed && ompi_debug_show_handle_leaks) { if (ompi_debug_show_handle_leaks) { opal_output(0, "WARNING: MPI_Info still allocated at MPI_FINALIZE"); for (item = opal_list_get_first(&(info->super)); opal_list_get_end(&(info->super)) != item; item = opal_list_get_next(item)) { entry = (ompi_info_entry_t *) item; opal_output(0, "WARNING: key=\"%s\", value=\"%s\"", entry->ie_key, NULL != entry->ie_value ? entry->ie_value : "(null)"); found = true; } } OBJ_RELEASE(info); } /* Don't bother setting each element back down to NULL; it would just take a lot of thread locks / unlocks and since we're destroying everything, it isn't worth it */ if (!found && ompi_debug_show_handle_leaks) { opal_output(0, "WARNING: (no keys)"); } } } /* All done -- destroy the table */ OBJ_DESTRUCT(&ompi_info_f_to_c_table); return OMPI_SUCCESS; } /* * This function is invoked when OBJ_NEW() is called. Here, we add this * info pointer to the table and then store its index as the handle */ static void info_constructor(ompi_info_t *info) { info->i_f_to_c_index = opal_pointer_array_add(&ompi_info_f_to_c_table, info); info->i_lock = OBJ_NEW(opal_mutex_t); info->i_freed = false; /* If the user doesn't want us to ever free it, then add an extra RETAIN here */ if (ompi_debug_no_free_handles) { OBJ_RETAIN(&(info->super)); } } /* * This function is called during OBJ_DESTRUCT of "info". When this * done, we need to remove the entry from the ompi fortran to C * translation table */ static void info_destructor(ompi_info_t *info) { opal_list_item_t *item; ompi_info_entry_t *iterator; /* Remove every key in the list */ for (item = opal_list_remove_first(&(info->super)); NULL != item; item = opal_list_remove_first(&(info->super))) { iterator = (ompi_info_entry_t *) item; OBJ_RELEASE(iterator); } /* reset the &ompi_info_f_to_c_table entry - make sure that the entry is in the table */ if (MPI_UNDEFINED != info->i_f_to_c_index && NULL != opal_pointer_array_get_item(&ompi_info_f_to_c_table, info->i_f_to_c_index)){ opal_pointer_array_set_item(&ompi_info_f_to_c_table, info->i_f_to_c_index, NULL); } /* Release the lock */ OBJ_RELEASE(info->i_lock); } /* * ompi_info_entry_t interface functions */ static void info_entry_constructor(ompi_info_entry_t *entry) { memset(entry->ie_key, 0, sizeof(entry->ie_key)); entry->ie_key[MPI_MAX_INFO_KEY] = 0; } static void info_entry_destructor(ompi_info_entry_t *entry) { if (NULL != entry->ie_value) { free(entry->ie_value); } } /* * Find a key * * Do NOT thread lock in here -- the calling function is responsible * for that. */ static ompi_info_entry_t *info_find_key (ompi_info_t *info, char *key) { ompi_info_entry_t *iterator; /* No thread locking in here! */ /* Iterate over all the entries. If the key is found, then * return immediately. Else, the loop will fall of the edge * and NULL is returned */ for (iterator = (ompi_info_entry_t *)opal_list_get_first(&(info->super)); opal_list_get_end(&(info->super)) != (opal_list_item_t*) iterator; iterator = (ompi_info_entry_t *)opal_list_get_next(iterator)) { if (0 == strcmp(key, iterator->ie_key)) { return iterator; } } return NULL; } int ompi_info_value_to_int(char *value, int *interp) { long tmp; char *endp; if (NULL == value || '\0' == value[0]) return OMPI_ERR_BAD_PARAM; errno = 0; tmp = strtol(value, &endp, 10); /* we found something not a number */ if (*endp != '\0') return OMPI_ERR_BAD_PARAM; /* underflow */ if (tmp == 0 && errno == EINVAL) return OMPI_ERR_BAD_PARAM; *interp = (int) tmp; return OMPI_SUCCESS; } int ompi_info_value_to_bool(char *value, bool *interp) { int tmp; /* idiot case */ if (NULL == value || NULL == interp) return OMPI_ERR_BAD_PARAM; /* is it true / false? */ if (0 == strcmp(value, "true")) { *interp = true; return OMPI_SUCCESS; } else if (0 == strcmp(value, "false")) { *interp = false; return OMPI_SUCCESS; /* is it a number? */ } else if (OMPI_SUCCESS == ompi_info_value_to_int(value, &tmp)) { if (tmp == 0) { *interp = false; } else { *interp = true; } return OMPI_SUCCESS; } return OMPI_ERR_BAD_PARAM; }