ompi/debuggers/ompi_msgq

/* [<][>][^][v][top][bottom][index][help] */
This source file includes following definitions.
mqs_setup_basic_callbacks
mqs_version_compatibility
mqs_version_string
mqs_dll_taddr_width
translate
find_or_create_group
group_decref
mqs_setup_image
mqs_image_has_queues
mqs_setup_process
mqs_process_has_queues
communicators_changed
find_communicator
compare_comms
rebuild_communicator_list
mqs_update_communicator_list
mqs_setup_communicator_iterator
mqs_get_communicator
mqs_get_comm_group
mqs_next_communicator
opal_list_t_init_parser
next_item_opal_list_t
opal_free_list_t_dump_position
opal_free_list_t_init_parser
opal_free_list_t_next_item
dump_request
fetch_request
mqs_setup_operation_iterator
mqs_next_operation
mqs_destroy_process_info
mqs_destroy_image_info
mqs_dll_error_string
   1 /* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */
   2 /*
   3  * Copyright (c) 2007-2018 Cisco Systems, Inc.  All rights reserved.
   4  * Copyright (c) 2004-2010 The University of Tennessee and The University
   5  *                         of Tennessee Research Foundation.  All rights
   6  *                         reserved.
   7  * Copyright (c) 2008-2009 Sun Microsystems, Inc.  All rights reserved.
   8  * Copyright (c) 2015      Los Alamos National Security, LLC.  All rights
   9  *                         reserved.
  10  * Copyright (c) 2016      Intel, Inc. All rights reserved.
  11  * Copyright (c) 2016      Research Organization for Information Science
  12  *                         and Technology (RIST). All rights reserved.
  13  * $COPYRIGHT$
  14  *
  15  * Additional copyrights may follow
  16  *
  17  * $HEADER$
  18  */
  19 
  20 /**********************************************************************
  21  * Copyright (C) 2000-2004 by Etnus, LLC.
  22  * Copyright (C) 1999 by Etnus, Inc.
  23  * Copyright (C) 1997-1998 Dolphin Interconnect Solutions Inc.
  24  *
  25  * Permission is hereby granted to use, reproduce, prepare derivative
  26  * works, and to redistribute to others.
  27  *
  28  *                                DISCLAIMER
  29  *
  30  * Neither Dolphin Interconnect Solutions, Etnus LLC, nor any of their
  31  * employees, makes any warranty express or implied, or assumes any
  32  * legal liability or responsibility for the accuracy, completeness,
  33  * or usefulness of any information, apparatus, product, or process
  34  * disclosed, or represents that its use would not infringe privately
  35  * owned rights.
  36  *
  37  * This code was written by
  38  * James Cownie: Dolphin Interconnect Solutions. <jcownie@dolphinics.com>
  39  *               Etnus LLC <jcownie@etnus.com>
  40  **********************************************************************/
  41 
  42 /* Update log
  43  *
  44  * Jul 12 2001 FNW: Add a meaningful ID to the communicator name, and switch
  45  *                  to using the recv_context as the unique_id field.
  46  * Mar  6 2001 JHC: Add mqs_get_comm_group to allow a debugger to acquire
  47  *                  processes less eagerly.
  48  * Dec 13 2000 JHC: totalview/2514: Modify image_has_queues to return
  49  *                  a silent FALSE if none of the expected data is
  50  *                  present. This way you won't get complaints when
  51  *                  you try this on non MPICH processes.
  52  * Sep  8 2000 JVD: #include <string.h> to silence Linux Alpha compiler warnings.
  53  * Mar 21 2000 JHC: Add the new entrypoint mqs_dll_taddr_width
  54  * Nov 26 1998 JHC: Fix the problem that we weren't handling
  55  *                  MPIR_Ignore_queues properly.
  56  * Oct 22 1998 JHC: Fix a zero allocation problem
  57  * Aug 19 1998 JHC: Fix some problems in our use of target_to_host on
  58  *                  big endian machines.
  59  * May 28 1998 JHC: Use the extra information we can return to say
  60  *                  explicitly that sends are only showing non-blocking ops
  61  * May 19 1998 JHC: Changed the names of the structs and added casts
  62  *                  where needed to reflect the change to the way we handle
  63  *                  type safety across the interface.
  64  * Oct 27 1997 JHC: Created by exploding db_message_state_mpich.cxx
  65  */
  66 
  67 /*
  68    The following was added by William Gropp to improve the portability
  69    to systems with non-ANSI C compilers
  70  */
  71 
  72 #include "ompi_config.h"
  73 
  74 #ifdef HAVE_NO_C_CONST
  75 #define const
  76 #endif
  77 #include <string.h>
  78 #include <stdlib.h>
  79 
  80 /* Notice to developers!!!!
  81  * The following include files with _dbg.h suffixes contains definitions
  82  * that are shared between the debuggger plugins and the OMPI code base.
  83  * This is done instead of including the non-_dbg suffixed files because
  84  * of the different way compilers may handle extern definitions. The
  85  * particular case that is causing problems is when there is an extern
  86  * variable or function that is accessed in a static inline function.
  87  * For example, here is the code we often see in a header file.
  88  *
  89  * extern int request_complete;
  90  * static inline check_request(void) {
  91  *    request_complete = 1;
  92  * }
  93  *
  94  * If this code exists in a header file and gets included in a source
  95  * file, then some compilers expect to have request_complete defined
  96  * somewhere even if request_complete is never referenced and
  97  * check_request is never called. Other compilers do not need them defined
  98  * if they are never referenced in the source file.
  99  *
 100  * In the case of extern functions we something like the following:
 101  *
 102  * extern int foo();
 103  * static inline bar(void) {
 104  *     foo();
 105  * }
 106  *
 107  * If this code exists it actually compiles fine however an undefined symbol
 108  * is kept for foo() and in the case of some tools that load in plugins with
 109  * RTLD_NOW this undefined symbol causes the dlopen to fail since we do not
 110  * have (nor really need) the supporting library containing foo().
 111  *
 112  * Therefore, to handle cases like the above with compilers that require the
 113  * symbols (like Sun Studio) instead of  pulling in all of OMPI into the
 114  * plugins or defining dummy symbols here we separate the definitions used by
 115  * both sets of code into the _dbg.h files.
 116  *
 117  * This means if one needs to add another definition that the plugins must see
 118  * one should either move the definition into one of the existing _dbg.h file or
 119  * create a new _dbg.h file.
 120  */
 121 #include "ompi/group/group_dbg.h"
 122 #include "ompi/request/request_dbg.h"
 123 #include "ompi/mca/pml/base/pml_base_request_dbg.h"
 124 #include "mpi.h" /* needed for MPI_ANY_TAG */
 125 
 126 #include "msgq_interface.h"
 127 #include "ompi_msgq_dll_defs.h"
 128 
 129 /*
 130    End of inclusion
 131  */
 132 
 133 
 134 /* Essential macros for C */
 135 #ifndef NULL
 136 #define NULL ((void *)0)
 137 #endif
 138 #ifndef TRUE
 139 #define TRUE (0==0)
 140 #endif
 141 #ifndef FALSE
 142 #define FALSE (0==1)
 143 #endif
 144 
 145 #ifdef OLD_STYLE_CPP_CONCAT
 146 #define concat(a,b) a/**/b
 147 #define stringize(a) "a"
 148 #else
 149 #define concat(a,b) a##b
 150 #define stringize(a) #a
 151 #endif
 152 
 153 #define OPAL_ALIGN(x,a,t) (((x)+((t)(a)-1)) & ~(((t)(a)-1)))
 154 
 155 /**
 156  * The internal debugging interface.
 157  */
 158 #define VERBOSE_GENERAL  0x00000001
 159 #define VERBOSE_GROUP    0x00000002
 160 #define VERBOSE_COMM     0x00000004
 161 #define VERBOSE_LISTS    0x00000008
 162 #define VERBOSE_REQ      0x00000010
 163 #define VERBOSE_REQ_DUMP 0x00000020
 164 
 165 #define VERBOSE 0x00000000
 166 
 167 #if VERBOSE
 168 #define DEBUG(LEVEL, WHAT) if(LEVEL & VERBOSE) { printf WHAT; }
 169 #else
 170 #define DEBUG(LEVEL,WHAT)
 171 #endif  /* VERBOSE */
 172 
 173 /**********************************************************************/
 174 /* Set up the basic callbacks into the debugger */
 175 
 176 void mqs_setup_basic_callbacks (const mqs_basic_callbacks * cb)
 177 {
 178     mqs_basic_entrypoints = cb;
 179 } /* mqs_setup_callbacks */
 180 
 181 
 182 /**********************************************************************/
 183 /* Version handling functions.
 184  * This one should never be changed.
 185  */
 186 int mqs_version_compatibility (void)
 187 {
 188     return MQS_INTERFACE_COMPATIBILITY;
 189 } /* mqs_version_compatibility */
 190 
 191 static char mqs_version_str[OMPI_MAX_VER_SIZE];
 192 
 193 /* This one can say what you like */
 194 char *mqs_version_string (void)
 195 {
 196     int offset;
 197     offset = snprintf(mqs_version_str, OMPI_MAX_VER_SIZE-1,  
 198                       "Open MPI message queue support for parallel debuggers ");
 199     ompi_get_lib_version(mqs_version_str+offset, OMPI_MAX_VER_SIZE-offset);
 200     return mqs_version_str;
 201 } /* mqs_version_string */
 202 
 203 /* So the debugger can tell what interface width the library was compiled with */
 204 int mqs_dll_taddr_width (void)
 205 {
 206     return sizeof (mqs_taddr_t);
 207 } /* mqs_dll_taddr_width */
 208 
 209 /**********************************************************************/
 210 /* Functions to handle translation groups.
 211  * We have a list of these on the process info, so that we can
 212  * share the group between multiple communicators.
 213  */
 214 /**********************************************************************/
 215 /* Translate a process number */
 216 static int translate (group_t *this, int index)
 217 {
 218     if (index == MQS_INVALID_PROCESS ||
 219         ((unsigned int)index) >= ((unsigned int) this->entries))
 220         return MQS_INVALID_PROCESS;
 221     return this->local_to_global[index];
 222 } /* translate */
 223 
 224 /**********************************************************************/
 225 /* Search the group list for this group, if not found create it.
 226  */
 227 static group_t * find_or_create_group( mqs_process *proc,
 228                                        mqs_taddr_t group_base )
 229 {
 230     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
 231     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
 232     mqs_image * image        = mqs_get_image (proc);
 233     mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
 234     communicator_t *comm     = extra->communicator_list;
 235     int *tr;
 236     char *trbuffer;
 237     int i, np, is_dense;
 238     group_t *group;
 239     mqs_taddr_t value;
 240     mqs_taddr_t tablep;
 241 
 242     np = ompi_fetch_int( proc,
 243                          group_base + i_info->ompi_group_t.offset.grp_proc_count,
 244                          p_info );
 245     if( np < 0 ) {
 246         DEBUG(VERBOSE_COMM, ("Get a size for the communicator = %d\n", np));
 247         return NULL;  /* Makes no sense ! */
 248     }
 249     is_dense =
 250         ompi_fetch_int( proc,
 251                         group_base + i_info->ompi_group_t.offset.grp_flags,
 252                         p_info );
 253     is_dense = (0 != (is_dense & OMPI_GROUP_DENSE));
 254 
 255     /* Iterate over each communicator seeing if we can find this group */
 256     for (;comm; comm = comm->next) {
 257         group = comm->group;
 258         if( group && (group->group_base == group_base) ) {
 259             group->ref_count++;                 /* Someone else is interested */
 260             DEBUG(VERBOSE_GROUP, ("Increase refcount for group 0x%p to %d\n",
 261                                   (void*)group, group->ref_count) );
 262             return group;
 263         }
 264     }
 265 
 266     /* Hmm, couldn't find one, so fetch it */
 267     group = (group_t *)mqs_malloc (sizeof (group_t));
 268     tr = (int *)mqs_malloc (np*sizeof(int));
 269     trbuffer = (char *)mqs_malloc (np*sizeof(mqs_taddr_t));
 270     group->local_to_global = tr;
 271     group->group_base = group_base;
 272     DEBUG(VERBOSE_GROUP, ("Create a new group 0x%p with %d members\n",
 273                           (void*)group, np) );
 274 
 275     tablep = ompi_fetch_pointer( proc,
 276                                  group_base + i_info->ompi_group_t.offset.grp_proc_pointers,
 277                                  p_info);
 278 
 279     if( (0 != np) &&
 280         (mqs_ok != mqs_fetch_data(proc, tablep, np * p_info->sizes.pointer_size,
 281                                   trbuffer)) ) {
 282         DEBUG(VERBOSE_GROUP,("Failed to read the proc data. Destroy group %p\n",
 283                              (void*)group));
 284         mqs_free (group);
 285         mqs_free (tr);
 286         mqs_free (trbuffer);
 287         return NULL;
 288     }
 289 
 290     /**
 291      * Now convert the process representation into the local representation.
 292      * We will endup with an array of Open MPI internal pointers to proc
 293      * structure. By comparing this pointers to the MPI_COMM_WORLD group
 294      * we can figure out the global rank in the MPI_COMM_WORLD of the process.
 295      *
 296      * Note that this only works for dense groups.  Someday we may
 297      * support more than dense groups, but that's what we've got for
 298      * today.
 299      */
 300      if( NULL == extra->world_proc_array ) {
 301          extra->world_proc_array = mqs_malloc( np * sizeof(mqs_taddr_t) );
 302          for( i = 0; i < np; i++ ) {
 303              mqs_target_to_host( proc, trbuffer + p_info->sizes.pointer_size*i,
 304                                  &value, p_info->sizes.pointer_size );
 305              extra->world_proc_array[i] = value;
 306              group->local_to_global[i] = is_dense ? i : -1;
 307          }
 308          extra->world_proc_array_entries = np;
 309      } else {
 310          int j;
 311 
 312          for( i = 0; i < np; i++ ) {
 313              mqs_target_to_host( proc, trbuffer + p_info->sizes.pointer_size*i,
 314                                  &value, p_info->sizes.pointer_size );
 315              if (is_dense) {
 316                  /* get the global rank this MPI process */
 317                  for( j = 0; j < extra->world_proc_array_entries; j++ ) {
 318                      if( value == extra->world_proc_array[j] ) {
 319                          group->local_to_global[i] = j;
 320                          break;
 321                      }
 322                  }
 323              } else {
 324                  group->local_to_global[i] = -1;
 325              }
 326          }
 327      }
 328 
 329     mqs_free(trbuffer);
 330 
 331     group->entries = np;
 332     group->ref_count = 1;
 333     return group;
 334 } /* find_or_create_group */
 335 
 336 /***********************************************************************/
 337 static void group_decref (group_t * group)
 338 {
 339     DEBUG(VERBOSE_GROUP, ("Decrement reference count for group %p to %d\n", (void*)group,
 340                           (group->ref_count - 1)));
 341     if (--(group->ref_count) == 0) {
 342         mqs_free (group->local_to_global);
 343         DEBUG(VERBOSE_GROUP, ("Destroy group %p\n", (void*)group));
 344         mqs_free (group);
 345     }
 346 } /* group_decref */
 347 
 348 /***********************************************************************
 349  * Perform basic setup for the image, we just allocate and clear
 350  * our info.
 351  */
 352 int mqs_setup_image (mqs_image *image, const mqs_image_callbacks *icb)
 353 {
 354     mpi_image_info *i_info = (mpi_image_info *)mqs_malloc (sizeof (mpi_image_info));
 355 
 356     if (!i_info)
 357         return err_no_store;
 358 
 359     memset ((void *)i_info, 0, sizeof (mpi_image_info));
 360     i_info->image_callbacks = icb;              /* Before we do *ANYTHING* */
 361     i_info->extra = NULL;
 362 
 363     mqs_put_image_info (image, (mqs_image_info *)i_info);
 364 
 365     return mqs_ok;
 366 } /* mqs_setup_image */
 367 
 368 
 369 /***********************************************************************
 370  * Check for all the information we require to access the Open MPI message queues.
 371  * Stash it into our structure on the image if we're successful.
 372  */
 373 
 374 int mqs_image_has_queues (mqs_image *image, char **message)
 375 {
 376     mpi_image_info * i_info = (mpi_image_info *)mqs_get_image_info (image);
 377 
 378     i_info->extra = NULL;
 379 
 380     /* Default failure message ! */
 381     *message = "The symbols and types in the Open MPI library used by the debugger\n"
 382         "to extract the message queues are not as expected in\n"
 383         "the image '%s'\n"
 384         "No message queue display is possible.\n"
 385         "This is probably an Open MPI version or configuration problem.";
 386 
 387     /* Force in the file containing our breakpoint function, to ensure
 388      * that types have been read from there before we try to look them
 389      * up.
 390      */
 391     mqs_find_function (image, "ompi_debugger_setup_dlls", mqs_lang_c, NULL);
 392 
 393     /* Are we supposed to ignore this ? (e.g. it's really an HPF
 394      * runtime using the Open MPI process acquisition, but not wanting
 395      * queue display)
 396      */
 397     if (mqs_find_symbol (image, "MPIR_Ignore_queues", NULL) == mqs_ok) {
 398         *message = NULL;                                /* Fail silently */
 399         return err_silent_failure;
 400     }
 401 
 402     /* Fill in the type information */
 403     return ompi_fill_in_type_info(image, message);
 404 } /* mqs_image_has_queues */
 405 
 406 /***********************************************************************
 407  * Setup information needed for a specific process.
 408  * TV assumes that this will hang something onto the process,
 409  * if nothing is attached to it, then TV will believe that this process
 410  * has no message queue information.
 411  */
 412 int mqs_setup_process (mqs_process *process, const mqs_process_callbacks *pcb)
 413 {
 414     /* Extract the addresses of the global variables we need and save them away */
 415     mpi_process_info *p_info = (mpi_process_info *)mqs_malloc (sizeof (mpi_process_info));
 416 
 417     if (p_info) {
 418         mqs_image        *image;
 419         mpi_image_info   *i_info;
 420         mpi_process_info_extra *extra;
 421 
 422         p_info->process_callbacks = pcb;
 423 
 424         p_info->extra = mqs_malloc(sizeof(mpi_process_info_extra));
 425         extra = (mpi_process_info_extra*) p_info->extra;
 426 
 427         /* Now we can get the rest of the info ! */
 428         image  = mqs_get_image (process);
 429         i_info   = (mpi_image_info *)mqs_get_image_info (image);
 430 
 431         /* We have no communicators yet */
 432         extra->communicator_list = NULL;
 433         /* Enforce the generation of the communicators list */
 434         extra->comm_lowest_free  = 0;
 435         extra->comm_number_free  = 0;
 436         /* By default we don't show our internal requests*/
 437         extra->show_internal_requests = 0;
 438 
 439         extra->world_proc_array_entries = 0;
 440         extra->world_proc_array = NULL;
 441 
 442         mqs_get_type_sizes (process, &p_info->sizes);
 443         /*
 444          * Before going any further make sure we know exactly how the
 445          * Open MPI library was compiled. This means we know the size
 446          * of each of the basic types as stored in the
 447          * MPIR_debug_typedefs_sizeof array.
 448          */
 449         {
 450             mqs_taddr_t typedefs_sizeof;
 451 
 452             if (mqs_find_symbol (image, "MPIR_debug_typedefs_sizeof", &typedefs_sizeof) != mqs_ok) {
 453                 return err_no_store;
 454             }
 455             p_info->sizes.short_size = ompi_fetch_int( process, /* sizeof (short) */
 456                                                        typedefs_sizeof,
 457                                                        p_info );
 458             typedefs_sizeof += p_info->sizes.int_size;
 459             p_info->sizes.int_size = ompi_fetch_int( process, /* sizeof (int) */
 460                                                      typedefs_sizeof,
 461                                                      p_info );
 462             typedefs_sizeof += p_info->sizes.int_size;
 463              p_info->sizes.long_size = ompi_fetch_int( process, /* sizeof (long) */
 464                                                        typedefs_sizeof,
 465                                                        p_info );
 466             typedefs_sizeof += p_info->sizes.int_size;
 467             p_info->sizes.long_long_size = ompi_fetch_int( process, /* sizeof (long long) */
 468                                                            typedefs_sizeof,
 469                                                            p_info );
 470             typedefs_sizeof += p_info->sizes.int_size;
 471             p_info->sizes.pointer_size = ompi_fetch_int( process, /* sizeof (void *) */
 472                                                          typedefs_sizeof,
 473                                                          p_info );
 474             typedefs_sizeof += p_info->sizes.int_size;
 475             p_info->sizes.bool_size = ompi_fetch_int( process, /* sizeof (bool) */
 476                                                       typedefs_sizeof,
 477                                                       p_info );
 478             typedefs_sizeof += p_info->sizes.int_size;
 479             p_info->sizes.size_t_size = ompi_fetch_int( process, /* sizeof (size_t) */
 480                                                         typedefs_sizeof,
 481                                                         p_info );
 482             DEBUG( VERBOSE_GENERAL,
 483                    ("sizes short = %d int = %d long = %d long long = %d "
 484                     "void* = %d bool = %d size_t = %d\n",
 485                     p_info->sizes.short_size, p_info->sizes.int_size,
 486                     p_info->sizes.long_size, p_info->sizes.long_long_size,
 487                     p_info->sizes.pointer_size, p_info->sizes.bool_size,
 488                     p_info->sizes.size_t_size) );
 489         }
 490 
 491         mqs_put_process_info (process, (mqs_process_info *)p_info);
 492 
 493         return mqs_ok;
 494     }
 495     return err_no_store;
 496 } /* mqs_setup_process */
 497 
 498 /***********************************************************************
 499  * Check the process for message queues.
 500  */
 501 int mqs_process_has_queues (mqs_process *proc, char **msg)
 502 {
 503     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
 504     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
 505     mqs_image * image        = mqs_get_image (proc);
 506     mpi_image_info   *i_info = (mpi_image_info *)mqs_get_image_info (image);
 507 
 508     /* Don't bother with a pop up here, it's unlikely to be helpful */
 509     *msg = 0;
 510     DEBUG(VERBOSE_GENERAL,("checking the status of the OMPI dll\n"));
 511     if (mqs_find_symbol (image, "ompi_mpi_communicators", &extra->commlist_base) != mqs_ok)
 512         return err_all_communicators;
 513 
 514     if (mqs_find_symbol (image, "mca_pml_base_send_requests", &extra->send_queue_base) != mqs_ok)
 515         return err_mpid_sends;
 516 
 517     if (mqs_find_symbol (image, "mca_pml_base_recv_requests", &extra->recv_queue_base) != mqs_ok)
 518         return err_mpid_recvs;
 519     DEBUG(VERBOSE_GENERAL,("process_has_queues returned success\n"));
 520     return mqs_ok;
 521 } /* mqs_process_has_queues */
 522 
 523 /***********************************************************************
 524  * Check if the communicators have changed by looking at the
 525  * pointer array values for lowest_free and number_free.
 526  */
 527 static int communicators_changed (mqs_process *proc)
 528 {
 529     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
 530     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
 531     mqs_image * image          = mqs_get_image (proc);
 532     mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
 533     mqs_tword_t number_free;         /* the number of available positions in
 534                                       * the communicator array. */
 535     mqs_tword_t lowest_free;         /* the lowest free communicator */
 536 
 537     lowest_free = ompi_fetch_int( proc,
 538                                   extra->commlist_base + i_info->opal_pointer_array_t.offset.lowest_free,
 539                                   p_info );
 540     number_free = ompi_fetch_int( proc,
 541                                   extra->commlist_base + i_info->opal_pointer_array_t.offset.number_free,
 542                                   p_info );
 543     if( (lowest_free != extra->comm_lowest_free) ||
 544         (number_free != extra->comm_number_free) ) {
 545         DEBUG(VERBOSE_COMM, ("Recreate the communicator list\n"
 546                              "    lowest_free [current] %d != [stored] %d\n"
 547                              "    number_free [current] %d != [stored] %d\n",
 548                              (int)lowest_free, (int)extra->comm_lowest_free,
 549                              (int)number_free, (int)extra->comm_number_free) );
 550         return 1;
 551     }
 552     DEBUG(VERBOSE_COMM, ("Communicator list not modified\n") );
 553     return 0;
 554 } /* mqs_communicators_changed */
 555 
 556 /***********************************************************************
 557  * Find a matching communicator on our list. We check the recv context
 558  * as well as the address since the communicator structures may be
 559  * being re-allocated from a free list, in which case the same
 560  * address will be re-used a lot, which could confuse us.
 561  */
 562 static communicator_t * find_communicator( mpi_process_info *p_info,
 563                                            int recv_ctx )
 564 {
 565     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
 566     communicator_t * comm = extra->communicator_list;
 567 
 568     for( ; comm; comm = comm->next ) {
 569         if( comm->comm_info.unique_id == (mqs_taddr_t)recv_ctx )
 570             return comm;
 571     }
 572 
 573     return NULL;
 574 } /* find_communicator */
 575 
 576 /***********************************************************************
 577  * Comparison function for sorting communicators.
 578  */
 579 static int compare_comms (const void *a, const void *b)
 580 {
 581     communicator_t * ca = *(communicator_t **)a;
 582     communicator_t * cb = *(communicator_t **)b;
 583 
 584     return cb->comm_info.unique_id - ca->comm_info.unique_id;
 585 } /* compare_comms */
 586 
 587 /***********************************************************************
 588  * Rebuild our list of communicators because something has changed
 589  */
 590 static int rebuild_communicator_list (mqs_process *proc)
 591 {
 592     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
 593     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
 594     mqs_image * image        = mqs_get_image (proc);
 595     mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
 596     communicator_t **commp, *old;
 597     int i, commcount = 0, context_id;
 598     mqs_tword_t comm_size, lowest_free, number_free;
 599     mqs_taddr_t comm_addr_base;
 600     mqs_taddr_t comm_ptr;
 601 
 602     DEBUG(VERBOSE_COMM,("rebuild_communicator_list called "
 603                         "(commlist_base %llx, array offset %ld array size %d)\n",
 604                         (long long)extra->commlist_base,
 605                         (long)i_info->opal_pointer_array_t.offset.addr,
 606                         i_info->opal_pointer_array_t.size));
 607     /**
 608      * Start by getting the number of registered communicators in the
 609      * global communicator array.
 610      */
 611     comm_size = ompi_fetch_int( proc,
 612                                 extra->commlist_base + i_info->opal_pointer_array_t.offset.size,
 613                                 p_info );
 614     lowest_free = ompi_fetch_int( proc,
 615                                   extra->commlist_base + i_info->opal_pointer_array_t.offset.lowest_free,
 616                                   p_info );
 617     number_free = ompi_fetch_int( proc,
 618                                   extra->commlist_base + i_info->opal_pointer_array_t.offset.number_free,
 619                                   p_info );
 620     extra->comm_lowest_free = lowest_free;
 621     extra->comm_number_free = number_free;
 622 
 623     DEBUG(VERBOSE_COMM,("Number of coms %d lowest_free %d number_free %d\n",
 624                         (int)comm_size, (int)lowest_free, (int)number_free));
 625     /* In Open MPI the MPI_COMM_WORLD is always at index 0. By default, the
 626      * MPI_COMM_WORLD will never get modified. Except, when the fault tolerance
 627      * features are enabled in Open MPI. Therefore, we will regenerate the
 628      * list of proc pointers every time we rescan the communicators list.
 629      * We can use the fact that MPI_COMM_WORLD is at index 0 to force the
 630      * creation of the world_proc_array.
 631      */
 632     extra->world_proc_array_entries = 0;
 633     mqs_free( extra->world_proc_array );
 634     extra->world_proc_array = NULL;
 635 
 636     /* Now get the pointer to the array of pointers to communicators */
 637     comm_addr_base =
 638         ompi_fetch_pointer( proc,
 639                             extra->commlist_base + i_info->opal_pointer_array_t.offset.addr,
 640                             p_info );
 641     DEBUG(VERBOSE_COMM,("Array of communicators starting at 0x%llx (sizeof(mqs_taddr_t*) = %d)\n",
 642                         (long long)comm_addr_base, (int)sizeof(mqs_taddr_t)));
 643     for( i = 0; (commcount < (comm_size - number_free)) && (i < comm_size); i++ ) {
 644         /* Get the communicator pointer */
 645         comm_ptr =
 646             ompi_fetch_pointer( proc,
 647                                 comm_addr_base + i * p_info->sizes.pointer_size,
 648                                 p_info );
 649         DEBUG(VERBOSE_GENERAL,("Fetch communicator pointer 0x%llx\n", (long long)comm_ptr));
 650         if( 0 == comm_ptr ) continue;
 651         commcount++;
 652         /* Now let's grab the data we want from inside */
 653         DEBUG(VERBOSE_GENERAL, ("Retrieve context_id from 0x%llx and local_rank from 0x%llx\n",
 654                                 (long long)(comm_ptr + i_info->ompi_communicator_t.offset.c_contextid),
 655                                 (long long)(comm_ptr + i_info->ompi_communicator_t.offset.c_my_rank)));
 656         context_id = ompi_fetch_int( proc,
 657                                      comm_ptr + i_info->ompi_communicator_t.offset.c_contextid,
 658                                      p_info );
 659         /* Do we already have this communicator ? */
 660         old = find_communicator(p_info, context_id);
 661         if( NULL == old ) {
 662             mqs_taddr_t group_base;
 663 
 664             old = (communicator_t *)mqs_malloc (sizeof (communicator_t));
 665             /* Save the results */
 666             old->next                 = extra->communicator_list;
 667             extra->communicator_list = old;
 668             old->comm_ptr             = comm_ptr;
 669             old->comm_info.unique_id  = context_id;
 670             old->comm_info.local_rank = ompi_fetch_int(proc,
 671                                                        comm_ptr + i_info->ompi_communicator_t.offset.c_my_rank,
 672                                                        p_info);
 673             old->group = NULL;
 674 
 675             DEBUG(VERBOSE_COMM,("Create new communicator 0x%lx with context_id %d and local_rank %d\n",
 676                                 (long)old, context_id, local_rank));
 677             /* Now get the information about the group */
 678             group_base =
 679                 ompi_fetch_pointer( proc, comm_ptr + i_info->ompi_communicator_t.offset.c_local_group,
 680                                     p_info );
 681             old->group = find_or_create_group( proc, group_base );
 682         }
 683         mqs_fetch_data( proc, comm_ptr + i_info->ompi_communicator_t.offset.c_name,
 684                         64, old->comm_info.name );
 685 
 686         if( NULL != old->group ) {
 687             old->comm_info.size = old->group->entries;
 688         }
 689         old->present = TRUE;
 690         DEBUG(VERBOSE_COMM,("Communicator 0x%llx %d local_rank %d name %s group %p\n",
 691                             (long long)old->comm_ptr, (int)old->comm_info.unique_id,
 692                             (int)old->comm_info.local_rank, old->comm_info.name,
 693                             (void*)old->group));
 694     }
 695 
 696     /* Now iterate over the list tidying up any communicators which
 697      * no longer exist, and cleaning the flags on any which do.
 698      */
 699     commp = &extra->communicator_list;
 700     commcount = 0;
 701     for (; *commp; ) {
 702         communicator_t *comm = *commp;
 703         if (comm->present) {
 704             comm->present = FALSE;
 705             commcount++;
 706             DEBUG(VERBOSE_COMM, ("Keep communicator 0x%llx name %s\n",
 707                                  (long long)comm->comm_ptr, comm->comm_info.name));
 708             commp = &(*commp)->next;        /* go to the next communicator */
 709         } else { /* It needs to be deleted */
 710             *commp = comm->next;                        /* Remove from the list, *commp now points to the next */
 711             DEBUG(VERBOSE_COMM, ("Remove communicator 0x%llx name %s (group %p)\n",
 712                                  (long long)comm->comm_ptr, comm->comm_info.name,
 713                                  (void*)comm->group));
 714             group_decref (comm->group);         /* Group is no longer referenced from here */
 715             mqs_free (comm);
 716         }
 717     }
 718 
 719     if (commcount) {
 720         /* Sort the list so that it is displayed in some semi-sane order. */
 721         communicator_t ** comm_array =
 722             (communicator_t **) mqs_malloc(commcount * sizeof (communicator_t *));
 723         communicator_t *comm = extra->communicator_list;
 724 
 725         for (i=0; i<commcount; i++, comm=comm->next)
 726             comm_array [i] = comm;
 727 
 728         /* Do the sort */
 729         qsort (comm_array, commcount, sizeof (communicator_t *), compare_comms);
 730 
 731         /* Rebuild the list */
 732         extra->communicator_list = NULL;
 733         for (i=0; i<commcount; i++) {
 734             comm = comm_array[i];
 735             comm->next = extra->communicator_list;
 736             extra->communicator_list = comm;
 737         }
 738 
 739         mqs_free (comm_array);
 740     }
 741 
 742     return mqs_ok;
 743 } /* rebuild_communicator_list */
 744 
 745 /***********************************************************************
 746  * Update the list of communicators in the process if it has changed.
 747  */
 748 int mqs_update_communicator_list (mqs_process *proc)
 749 {
 750     if (communicators_changed (proc))
 751         return rebuild_communicator_list (proc);
 752     return mqs_ok;
 753 } /* mqs_update_communicator_list */
 754 
 755 /***********************************************************************
 756  * Setup to iterate over communicators.
 757  * This is where we check whether our internal communicator list needs
 758  * updating and if so do it.
 759  */
 760 int mqs_setup_communicator_iterator (mqs_process *proc)
 761 {
 762     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
 763     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
 764 
 765     /* Start at the front of the list again */
 766     extra->current_communicator = extra->communicator_list;
 767     /* Reset the operation iterator too */
 768     extra->next_msg.free_list            = 0;
 769     extra->next_msg.current_item         = 0;
 770     extra->next_msg.opal_list_t_pos.list = 0;
 771 
 772     DEBUG(VERBOSE_COMM,("mqs_setup_communicator_iterator called\n"));
 773     return extra->current_communicator == NULL ? mqs_end_of_list : mqs_ok;
 774 } /* mqs_setup_communicator_iterator */
 775 
 776 /***********************************************************************
 777  * Fetch information about the current communicator.
 778  */
 779 int mqs_get_communicator (mqs_process *proc, mqs_communicator *comm)
 780 {
 781     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
 782     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
 783 
 784     if (extra->current_communicator) {
 785         *comm = extra->current_communicator->comm_info;
 786         DEBUG(VERBOSE_COMM,("mqs_get_communicator %d local_rank %d name %s\n",
 787                             (int)comm->unique_id, (int)comm->local_rank,
 788                             comm->name));
 789         return mqs_ok;
 790     }
 791     DEBUG(VERBOSE_COMM,("No more communicators for this iteration\n"));
 792     return err_no_current_communicator;
 793 } /* mqs_get_communicator */
 794 
 795 /***********************************************************************
 796  * Get the group information about the current communicator.
 797  */
 798 int mqs_get_comm_group (mqs_process *proc, int *group_members)
 799 {
 800     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
 801     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
 802     communicator_t     *comm   = extra->current_communicator;
 803 
 804     if (comm && comm->group) {
 805         group_t * g = comm->group;
 806         int i;
 807 
 808         for (i=0; i<g->entries; i++)
 809             group_members[i] = g->local_to_global[i];
 810 
 811         return mqs_ok;
 812     }
 813     return err_no_current_communicator;
 814 } /* mqs_get_comm_group */
 815 
 816 /***********************************************************************
 817  * Step to the next communicator.
 818  */
 819 int mqs_next_communicator (mqs_process *proc)
 820 {
 821     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
 822     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
 823 
 824     extra->current_communicator = extra->current_communicator->next;
 825     return (extra->current_communicator != NULL) ? mqs_ok : mqs_end_of_list;
 826 } /* mqs_next_communicator */
 827 
 828 /**
 829  * Parsing the opal_list_t.
 830  */
 831 static int opal_list_t_init_parser( mqs_process *proc, mpi_process_info *p_info,
 832                                     mqs_opal_list_t_pos* position, mqs_taddr_t list )
 833 {
 834     mqs_image * image        = mqs_get_image (proc);
 835     mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
 836 
 837     position->list = list;
 838     position->sentinel = position->list + i_info->opal_list_t.offset.opal_list_sentinel;
 839     position->current_item =
 840         ompi_fetch_pointer( proc, position->sentinel + i_info->opal_list_item_t.offset.opal_list_next,
 841                             p_info );
 842     if( position->current_item == position->sentinel )
 843         position->current_item = 0;
 844     DEBUG(VERBOSE_LISTS,("opal_list_t_init_parser list = 0x%llx, sentinel = 0x%llx, "
 845                          "current_item = 0x%llx\n", (long long)position->list,
 846                          (long long)position->sentinel, (long long)position->current_item));
 847     return mqs_ok;
 848 }
 849 
 850 static int next_item_opal_list_t( mqs_process *proc, mpi_process_info *p_info,
 851                                   mqs_opal_list_t_pos* position, mqs_taddr_t* active_item )
 852 {
 853     mqs_image * image        = mqs_get_image (proc);
 854     mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
 855 
 856     *active_item = position->current_item;
 857     if( 0 == position->current_item )
 858         return mqs_end_of_list;
 859 
 860     position->current_item =
 861         ompi_fetch_pointer( proc,
 862                             position->current_item + i_info->opal_list_item_t.offset.opal_list_next,
 863                             p_info );
 864     if( position->current_item == position->sentinel )
 865         position->current_item = 0;
 866     return mqs_ok;
 867 }
 868 
 869 #if defined(CODE_NOT_USED)
 870 /**
 871  * Parsing the opal_free_list lists.
 872  */
 873 static void opal_free_list_t_dump_position( mqs_opal_free_list_t_pos* position )
 874 {
 875     printf( "position->opal_list_t_pos.current_item = 0x%llx\n", (long long)position->opal_list_t_pos.current_item );
 876     printf( "position->opal_list_t_pos.list         = 0x%llx\n", (long long)position->opal_list_t_pos.list );
 877     printf( "position->opal_list_t_pos.sentinel     = 0x%llx\n", (long long)position->opal_list_t_pos.sentinel );
 878     printf( "position->current_item                 = 0x%llx\n", (long long)position->current_item );
 879     printf( "position->upper_bound                  = 0x%llx\n", (long long)position->upper_bound );
 880     printf( "position->header_space                 = %llx\n", (long long)position->header_space );
 881     printf( "position->free_list                    = 0x%llx\n", (long long)position->free_list );
 882     printf( "position->fl_frag_class                = 0x%llx\n", (long long)position->fl_frag_class );
 883     printf( "position->fl_mpool                     = 0x%llx\n", (long long)position->fl_mpool );
 884     printf( "position->fl_frag_size                 = %llx\n", (long long)position->fl_frag_size );
 885     printf( "position->fl_frag_alignment            = %llx\n", (long long)position->fl_frag_alignment );
 886     printf( "position->fl_num_per_alloc             = %llx\n", (long long)position->fl_num_per_alloc );
 887     printf( "position->fl_num_allocated             = %llx\n", (long long)position->fl_num_allocated );
 888     printf( "position->fl_num_initial_alloc         = %llx\n", (long long)position->fl_num_initial_alloc );
 889 }
 890 #endif  /* CODE_NOT_USED */
 891 
 892 static int opal_free_list_t_init_parser( mqs_process *proc, mpi_process_info *p_info,
 893                                          mqs_opal_free_list_t_pos* position, mqs_taddr_t free_list )
 894 {
 895     mqs_image * image          = mqs_get_image (proc);
 896     mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
 897     mqs_taddr_t active_allocation;
 898 
 899     position->free_list = free_list;
 900 
 901     position->fl_frag_size =
 902         ompi_fetch_size_t( proc, position->free_list + i_info->opal_free_list_t.offset.fl_frag_size,
 903                            p_info );
 904     position->fl_frag_alignment =
 905         ompi_fetch_size_t( proc, position->free_list + i_info->opal_free_list_t.offset.fl_frag_alignment,
 906                            p_info );
 907     position->fl_frag_class =
 908         ompi_fetch_pointer( proc, position->free_list + i_info->opal_free_list_t.offset.fl_frag_class,
 909                             p_info );
 910     position->fl_mpool =
 911         ompi_fetch_pointer( proc, position->free_list + i_info->opal_free_list_t.offset.fl_mpool,
 912                             p_info );
 913     position->fl_num_per_alloc =
 914         ompi_fetch_size_t( proc, position->free_list + i_info->opal_free_list_t.offset.fl_num_per_alloc,
 915                            p_info );
 916     position->fl_num_allocated =
 917         ompi_fetch_size_t( proc, position->free_list + i_info->opal_free_list_t.offset.fl_num_allocated,
 918                            p_info );
 919 
 920     if( 0 == position->fl_mpool ) {
 921         position->header_space = position->fl_frag_size;
 922     } else {
 923         DEBUG(VERBOSE_GENERAL, ("BLAH !!! (CORRECT ME)\n"));
 924         position->header_space = position->fl_frag_size;
 925     }
 926     position->header_space = OPAL_ALIGN( position->header_space,
 927                                          position->fl_frag_alignment, mqs_taddr_t );
 928 
 929     /**
 930      * Work around the strange opal_free_list_t way to allocate elements. The first chunk is
 931      * not required to have the same size as the others.
 932      * A similar work around should be set for the last chunk of allocations too !!! But how
 933      * can we solve ONE equation with 2 unknowns ?
 934      */
 935     if( position->fl_num_allocated <= position->fl_num_per_alloc ) {
 936         position->fl_num_initial_alloc = position->fl_num_allocated;
 937     } else {
 938         position->fl_num_initial_alloc = position->fl_num_allocated % position->fl_num_per_alloc;
 939         if( 0 == position->fl_num_initial_alloc )
 940             position->fl_num_initial_alloc = position->fl_num_per_alloc;
 941     }
 942     DEBUG(VERBOSE_LISTS,("opal_free_list_t fl_frag_size = %lld fl_header_space = %lld\n"
 943                          "                 fl_frag_alignment = %lld fl_num_per_alloc = %lld\n"
 944                          "                 fl_num_allocated = %lld fl_num_initial_alloc = %lld\n"
 945                          "                 header_space = %lld\n",
 946                          (long long)position->fl_frag_size, (long long)position->header_space,
 947                          (long long)position->fl_frag_alignment, (long long)position->fl_num_per_alloc,
 948                          (long long)position->fl_num_allocated, (long long)position->fl_num_initial_alloc,
 949                          (long long)position->header_space));
 950 
 951     /**
 952      * Initialize the pointer to the opal_list_t.
 953      */
 954     opal_list_t_init_parser( proc, p_info, &position->opal_list_t_pos,
 955                              position->free_list + i_info->opal_free_list_t.offset.fl_allocations );
 956     next_item_opal_list_t( proc, p_info, &position->opal_list_t_pos, &active_allocation );
 957     DEBUG(VERBOSE_LISTS,("active_allocation 0x%llx header_space %d\n",
 958                          (long long)active_allocation, (int)position->header_space));
 959     if( 0 == active_allocation ) {  /* the end of the list */
 960         position->upper_bound = 0;
 961     } else {
 962         /**
 963          * Handle alignment issues...
 964          */
 965         active_allocation += i_info->opal_free_list_item_t.size;
 966         active_allocation = OPAL_ALIGN( active_allocation,
 967                                         position->fl_frag_alignment, mqs_taddr_t );
 968         /**
 969          * Now let's try to compute the upper bound ...
 970          */
 971         position->upper_bound =
 972             position->fl_num_initial_alloc * position->header_space + active_allocation;
 973         DEBUG(VERBOSE_LISTS,("there are some elements in the list "
 974                              "active_allocation = %llx upper_bound = %llx\n",
 975                              (long long)active_allocation, (long long)position->upper_bound));
 976     }
 977     position->current_item = active_allocation;
 978 
 979     /*opal_free_list_t_dump_position( position );*/
 980     return mqs_ok;
 981 }
 982 
 983 /**
 984  * Return the current position and move the internal counter to the next element.
 985  */
 986 static int opal_free_list_t_next_item( mqs_process *proc, mpi_process_info *p_info,
 987                                        mqs_opal_free_list_t_pos* position, mqs_taddr_t* active_item )
 988 {
 989     mqs_image * image          = mqs_get_image (proc);
 990     mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
 991     mqs_taddr_t active_allocation;
 992 
 993     *active_item = position->current_item;
 994     if( 0 == position->current_item )  /* the end ... */
 995         return mqs_ok;
 996 
 997     position->current_item += position->header_space;
 998     if( position->current_item >= position->upper_bound ) {
 999         DEBUG(VERBOSE_LISTS,("Reach the end of one of the opal_free_list_t "
1000                              "allocations. Go to the next one\n"));
1001         /* we should go to the next allocation */
1002         next_item_opal_list_t( proc, p_info,
1003                                &position->opal_list_t_pos, &active_allocation );
1004         if( 0 == active_allocation ) { /* we're at the end */
1005             position->current_item = 0;
1006             return mqs_ok;
1007         }
1008         /**
1009          * Handle alignment issues...
1010          */
1011         active_allocation += i_info->opal_free_list_item_t.size;
1012         active_allocation = OPAL_ALIGN( active_allocation,
1013                                         position->fl_frag_alignment, mqs_taddr_t );
1014         /**
1015          * Now let's try to compute the upper bound ...
1016          */
1017         position->upper_bound =
1018             position->fl_num_per_alloc * position->header_space + active_allocation;
1019         position->current_item = active_allocation;
1020         DEBUG(VERBOSE_LISTS,("there are more elements in the list "
1021                              "active_allocation = %llx upper_bound = %llx\n",
1022                              (long long)active_allocation, (long long)position->upper_bound));
1023         /*opal_free_list_t_dump_position( position );*/
1024     }
1025     DEBUG(VERBOSE_LISTS,("Free list actual position 0x%llx next element at 0x%llx\n",
1026                          (long long)*active_item, (long long)position->current_item));
1027     return mqs_ok;
1028 }
1029 
1030 static void dump_request( mqs_taddr_t current_item, mqs_pending_operation *res )
1031 {
1032     if(!(VERBOSE_REQ_DUMP & VERBOSE)) return;
1033     printf( "\n+===============================================+\n"
1034             "|Request 0x%llx contain \n"
1035             "|    res->status              = %d\n"
1036             "|    res->desired_local_rank  = %ld\n"
1037             "|    res->desired_global_rank = %ld\n"
1038             "|    res->tag_wild            = %ld\n"
1039             "|    res->desired_tag         = %ld\n"
1040             "|    res->system_buffer       = %s\n"
1041             "|    res->buffer              = 0x%llx\n"
1042             "|    res->desired_length      = %ld\n",
1043         (long long)current_item, res->status, (long)res->desired_local_rank,
1044         (long)res->desired_global_rank, (long)res->tag_wild, (long)res->desired_tag,
1045         (TRUE == res->system_buffer ? "TRUE" : "FALSE"), (long long)res->buffer,
1046         (long)res->desired_length );
1047 
1048     if( res->status > mqs_st_pending ) {
1049         printf( "|    res->actual_length       = %ld\n"
1050                 "|    res->actual_tag          = %ld\n"
1051                 "|    res->actual_local_rank   = %ld\n"
1052                 "|    res->actual_global_rank  = %ld\n",
1053                 (long)res->actual_length, (long)res->actual_tag,
1054                 (long)res->actual_local_rank, (long)res->actual_global_rank );
1055     }
1056     if( '\0' != res->extra_text[0][0] )
1057         printf( "|    extra[0] = %s\n", res->extra_text[0] );
1058     if( '\0' != res->extra_text[1][0] )
1059         printf( "|    extra[1] = %s\n", res->extra_text[1] );
1060     if( '\0' != res->extra_text[2][0] )
1061         printf( "|    extra[2] = %s\n", res->extra_text[2] );
1062     if( '\0' != res->extra_text[3][0] )
1063         printf( "|    extra[3] = %s\n", res->extra_text[3] );
1064     if( '\0' != res->extra_text[4][0] )
1065         printf( "|    extra[4] = %s\n", res->extra_text[4] );
1066     printf( "+===============================================+\n\n" );
1067 }
1068 
1069 /**
1070  * Handle the send queue as well as the receive queue. The unexpected queue
1071  * is a whole different story ...
1072  */
1073 static int fetch_request( mqs_process *proc, mpi_process_info *p_info,
1074                           mqs_pending_operation *res, int look_for_user_buffer )
1075 {
1076     mqs_image * image        = mqs_get_image (proc);
1077     mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
1078     mqs_taddr_t current_item;
1079     mqs_tword_t req_complete, req_pml_complete, req_valid, req_type;
1080     mqs_taddr_t req_buffer, req_comm;
1081     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
1082 
1083     /* If we get a PML request with an internal tag we will jump back here */
1084   rescan_requests:
1085     while( 1 ) {
1086         opal_free_list_t_next_item( proc, p_info,
1087                                     &extra->next_msg, &current_item );
1088         if( 0 == current_item ) {
1089             DEBUG(VERBOSE_REQ,("no more items in the %s request queue\n",
1090                                look_for_user_buffer ? "receive" : "send" ));
1091             return mqs_end_of_list;
1092         }
1093         req_valid = ompi_fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_state, p_info );
1094         if( OMPI_REQUEST_INVALID == req_valid ) continue;
1095         req_comm = ompi_fetch_pointer( proc, current_item + i_info->mca_pml_base_request_t.offset.req_comm, p_info );
1096         if( extra->current_communicator->comm_ptr == req_comm ) break;
1097         DEBUG(VERBOSE_REQ,("unmatched request (0x%llx) req_comm = %llx current_com = %llx\n",
1098                            (long long)current_item, (long long)req_comm,
1099                            (long long)extra->current_communicator->comm_ptr));
1100     }
1101 
1102     res->extra_text[0][0] = 0; res->extra_text[1][0] = 0; res->extra_text[2][0] = 0;
1103     res->extra_text[3][0] = 0; res->extra_text[4][0] = 0;
1104 
1105     req_type = ompi_fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_type, p_info );
1106     if( OMPI_REQUEST_PML == req_type ) {
1107         mqs_taddr_t ompi_datatype;
1108         char data_name[64];
1109 
1110         /**
1111          * First retrieve the tag. If the tag is negative and the user didn't
1112          * request the internal requests information then move along.
1113          */
1114         res->desired_tag =
1115             ompi_fetch_int( proc, current_item + i_info->mca_pml_base_request_t.offset.req_tag, p_info );
1116         if( MPI_ANY_TAG == (int)res->desired_tag ) {
1117             res->tag_wild = TRUE;
1118         } else {
1119             /* Don't allow negative tags to show up */
1120             if( ((int)res->desired_tag < 0) && (0 == extra->show_internal_requests) )
1121                 goto rescan_requests;
1122             res->tag_wild = FALSE;
1123         }
1124 
1125         req_type =
1126             ompi_fetch_int( proc, current_item + i_info->mca_pml_base_request_t.offset.req_type,
1127                             p_info);
1128         req_complete =
1129             ompi_fetch_bool( proc,
1130                              current_item + i_info->ompi_request_t.offset.req_complete,
1131                              p_info );
1132         req_pml_complete =
1133             ompi_fetch_bool( proc,
1134                              current_item + i_info->mca_pml_base_request_t.offset.req_pml_complete,
1135                              p_info );
1136         res->status = (0 == req_complete ? mqs_st_pending : mqs_st_complete);
1137 
1138         res->desired_local_rank  = ompi_fetch_int( proc, current_item + i_info->mca_pml_base_request_t.offset.req_peer, p_info );
1139         res->desired_global_rank = translate( extra->current_communicator->group,
1140                                               res->desired_local_rank );
1141 
1142         res->buffer = ompi_fetch_pointer( proc, current_item + i_info->mca_pml_base_request_t.offset.req_addr,
1143                                      p_info );
1144         /* Set this to true if it's a buffered request */
1145         res->system_buffer = FALSE;
1146 
1147         /* The pointer to the request datatype */
1148         ompi_datatype =
1149             ompi_fetch_pointer( proc,
1150                                 current_item + i_info->mca_pml_base_request_t.offset.req_datatype, p_info );
1151         /* Retrieve the count as specified by the user */
1152         res->desired_length =
1153             ompi_fetch_size_t( proc,
1154                                ompi_datatype + i_info->ompi_datatype_t.offset.size,
1155                                p_info );
1156         /* Be user friendly, show the datatype name */
1157         mqs_fetch_data( proc, ompi_datatype + i_info->ompi_datatype_t.offset.name,
1158                         64, data_name );
1159         if( '\0' != data_name[0] ) {
1160             // res->extra_text[x] is only 64 chars long -- same as
1161             // data_name.  If you try to snprintf it into
1162             // res->extra_text with additional text, some compilers
1163             // will warn that we might truncate the string (because it
1164             // can see the static char array lengths).  So just put
1165             // data_name in res->extra_text[2] (vs. extra_text[1]),
1166             // where it is guaranteed to fit.
1167             data_name[4] = '\0';
1168             snprintf( (char*)res->extra_text[1], 64, "Data: %d",
1169                       (int)res->desired_length);
1170             snprintf( (char*)res->extra_text[2], 64, "%s",
1171                       data_name );
1172         }
1173         /* And now compute the real length as specified by the user */
1174         res->desired_length *=
1175             ompi_fetch_size_t( proc,
1176                                current_item + i_info->mca_pml_base_request_t.offset.req_count,
1177                                p_info );
1178 
1179         if( MCA_PML_REQUEST_SEND == req_type ) {
1180             snprintf( (char *)res->extra_text[0], 64, "Send: 0x%llx", (long long)current_item );
1181             req_buffer =
1182                 ompi_fetch_pointer( proc,
1183                                     current_item + i_info->mca_pml_base_send_request_t.offset.req_addr,
1184                                     p_info );
1185             res->system_buffer = ( req_buffer == res->buffer ? FALSE : TRUE );
1186             res->actual_length =
1187                 ompi_fetch_size_t( proc,
1188                                    current_item + i_info->mca_pml_base_send_request_t.offset.req_bytes_packed, p_info );
1189             res->actual_tag         = res->desired_tag;
1190             res->actual_local_rank  = res->desired_local_rank;
1191             res->actual_global_rank = res->actual_local_rank;
1192         } else if( MCA_PML_REQUEST_RECV == req_type ) {
1193             snprintf( (char *)res->extra_text[0], 64, "Receive: 0x%llx", (long long)current_item );
1194             /**
1195              * There is a trick with the MPI_TAG. All receive requests set it to MPI_ANY_TAG
1196              * when the request get initialized, and to the real tag once the request
1197              * is matched.
1198              */
1199             res->actual_tag =
1200                 ompi_fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_status +
1201                                 i_info->ompi_status_public_t.offset.MPI_TAG, p_info );
1202             if( MPI_ANY_TAG != (int)res->actual_tag ) {
1203                 res->status = mqs_st_matched;
1204                 res->desired_length =
1205                     ompi_fetch_size_t( proc,
1206                                        current_item + i_info->mca_pml_base_recv_request_t.offset.req_bytes_packed,
1207                                        p_info );
1208                 res->actual_local_rank =
1209                     ompi_fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_status +
1210                                     i_info->ompi_status_public_t.offset.MPI_SOURCE, p_info );
1211                 res->actual_global_rank = translate( extra->current_communicator->group,
1212                                                   res->actual_local_rank );
1213             }
1214         } else {
1215             snprintf( (char *)res->extra_text[0], 64, "Unknown type of request 0x%llx", (long long)current_item );
1216         }
1217         if( 0 != req_pml_complete ) {
1218                         snprintf( (char *)res->extra_text[1], 64, "Data transfer completed" );
1219         }
1220 
1221         /* If the length we're looking for is the count ... */
1222         /*res->desired_length      =
1223           ompi_fetch_int( proc, current_item + i_info->mca_pml_base_request_t.offset.req_count, p_info );*/
1224 
1225         if( (mqs_st_pending < res->status) && (MCA_PML_REQUEST_SEND != req_type) ) {  /* The real data from the status */
1226             res->actual_length       =
1227                 ompi_fetch_size_t( proc, current_item + i_info->ompi_request_t.offset.req_status +
1228                                    i_info->ompi_status_public_t.offset._ucount, p_info );
1229             res->actual_tag          =
1230                 ompi_fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_status +
1231                                 i_info->ompi_status_public_t.offset.MPI_TAG, p_info );
1232             res->actual_local_rank   =
1233                 ompi_fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_status +
1234                                 i_info->ompi_status_public_t.offset.MPI_SOURCE, p_info );
1235             res->actual_global_rank  = translate( extra->current_communicator->group,
1236                                                   res->actual_local_rank );
1237         }
1238         dump_request( current_item, res );
1239     }
1240     return mqs_ok;
1241 }
1242 
1243 /***********************************************************************
1244  * Setup to iterate over pending operations
1245  */
1246 int mqs_setup_operation_iterator (mqs_process *proc, int op)
1247 {
1248     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
1249     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
1250 
1251     extra->what = (mqs_op_class)op;
1252 
1253     switch (op) {
1254     case mqs_pending_sends:
1255         DEBUG(VERBOSE_REQ,("setup the send queue iterator\n"));
1256         opal_free_list_t_init_parser( proc, p_info, &extra->next_msg, extra->send_queue_base );
1257         return mqs_ok;
1258 
1259     case mqs_pending_receives:
1260         DEBUG(VERBOSE_REQ,("setup the receive queue iterator\n"));
1261         opal_free_list_t_init_parser( proc, p_info, &extra->next_msg, extra->recv_queue_base );
1262         return mqs_ok;
1263 
1264     case mqs_unexpected_messages:  /* TODO */
1265         return mqs_no_information;
1266 
1267     default:
1268         return err_bad_request;
1269     }
1270 } /* mqs_setup_operation_iterator */
1271 
1272 /***********************************************************************
1273  * Fetch the next valid operation.
1274  * Since Open MPI only maintains a single queue of each type of operation,
1275  * we have to run over it and filter out the operations which
1276  * match the active communicator.
1277  */
1278 int mqs_next_operation (mqs_process *proc, mqs_pending_operation *op)
1279 {
1280     mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
1281     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
1282 
1283     switch (extra->what) {
1284     case mqs_pending_receives:
1285         DEBUG(VERBOSE_REQ,("digging for the receive queue\n"));
1286         return fetch_request( proc, p_info, op, TRUE );
1287     case mqs_unexpected_messages:
1288         /* TODO: not handled yet */
1289         return err_bad_request;
1290     case mqs_pending_sends:
1291         DEBUG(VERBOSE_REQ,("digging for the send queue\n"));
1292         return fetch_request( proc, p_info, op, FALSE );
1293     default: return err_bad_request;
1294     }
1295 } /* mqs_next_operation */
1296 
1297 /***********************************************************************
1298  * Destroy the info.
1299  */
1300 void mqs_destroy_process_info (mqs_process_info *mp_info)
1301 {
1302     mpi_process_info *p_info = (mpi_process_info *)mp_info;
1303     mpi_process_info_extra *extra = (mpi_process_info_extra*) p_info->extra;
1304     /* Need to handle the communicators and groups too */
1305     communicator_t *comm;
1306 
1307     if( NULL != extra) {
1308         comm = extra->communicator_list;
1309         while (comm) {
1310             communicator_t *next = comm->next;
1311 
1312             if( NULL != comm->group )
1313                 group_decref (comm->group);  /* Group is no longer referenced from here */
1314             mqs_free (comm);
1315 
1316             comm = next;
1317         }
1318         if (NULL != extra) {
1319             mqs_free(extra);
1320         }
1321     }
1322     mqs_free (p_info);
1323 } /* mqs_destroy_process_info */
1324 
1325 /***********************************************************************
1326  * Free off the data we associated with an image. Since we malloced it
1327  * we just free it.
1328  */
1329 void mqs_destroy_image_info (mqs_image_info *info)
1330 {
1331     mqs_free (info);
1332 } /* mqs_destroy_image_info */
1333 
1334 /***********************************************************************/
1335 /* Convert an error code into a printable string */
1336 char * mqs_dll_error_string (int errcode)
1337 {
1338     switch (errcode) {
1339     case err_silent_failure:
1340         return "";
1341     case err_no_current_communicator:
1342         return "No current communicator in the communicator iterator";
1343     case err_bad_request:
1344         return "Attempting to setup to iterate over an unknown queue of operations";
1345     case err_no_store:
1346         return "Unable to allocate store";
1347     case err_failed_qhdr:
1348         return "Failed to find type MPID_QHDR";
1349     case err_unexpected:
1350         return "Failed to find field 'unexpected' in MPID_QHDR";
1351     case err_posted:
1352         return "Failed to find field 'posted' in MPID_QHDR";
1353     case err_failed_queue:
1354         return "Failed to find type MPID_QUEUE";
1355     case err_first:
1356         return "Failed to find field 'first' in MPID_QUEUE";
1357     case err_context_id:
1358         return "Failed to find field 'context_id' in MPID_QEL";
1359     case err_tag:
1360         return "Failed to find field 'tag' in MPID_QEL";
1361     case err_tagmask:
1362         return "Failed to find field 'tagmask' in MPID_QEL";
1363     case err_lsrc:
1364         return "Failed to find field 'lsrc' in MPID_QEL";
1365     case err_srcmask:
1366         return "Failed to find field 'srcmask' in MPID_QEL";
1367     case err_next:
1368         return "Failed to find field 'next' in MPID_QEL";
1369     case err_ptr:
1370         return "Failed to find field 'ptr' in MPID_QEL";
1371     case err_missing_type:
1372         return "Failed to find some type";
1373     case err_missing_symbol:
1374         return "Failed to find field the global symbol";
1375     case err_db_shandle:
1376         return "Failed to find field 'db_shandle' in MPIR_SQEL";
1377     case err_db_comm:
1378         return "Failed to find field 'db_comm' in MPIR_SQEL";
1379     case err_db_target:
1380         return "Failed to find field 'db_target' in MPIR_SQEL";
1381     case err_db_tag:
1382         return "Failed to find field 'db_tag' in MPIR_SQEL";
1383     case err_db_data:
1384         return "Failed to find field 'db_data' in MPIR_SQEL";
1385     case err_db_byte_length:
1386         return "Failed to find field 'db_byte_length' in MPIR_SQEL";
1387     case err_db_next:
1388         return "Failed to find field 'db_next' in MPIR_SQEL";
1389     case err_failed_rhandle:
1390         return "Failed to find type MPIR_RHANDLE";
1391     case err_is_complete:
1392         return "Failed to find field 'is_complete' in MPIR_RHANDLE";
1393     case err_buf:
1394         return "Failed to find field 'buf' in MPIR_RHANDLE";
1395     case err_len:
1396         return "Failed to find field 'len' in MPIR_RHANDLE";
1397     case err_s:
1398         return "Failed to find field 's' in MPIR_RHANDLE";
1399     case err_failed_status:
1400         return "Failed to find type MPI_Status";
1401     case err_count:
1402         return "Failed to find field 'count' in MPIR_Status";
1403     case err_MPI_SOURCE:
1404         return "Failed to find field 'MPI_SOURCE' in MPIR_Status";
1405     case err_MPI_TAG:
1406         return "Failed to find field 'MPI_TAG' in MPIR_Status";
1407     case err_failed_commlist:
1408         return "Failed to find type MPIR_Comm_list";
1409     case err_sequence_number:
1410         return "Failed to find field 'sequence_number' in MPIR_Comm_list";
1411     case err_comm_first:
1412         return "Failed to find field 'comm_first' in MPIR_Comm_list";
1413     case err_failed_communicator:
1414         return "Failed to find type MPIR_Communicator";
1415     case err_lrank_to_grank:
1416         return "Failed to find field 'lrank_to_grank' in MPIR_Communicator";
1417     case err_send_context:
1418         return "Failed to find field 'send_context' in MPIR_Communicator";
1419     case err_recv_context:
1420         return "Failed to find field 'recv_context' in MPIR_Communicator";
1421     case err_comm_next:
1422         return "Failed to find field 'comm_next' in MPIR_Communicator";
1423     case err_comm_name:
1424         return "Failed to find field 'comm_name' in MPIR_Communicator";
1425     case err_all_communicators:
1426         return "Failed to find the global symbol MPIR_All_communicators";
1427     case err_mpid_sends:
1428         return "Failed to access the global send requests list";
1429     case err_mpid_recvs:
1430         return "Failed to access the global receive requests list";
1431     case err_group_corrupt:
1432         return "Could not read a communicator's group from the process (probably a store corruption)";
1433 
1434     default: return "Unknown error code";
1435     }
1436 } /* mqs_dll_error_string */
/* [<][>][^][v][top][bottom][index][help] */
root/ompi/debuggers/ompi_msgq_dll.c

DEFINITIONS
