1
2/*---------------------------------------------------------------*/
3/*---                                                         ---*/
4/*--- A library of wrappers for MPI 2 functions.              ---*/
5/*---                                                         ---*/
6/*---------------------------------------------------------------*/
7
8/* ----------------------------------------------------------------
9
10   Notice that the following BSD-style license applies to this one
11   file (mpiwrap.c) only.  The rest of Valgrind is licensed under the
12   terms of the GNU General Public License, version 2, unless
13   otherwise indicated.  See the COPYING file in the source
14   distribution for details.
15
16   ----------------------------------------------------------------
17
18   This file is part of Valgrind, a dynamic binary instrumentation
19   framework.
20
21   Copyright (C) 2006-2015 OpenWorks LLP.  All rights reserved.
22
23   Redistribution and use in source and binary forms, with or without
24   modification, are permitted provided that the following conditions
25   are met:
26
27   1. Redistributions of source code must retain the above copyright
28      notice, this list of conditions and the following disclaimer.
29
30   2. The origin of this software must not be misrepresented; you must
31      not claim that you wrote the original software.  If you use this
32      software in a product, an acknowledgment in the product
33      documentation would be appreciated but is not required.
34
35   3. Altered source versions must be plainly marked as such, and must
36      not be misrepresented as being the original software.
37
38   4. The name of the author may not be used to endorse or promote
39      products derived from this software without specific prior written
40      permission.
41
42   THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS
43   OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
44   WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
45   ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
46   DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
47   DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
48   GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
49   INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
50   WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
51   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
52   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
53
54   Neither the names of the U.S. Department of Energy nor the
55   University of California nor the names of its contributors may be
56   used to endorse or promote products derived from this software
57   without prior written permission.
58*/
59
60/* Handling of MPI_STATUS{ES}_IGNORE for MPI_Status* arguments.
61
62   The MPI-2 spec allows many functions which have MPI_Status* purely
63   as an out parameter, to accept the constants MPI_STATUS_IGNORE or
64   MPI_STATUSES_IGNORE there instead, if the caller does not care
65   about the status.  See the MPI-2 spec sec 4.5.1 ("Passing
66   MPI_STATUS_IGNORE for Status").  (mpi2-report.pdf, 1615898 bytes,
67   md5=694a5efe2fd291eecf7e8c9875b5f43f).
68
69   This library handles such cases by allocating a fake MPI_Status
70   object (on the stack) or an array thereof (on the heap), and
71   passing that onwards instead.  From the outside the caller sees no
72   difference.  Unfortunately the simpler approach of merely detecting
73   and handling these special cases at a lower level does not work,
74   because we need to use information returned in MPI_Status*
75   arguments to paint result buffers, even if the caller doesn't
76   supply a real MPI_Status object.
77
78   Eg, MPI_Recv.  We can't paint the result buffer without knowing how
79   many items arrived; but we can't find that out without passing a
80   real MPI_Status object to the (real) MPI_Recv call.  Hence, if the
81   caller did not supply one, we have no option but to use a temporary
82   stack allocated one for the inner call.  Ditto, more indirectly
83   (via maybe_complete) for nonblocking receives and the various
84   associated wait/test calls. */
85
86
87/*------------------------------------------------------------*/
88/*--- includes                                             ---*/
89/*------------------------------------------------------------*/
90
91#include <stdio.h>
92#include <assert.h>
93#include <unistd.h>     /* getpid */
94#include <stdlib.h>     /* exit */
95#include <string.h>     /* strstr */
96#include <pthread.h>    /* pthread_mutex_{lock,unlock} */
97
98/* Include Valgrind magic macros for writing wrappers. */
99#include "../memcheck/memcheck.h"
100
101/* Include macros for VALGRIND_{DIS,EN}ABLE_ERROR_REPORTING.
102   This is somewhat experimental and hence disable-able, by
103   setting cONFIG_DER to zero. */
104#include "../include/valgrind.h"
105
106#define cONFIG_DER  1   /* set to 0 to disable */
107
108
109/*------------------------------------------------------------*/
110/*--- Connect to MPI library                               ---*/
111/*------------------------------------------------------------*/
112
113/* Include headers for whatever MPI implementation the wrappers are to
114   be used with.  The configure system will tell us what the path to
115   the chosen MPI implementation is, via -I.. to the compiler. */
116#include "mpi.h"
117
118/* Where are API symbols?
119   Open MPI      lib/libmpi.so,   soname = libmpi.so.0
120   Quadrics MPI  lib/libmpi.so,   soname = libmpi.so.0
121   MPICH         libmpich.so.1.0, soname = libmpich.so.1.0
122
123   A suitable soname to match with is therefore "libmpi*.so*".
124*/
125#define I_WRAP_FNNAME_U(_name) \
126        I_WRAP_SONAME_FNNAME_ZU(libmpiZaZdsoZa,_name)
127
128
129/* Define HAVE_MPI_STATUS_IGNORE iff we have to deal with
130   MPI_STATUS{ES}_IGNORE. */
131#if MPI_VERSION >= 2 \
132    || (defined(MPI_STATUS_IGNORE) && defined(MPI_STATUSES_IGNORE))
133#  undef HAVE_MPI_STATUS_IGNORE
134#  define HAVE_MPI_STATUS_IGNORE 1
135#else
136#  undef HAVE_MPI_STATUS_IGNORE
137#endif
138
139
140/*------------------------------------------------------------*/
141/*--- Decls                                                ---*/
142/*------------------------------------------------------------*/
143
144typedef  unsigned char  Bool;
145#define False ((Bool)0)
146#define True  ((Bool)1)
147
148/* Word, UWord are machine words - same size as a pointer.  This is
149   checked at startup.  The wrappers below use 'long' to mean a
150   machine word - this too is tested at startup. */
151typedef    signed long  Word;
152typedef  unsigned long  UWord;
153
154#if !defined(offsetof)
155#  define offsetof(type,memb) ((UWord)&((type*)0)->memb)
156#endif
157
158/* Find the size of long double image (not 'sizeof(long double)').
159   See comments in sizeofOneNamedTy. */
160static long sizeof_long_double_image ( void );
161
162
163/*------------------------------------------------------------*/
164/*--- Simple helpers                                       ---*/
165/*------------------------------------------------------------*/
166
167/* ------ Helpers for debug printing ------ */
168
169/* constant */
170static const char* preamble = "valgrind MPI wrappers";
171
172/* established at startup */
173static pid_t my_pid         = -1;
174static char* options_str    = NULL;
175static int   opt_verbosity  = 1;
176static Bool  opt_missing    = 0; /* 0:silent; 1:warn; 2:abort */
177static Bool  opt_help       = False;
178static Bool  opt_initkludge = False;
179
180static void before ( char* fnname )
181{
182   /* This isn't thread-safe wrt 'done' (no locking).  It's not
183      critical. */
184   static int done = 0;
185   if (done == 0) {
186      done = 1;
187      my_pid = getpid();
188      options_str = getenv("MPIWRAP_DEBUG");
189      if (options_str) {
190         if (NULL != strstr(options_str, "warn"))
191            opt_missing = 1;
192         if (NULL != strstr(options_str, "strict"))
193            opt_missing = 2;
194         if (NULL != strstr(options_str, "verbose"))
195            opt_verbosity++;
196         if (NULL != strstr(options_str, "quiet"))
197            opt_verbosity--;
198         if (NULL != strstr(options_str, "help"))
199            opt_help = True;
200         if (NULL != strstr(options_str, "initkludge"))
201            opt_initkludge = True;
202      }
203      if (opt_verbosity > 0)
204         fprintf(stderr, "%s %5d: Active for pid %d\n",
205                         preamble, my_pid, my_pid);
206      /* Sanity check - that Word/UWord really are machine words. */
207      assert(sizeof(Word)  == sizeof(void*));
208      assert(sizeof(UWord) == sizeof(void*));
209      /* Sanity check - char is byte-sized (else address calculations
210         in walk_type don't work. */
211      assert(sizeof(char) == 1);
212      if (opt_help) {
213         fprintf(stderr, "\n");
214         fprintf(stderr, "Valid options for the MPIWRAP_DEBUG environment"
215                         " variable are:\n");
216         fprintf(stderr, "\n");
217         fprintf(stderr, "   quiet       be silent except for errors\n");
218         fprintf(stderr, "   verbose     show wrapper entries/exits\n");
219         fprintf(stderr, "   strict      abort the program if a function"
220                         " with no wrapper is used\n");
221         fprintf(stderr, "   warn        give a warning if a function"
222                         " with no wrapper is used\n");
223         fprintf(stderr, "   help        display this message, then exit\n");
224         fprintf(stderr, "   initkludge  debugging hack; do not use\n");
225         fprintf(stderr, "\n");
226         fprintf(stderr, "Multiple options are allowed, eg"
227                         " MPIWRAP_DEBUG=strict,verbose\n");
228         fprintf(stderr, "Note: 'warn' generates output even if 'quiet'"
229                         " is also specified\n");
230         fprintf(stderr, "\n");
231         fprintf(stderr, "%s %5d: exiting now\n", preamble, my_pid );
232         exit(1);
233      }
234      if (opt_verbosity > 0)
235         fprintf(stderr,
236                 "%s %5d: Try MPIWRAP_DEBUG=help for possible options\n",
237                 preamble, my_pid);
238
239   }
240   if (opt_verbosity > 1)
241      fprintf(stderr, "%s %5d: enter PMPI_%s\n", preamble,  my_pid, fnname );
242}
243
244static __inline__ void after ( char* fnname, int err )
245{
246   if (opt_verbosity > 1)
247      fprintf(stderr, "%s %5d:  exit PMPI_%s (err = %d)\n",
248                      preamble, my_pid, fnname, err );
249}
250
251static void barf ( char* msg )
252{
253   fprintf(stderr, "%s %5d: fatal: %s\n",   preamble, my_pid, msg);
254   fprintf(stderr, "%s %5d: exiting now\n", preamble, my_pid );
255   exit(1);
256}
257
258/* Half-hearted type-showing function (for debugging). */
259static void showTy ( FILE* f, MPI_Datatype ty )
260{
261        if (ty == MPI_DATATYPE_NULL)  fprintf(f,"DATATYPE_NULL");
262   else if (ty == MPI_BYTE)           fprintf(f,"BYTE");
263   else if (ty == MPI_PACKED)         fprintf(f,"PACKED");
264   else if (ty == MPI_CHAR)           fprintf(f,"CHAR");
265   else if (ty == MPI_SHORT)          fprintf(f,"SHORT");
266   else if (ty == MPI_INT)            fprintf(f,"INT");
267   else if (ty == MPI_LONG)           fprintf(f,"LONG");
268   else if (ty == MPI_FLOAT)          fprintf(f,"FLOAT");
269   else if (ty == MPI_DOUBLE)         fprintf(f,"DOUBLE");
270   else if (ty == MPI_LONG_DOUBLE)    fprintf(f,"LONG_DOUBLE");
271   else if (ty == MPI_UNSIGNED_CHAR)  fprintf(f,"UNSIGNED_CHAR");
272   else if (ty == MPI_UNSIGNED_SHORT) fprintf(f,"UNSIGNED_SHORT");
273   else if (ty == MPI_UNSIGNED_LONG)  fprintf(f,"UNSIGNED_LONG");
274   else if (ty == MPI_UNSIGNED)       fprintf(f,"UNSIGNED");
275   else if (ty == MPI_FLOAT_INT)      fprintf(f,"FLOAT_INT");
276   else if (ty == MPI_DOUBLE_INT)     fprintf(f,"DOUBLE_INT");
277   else if (ty == MPI_LONG_DOUBLE_INT) fprintf(f,"LONG_DOUBLE_INT");
278   else if (ty == MPI_LONG_INT)       fprintf(f,"LONG_INT");
279   else if (ty == MPI_SHORT_INT)      fprintf(f,"SHORT_INT");
280   else if (ty == MPI_2INT)           fprintf(f,"2INT");
281   else if (ty == MPI_UB)             fprintf(f,"UB");
282   else if (ty == MPI_LB)             fprintf(f,"LB");
283#  if defined(MPI_WCHAR)
284   else if (ty == MPI_WCHAR)          fprintf(f,"WCHAR");
285#  endif
286   else if (ty == MPI_LONG_LONG_INT)  fprintf(f,"LONG_LONG_INT");
287#  if defined(MPI_LONG_LONG)
288   else if (ty == MPI_LONG_LONG)      fprintf(f,"LONG_LONG");
289#  endif
290#  if defined(MPI_UNSIGNED_LONG_LONG)
291   else if (ty == MPI_UNSIGNED_LONG_LONG) fprintf(f,"UNSIGNED_LONG_LONG");
292#  endif
293#  if defined(MPI_REAL8)
294   else if (ty == MPI_REAL8)          fprintf(f, "REAL8");
295#  endif
296#  if defined(MPI_REAL4)
297   else if (ty == MPI_REAL4)          fprintf(f, "REAL4");
298#  endif
299#  if defined(MPI_REAL)
300   else if (ty == MPI_REAL)           fprintf(f, "REAL");
301#  endif
302#  if defined(MPI_INTEGER8)
303   else if (ty == MPI_INTEGER8)       fprintf(f, "INTEGER8");
304#  endif
305#  if defined(MPI_INTEGER4)
306   else if (ty == MPI_INTEGER4)       fprintf(f, "INTEGER4");
307#  endif
308#  if defined(MPI_INTEGER)
309   else if (ty == MPI_INTEGER)        fprintf(f, "INTEGER");
310#  endif
311#  if defined(MPI_DOUBLE_PRECISION)
312   else if (ty == MPI_DOUBLE_PRECISION) fprintf(f, "DOUBLE_PRECISION");
313#  endif
314#  if defined(MPI_COMPLEX)
315   else if (ty == MPI_COMPLEX)          fprintf(f, "COMPLEX");
316#  endif
317#  if defined(MPI_DOUBLE_COMPLEX)
318   else if (ty == MPI_DOUBLE_COMPLEX)   fprintf(f, "DOUBLE_COMPLEX");
319#  endif
320#  if defined(MPI_LOGICAL)
321   else if (ty == MPI_LOGICAL)          fprintf(f, "LOGICAL");
322#  endif
323#  if defined(MPI_2INTEGER)
324   else if (ty == MPI_2INTEGER)         fprintf(f, "2INTEGER");
325#  endif
326#  if defined(MPI_2COMPLEX)
327   else if (ty == MPI_2COMPLEX)         fprintf(f, "2COMPLEX");
328#  endif
329#  if defined(MPI_2DOUBLE_COMPLEX)
330   else if (ty == MPI_2DOUBLE_COMPLEX)  fprintf(f, "2DOUBLE_COMPLEX");
331#  endif
332#  if defined(MPI_2REAL)
333   else if (ty == MPI_2REAL)            fprintf(f, "2REAL");
334#  endif
335#  if defined(MPI_2DOUBLE_PRECISION)
336   else if (ty == MPI_2DOUBLE_PRECISION) fprintf(f, "2DOUBLE_PRECISION");
337#  endif
338#  if defined(MPI_CHARACTER)
339   else if (ty == MPI_CHARACTER)         fprintf(f, "CHARACTER");
340#  endif
341   else fprintf(f,"showTy:???");
342}
343
344static void showCombiner ( FILE* f, int combiner )
345{
346   switch (combiner) {
347      case MPI_COMBINER_NAMED:       fprintf(f, "NAMED"); break;
348#if   defined(MPI_COMBINER_DUP)
349      case MPI_COMBINER_DUP:         fprintf(f, "DUP"); break;
350#     endif
351      case MPI_COMBINER_CONTIGUOUS:  fprintf(f, "CONTIGUOUS"); break;
352      case MPI_COMBINER_VECTOR:      fprintf(f, "VECTOR"); break;
353#if   defined(MPI_COMBINER_HVECTOR_INTEGER)
354      case MPI_COMBINER_HVECTOR_INTEGER: fprintf(f, "HVECTOR_INTEGER"); break;
355#     endif
356      case MPI_COMBINER_HVECTOR:     fprintf(f, "HVECTOR"); break;
357      case MPI_COMBINER_INDEXED:     fprintf(f, "INDEXED"); break;
358#if   defined(MPI_COMBINER_HINDEXED_INTEGER)
359      case MPI_COMBINER_HINDEXED_INTEGER: fprintf(f, "HINDEXED_INTEGER"); break;
360#     endif
361      case MPI_COMBINER_HINDEXED:    fprintf(f, "HINDEXED"); break;
362#if   defined(MPI_COMBINER_INDEXED_BLOCK)
363      case MPI_COMBINER_INDEXED_BLOCK: fprintf(f, "INDEXED_BLOCK"); break;
364#     endif
365#if   defined(MPI_COMBINER_STRUCT_INTEGER)
366      case MPI_COMBINER_STRUCT_INTEGER: fprintf(f, "STRUCT_INTEGER"); break;
367#     endif
368      case MPI_COMBINER_STRUCT:      fprintf(f, "STRUCT"); break;
369#if   defined(MPI_COMBINER_SUBARRAY)
370      case MPI_COMBINER_SUBARRAY:    fprintf(f, "SUBARRAY"); break;
371#     endif
372#if   defined(MPI_COMBINER_DARRAY)
373      case MPI_COMBINER_DARRAY:      fprintf(f, "DARRAY"); break;
374#     endif
375#if   defined(MPI_COMBINER_F90_REAL)
376      case MPI_COMBINER_F90_REAL:    fprintf(f, "F90_REAL"); break;
377#     endif
378#if   defined(MPI_COMBINER_F90_COMPLEX)
379      case MPI_COMBINER_F90_COMPLEX: fprintf(f, "F90_COMPLEX"); break;
380#     endif
381#if   defined(MPI_COMBINER_F90_INTEGER)
382      case MPI_COMBINER_F90_INTEGER: fprintf(f, "F90_INTEGER"); break;
383#     endif
384#if   defined(MPI_COMBINER_RESIZED)
385      case MPI_COMBINER_RESIZED:     fprintf(f, "RESIZED"); break;
386#     endif
387      default: fprintf(f, "showCombiner:??"); break;
388   }
389}
390
391
392/* ------ Get useful bits of info ------ */
393
394/* Note, PMPI_Comm_rank/size are themselves wrapped.  Should work
395   fine. */
396
397static __inline__ int comm_rank ( MPI_Comm comm )
398{
399   int err, r;
400   err = PMPI_Comm_rank(comm, &r);
401   return err ? 0/*arbitrary*/ : r;
402}
403
404static __inline__ int comm_size ( MPI_Comm comm )
405{
406   int err, r;
407   err = PMPI_Comm_size(comm, &r);
408   return err ? 0/*arbitrary*/ : r;
409}
410
411static __inline__ Bool count_from_Status( /*OUT*/int* recv_count,
412                                      MPI_Datatype datatype,
413                                      MPI_Status* status)
414{
415   int n;
416   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
417   int err = PMPI_Get_count(status, datatype, &n);
418   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
419   if (err == MPI_SUCCESS) {
420      VALGRIND_MAKE_MEM_DEFINED(&n, sizeof(n));
421      *recv_count = n;
422      return True;
423   } else {
424      return False;
425   }
426}
427
428/* It's critical that we can do equality on MPI_Requests.
429   Unfortunately these are opaque objects to us (handles, in the
430   parlance of the MPI 1.1 spec).  Fortunately Sec 2.4.1 ("Opaque
431   Objects") specifies that "In C, [...] These [handles] should be
432   types that support assignment and equality operations."  Hence the
433   following function should compile for any compliant definition of
434   MPI_Request. */
435static __inline__
436Bool eq_MPI_Request ( MPI_Request r1, MPI_Request r2 )
437{
438   return r1 == r2;
439}
440
441/* Return True if status is MPI_STATUS_IGNORE or MPI_STATUSES_IGNORE.
442   On MPI-1.x platforms which don't have these symbols (and they would
443   only have them if they've been backported from 2.x) always return
444   False. */
445static __inline__
446Bool isMSI ( MPI_Status* status )
447{
448#  if defined(HAVE_MPI_STATUS_IGNORE)
449   return status == MPI_STATUSES_IGNORE || status == MPI_STATUS_IGNORE;
450#  else
451   return False;
452#  endif
453}
454
455/* Get the 'extent' of a type.  Note, as per the MPI spec this
456   includes whatever padding would be required when using 'ty' in an
457   array. */
458static long extentOfTy ( MPI_Datatype ty )
459{
460   int      r;
461   MPI_Aint n;
462   r = PMPI_Type_extent(ty, &n);
463   assert(r == MPI_SUCCESS);
464   return (long)n;
465}
466
467/* Free up *ty, if it is safe to do so */
468static void maybeFreeTy ( MPI_Datatype* ty )
469{
470   int r, n_ints, n_addrs, n_dtys, tycon;
471
472   r = PMPI_Type_get_envelope( *ty, &n_ints, &n_addrs, &n_dtys, &tycon );
473   assert(r == MPI_SUCCESS);
474
475   /* can't free named types */
476   if (tycon == MPI_COMBINER_NAMED)
477      return;
478
479   /* some kinds of structs are predefined so we can't free them
480      either. */
481   if (*ty == MPI_FLOAT_INT || *ty == MPI_DOUBLE_INT
482       || *ty == MPI_LONG_INT || *ty == MPI_2INT
483       || *ty == MPI_SHORT_INT || *ty == MPI_LONG_DOUBLE_INT)
484      return;
485
486   /* Looks OK - free it. */
487   if (0) {
488      /* show me what you're about to free .. */
489      fprintf(stderr, "freeing combiner ");
490      showCombiner(stderr,tycon);
491      fprintf(stderr, " ty= ");
492      showTy(stderr,*ty);
493      fprintf(stderr,"\n");
494   }
495   r = PMPI_Type_free(ty);
496   assert(r == MPI_SUCCESS);
497}
498
499/* How big is a "named" (base) type?  Returns 0 if not known.  Note.
500   There is a subtlety, which is that this is required to return the
501   exact size of one item of the type, NOT the size of it when padded
502   suitably to make an array of them.  In particular that's why the
503   size of LONG_DOUBLE is computed by looking at the result of doing a
504   long double store, rather than just asking what is the sizeof(long
505   double).
506
507   For LONG_DOUBLE on x86-linux and amd64-linux my impression is that
508   the right answer is 10 even though sizeof(long double) says 12 and
509   16 respectively.  On ppc32-linux it appears to be 16.
510
511   Ref: MPI 1.1 doc p18 */
512static long sizeofOneNamedTy ( MPI_Datatype ty )
513{
514   if (ty == MPI_CHAR)           return sizeof(signed char);
515   if (ty == MPI_SHORT)          return sizeof(signed short int);
516   if (ty == MPI_INT)            return sizeof(signed int);
517   if (ty == MPI_LONG)           return sizeof(signed long int);
518   if (ty == MPI_UNSIGNED_CHAR)  return sizeof(unsigned char);
519   if (ty == MPI_UNSIGNED_SHORT) return sizeof(unsigned short int);
520   if (ty == MPI_UNSIGNED)       return sizeof(unsigned int);
521   if (ty == MPI_UNSIGNED_LONG)  return sizeof(unsigned long int);
522   if (ty == MPI_FLOAT)          return sizeof(float);
523   if (ty == MPI_DOUBLE)         return sizeof(double);
524   if (ty == MPI_BYTE)           return 1;
525   if (ty == MPI_LONG_DOUBLE)    return sizeof_long_double_image();
526   if (ty == MPI_PACKED)         return 1;
527   if (ty == MPI_LONG_LONG_INT)  return sizeof(signed long long int);
528
529#  if defined(MPI_REAL8)
530   if (ty == MPI_REAL8)          return 8; /* MPI2 spec */;
531#  endif
532#  if defined(MPI_REAL4)
533   if (ty == MPI_REAL4)          return 4; /* MPI2 spec */;
534#  endif
535#  if defined(MPI_REAL)
536   if (ty == MPI_REAL)           return 4; /* MPI2 spec */;
537#  endif
538#  if defined(MPI_INTEGER8)
539   if (ty == MPI_INTEGER8)       return 8; /* MPI2 spec */;
540#  endif
541#  if defined(MPI_INTEGER4)
542   if (ty == MPI_INTEGER4)       return 4; /* MPI2 spec */;
543#  endif
544#  if defined(MPI_INTEGER)
545   if (ty == MPI_INTEGER)        return 4; /* MPI2 spec */;
546#  endif
547#  if defined(MPI_DOUBLE_PRECISION)
548   if (ty == MPI_DOUBLE_PRECISION) return 8; /* MPI2 spec */;
549#  endif
550
551   /* new in MPI2: */
552#  if defined(MPI_WCHAR)
553   if (ty == MPI_WCHAR)              return 2; /* MPI2 spec */;
554#  endif
555#  if defined(MPI_SIGNED_CHAR)
556   if (ty == MPI_SIGNED_CHAR)        return 1; /* MPI2 spec */;
557#  endif
558#  if defined(MPI_UNSIGNED_LONG_LONG)
559   if (ty == MPI_UNSIGNED_LONG_LONG) return 8; /* MPI2 spec */;
560#  endif
561#  if defined(MPI_COMPLEX)
562   if (ty == MPI_COMPLEX)            return 2 * 4; /* MPI2 spec */
563#  endif
564#  if defined(MPI_DOUBLE_COMPLEX)
565   if (ty == MPI_DOUBLE_COMPLEX)     return 2 * 8; /* MPI2 spec */
566#  endif
567#  if defined(MPI_LOGICAL)
568   if (ty == MPI_LOGICAL)            return 4; /* MPI2 spec */
569#  endif
570#  if defined(MPI_2INTEGER)
571   if (ty == MPI_2INTEGER)      return 2 * 4; /* undocumented in MPI2 */
572#  endif
573#  if defined(MPI_2COMPLEX)
574   if (ty == MPI_2COMPLEX)      return 2 * 8; /* undocumented in MPI2 */
575#  endif
576#  if defined(MPI_2DOUBLE_COMPLEX)
577   /* 32: this is how openmpi-1.2.2 behaves on x86-linux, but I have
578      really no idea if this is right. */
579   if (ty == MPI_2DOUBLE_COMPLEX)   return 32; /* undocumented in MPI2 */
580#  endif
581#  if defined(MPI_2REAL)
582   if (ty == MPI_2REAL)              return 2 * 4; /* undocumented in MPI2 */
583#  endif
584#  if defined(MPI_2DOUBLE_PRECISION)
585   if (ty == MPI_2DOUBLE_PRECISION)  return 2 * 8; /* undocumented in MPI2 */
586#  endif
587#  if defined(MPI_CHARACTER)
588   if (ty == MPI_CHARACTER)          return 1; /* MPI2 spec */
589#  endif
590
591   /* Note: the following are named structs, not named basic types,
592      and so are not handled here:
593         FLOAT_INT DOUBLE_INT LONG_INT 2INT SHORT_INT LONG_DOUBLE_INT
594      My guess is they are probably for doing max-w-index style
595      reductions, the INT carrying the index of the max/min and the
596      other type its actual value.
597   */
598   return 0;
599}
600
601
602/* Find the size of long double image (not 'sizeof(long double)').
603   See comments in sizeofOneNamedTy.
604*/
605static long sizeof_long_double_image ( void )
606{
607   long i;
608   unsigned char* p;
609   static long cached_result = 0;
610
611   /* Hopefully we have it already. */
612   if (cached_result != 0) {
613      assert(cached_result == 10 || cached_result == 16 || cached_result == 8);
614      return cached_result;
615   }
616
617   /* No?  Then we'll have to compute it.  This isn't thread-safe but
618      it doesn't really matter since all races to compute it should
619      produce the same answer. */
620   p = malloc(64);
621   assert(p);
622   for (i = 0; i < 64; i++)
623      p[i] = 0x55;
624
625   /* Write a value which isn't known at compile time and therefore
626      must come out of a register.  If we just store a constant here,
627      some compilers write more data than a store from a machine
628      register would.  Therefore we have to force a store from a
629      machine register by storing a value which isn't known at compile
630      time.  Since getpid() will return a value < 1 million, turn it
631      into a zero by dividing by 1e+30. */
632   *(long double*)(&p[16]) = (long double)(1.0e-30 * (double)getpid());
633
634   for (i = 0; i < 16; i++) {
635      assert(p[i] == 0x55);
636      assert(p[i+48] == 0x55);
637   }
638   for (i = 16; i <= 48; i++) {
639      if (p[i] == 0x55)
640         break;
641   }
642
643   assert(i < 48);
644   assert(i > 16);
645   free(p);
646   cached_result = i - 16;
647
648   if (0)
649      printf("sizeof_long_double_image: computed %d\n", (int)cached_result);
650
651   assert(cached_result == 10 || cached_result == 16 || cached_result == 8);
652   return cached_result;
653}
654
655
656/*------------------------------------------------------------*/
657/*--- Unpicking datatypes                                  ---*/
658/*------------------------------------------------------------*/
659
660static __inline__
661void walk_type_array ( void(*f)(void*,long), char* base,
662                       MPI_Datatype ty, long count );
663
664
665/* Walk over all fragments of the object of type 'ty' with base
666   address 'base', and apply 'f' to the start/length of each
667   contiguous fragment. */
668static
669void walk_type ( void(*f)(void*,long), char* base, MPI_Datatype ty )
670{
671   int  r, n_ints, n_addrs, n_dtys, tycon;
672   long ex, i;
673   int*          ints  = NULL;
674   MPI_Aint*     addrs = NULL;
675   MPI_Datatype* dtys  = NULL;
676
677   /* Stuff for limiting how much complaining text it spews out */
678   static int complaints = 3;
679   static int last_complained_about_tycon = -987654321; /* presumably bogus */
680
681   if (0)
682      printf("walk_type %p\n", (void*)(unsigned long)ty);
683
684   r = PMPI_Type_get_envelope( ty, &n_ints, &n_addrs, &n_dtys, &tycon );
685   assert(r == MPI_SUCCESS);
686
687   /* Handle the base cases fast(er/ish). */
688   if (tycon == MPI_COMBINER_NAMED) {
689      long sz = sizeofOneNamedTy(ty);
690      if (sz > 0) {
691         f(base, sz);
692         return;
693      }
694      /* Hmm.  Perhaps it's a named struct?  Unfortunately we can't
695         take them to bits so we have to do a really ugly hack, which
696         makes assumptions about how the MPI implementation has laid
697         out these types.  At least Open MPI 1.0.1 appears to put
698         the 'val' field first.  MPICH2 agrees.
699      */
700      if (ty == MPI_2INT) {
701         typedef struct { int val; int loc; } Ty;
702         f(base + offsetof(Ty,val), sizeof(int));
703         f(base + offsetof(Ty,loc), sizeof(int));
704         return;
705      }
706      if (ty == MPI_LONG_INT) {
707         typedef struct { long val; int loc; } Ty;
708         f(base + offsetof(Ty,val), sizeof(long));
709         f(base + offsetof(Ty,loc), sizeof(int));
710         return;
711      }
712      if (ty == MPI_DOUBLE_INT) {
713         typedef struct { double val; int loc; } Ty;
714         f(base + offsetof(Ty,val), sizeof(double));
715         f(base + offsetof(Ty,loc), sizeof(int));
716         return;
717      }
718      if (ty == MPI_SHORT_INT) {
719         typedef struct { short val; int loc; } Ty;
720         f(base + offsetof(Ty,val), sizeof(short));
721         f(base + offsetof(Ty,loc), sizeof(int));
722         return;
723      }
724      if (ty == MPI_FLOAT_INT) {
725         typedef struct { float val; int loc; } Ty;
726         f(base + offsetof(Ty,val), sizeof(float));
727         f(base + offsetof(Ty,loc), sizeof(int));
728         return;
729      }
730      if (ty == MPI_LONG_DOUBLE_INT) {
731         typedef struct { long double val; int loc; } Ty;
732         f(base + offsetof(Ty,val), sizeof_long_double_image());
733         f(base + offsetof(Ty,loc), sizeof(int));
734         return;
735      }
736      if (ty == MPI_LB || ty == MPI_UB)
737         return; /* have zero size, so nothing needs to be done */
738      goto unhandled;
739      /*NOTREACHED*/
740   }
741
742   if (0) {
743      ex = extentOfTy(ty);
744      printf("tycon 0x%llx %d %d %d (ext %d)\n",
745             (unsigned long long int)tycon,
746             n_ints, n_addrs, n_dtys, (int)ex );
747   }
748
749   /* Now safe to do MPI_Type_get_contents */
750   assert(n_ints  >= 0);
751   assert(n_addrs >= 0);
752   assert(n_dtys  >= 0);
753
754   if (n_ints  > 0) {
755      ints = malloc(n_ints * sizeof(int));
756      assert(ints);
757   }
758   if (n_addrs > 0) {
759      addrs = malloc(n_addrs * sizeof(MPI_Aint));
760      assert(addrs);
761   }
762   if (n_dtys  > 0) {
763      dtys = malloc(n_dtys * sizeof(MPI_Datatype));
764      assert(dtys);
765   }
766
767   r = PMPI_Type_get_contents( ty, n_ints, n_addrs, n_dtys,
768                                   ints, addrs, dtys );
769   assert(r == MPI_SUCCESS);
770
771   switch (tycon) {
772
773      case MPI_COMBINER_CONTIGUOUS:
774         assert(n_ints == 1 && n_addrs == 0 && n_dtys == 1);
775	 walk_type_array( f, base, dtys[0], ints[0] );
776         maybeFreeTy( &dtys[0] );
777         break;
778
779      case MPI_COMBINER_VECTOR:
780         assert(n_ints == 3 && n_addrs == 0 && n_dtys == 1);
781         ex = extentOfTy(dtys[0]);
782         if (0)
783         printf("vector count %d x (bl %d stride %d)\n",
784                (int)ints[0], (int)ints[1], (int)ints[2]);
785         for (i = 0; i < ints[0]; i++) {
786            walk_type_array( f, base + i * ints[2]/*stride*/ * ex,
787                                dtys[0], ints[1]/*blocklength*/ );
788         }
789         maybeFreeTy( &dtys[0] );
790         break;
791
792      case MPI_COMBINER_HVECTOR:
793         assert(n_ints == 2 && n_addrs == 1 && n_dtys == 1);
794         ex = extentOfTy(dtys[0]);
795         if (0)
796         printf("hvector count %d x (bl %d hstride %d)\n",
797                (int)ints[0], (int)ints[1], (int)addrs[0]);
798         for (i = 0; i < ints[0]; i++) {
799            walk_type_array( f, base + i * addrs[0]/*hstride*/,
800                                dtys[0], ints[1]/*blocklength*/ );
801         }
802         maybeFreeTy( &dtys[0] );
803         break;
804
805      case MPI_COMBINER_INDEXED:
806         assert(n_addrs == 0 && n_dtys == 1);
807         assert(n_ints > 0);
808         assert(n_ints == 2 * ints[0] + 1);
809         ex = extentOfTy(dtys[0]);
810         for (i = 0; i < ints[0]; i++) {
811            if (0)
812            printf("indexed (elem %d) off %d copies %d\n",
813                   (int)i, ints[i+1+ints[0]], ints[i+1] );
814            walk_type_array( f, base + ex * ints[i+1+ints[0]],
815                                dtys[0], ints[i+1] );
816         }
817         maybeFreeTy( &dtys[0] );
818         break;
819
820      case MPI_COMBINER_HINDEXED:
821         assert(n_ints > 0);
822         assert(n_ints == ints[0] + 1);
823         assert(n_addrs == ints[0] && n_dtys == 1);
824         ex = extentOfTy(dtys[0]);
825         for (i = 0; i < ints[0]; i++) {
826            if (0)
827            printf("hindexed (elem %d) hoff %d copies %d\n",
828                   (int)i, (int)addrs[i], ints[i+1] );
829            walk_type_array( f, base + addrs[i],
830                                dtys[0], ints[i+1] );
831         }
832         maybeFreeTy( &dtys[0] );
833         break;
834
835      case MPI_COMBINER_STRUCT:
836         assert(n_addrs == n_ints-1);
837         assert(n_dtys  == n_ints-1);
838         assert(n_ints > 0);
839         assert(n_ints == ints[0] + 1);
840	 for (i = 0; i < ints[0]; i++) {
841            if (0)
842            printf("struct (elem %d limit %d) hoff %d copies %d\n",
843                   (int)i, (int)ints[0], (int)addrs[i], (int)ints[i+1]);
844            walk_type_array( f, base + addrs[i], dtys[i], (long)ints[i+1] );
845            maybeFreeTy( &dtys[i] );
846	 }
847         break;
848
849      default:
850         goto unhandled;
851
852   }
853
854   /* normal exit */
855   if (ints)  free(ints);
856   if (addrs) free(addrs);
857   if (dtys)  free(dtys);
858   return;
859
860  unhandled:
861   /* Complain, but limit the amount of complaining that can happen to
862      the first 3 different unhandled tycons that show up, so as to
863      avoid swamping users with thousands of duplicate messages. */
864   if (complaints > 0 && tycon != last_complained_about_tycon) {
865      complaints--;
866      last_complained_about_tycon = tycon;
867      if (tycon == MPI_COMBINER_NAMED) {
868         fprintf(stderr, "%s %5d: walk_type: unhandled base type 0x%lx ",
869                         preamble, my_pid, (long)ty);
870         showTy(stderr, ty);
871         fprintf(stderr, "\n");
872      } else {
873         fprintf(stderr, "%s %5d: walk_type: unhandled combiner 0x%lx\n",
874                         preamble, my_pid, (long)tycon);
875      }
876   }
877   if (ints)  free(ints);
878   if (addrs) free(addrs);
879   if (dtys)  free(dtys);
880   if (opt_missing >= 2)
881      barf("walk_type: unhandled combiner, strict checking selected");
882}
883
884
885/* Same as walk_type but apply 'f' to every element in an array of
886   'count' items starting at 'base'.  The only purpose of pushing this
887   into a different routine is so it can attempt to optimise the case
888   where the array elements are contiguous and packed together without
889   holes. */
890static __inline__
891void walk_type_array ( void(*f)(void*,long), char* base,
892                       MPI_Datatype elemTy, long count )
893{
894   long i, ex;
895
896   assert(sizeof(unsigned long) == sizeof(char*));
897
898   /* First see if we can do this the fast way. */
899   ex = sizeofOneNamedTy(elemTy);
900
901   if ( /* ty is a primitive type with power-of-2 size */
902        (ex == 8 || ex == 4 || ex == 2 || ex == 1)
903        && /* base is suitably aligned for ty */
904           ( ((unsigned long)base) & (ex-1)) == 0)  {
905
906      /* We're sure it's contiguous, so just paint/check it in one
907         go. */
908     if (0) printf("walk_type_array fast %ld of size %ld\n", count, ex );
909     f ( base, count * ex );
910
911   } else {
912
913      /* Bad news.  We have to futz with each element individually.
914         This could be very expensive.
915
916         Note: subtle.  If ty is LONG_DOUBLE then the extent will be
917         12, so the following loop will jump along in steps of 12, but
918         the size painted by walk_type will be 10 since it uses
919         sizeofOneNamedTy to establish the size of base types.  Which
920         is what we need to happen. */
921      ex = extentOfTy(elemTy);
922      if (0) printf("walk_type_array SLOW %ld of size %ld\n", count, ex );
923      for (i = 0; i < count; i++)
924         walk_type( f, base + i * ex, elemTy );
925
926   }
927}
928
929
930/* Hook so it's visible from outside (can be handy to dlopen/dlsym
931   it) */
932void mpiwrap_walk_type_EXTERNALLY_VISIBLE
933    ( void(*f)(void*,long), char* base, MPI_Datatype ty )
934{
935   walk_type(f, base, ty);
936}
937
938
939/*------------------------------------------------------------*/
940/*--- Address-range helpers                                ---*/
941/*------------------------------------------------------------*/
942
943/* ----------------
944   Do corresponding checks on memory areas defined using a
945   straightforward (start, length) description.
946   ----------------
947*/
948
949static __inline__
950void check_mem_is_defined_untyped ( void* buffer, long nbytes )
951{
952   if (nbytes > 0) {
953      VALGRIND_CHECK_MEM_IS_DEFINED(buffer, nbytes);
954   }
955}
956
957static __inline__
958void check_mem_is_addressable_untyped ( void* buffer, long nbytes )
959{
960   if (nbytes > 0) {
961      VALGRIND_CHECK_MEM_IS_ADDRESSABLE(buffer, nbytes);
962   }
963}
964
965static __inline__
966void make_mem_defined_if_addressable_untyped ( void* buffer, long nbytes )
967{
968   if (nbytes > 0) {
969      VALGRIND_MAKE_MEM_DEFINED_IF_ADDRESSABLE(buffer, nbytes);
970   }
971}
972
973static __inline__
974void make_mem_defined_if_addressable_if_success_untyped ( int err,
975                                       void* buffer, long nbytes )
976{
977   if (err == MPI_SUCCESS && nbytes > 0) {
978      VALGRIND_MAKE_MEM_DEFINED_IF_ADDRESSABLE(buffer, nbytes);
979   }
980}
981
982
983/* ----------------
984   Do checks on memory areas defined using the MPI (buffer, count,
985   type) convention.
986   ----------------
987*/
988
989/* Check that the specified area is both addressible and contains
990   initialised data, and cause V to complain if not. */
991
992static __inline__
993void check_mem_is_defined ( char* buffer, long count, MPI_Datatype datatype )
994{
995   walk_type_array( check_mem_is_defined_untyped, buffer, datatype, count );
996}
997
998
999/* Check that the specified area is addressible, and cause V to
1000   complain if not. Doesn't matter whether the data there is
1001   initialised or not. */
1002
1003static __inline__
1004void check_mem_is_addressable ( void *buffer, long count, MPI_Datatype datatype )
1005{
1006   walk_type_array( check_mem_is_addressable_untyped, buffer, datatype, count );
1007}
1008
1009
1010/* Set the specified area to 'defined for each byte which is
1011   addressible' state. */
1012
1013static __inline__
1014void make_mem_defined_if_addressable ( void *buffer, int count, MPI_Datatype datatype )
1015{
1016   walk_type_array( make_mem_defined_if_addressable_untyped,
1017                    buffer, datatype, count );
1018}
1019
1020static __inline__
1021void
1022make_mem_defined_if_addressable_if_success ( int err, void *buffer, int count,
1023                                             MPI_Datatype datatype )
1024{
1025   if (err == MPI_SUCCESS)
1026      make_mem_defined_if_addressable(buffer, count, datatype);
1027}
1028
1029
1030/*------------------------------------------------------------*/
1031/*---                                                      ---*/
1032/*--- The wrappers proper.   They are listed in the order  ---*/
1033/*--- in which they appear in "MPI: A Message-Passing      ---*/
1034/*--- Interface Standard, MPIF, Nov 15 2003" (the MPI 1.1  ---*/
1035/*--- spec.  All unimplemented wrappers are listed at the  ---*/
1036/*--- end of the file.  The list of function names is      ---*/
1037/*--- taken from the headers of Open MPI svn r9191.        ---*/
1038/*--- Hopefully it is a complete list of all the MPI 2     ---*/
1039/*--- functions.                                           ---*/
1040/*---                                                      ---*/
1041/*------------------------------------------------------------*/
1042
1043/* Handy abbreviation */
1044#define WRAPPER_FOR(name) I_WRAP_FNNAME_U(name)
1045
1046/* Generates (conceptually) a wrapper which does nothing.  In
1047   fact just generate no wrapper at all. */
1048#define HAS_NO_WRAPPER(basename) /* */
1049
1050
1051/*------------------------------------------------------------*/
1052/*---                                                      ---*/
1053/*--- Sec 3.2, Blocking Send and Receive Operations        ---*/
1054/*---                                                      ---*/
1055/*------------------------------------------------------------*/
1056
1057/* --- {,B,S,R}Send --- */
1058/* pre: rd: (buf,count,datatype) */
1059static
1060int generic_Send(void *buf, int count, MPI_Datatype datatype,
1061                            int dest, int tag, MPI_Comm comm)
1062{
1063   OrigFn fn;
1064   int    err;
1065   VALGRIND_GET_ORIG_FN(fn);
1066   before("{,B,S,R}Send");
1067   check_mem_is_defined(buf, count, datatype);
1068   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1069   CALL_FN_W_6W(err, fn, buf,count,datatype,dest,tag,comm);
1070   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1071   after("{,B,S,R}Send", err);
1072   return err;
1073}
1074int WRAPPER_FOR(PMPI_Send)(void *buf, int count, MPI_Datatype datatype,
1075                           int dest, int tag, MPI_Comm comm) {
1076   return generic_Send(buf,count,datatype, dest,tag,comm);
1077}
1078int WRAPPER_FOR(PMPI_Bsend)(void *buf, int count, MPI_Datatype datatype,
1079                            int dest, int tag, MPI_Comm comm) {
1080   return generic_Send(buf,count,datatype, dest,tag,comm);
1081}
1082int WRAPPER_FOR(PMPI_Ssend)(void *buf, int count, MPI_Datatype datatype,
1083                            int dest, int tag, MPI_Comm comm) {
1084   return generic_Send(buf,count,datatype, dest,tag,comm);
1085}
1086int WRAPPER_FOR(PMPI_Rsend)(void *buf, int count, MPI_Datatype datatype,
1087                            int dest, int tag, MPI_Comm comm) {
1088   return generic_Send(buf,count,datatype, dest,tag,comm);
1089}
1090
1091/* --- Recv --- */
1092/* pre:  must be writable: (buf,count,datatype)
1093         must be writable: status
1094   post: make readable: (buf,recv_count,datatype)
1095         where recv_count is determined from *status
1096*/
1097int WRAPPER_FOR(PMPI_Recv)(void *buf, int count, MPI_Datatype datatype,
1098                           int source, int tag,
1099                           MPI_Comm comm, MPI_Status *status)
1100{
1101   OrigFn     fn;
1102   int        err, recv_count = 0;
1103   MPI_Status fake_status;
1104   VALGRIND_GET_ORIG_FN(fn);
1105   before("Recv");
1106   if (isMSI(status))
1107      status = &fake_status;
1108   check_mem_is_addressable(buf, count, datatype);
1109   check_mem_is_addressable_untyped(status, sizeof(*status));
1110   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1111   CALL_FN_W_7W(err, fn, buf,count,datatype,source,tag,comm,status);
1112   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1113   make_mem_defined_if_addressable_if_success_untyped(err, status, sizeof(*status));
1114   if (err == MPI_SUCCESS && count_from_Status(&recv_count,datatype,status)) {
1115      make_mem_defined_if_addressable(buf, recv_count, datatype);
1116   }
1117   after("Recv", err);
1118   return err;
1119}
1120
1121/* --- Get_count --- */
1122/* pre:  must be readable: *status
1123   post: make defined: *count -- don't bother, libmpi will surely do this
1124*/
1125int WRAPPER_FOR(PMPI_Get_count)(MPI_Status* status,
1126                                MPI_Datatype ty, int* count )
1127{
1128   OrigFn fn;
1129   int    err;
1130   VALGRIND_GET_ORIG_FN(fn);
1131   before("Get_count");
1132   check_mem_is_defined_untyped(status, sizeof(*status));
1133   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1134   CALL_FN_W_WWW(err, fn, status,ty,count);
1135   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1136   after("Get_count", err);
1137   return err;
1138}
1139
1140
1141/*------------------------------------------------------------*/
1142/*---                                                      ---*/
1143/*--- Sec 3.7, Nonblocking communication                   ---*/
1144/*---                                                      ---*/
1145/*------------------------------------------------------------*/
1146
1147/* Maintain a table that makes it possible for the wrappers to
1148   complete MPI_Irecv successfully.
1149
1150   The issue is that MPI_Irecv states the recv buffer and returns
1151   immediately, giving a handle (MPI_Request) for the transaction.
1152   Later the user will have to poll for completion with MPI_Wait etc,
1153   and at that point these wrappers have to paint the recv buffer.
1154   But the recv buffer details are not presented to MPI_Wait - only
1155   the handle is.  We therefore have to use a shadow table
1156   (sReqs{,_size,_used,_lock}) which associates uncompleted
1157   MPI_Requests with the corresponding buffer address/count/type.
1158
1159   Only read requests are placed in the table, since there is no need
1160   to do any buffer painting following completion of an Isend - all
1161   the checks for that are done at the time Isend is called.
1162
1163   Care has to be take to remove completed requests from the table.
1164
1165   Access to the table is guarded by sReqs_lock so as to make it
1166   thread-safe.
1167*/
1168
1169typedef
1170   struct {
1171      Bool         inUse;
1172      MPI_Request  key;
1173      void*        buf;
1174      int          count;
1175      MPI_Datatype datatype;
1176   }
1177   ShadowRequest;
1178
1179static ShadowRequest*  sReqs      = NULL;
1180static int             sReqs_size = 0;
1181static int             sReqs_used = 0;
1182static pthread_mutex_t sReqs_lock = PTHREAD_MUTEX_INITIALIZER;
1183
1184#define LOCK_SREQS                                  \
1185  do { int pr = pthread_mutex_lock(&sReqs_lock);    \
1186       assert(pr == 0);                             \
1187  } while (0)
1188
1189#define UNLOCK_SREQS                                \
1190  do { int pr = pthread_mutex_unlock(&sReqs_lock);  \
1191       assert(pr == 0);                             \
1192  } while (0)
1193
1194
1195/* Ensure the sReqs expandable array has at least one free slot, by
1196   copying it into a larger one if necessary.  NOTE: sReqs_lock is
1197   held throughout this procedure.*/
1198static void ensure_sReq_space ( void )
1199{
1200   int            i;
1201   ShadowRequest* sReqs2;
1202   if (sReqs_used == sReqs_size) {
1203      sReqs_size = sReqs_size==0 ? 2 : 2*sReqs_size;
1204      sReqs2 = malloc( sReqs_size * sizeof(ShadowRequest) );
1205      if (sReqs2 == NULL) {
1206         UNLOCK_SREQS;
1207         barf("add_shadow_Request: malloc failed.\n");
1208      }
1209      for (i = 0; i < sReqs_used; i++)
1210         sReqs2[i] = sReqs[i];
1211      if (sReqs)
1212         free(sReqs);
1213      sReqs = sReqs2;
1214   }
1215   assert(sReqs_used < sReqs_size);
1216}
1217
1218
1219/* Find shadow info for 'request', or NULL if none. */
1220
1221static
1222ShadowRequest* find_shadow_Request ( MPI_Request request )
1223{
1224   ShadowRequest* ret = NULL;
1225   int i;
1226   LOCK_SREQS;
1227   for (i = 0; i < sReqs_used; i++) {
1228      if (sReqs[i].inUse && eq_MPI_Request(sReqs[i].key,request)) {
1229         ret = &sReqs[i];
1230         break;
1231      }
1232   }
1233   UNLOCK_SREQS;
1234   return ret;
1235}
1236
1237
1238/* Delete shadow info for 'request', if any. */
1239
1240static void delete_shadow_Request ( MPI_Request request )
1241{
1242   int i;
1243   LOCK_SREQS;
1244   for (i = 0; i < sReqs_used; i++) {
1245      if (sReqs[i].inUse && eq_MPI_Request(sReqs[i].key,request)) {
1246         sReqs[i].inUse = False;
1247         break;
1248      }
1249   }
1250   UNLOCK_SREQS;
1251}
1252
1253
1254/* Add a shadow for 'request', overwriting any old binding for it. */
1255
1256static
1257void add_shadow_Request( MPI_Request request,
1258                         void* buf, int count,
1259                         MPI_Datatype datatype )
1260{
1261   int i, ix = -1;
1262   LOCK_SREQS;
1263   assert(sReqs_used >= 0);
1264   assert(sReqs_size >= 0);
1265   assert(sReqs_used <= sReqs_size);
1266   if (sReqs == NULL) assert(sReqs_size == 0);
1267
1268   /* First of all see if we already have a binding for this key; if
1269      so just replace it, and have done. */
1270   for (i = 0; i < sReqs_used; i++) {
1271      if (sReqs[i].inUse && eq_MPI_Request(sReqs[i].key,request)) {
1272         ix = i;
1273         break;
1274      }
1275   }
1276
1277   if (ix < 0) {
1278      /* Ok, we don't have it, so will have to add it.  First search
1279         to see if there is an existing empty slot. */
1280      for (i = 0; i < sReqs_used; i++) {
1281         if (!sReqs[i].inUse) {
1282            ix = i;
1283            break;
1284         }
1285      }
1286   }
1287
1288   /* No empty slots.  Allocate a new one. */
1289   if (ix < 0) {
1290      ensure_sReq_space();
1291      assert(sReqs_used < sReqs_size);
1292      ix = sReqs_used;
1293      sReqs_used++;
1294   }
1295
1296   assert(ix >= 0 && ix < sReqs_used);
1297   assert(sReqs_used <= sReqs_size);
1298
1299   sReqs[ix].inUse    = True;
1300   sReqs[ix].key      = request;
1301   sReqs[ix].buf      = buf;
1302   sReqs[ix].count    = count;
1303   sReqs[ix].datatype = datatype;
1304
1305   UNLOCK_SREQS;
1306   if (opt_verbosity > 1)
1307      fprintf(stderr, "%s %5d: sReq+ 0x%lx -> b/c/d %p/%d/0x%lx [slot %d]\n",
1308                      preamble, my_pid, (unsigned long)request,
1309                                buf, count, (long)datatype, ix);
1310}
1311
1312static
1313MPI_Request* clone_Request_array ( int count, MPI_Request* orig )
1314{
1315   MPI_Request* copy;
1316   int i;
1317   LOCK_SREQS;
1318   if (count < 0)
1319      count = 0; /* Hmm.  Call Mulder and Scully. */
1320   copy = malloc( count * sizeof(MPI_Request) );
1321   if (copy == NULL && count > 0) {
1322      UNLOCK_SREQS;
1323      barf("clone_Request_array: malloc failed");
1324   }
1325   for (i = 0; i < count; i++)
1326      copy[i] = orig[i];
1327   UNLOCK_SREQS;
1328   return copy;
1329}
1330
1331#undef LOCK_SREQS
1332#undef UNLOCK_SREQS
1333
1334
1335static void maybe_complete ( Bool         error_in_status,
1336                             MPI_Request  request_before,
1337                             MPI_Request  request_after,
1338                             MPI_Status*  status )
1339{
1340   int recv_count = 0;
1341   ShadowRequest* shadow;
1342   /* How do we know if this is an Irecv request that has now
1343      finished successfully?
1344
1345      request_before isn't MPI_REQUEST_NULL
1346      and request_before is found in the shadow table
1347      and request_after *is* MPI_REQUEST_NULL
1348      and (if error_in_status then status.MPI_ERROR is MPI_SUCCESS)
1349
1350      (when error_in_status == False, then we expect not to get
1351      called at all if there was an error.)
1352   */
1353   if (request_before != MPI_REQUEST_NULL
1354       && request_after == MPI_REQUEST_NULL
1355       && (error_in_status ? status->MPI_ERROR == MPI_SUCCESS : True)
1356       && ( (shadow=find_shadow_Request(request_before)) != NULL) ) {
1357      /* The Irecv detailed in 'shadow' completed.  Paint the result
1358         buffer, and delete the entry. */
1359      if (count_from_Status(&recv_count, shadow->datatype, status)) {
1360         make_mem_defined_if_addressable(shadow->buf, recv_count, shadow->datatype);
1361         if (opt_verbosity > 1)
1362            fprintf(stderr, "%s %5d: sReq- %p (completed)\n",
1363                            preamble, my_pid, request_before);
1364      }
1365      delete_shadow_Request(request_before);
1366   }
1367}
1368
1369
1370/* --- Isend --- */
1371/* rd: (buf,count,datatype) */
1372/* wr: *request */
1373static __inline__
1374int generic_Isend(void *buf, int count, MPI_Datatype datatype,
1375                             int dest, int tag, MPI_Comm comm,
1376                             MPI_Request* request)
1377{
1378   OrigFn fn;
1379   int    err;
1380   VALGRIND_GET_ORIG_FN(fn);
1381   before("{,B,S,R}Isend");
1382   check_mem_is_defined(buf, count, datatype);
1383   check_mem_is_addressable_untyped(request, sizeof(*request));
1384   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1385   CALL_FN_W_7W(err, fn, buf,count,datatype,dest,tag,comm,request);
1386   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1387   make_mem_defined_if_addressable_if_success_untyped(err, request, sizeof(*request));
1388   after("{,B,S,R}Isend", err);
1389   return err;
1390}
1391int WRAPPER_FOR(PMPI_Isend)(void *buf, int count, MPI_Datatype datatype,
1392                            int dest, int tag, MPI_Comm comm,
1393                            MPI_Request* request) {
1394   return generic_Isend(buf,count,datatype, dest,tag,comm, request);
1395}
1396int WRAPPER_FOR(PMPI_Ibsend)(void *buf, int count, MPI_Datatype datatype,
1397                             int dest, int tag, MPI_Comm comm,
1398                             MPI_Request* request) {
1399   return generic_Isend(buf,count,datatype, dest,tag,comm, request);
1400}
1401int WRAPPER_FOR(PMPI_Issend)(void *buf, int count, MPI_Datatype datatype,
1402                             int dest, int tag, MPI_Comm comm,
1403                             MPI_Request* request) {
1404   return generic_Isend(buf,count,datatype, dest,tag,comm, request);
1405}
1406int WRAPPER_FOR(PMPI_Irsend)(void *buf, int count, MPI_Datatype datatype,
1407                             int dest, int tag, MPI_Comm comm,
1408                             MPI_Request* request) {
1409   return generic_Isend(buf,count,datatype, dest,tag,comm, request);
1410}
1411
1412
1413/* --- Irecv --- */
1414/* pre:  must be writable: (buf,count,datatype), *request
1415   post: make readable *request
1416         add a request->(buf,count,ty) binding to the
1417         shadow request table.
1418*/
1419int WRAPPER_FOR(PMPI_Irecv)( void* buf, int count, MPI_Datatype datatype,
1420                             int source, int tag, MPI_Comm comm,
1421                             MPI_Request* request )
1422{
1423   OrigFn fn;
1424   int    err;
1425   VALGRIND_GET_ORIG_FN(fn);
1426   before("Irecv");
1427   check_mem_is_addressable(buf, count, datatype);
1428   check_mem_is_addressable_untyped(request, sizeof(*request));
1429   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1430   CALL_FN_W_7W(err, fn, buf,count,datatype,source,tag,comm,request);
1431   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1432   if (err == MPI_SUCCESS) {
1433      make_mem_defined_if_addressable_untyped(request, sizeof(*request));
1434      add_shadow_Request( *request, buf,count,datatype );
1435   }
1436   after("Irecv", err);
1437   return err;
1438}
1439
1440/* --- Wait --- */
1441/* The MPI1 spec (imprecisely) defines 3 request states:
1442   - "null"     if the request is MPI_REQUEST_NULL
1443   - "inactive" if not "null" and not associated with ongoing comms
1444   - "active"   if not "null" and is associated with ongoing comms
1445*/
1446int WRAPPER_FOR(PMPI_Wait)( MPI_Request* request,
1447                            MPI_Status* status )
1448{
1449   MPI_Request  request_before;
1450   MPI_Status   fake_status;
1451   OrigFn       fn;
1452   int          err;
1453   VALGRIND_GET_ORIG_FN(fn);
1454   before("Wait");
1455   if (isMSI(status))
1456      status = &fake_status;
1457   check_mem_is_addressable_untyped(status, sizeof(MPI_Status));
1458   check_mem_is_defined_untyped(request, sizeof(MPI_Request));
1459   request_before = *request;
1460   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1461   CALL_FN_W_WW(err, fn, request,status);
1462   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1463   if (err == MPI_SUCCESS) {
1464      maybe_complete(False/*err in status?*/,
1465                     request_before, *request, status);
1466      make_mem_defined_if_addressable_untyped(status, sizeof(MPI_Status));
1467   }
1468   after("Wait", err);
1469   return err;
1470}
1471
1472/* --- Waitany --- */
1473int WRAPPER_FOR(PMPI_Waitany)( int count,
1474                               MPI_Request* requests,
1475                               int* index,
1476                               MPI_Status* status )
1477{
1478   MPI_Request* requests_before = NULL;
1479   MPI_Status   fake_status;
1480   OrigFn       fn;
1481   int          err, i;
1482   VALGRIND_GET_ORIG_FN(fn);
1483   before("Waitany");
1484   if (isMSI(status))
1485      status = &fake_status;
1486   if (0) fprintf(stderr, "Waitany: %d\n", count);
1487   check_mem_is_addressable_untyped(index, sizeof(int));
1488   check_mem_is_addressable_untyped(status, sizeof(MPI_Status));
1489   for (i = 0; i < count; i++) {
1490      check_mem_is_defined_untyped(&requests[i], sizeof(MPI_Request));
1491   }
1492   requests_before = clone_Request_array( count, requests );
1493   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1494   CALL_FN_W_WWWW(err, fn, count,requests,index,status);
1495   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1496   if (err == MPI_SUCCESS && *index >= 0 && *index < count) {
1497      maybe_complete(False/*err in status?*/,
1498                     requests_before[*index], requests[*index], status);
1499      make_mem_defined_if_addressable_untyped(status, sizeof(MPI_Status));
1500   }
1501   if (requests_before)
1502      free(requests_before);
1503   after("Waitany", err);
1504   return err;
1505}
1506
1507/* --- Waitall --- */
1508int WRAPPER_FOR(PMPI_Waitall)( int count,
1509                               MPI_Request* requests,
1510                               MPI_Status* statuses )
1511{
1512   MPI_Request* requests_before = NULL;
1513   OrigFn       fn;
1514   int          err, i;
1515   Bool         free_sta = False;
1516   VALGRIND_GET_ORIG_FN(fn);
1517   before("Waitall");
1518   if (0) fprintf(stderr, "Waitall: %d\n", count);
1519   if (isMSI(statuses)) {
1520      free_sta = True;
1521      statuses = malloc( (count < 0 ? 0 : count) * sizeof(MPI_Status) );
1522   }
1523   for (i = 0; i < count; i++) {
1524      check_mem_is_addressable_untyped(&statuses[i], sizeof(MPI_Status));
1525      check_mem_is_defined_untyped(&requests[i], sizeof(MPI_Request));
1526   }
1527   requests_before = clone_Request_array( count, requests );
1528   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1529   CALL_FN_W_WWW(err, fn, count,requests,statuses);
1530   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1531   if (err == MPI_SUCCESS /*complete success*/
1532       || err == MPI_ERR_IN_STATUS /* partial success */) {
1533      Bool e_i_s = err == MPI_ERR_IN_STATUS;
1534      for (i = 0; i < count; i++) {
1535         maybe_complete(e_i_s, requests_before[i], requests[i],
1536                               &statuses[i]);
1537         make_mem_defined_if_addressable_untyped(&statuses[i],
1538                                                 sizeof(MPI_Status));
1539      }
1540   }
1541   if (requests_before)
1542      free(requests_before);
1543   if (free_sta)
1544      free(statuses);
1545   after("Waitall", err);
1546   return err;
1547}
1548
1549/* --- Test --- */
1550/* nonblocking version of Wait */
1551int WRAPPER_FOR(PMPI_Test)( MPI_Request* request, int* flag,
1552                            MPI_Status* status )
1553{
1554   MPI_Request  request_before;
1555   MPI_Status   fake_status;
1556   OrigFn       fn;
1557   int          err;
1558   VALGRIND_GET_ORIG_FN(fn);
1559   before("Test");
1560   if (isMSI(status))
1561      status = &fake_status;
1562   check_mem_is_addressable_untyped(status, sizeof(MPI_Status));
1563   check_mem_is_addressable_untyped(flag, sizeof(int));
1564   check_mem_is_defined_untyped(request, sizeof(MPI_Request));
1565   request_before = *request;
1566   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1567   CALL_FN_W_WWW(err, fn, request,flag,status);
1568   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1569   if (err == MPI_SUCCESS && *flag) {
1570      maybe_complete(False/*err in status?*/,
1571                     request_before, *request, status);
1572      make_mem_defined_if_addressable_untyped(status, sizeof(MPI_Status));
1573   }
1574   after("Test", err);
1575   return err;
1576}
1577
1578/* --- Testall --- */
1579/* nonblocking version of Waitall */
1580int WRAPPER_FOR(PMPI_Testall)( int count, MPI_Request* requests,
1581                               int* flag, MPI_Status* statuses )
1582{
1583   MPI_Request* requests_before = NULL;
1584   OrigFn       fn;
1585   int          err, i;
1586   Bool         free_sta = False;
1587   VALGRIND_GET_ORIG_FN(fn);
1588   before("Testall");
1589   if (0) fprintf(stderr, "Testall: %d\n", count);
1590   if (isMSI(statuses)) {
1591      free_sta = True;
1592      statuses = malloc( (count < 0 ? 0 : count) * sizeof(MPI_Status) );
1593   }
1594   check_mem_is_addressable_untyped(flag, sizeof(int));
1595   for (i = 0; i < count; i++) {
1596      check_mem_is_addressable_untyped(&statuses[i], sizeof(MPI_Status));
1597      check_mem_is_defined_untyped(&requests[i], sizeof(MPI_Request));
1598   }
1599   requests_before = clone_Request_array( count, requests );
1600   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1601   CALL_FN_W_WWWW(err, fn, count,requests,flag,statuses);
1602   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1603   /* Urk.  Is the following "if (...)" really right?  I don't know. */
1604   if (*flag
1605       && (err == MPI_SUCCESS /*complete success*/
1606           || err == MPI_ERR_IN_STATUS /* partial success */)) {
1607      Bool e_i_s = err == MPI_ERR_IN_STATUS;
1608      for (i = 0; i < count; i++) {
1609         maybe_complete(e_i_s, requests_before[i], requests[i],
1610                               &statuses[i]);
1611         make_mem_defined_if_addressable_untyped(&statuses[i],
1612                                                 sizeof(MPI_Status));
1613      }
1614   }
1615   if (requests_before)
1616      free(requests_before);
1617   if (free_sta)
1618      free(statuses);
1619   after("Testall", err);
1620   return err;
1621}
1622
1623/* --- Iprobe --- */
1624/* pre:  must-be-writable: *flag, *status */
1625/* post: make-readable *flag
1626         if *flag==True  make-defined *status */
1627int WRAPPER_FOR(PMPI_Iprobe)(int source, int tag,
1628                             MPI_Comm comm,
1629                             int* flag, MPI_Status* status)
1630{
1631   MPI_Status fake_status;
1632   OrigFn     fn;
1633   int        err;
1634   VALGRIND_GET_ORIG_FN(fn);
1635   before("Iprobe");
1636   if (isMSI(status))
1637      status = &fake_status;
1638   check_mem_is_addressable_untyped(flag, sizeof(*flag));
1639   check_mem_is_addressable_untyped(status, sizeof(*status));
1640   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1641   CALL_FN_W_5W(err, fn, source,tag,comm,flag,status);
1642   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1643   if (err == MPI_SUCCESS) {
1644      make_mem_defined_if_addressable_untyped(flag, sizeof(*flag));
1645      if (*flag)
1646         make_mem_defined_if_addressable_untyped(status, sizeof(*status));
1647   }
1648   after("Iprobe", err);
1649   return err;
1650}
1651
1652/* --- Probe --- */
1653/* pre:  must-be-writable *status */
1654/* post: make-defined *status */
1655int WRAPPER_FOR(PMPI_Probe)(int source, int tag,
1656                            MPI_Comm comm, MPI_Status* status)
1657{
1658   MPI_Status fake_status;
1659   OrigFn     fn;
1660   int        err;
1661   VALGRIND_GET_ORIG_FN(fn);
1662   before("Probe");
1663   if (isMSI(status))
1664      status = &fake_status;
1665   check_mem_is_addressable_untyped(status, sizeof(*status));
1666   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1667   CALL_FN_W_WWWW(err, fn, source,tag,comm,status);
1668   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1669   make_mem_defined_if_addressable_if_success_untyped(err, status, sizeof(*status));
1670   after("Probe", err);
1671   return err;
1672}
1673
1674/* --- Cancel --- */
1675/* Wrapping PMPI_Cancel is interesting only to the extent that we need
1676   to be able to detect when a request should be removed from our
1677   shadow table due to cancellation. */
1678int WRAPPER_FOR(PMPI_Cancel)(MPI_Request* request)
1679{
1680   OrigFn      fn;
1681   int         err;
1682   MPI_Request tmp;
1683   VALGRIND_GET_ORIG_FN(fn);
1684   before("Cancel");
1685   check_mem_is_addressable_untyped(request, sizeof(*request));
1686   tmp = *request;
1687   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1688   CALL_FN_W_W(err, fn, request);
1689   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1690   if (err == MPI_SUCCESS)
1691      delete_shadow_Request(tmp);
1692   after("Cancel", err);
1693   return err;
1694}
1695
1696
1697/*------------------------------------------------------------*/
1698/*---                                                      ---*/
1699/*--- Sec 3.10, Send-receive                               ---*/
1700/*---                                                      ---*/
1701/*------------------------------------------------------------*/
1702
1703/* --- Sendrecv --- */
1704/* pre: must be readable: (sendbuf,sendcount,sendtype)
1705        must be writable: (recvbuf,recvcount,recvtype)
1706   post: make readable: (recvbuf,recvcount_actual,datatype)
1707         where recvcount_actual is determined from *status
1708*/
1709int WRAPPER_FOR(PMPI_Sendrecv)(
1710       void *sendbuf, int sendcount, MPI_Datatype sendtype,
1711       int dest, int sendtag,
1712       void *recvbuf, int recvcount, MPI_Datatype recvtype,
1713       int source, int recvtag,
1714       MPI_Comm comm,  MPI_Status *status)
1715{
1716   MPI_Status fake_status;
1717   OrigFn     fn;
1718   int        err, recvcount_actual = 0;
1719   VALGRIND_GET_ORIG_FN(fn);
1720   before("Sendrecv");
1721   if (isMSI(status))
1722      status = &fake_status;
1723   check_mem_is_defined(sendbuf, sendcount, sendtype);
1724   check_mem_is_addressable(recvbuf, recvcount, recvtype);
1725   check_mem_is_addressable_untyped(status, sizeof(*status));
1726   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1727   CALL_FN_W_12W(err, fn, sendbuf,sendcount,sendtype,dest,sendtag,
1728                          recvbuf,recvcount,recvtype,source,recvtag,
1729                          comm,status);
1730   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1731   make_mem_defined_if_addressable_if_success_untyped(err, status, sizeof(*status));
1732   if (err == MPI_SUCCESS
1733       && count_from_Status(&recvcount_actual,recvtype,status)) {
1734      make_mem_defined_if_addressable(recvbuf, recvcount_actual, recvtype);
1735   }
1736   after("Sendrecv", err);
1737   return err;
1738}
1739
1740
1741/*------------------------------------------------------------*/
1742/*---                                                      ---*/
1743/*--- Sec 3.12, Derived datatypes                          ---*/
1744/*---                                                      ---*/
1745/*------------------------------------------------------------*/
1746
1747/* --- Address --- */
1748/* Does this have anything worth checking? */
1749HAS_NO_WRAPPER(Address)
1750
1751/* --- MPI 2 stuff --- */
1752/* Type_extent, Type_get_contents and Type_get_envelope sometimes get
1753   used intensively by the type walker (walk_type).  There's no reason
1754   why they couldn't be properly wrapped if needed, but doing so slows
1755   everything down, so don't bother until needed. */
1756HAS_NO_WRAPPER(Type_extent)
1757HAS_NO_WRAPPER(Type_get_contents)
1758HAS_NO_WRAPPER(Type_get_envelope)
1759
1760/* --- Type_commit --- */
1761int WRAPPER_FOR(PMPI_Type_commit)( MPI_Datatype* ty )
1762{
1763   OrigFn fn;
1764   int    err;
1765   VALGRIND_GET_ORIG_FN(fn);
1766   before("Type_commit");
1767   check_mem_is_defined_untyped(ty, sizeof(*ty));
1768   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1769   CALL_FN_W_W(err, fn, ty);
1770   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1771   after("Type_commit", err);
1772   return err;
1773}
1774
1775/* --- Type_free --- */
1776int WRAPPER_FOR(PMPI_Type_free)( MPI_Datatype* ty )
1777{
1778   OrigFn fn;
1779   int    err;
1780   VALGRIND_GET_ORIG_FN(fn);
1781   before("Type_free");
1782   check_mem_is_defined_untyped(ty, sizeof(*ty));
1783   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1784   CALL_FN_W_W(err, fn, ty);
1785   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1786   after("Type_free", err);
1787   return err;
1788}
1789
1790
1791/*------------------------------------------------------------*/
1792/*---                                                      ---*/
1793/*--- Sec 3.13, Pack and unpack                            ---*/
1794/*---                                                      ---*/
1795/*------------------------------------------------------------*/
1796
1797/* --- Pack --- */
1798/* pre: must be readable: position
1799        must be readable: (inbuf,incount,datatype)
1800        must be writable: outbuf[0 .. outsize-1]
1801        must be writable: outbuf[*position ..
1802                                 *position - 1
1803                                 + however much space PMPI_Pack_size
1804                                   says we will need]
1805   post: make readable: outbuf[old *position .. new *position]
1806*/
1807int WRAPPER_FOR(PMPI_Pack)( void* inbuf, int incount, MPI_Datatype datatype,
1808                            void* outbuf, int outsize,
1809                            int* position, MPI_Comm comm )
1810{
1811   OrigFn fn;
1812   int    err, szB = 0;
1813   int    position_ORIG = *position;
1814   VALGRIND_GET_ORIG_FN(fn);
1815   before("Pack");
1816   /* stay sane */
1817   check_mem_is_defined_untyped(position, sizeof(*position));
1818   /* check input */
1819   check_mem_is_defined(inbuf, incount, datatype);
1820   /* check output area's stated bounds make sense */
1821   check_mem_is_addressable_untyped(outbuf, outsize);
1822   /* check output area's actual used size properly */
1823   err = PMPI_Pack_size( incount, datatype, comm, &szB );
1824   if (err == MPI_SUCCESS && szB > 0) {
1825      check_mem_is_addressable_untyped(
1826         ((char*)outbuf) + position_ORIG, szB
1827      );
1828   }
1829
1830   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1831   CALL_FN_W_7W(err, fn, inbuf,incount,datatype, outbuf,outsize,position, comm);
1832   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1833
1834   if (err == MPI_SUCCESS && (*position) > position_ORIG) {
1835      /* paint output */
1836      make_mem_defined_if_addressable_untyped(
1837         ((char*)outbuf) + position_ORIG, *position - position_ORIG
1838      );
1839   }
1840   after("Pack", err);
1841   return err;
1842}
1843
1844/* --- Unpack --- */
1845/* pre: must be readable: position
1846        must be writable: (outbuf,outcount,datatype)
1847        must be writable: outbuf[0 .. outsize-1]
1848        must be writable: outbuf[*position ..
1849                                 *position - 1
1850                                 + however much space PMPI_Pack_size
1851                                   says we will need]
1852   post: make readable: (outbuf,outcount,datatype)
1853         and also do a readability check of
1854         inbuf[old *position .. new *position]
1855*/
1856int WRAPPER_FOR(PMPI_Unpack)( void* inbuf, int insize, int* position,
1857                              void* outbuf, int outcount, MPI_Datatype datatype,
1858                              MPI_Comm comm )
1859{
1860   OrigFn fn;
1861   int    err, szB = 0;
1862   int    position_ORIG = *position;
1863   VALGRIND_GET_ORIG_FN(fn);
1864   before("Unpack");
1865   /* stay sane */
1866   check_mem_is_defined_untyped(position, sizeof(*position));
1867   /* check output area is accessible */
1868   check_mem_is_addressable(outbuf, outcount, datatype);
1869   /* check input area's stated bounds make sense */
1870   check_mem_is_addressable_untyped(inbuf, insize);
1871   /* check input area's actual used size properly */
1872   err = PMPI_Pack_size( outcount, datatype, comm, &szB );
1873   if (err == MPI_SUCCESS && szB > 0) {
1874      check_mem_is_addressable_untyped(
1875         ((char*)inbuf) + position_ORIG, szB
1876      );
1877   }
1878
1879   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1880   CALL_FN_W_7W(err, fn, inbuf,insize,position, outbuf,outcount,datatype, comm);
1881   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1882
1883   if (err == MPI_SUCCESS && (*position) > position_ORIG) {
1884      /* recheck input more carefully */
1885      check_mem_is_defined_untyped(
1886         ((char*)inbuf) + position_ORIG, *position - position_ORIG
1887      );
1888      /* paint output */
1889      make_mem_defined_if_addressable( outbuf, outcount, datatype );
1890   }
1891   after("Unpack", err);
1892   return err;
1893}
1894
1895
1896/*------------------------------------------------------------*/
1897/*---                                                      ---*/
1898/*--- Sec 4.4, Broadcast                                   ---*/
1899/*---                                                      ---*/
1900/*------------------------------------------------------------*/
1901
1902/* --- Bcast --- */
1903/* pre:  must-be-readable (buffer,count,datatype) for rank==root
1904         must-be-writable (buffer,count,datatype) for rank!=root
1905   post: make-readable (buffer,count,datatype) for all
1906
1907   Resulting behaviour is: if root sends uninitialised stuff, then
1908   V complains, but then all ranks, including itself, see the buffer
1909   as initialised after that.
1910*/
1911int WRAPPER_FOR(PMPI_Bcast)(void *buffer, int count,
1912                            MPI_Datatype datatype,
1913                            int root, MPI_Comm comm)
1914{
1915   OrigFn fn;
1916   int    err;
1917   Bool  i_am_sender;
1918   VALGRIND_GET_ORIG_FN(fn);
1919   before("Bcast");
1920   i_am_sender = root == comm_rank(comm);
1921   if (i_am_sender) {
1922      check_mem_is_defined(buffer, count, datatype);
1923   } else {
1924      check_mem_is_addressable(buffer, count, datatype);
1925   }
1926   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1927   CALL_FN_W_5W(err, fn, buffer,count,datatype,root,comm);
1928   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1929   make_mem_defined_if_addressable_if_success(err, buffer, count, datatype);
1930   after("Bcast", err);
1931   return err;
1932}
1933
1934
1935/*------------------------------------------------------------*/
1936/*---                                                      ---*/
1937/*--- Sec 4.5, Gather                                      ---*/
1938/*---                                                      ---*/
1939/*------------------------------------------------------------*/
1940
1941/* --- Gather --- */
1942/* JRS 20060217: I don't really understand this.  Each process is
1943   going to send sendcount items of type sendtype to the root.  So
1944   the root is going to receive comm_size*sendcount items of type
1945   sendtype (right?)  So why specify recvcount and recvtype?
1946
1947   Anyway, assuming the MPI Spec is correct (seems likely :-) we have:
1948
1949   pre:  (all)        must be readable: (sendbuf,sendcount,sendtype)
1950         (root only): must be writable: (recvbuf,recvcount * comm_size,recvtype)
1951   post: (root only): make readable: (recvbuf,recvcount * comm_size,recvtype)
1952*/
1953int WRAPPER_FOR(PMPI_Gather)(
1954       void *sendbuf, int sendcount, MPI_Datatype sendtype,
1955       void *recvbuf, int recvcount, MPI_Datatype recvtype,
1956       int root, MPI_Comm comm)
1957{
1958   OrigFn fn;
1959   int    err, me, sz;
1960   VALGRIND_GET_ORIG_FN(fn);
1961   before("Gather");
1962   me = comm_rank(comm);
1963   sz = comm_size(comm);
1964   check_mem_is_defined(sendbuf, sendcount, sendtype);
1965   if (me == root)
1966      check_mem_is_addressable(recvbuf, recvcount * sz, recvtype);
1967   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
1968   CALL_FN_W_8W(err, fn, sendbuf,sendcount,sendtype,
1969                         recvbuf,recvcount,recvtype,
1970                         root,comm);
1971   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
1972   if (me == root)
1973      make_mem_defined_if_addressable_if_success(err, recvbuf, recvcount * sz, recvtype);
1974   after("Gather", err);
1975   return err;
1976}
1977
1978
1979/*------------------------------------------------------------*/
1980/*---                                                      ---*/
1981/*--- Sec 4.6, Scatter                                     ---*/
1982/*---                                                      ---*/
1983/*------------------------------------------------------------*/
1984
1985/* pre:  (root only): must be readable: (sendbuf,sendcount * comm_size,sendtype)
1986         (all):       must be writable: (recvbuf,recvbuf,recvtype)
1987   post: (all):       make defined: (recvbuf,recvbuf,recvtype)
1988*/
1989int WRAPPER_FOR(PMPI_Scatter)(
1990       void* sendbuf, int sendcount, MPI_Datatype sendtype,
1991       void* recvbuf, int recvcount, MPI_Datatype recvtype,
1992       int root, MPI_Comm comm)
1993{
1994   OrigFn fn;
1995   int    err, me, sz;
1996   VALGRIND_GET_ORIG_FN(fn);
1997   before("Scatter");
1998   me = comm_rank(comm);
1999   sz = comm_size(comm);
2000   check_mem_is_addressable(recvbuf, recvcount, recvtype);
2001   if (me == root)
2002      check_mem_is_defined(sendbuf, sendcount * sz, sendtype);
2003   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2004   CALL_FN_W_8W(err, fn, sendbuf,sendcount,sendtype,
2005                         recvbuf,recvcount,recvtype,
2006                         root,comm);
2007   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2008   make_mem_defined_if_addressable_if_success(err, recvbuf, recvcount, recvtype);
2009   after("Scatter", err);
2010   return err;
2011}
2012
2013
2014/*------------------------------------------------------------*/
2015/*---                                                      ---*/
2016/*--- Sec 4.8, All-to-All Scatter/Gather                   ---*/
2017/*---                                                      ---*/
2018/*------------------------------------------------------------*/
2019
2020/* pre:  (all) must be readable: (sendbuf,sendcount * comm_size,sendtype)
2021         (all) must be writable: (recvbuf,recvcount * comm_size,recvtype)
2022   post: (all) make defined:     (recvbuf,recvcount * comm_size,recvtype)
2023*/
2024int WRAPPER_FOR(PMPI_Alltoall)(
2025       void* sendbuf, int sendcount, MPI_Datatype sendtype,
2026       void* recvbuf, int recvcount, MPI_Datatype recvtype,
2027       MPI_Comm comm)
2028{
2029   OrigFn fn;
2030   int    err, sz;
2031   VALGRIND_GET_ORIG_FN(fn);
2032   before("Alltoall");
2033   sz = comm_size(comm);
2034   check_mem_is_defined(sendbuf, sendcount * sz, sendtype);
2035   check_mem_is_addressable(recvbuf, recvcount * sz, recvtype);
2036   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2037   CALL_FN_W_7W(err, fn, sendbuf,sendcount,sendtype,
2038                         recvbuf,recvcount,recvtype,
2039                         comm);
2040   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2041   make_mem_defined_if_addressable_if_success(err, recvbuf, recvcount * sz, recvtype);
2042   after("Alltoall", err);
2043   return err;
2044}
2045
2046
2047/*------------------------------------------------------------*/
2048/*---                                                      ---*/
2049/*--- Sec 4.9, Global Reduction Operations                 ---*/
2050/*---                                                      ---*/
2051/*------------------------------------------------------------*/
2052
2053/* --- Reduce --- */
2054/* rd: (sendbuf,count,datatype) for all
2055   wr: (recvbuf,count,datatype) but only for rank == root
2056*/
2057int WRAPPER_FOR(PMPI_Reduce)(void *sendbuf, void *recvbuf,
2058                             int count,
2059                             MPI_Datatype datatype, MPI_Op op,
2060                             int root, MPI_Comm comm)
2061{
2062   OrigFn fn;
2063   int    err;
2064   Bool  i_am_root;
2065   VALGRIND_GET_ORIG_FN(fn);
2066   before("Reduce");
2067   i_am_root = root == comm_rank(comm);
2068   check_mem_is_defined(sendbuf, count, datatype);
2069   if (i_am_root)
2070      check_mem_is_addressable(recvbuf, count, datatype);
2071   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2072   CALL_FN_W_7W(err, fn, sendbuf,recvbuf,count,datatype,op,root,comm);
2073   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2074   if (i_am_root)
2075      make_mem_defined_if_addressable_if_success(err, recvbuf, count, datatype);
2076   after("Reduce", err);
2077   return err;
2078}
2079
2080
2081/* --- Allreduce --- */
2082/* rd: (sendbuf,count,datatype) for all
2083   wr: (recvbuf,count,datatype) for all
2084*/
2085int WRAPPER_FOR(PMPI_Allreduce)(void *sendbuf, void *recvbuf,
2086                                int count,
2087                                MPI_Datatype datatype, MPI_Op op,
2088                                MPI_Comm comm)
2089{
2090   OrigFn fn;
2091   int    err;
2092   VALGRIND_GET_ORIG_FN(fn);
2093   before("Allreduce");
2094   check_mem_is_defined(sendbuf, count, datatype);
2095   check_mem_is_addressable(recvbuf, count, datatype);
2096   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2097   CALL_FN_W_6W(err, fn, sendbuf,recvbuf,count,datatype,op,comm);
2098   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2099   make_mem_defined_if_addressable_if_success(err, recvbuf, count, datatype);
2100   after("Allreduce", err);
2101   return err;
2102}
2103
2104
2105/* --- Op_create --- */
2106/* This is a bit dubious.  I suppose it takes 'function' and
2107   writes something at *op, but who knows what an MPI_Op is?
2108   Can we safely do 'sizeof' on it? */
2109int WRAPPER_FOR(PMPI_Op_create)( MPI_User_function* function,
2110                                 int commute,
2111                                 MPI_Op* op )
2112{
2113   OrigFn fn;
2114   int    err;
2115   VALGRIND_GET_ORIG_FN(fn);
2116   before("Op_create");
2117   check_mem_is_addressable_untyped(op, sizeof(*op));
2118   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2119   CALL_FN_W_WWW(err, fn, function,commute,op);
2120   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2121   make_mem_defined_if_addressable_if_success_untyped(err, op, sizeof(*op));
2122   after("Op_create", err);
2123   return err;
2124}
2125
2126
2127/*------------------------------------------------------------*/
2128/*---                                                      ---*/
2129/*--- Sec 5.4, Communicator management                     ---*/
2130/*---                                                      ---*/
2131/*------------------------------------------------------------*/
2132
2133/* Hardly seems worth wrapping Comm_rank and Comm_size, but
2134   since it's done now .. */
2135
2136/* --- Comm_create --- */
2137/* Let normal memcheck tracking handle this. */
2138int WRAPPER_FOR(PMPI_Comm_create)(MPI_Comm comm, MPI_Group group,
2139                                  MPI_Comm* newcomm)
2140{
2141   OrigFn fn;
2142   int    err;
2143   VALGRIND_GET_ORIG_FN(fn);
2144   before("Comm_create");
2145   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2146   CALL_FN_W_WWW(err, fn, comm,group,newcomm);
2147   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2148   after("Comm_create", err);
2149   return err;
2150}
2151
2152/* --- Comm_dup --- */
2153/* Let normal memcheck tracking handle this. */
2154int WRAPPER_FOR(PMPI_Comm_dup)(MPI_Comm comm, MPI_Comm* newcomm)
2155{
2156   OrigFn fn;
2157   int    err;
2158   VALGRIND_GET_ORIG_FN(fn);
2159   before("Comm_dup");
2160   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2161   CALL_FN_W_WW(err, fn, comm,newcomm);
2162   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2163   after("Comm_dup", err);
2164   return err;
2165}
2166
2167/* --- Comm_free --- */
2168/* Let normal memcheck tracking handle this. */
2169int WRAPPER_FOR(PMPI_Comm_free)(MPI_Comm* comm)
2170{
2171   OrigFn fn;
2172   int    err;
2173   VALGRIND_GET_ORIG_FN(fn);
2174   before("Comm_free");
2175   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2176   CALL_FN_W_W(err, fn, comm);
2177   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2178   after("Comm_free", err);
2179   return err;
2180}
2181
2182/* --- Comm_rank --- */
2183/* wr: (rank, sizeof(*rank)) */
2184int WRAPPER_FOR(PMPI_Comm_rank)(MPI_Comm comm, int *rank)
2185{
2186   OrigFn fn;
2187   int    err;
2188   VALGRIND_GET_ORIG_FN(fn);
2189   before("Comm_rank");
2190   check_mem_is_addressable_untyped(rank, sizeof(*rank));
2191   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2192   CALL_FN_W_WW(err, fn, comm,rank);
2193   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2194   make_mem_defined_if_addressable_if_success_untyped(err, rank, sizeof(*rank));
2195   after("Comm_rank", err);
2196   return err;
2197}
2198
2199/* --- Comm_size --- */
2200/* wr: (size, sizeof(*size)) */
2201int WRAPPER_FOR(PMPI_Comm_size)(MPI_Comm comm, int *size)
2202{
2203   OrigFn fn;
2204   int    err;
2205   VALGRIND_GET_ORIG_FN(fn);
2206   before("Comm_size");
2207   check_mem_is_addressable_untyped(size, sizeof(*size));
2208   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2209   CALL_FN_W_WW(err, fn, comm,size);
2210   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2211   make_mem_defined_if_addressable_if_success_untyped(err, size, sizeof(*size));
2212   after("Comm_size", err);
2213   return err;
2214}
2215
2216
2217/*------------------------------------------------------------*/
2218/*---                                                      ---*/
2219/*--- Sec 5.7, Caching                                     ---*/
2220/*---                                                      ---*/
2221/*------------------------------------------------------------*/
2222
2223
2224/*------------------------------------------------------------*/
2225/*---                                                      ---*/
2226/*--- Sec 7.3, Error codes and classes                     ---*/
2227/*---                                                      ---*/
2228/*------------------------------------------------------------*/
2229
2230/* --- Error_string --- */
2231int WRAPPER_FOR(PMPI_Error_string)( int errorcode, char* string,
2232                                    int* resultlen )
2233{
2234   OrigFn fn;
2235   int    err;
2236   VALGRIND_GET_ORIG_FN(fn);
2237   before("Error_string");
2238   check_mem_is_addressable_untyped(resultlen, sizeof(int));
2239   check_mem_is_addressable_untyped(string, MPI_MAX_ERROR_STRING);
2240   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2241   CALL_FN_W_WWW(err, fn, errorcode,string,resultlen);
2242   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2243   /* Don't bother to paint the result; we assume the real function
2244      will have filled it with defined characters :-) */
2245   after("Error_string", err);
2246   return err;
2247}
2248
2249
2250/*------------------------------------------------------------*/
2251/*---                                                      ---*/
2252/*--- Sec 7.5, Startup                                     ---*/
2253/*---                                                      ---*/
2254/*------------------------------------------------------------*/
2255
2256/* --- Init --- */
2257/* rd: *argc, *argv[0 .. *argc-1] */
2258long WRAPPER_FOR(PMPI_Init)(int *argc, char ***argv)
2259{
2260   OrigFn fn;
2261   int    err;
2262   VALGRIND_GET_ORIG_FN(fn);
2263   before("Init");
2264   if (argc) {
2265      check_mem_is_defined_untyped(argc, sizeof(int));
2266   }
2267   if (argc && argv) {
2268      check_mem_is_defined_untyped(*argv, *argc * sizeof(char**));
2269   }
2270   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2271   CALL_FN_W_WW(err, fn, argc,argv);
2272   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2273   after("Init", err);
2274   if (opt_initkludge)
2275      return (long)(void*)&mpiwrap_walk_type_EXTERNALLY_VISIBLE;
2276   else
2277      return (long)err;
2278}
2279
2280/* --- Initialized --- */
2281int WRAPPER_FOR(PMPI_Initialized)(int* flag)
2282{
2283   OrigFn fn;
2284   int    err;
2285   VALGRIND_GET_ORIG_FN(fn);
2286   before("Initialized");
2287   check_mem_is_addressable_untyped(flag, sizeof(int));
2288   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2289   CALL_FN_W_W(err, fn, flag);
2290   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2291   make_mem_defined_if_addressable_if_success_untyped(err, flag, sizeof(int));
2292   after("Initialized", err);
2293   return err;
2294}
2295
2296/* --- Finalize --- */
2297int WRAPPER_FOR(PMPI_Finalize)(void)
2298{
2299   OrigFn fn;
2300   int    err;
2301   VALGRIND_GET_ORIG_FN(fn);
2302   before("Finalize");
2303   if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;
2304   CALL_FN_W_v(err, fn);
2305   if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;
2306   after("Finalize", err);
2307   return err;
2308}
2309
2310
2311/*------------------------------------------------------------*/
2312/*---                                                      ---*/
2313/*--- Default wrappers for all remaining functions         ---*/
2314/*---                                                      ---*/
2315/*------------------------------------------------------------*/
2316
2317/* Boilerplate for default wrappers. */
2318#define DEFAULT_WRAPPER_PREAMBLE(basename)                        \
2319      OrigFn fn;                                                  \
2320      UWord  res;                                                 \
2321      static int complaints = 1;                                  \
2322      VALGRIND_GET_ORIG_FN(fn);                                   \
2323      before(#basename);                                          \
2324      if (opt_missing >= 2) {                                     \
2325         barf("no wrapper for PMPI_" #basename                    \
2326              ",\n\t\t\t     and you have "                       \
2327              "requested strict checking");                       \
2328      }                                                           \
2329      if (opt_missing == 1 && complaints > 0) {                   \
2330         fprintf(stderr, "%s %5d: warning: no wrapper "           \
2331                         "for PMPI_" #basename "\n",              \
2332                 preamble, my_pid);                               \
2333         complaints--;                                            \
2334      }                                                           \
2335
2336#define DEFAULT_WRAPPER_W_0W(basename)                            \
2337   UWord WRAPPER_FOR(PMPI_##basename)( void )                     \
2338   {                                                              \
2339      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2340      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2341      CALL_FN_W_v(res, fn);                                       \
2342      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2343      return res;                                                 \
2344   }
2345
2346#define DEFAULT_WRAPPER_W_1W(basename)                            \
2347   UWord WRAPPER_FOR(PMPI_##basename)( UWord a1 )                 \
2348   {                                                              \
2349      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2350      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2351      CALL_FN_W_W(res, fn, a1);                                   \
2352      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2353      return res;                                                 \
2354   }
2355
2356#define DEFAULT_WRAPPER_W_2W(basename)                            \
2357   UWord WRAPPER_FOR(PMPI_##basename)( UWord a1, UWord a2 )       \
2358   {                                                              \
2359      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2360      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2361      CALL_FN_W_WW(res, fn, a1,a2);                               \
2362      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2363      return res;                                                 \
2364   }
2365
2366#define DEFAULT_WRAPPER_W_3W(basename)                            \
2367   UWord WRAPPER_FOR(PMPI_##basename)                             \
2368      ( UWord a1, UWord a2, UWord a3 )                            \
2369   {                                                              \
2370      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2371      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2372      CALL_FN_W_WWW(res, fn, a1,a2,a3);                           \
2373      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2374      return res;                                                 \
2375   }
2376
2377#define DEFAULT_WRAPPER_W_4W(basename)                            \
2378   UWord WRAPPER_FOR(PMPI_##basename)                             \
2379      ( UWord a1, UWord a2, UWord a3, UWord a4 )                  \
2380   {                                                              \
2381      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2382      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2383      CALL_FN_W_WWWW(res, fn, a1,a2,a3,a4);                       \
2384      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2385      return res;                                                 \
2386   }
2387
2388#define DEFAULT_WRAPPER_W_5W(basename)                            \
2389   UWord WRAPPER_FOR(PMPI_##basename)                             \
2390      ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5 )        \
2391   {                                                              \
2392      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2393      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2394      CALL_FN_W_5W(res, fn, a1,a2,a3,a4,a5);                      \
2395      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2396      return res;                                                 \
2397   }
2398
2399#define DEFAULT_WRAPPER_W_6W(basename)                            \
2400   UWord WRAPPER_FOR(PMPI_##basename)                             \
2401      ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5,         \
2402        UWord a6 )                                                \
2403   {                                                              \
2404      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2405      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2406      CALL_FN_W_6W(res, fn, a1,a2,a3,a4,a5,a6);                   \
2407      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2408      return res;                                                 \
2409   }
2410
2411#define DEFAULT_WRAPPER_W_7W(basename)                            \
2412   UWord WRAPPER_FOR(PMPI_##basename)                             \
2413      ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5,         \
2414        UWord a6, UWord a7 )                                      \
2415   {                                                              \
2416      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2417      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2418      CALL_FN_W_7W(res, fn, a1,a2,a3,a4,a5,a6,a7);                \
2419      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2420      return res;                                                 \
2421   }
2422
2423#define DEFAULT_WRAPPER_W_8W(basename)                            \
2424   UWord WRAPPER_FOR(PMPI_##basename)                             \
2425      ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5,         \
2426        UWord a6, UWord a7, UWord a8 )                            \
2427   {                                                              \
2428      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2429      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2430      CALL_FN_W_8W(res, fn, a1,a2,a3,a4,a5,a6,a7,a8);             \
2431      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2432      return res;                                                 \
2433   }
2434
2435#define DEFAULT_WRAPPER_W_9W(basename)                            \
2436   UWord WRAPPER_FOR(PMPI_##basename)                             \
2437      ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5,         \
2438        UWord a6, UWord a7, UWord a8, UWord a9 )                  \
2439   {                                                              \
2440      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2441      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2442      CALL_FN_W_9W(res, fn, a1,a2,a3,a4,a5,a6,a7,a8,a9);          \
2443      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2444      return res;                                                 \
2445   }
2446
2447#define DEFAULT_WRAPPER_W_10W(basename)                           \
2448   UWord WRAPPER_FOR(PMPI_##basename)                             \
2449      ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5,         \
2450        UWord a6, UWord a7, UWord a8, UWord a9, UWord a10 )       \
2451   {                                                              \
2452      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2453      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2454      CALL_FN_W_10W(res, fn, a1,a2,a3,a4,a5,a6,a7,a8,a9,a10);     \
2455      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2456      return res;                                                 \
2457   }
2458
2459#define DEFAULT_WRAPPER_W_12W(basename)                           \
2460   UWord WRAPPER_FOR(PMPI_##basename)                             \
2461      ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5,         \
2462        UWord a6, UWord a7, UWord a8, UWord a9, UWord a10,        \
2463        UWord a11, UWord a12 )                                    \
2464   {                                                              \
2465      DEFAULT_WRAPPER_PREAMBLE(basename)                          \
2466      if (cONFIG_DER) VALGRIND_DISABLE_ERROR_REPORTING;           \
2467      CALL_FN_W_12W(res, fn, a1,a2,a3,a4,a5,a6,                   \
2468                             a7,a8,a9,a10,a11,a12);               \
2469      if (cONFIG_DER) VALGRIND_ENABLE_ERROR_REPORTING;            \
2470      return res;                                                 \
2471   }
2472
2473
2474/* Canned summary of MPI-1.1/MPI-2 entry points, as derived from mpi.h
2475   from Open MPI svn rev 9191 (somewhere between Open MPI versions
2476   1.0.1 and 1.1.0). */
2477
2478/* If a function is commented out in this list, it's because it has a
2479   proper wrapper written elsewhere (above here). */
2480
2481DEFAULT_WRAPPER_W_2W(Abort)
2482DEFAULT_WRAPPER_W_9W(Accumulate)
2483DEFAULT_WRAPPER_W_1W(Add_error_class)
2484DEFAULT_WRAPPER_W_2W(Add_error_code)
2485DEFAULT_WRAPPER_W_2W(Add_error_string)
2486/* DEFAULT_WRAPPER_W_2W(Address) */
2487DEFAULT_WRAPPER_W_7W(Allgather)
2488DEFAULT_WRAPPER_W_8W(Allgatherv)
2489DEFAULT_WRAPPER_W_3W(Alloc_mem)
2490/* DEFAULT_WRAPPER_W_6W(Allreduce) */
2491/* DEFAULT_WRAPPER_W_7W(Alltoall) */
2492DEFAULT_WRAPPER_W_9W(Alltoallv)
2493DEFAULT_WRAPPER_W_9W(Alltoallw)
2494DEFAULT_WRAPPER_W_2W(Attr_delete)
2495DEFAULT_WRAPPER_W_4W(Attr_get)
2496DEFAULT_WRAPPER_W_3W(Attr_put)
2497DEFAULT_WRAPPER_W_1W(Barrier)
2498/* DEFAULT_WRAPPER_W_5W(Bcast) */
2499/* DEFAULT_WRAPPER_W_6W(Bsend) */
2500DEFAULT_WRAPPER_W_7W(Bsend_init)
2501DEFAULT_WRAPPER_W_2W(Buffer_attach)
2502DEFAULT_WRAPPER_W_2W(Buffer_detach)
2503/* DEFAULT_WRAPPER_W_1W(Cancel) */
2504DEFAULT_WRAPPER_W_4W(Cart_coords)
2505DEFAULT_WRAPPER_W_6W(Cart_create)
2506DEFAULT_WRAPPER_W_5W(Cart_get)
2507DEFAULT_WRAPPER_W_5W(Cart_map)
2508DEFAULT_WRAPPER_W_3W(Cart_rank)
2509DEFAULT_WRAPPER_W_5W(Cart_shift)
2510DEFAULT_WRAPPER_W_3W(Cart_sub)
2511DEFAULT_WRAPPER_W_2W(Cartdim_get)
2512DEFAULT_WRAPPER_W_1W(Close_port)
2513DEFAULT_WRAPPER_W_5W(Comm_accept)
2514DEFAULT_WRAPPER_W_1W(Comm_c2f)
2515DEFAULT_WRAPPER_W_2W(Comm_call_errhandler)
2516DEFAULT_WRAPPER_W_3W(Comm_compare)
2517DEFAULT_WRAPPER_W_5W(Comm_connect)
2518DEFAULT_WRAPPER_W_2W(Comm_create_errhandler)
2519DEFAULT_WRAPPER_W_4W(Comm_create_keyval)
2520/* DEFAULT_WRAPPER_W_3W(Comm_create) */
2521DEFAULT_WRAPPER_W_2W(Comm_delete_attr)
2522DEFAULT_WRAPPER_W_1W(Comm_disconnect)
2523/* DEFAULT_WRAPPER_W_2W(Comm_dup) */
2524DEFAULT_WRAPPER_W_1W(Comm_f2c)
2525DEFAULT_WRAPPER_W_1W(Comm_free_keyval)
2526/* DEFAULT_WRAPPER_W_1W(Comm_free) */
2527DEFAULT_WRAPPER_W_4W(Comm_get_attr)
2528DEFAULT_WRAPPER_W_2W(Comm_get_errhandler)
2529DEFAULT_WRAPPER_W_3W(Comm_get_name)
2530DEFAULT_WRAPPER_W_1W(Comm_get_parent)
2531DEFAULT_WRAPPER_W_2W(Comm_group)
2532DEFAULT_WRAPPER_W_2W(Comm_join)
2533/* DEFAULT_WRAPPER_W_2W(Comm_rank) */
2534DEFAULT_WRAPPER_W_2W(Comm_remote_group)
2535DEFAULT_WRAPPER_W_2W(Comm_remote_size)
2536DEFAULT_WRAPPER_W_3W(Comm_set_attr)
2537DEFAULT_WRAPPER_W_2W(Comm_set_errhandler)
2538DEFAULT_WRAPPER_W_2W(Comm_set_name)
2539/* DEFAULT_WRAPPER_W_2W(Comm_size) */
2540DEFAULT_WRAPPER_W_8W(Comm_spawn)
2541DEFAULT_WRAPPER_W_9W(Comm_spawn_multiple)
2542DEFAULT_WRAPPER_W_4W(Comm_split)
2543DEFAULT_WRAPPER_W_2W(Comm_test_inter)
2544DEFAULT_WRAPPER_W_3W(Dims_create)
2545DEFAULT_WRAPPER_W_1W(Errhandler_c2f)
2546DEFAULT_WRAPPER_W_2W(Errhandler_create)
2547DEFAULT_WRAPPER_W_1W(Errhandler_f2c)
2548DEFAULT_WRAPPER_W_1W(Errhandler_free)
2549DEFAULT_WRAPPER_W_2W(Errhandler_get)
2550DEFAULT_WRAPPER_W_2W(Errhandler_set)
2551DEFAULT_WRAPPER_W_2W(Error_class)
2552/* DEFAULT_WRAPPER_W_3W(Error_string) */
2553DEFAULT_WRAPPER_W_6W(Exscan)
2554DEFAULT_WRAPPER_W_1W(File_c2f)
2555DEFAULT_WRAPPER_W_1W(File_f2c)
2556DEFAULT_WRAPPER_W_2W(File_call_errhandler)
2557DEFAULT_WRAPPER_W_2W(File_create_errhandler)
2558DEFAULT_WRAPPER_W_2W(File_set_errhandler)
2559DEFAULT_WRAPPER_W_2W(File_get_errhandler)
2560DEFAULT_WRAPPER_W_5W(File_open)
2561DEFAULT_WRAPPER_W_1W(File_close)
2562DEFAULT_WRAPPER_W_2W(File_delete)
2563DEFAULT_WRAPPER_W_2W(File_set_size)
2564DEFAULT_WRAPPER_W_2W(File_preallocate)
2565DEFAULT_WRAPPER_W_2W(File_get_size)
2566DEFAULT_WRAPPER_W_2W(File_get_group)
2567DEFAULT_WRAPPER_W_2W(File_get_amode)
2568DEFAULT_WRAPPER_W_2W(File_set_info)
2569DEFAULT_WRAPPER_W_2W(File_get_info)
2570DEFAULT_WRAPPER_W_6W(File_set_view)
2571DEFAULT_WRAPPER_W_5W(File_get_view)
2572DEFAULT_WRAPPER_W_6W(File_read_at)
2573DEFAULT_WRAPPER_W_6W(File_read_at_all)
2574DEFAULT_WRAPPER_W_6W(File_write_at)
2575DEFAULT_WRAPPER_W_6W(File_write_at_all)
2576DEFAULT_WRAPPER_W_6W(File_iread_at)
2577DEFAULT_WRAPPER_W_6W(File_iwrite_at)
2578DEFAULT_WRAPPER_W_5W(File_read)
2579DEFAULT_WRAPPER_W_5W(File_read_all)
2580DEFAULT_WRAPPER_W_5W(File_write)
2581DEFAULT_WRAPPER_W_5W(File_write_all)
2582DEFAULT_WRAPPER_W_5W(File_iread)
2583DEFAULT_WRAPPER_W_5W(File_iwrite)
2584DEFAULT_WRAPPER_W_3W(File_seek)
2585DEFAULT_WRAPPER_W_2W(File_get_position)
2586DEFAULT_WRAPPER_W_3W(File_get_byte_offset)
2587DEFAULT_WRAPPER_W_5W(File_read_shared)
2588DEFAULT_WRAPPER_W_5W(File_write_shared)
2589DEFAULT_WRAPPER_W_5W(File_iread_shared)
2590DEFAULT_WRAPPER_W_5W(File_iwrite_shared)
2591DEFAULT_WRAPPER_W_5W(File_read_ordered)
2592DEFAULT_WRAPPER_W_5W(File_write_ordered)
2593DEFAULT_WRAPPER_W_3W(File_seek_shared)
2594DEFAULT_WRAPPER_W_2W(File_get_position_shared)
2595DEFAULT_WRAPPER_W_5W(File_read_at_all_begin)
2596DEFAULT_WRAPPER_W_3W(File_read_at_all_end)
2597DEFAULT_WRAPPER_W_5W(File_write_at_all_begin)
2598DEFAULT_WRAPPER_W_3W(File_write_at_all_end)
2599DEFAULT_WRAPPER_W_4W(File_read_all_begin)
2600DEFAULT_WRAPPER_W_3W(File_read_all_end)
2601DEFAULT_WRAPPER_W_4W(File_write_all_begin)
2602DEFAULT_WRAPPER_W_3W(File_write_all_end)
2603DEFAULT_WRAPPER_W_4W(File_read_ordered_begin)
2604DEFAULT_WRAPPER_W_3W(File_read_ordered_end)
2605DEFAULT_WRAPPER_W_4W(File_write_ordered_begin)
2606DEFAULT_WRAPPER_W_3W(File_write_ordered_end)
2607DEFAULT_WRAPPER_W_3W(File_get_type_extent)
2608DEFAULT_WRAPPER_W_2W(File_set_atomicity)
2609DEFAULT_WRAPPER_W_2W(File_get_atomicity)
2610DEFAULT_WRAPPER_W_1W(File_sync)
2611/* DEFAULT_WRAPPER_W_0W(Finalize) */
2612DEFAULT_WRAPPER_W_1W(Finalized)
2613DEFAULT_WRAPPER_W_1W(Free_mem)
2614/* DEFAULT_WRAPPER_W_8W(Gather) */
2615DEFAULT_WRAPPER_W_9W(Gatherv)
2616DEFAULT_WRAPPER_W_2W(Get_address)
2617/* DEFAULT_WRAPPER_W_3W(Get_count) */
2618DEFAULT_WRAPPER_W_3W(Get_elements)
2619DEFAULT_WRAPPER_W_8W(Get)
2620DEFAULT_WRAPPER_W_2W(Get_processor_name)
2621DEFAULT_WRAPPER_W_2W(Get_version)
2622DEFAULT_WRAPPER_W_6W(Graph_create)
2623DEFAULT_WRAPPER_W_5W(Graph_get)
2624DEFAULT_WRAPPER_W_5W(Graph_map)
2625DEFAULT_WRAPPER_W_3W(Graph_neighbors_count)
2626DEFAULT_WRAPPER_W_4W(Graph_neighbors)
2627DEFAULT_WRAPPER_W_3W(Graphdims_get)
2628DEFAULT_WRAPPER_W_1W(Grequest_complete)
2629DEFAULT_WRAPPER_W_5W(Grequest_start)
2630DEFAULT_WRAPPER_W_1W(Group_c2f)
2631DEFAULT_WRAPPER_W_3W(Group_compare)
2632DEFAULT_WRAPPER_W_3W(Group_difference)
2633DEFAULT_WRAPPER_W_4W(Group_excl)
2634DEFAULT_WRAPPER_W_1W(Group_f2c)
2635DEFAULT_WRAPPER_W_1W(Group_free)
2636DEFAULT_WRAPPER_W_4W(Group_incl)
2637DEFAULT_WRAPPER_W_3W(Group_intersection)
2638DEFAULT_WRAPPER_W_4W(Group_range_excl)
2639DEFAULT_WRAPPER_W_4W(Group_range_incl)
2640DEFAULT_WRAPPER_W_2W(Group_rank)
2641DEFAULT_WRAPPER_W_2W(Group_size)
2642DEFAULT_WRAPPER_W_5W(Group_translate_ranks)
2643DEFAULT_WRAPPER_W_3W(Group_union)
2644/* DEFAULT_WRAPPER_W_7W(Ibsend) */
2645DEFAULT_WRAPPER_W_1W(Info_c2f)
2646DEFAULT_WRAPPER_W_1W(Info_create)
2647DEFAULT_WRAPPER_W_2W(Info_delete)
2648DEFAULT_WRAPPER_W_2W(Info_dup)
2649DEFAULT_WRAPPER_W_1W(Info_f2c)
2650DEFAULT_WRAPPER_W_1W(Info_free)
2651DEFAULT_WRAPPER_W_5W(Info_get)
2652DEFAULT_WRAPPER_W_2W(Info_get_nkeys)
2653DEFAULT_WRAPPER_W_3W(Info_get_nthkey)
2654DEFAULT_WRAPPER_W_4W(Info_get_valuelen)
2655DEFAULT_WRAPPER_W_3W(Info_set)
2656/* DEFAULT_WRAPPER_W_2W(Init) */
2657/* DEFAULT_WRAPPER_W_1W(Initialized) */
2658DEFAULT_WRAPPER_W_4W(Init_thread)
2659DEFAULT_WRAPPER_W_6W(Intercomm_create)
2660DEFAULT_WRAPPER_W_3W(Intercomm_merge)
2661/* DEFAULT_WRAPPER_W_5W(Iprobe) */
2662/* DEFAULT_WRAPPER_W_7W(Irecv) */
2663/* DEFAULT_WRAPPER_W_7W(Irsend) */
2664/* DEFAULT_WRAPPER_W_7W(Isend) */
2665/* DEFAULT_WRAPPER_W_7W(Issend) */
2666DEFAULT_WRAPPER_W_1W(Is_thread_main)
2667DEFAULT_WRAPPER_W_4W(Keyval_create)
2668DEFAULT_WRAPPER_W_1W(Keyval_free)
2669DEFAULT_WRAPPER_W_3W(Lookup_name)
2670DEFAULT_WRAPPER_W_1W(Op_c2f)
2671/* DEFAULT_WRAPPER_W_3W(Op_create) */
2672DEFAULT_WRAPPER_W_2W(Open_port)
2673DEFAULT_WRAPPER_W_1W(Op_f2c)
2674DEFAULT_WRAPPER_W_1W(Op_free)
2675DEFAULT_WRAPPER_W_7W(Pack_external)
2676DEFAULT_WRAPPER_W_4W(Pack_external_size)
2677/* DEFAULT_WRAPPER_W_7W(Pack) */
2678DEFAULT_WRAPPER_W_4W(Pack_size)
2679/* int MPI_Pcontrol(const int level, ...) */
2680/* DEFAULT_WRAPPER_W_4W(Probe) */
2681DEFAULT_WRAPPER_W_3W(Publish_name)
2682DEFAULT_WRAPPER_W_8W(Put)
2683DEFAULT_WRAPPER_W_1W(Query_thread)
2684DEFAULT_WRAPPER_W_7W(Recv_init)
2685/* DEFAULT_WRAPPER_W_7W(Recv) */
2686/* DEFAULT_WRAPPER_W_7W(Reduce) */
2687DEFAULT_WRAPPER_W_6W(Reduce_scatter)
2688DEFAULT_WRAPPER_W_5W(Register_datarep)
2689DEFAULT_WRAPPER_W_1W(Request_c2f)
2690DEFAULT_WRAPPER_W_1W(Request_f2c)
2691DEFAULT_WRAPPER_W_1W(Request_free)
2692DEFAULT_WRAPPER_W_3W(Request_get_status)
2693/* DEFAULT_WRAPPER_W_6W(Rsend) */
2694DEFAULT_WRAPPER_W_7W(Rsend_init)
2695DEFAULT_WRAPPER_W_6W(Scan)
2696/* DEFAULT_WRAPPER_W_8W(Scatter) */
2697DEFAULT_WRAPPER_W_9W(Scatterv)
2698DEFAULT_WRAPPER_W_7W(Send_init)
2699/* DEFAULT_WRAPPER_W_6W(Send) */
2700/* DEFAULT_WRAPPER_W_12W(Sendrecv) */
2701DEFAULT_WRAPPER_W_9W(Sendrecv_replace)
2702DEFAULT_WRAPPER_W_7W(Ssend_init)
2703/* DEFAULT_WRAPPER_W_6W(Ssend) */
2704DEFAULT_WRAPPER_W_1W(Start)
2705DEFAULT_WRAPPER_W_2W(Startall)
2706DEFAULT_WRAPPER_W_2W(Status_c2f)
2707DEFAULT_WRAPPER_W_2W(Status_f2c)
2708DEFAULT_WRAPPER_W_2W(Status_set_cancelled)
2709DEFAULT_WRAPPER_W_3W(Status_set_elements)
2710/* DEFAULT_WRAPPER_W_4W(Testall) */
2711DEFAULT_WRAPPER_W_5W(Testany)
2712/* DEFAULT_WRAPPER_W_3W(Test) */
2713DEFAULT_WRAPPER_W_2W(Test_cancelled)
2714DEFAULT_WRAPPER_W_5W(Testsome)
2715DEFAULT_WRAPPER_W_2W(Topo_test)
2716DEFAULT_WRAPPER_W_1W(Type_c2f)
2717/* DEFAULT_WRAPPER_W_1W(Type_commit) */
2718DEFAULT_WRAPPER_W_3W(Type_contiguous)
2719DEFAULT_WRAPPER_W_10W(Type_create_darray)
2720DEFAULT_WRAPPER_W_3W(Type_create_f90_complex)
2721DEFAULT_WRAPPER_W_2W(Type_create_f90_integer)
2722DEFAULT_WRAPPER_W_3W(Type_create_f90_real)
2723DEFAULT_WRAPPER_W_5W(Type_create_hindexed)
2724DEFAULT_WRAPPER_W_5W(Type_create_hvector)
2725DEFAULT_WRAPPER_W_4W(Type_create_keyval)
2726DEFAULT_WRAPPER_W_5W(Type_create_indexed_block)
2727DEFAULT_WRAPPER_W_5W(Type_create_struct)
2728DEFAULT_WRAPPER_W_7W(Type_create_subarray)
2729DEFAULT_WRAPPER_W_4W(Type_create_resized)
2730DEFAULT_WRAPPER_W_2W(Type_delete_attr)
2731DEFAULT_WRAPPER_W_2W(Type_dup)
2732/* DEFAULT_WRAPPER_W_2W(Type_extent) */
2733/* DEFAULT_WRAPPER_W_1W(Type_free) */
2734DEFAULT_WRAPPER_W_1W(Type_free_keyval)
2735DEFAULT_WRAPPER_W_1W(Type_f2c)
2736DEFAULT_WRAPPER_W_4W(Type_get_attr)
2737/* DEFAULT_WRAPPER_W_7W(Type_get_contents) */
2738/* DEFAULT_WRAPPER_W_5W(Type_get_envelope) */
2739DEFAULT_WRAPPER_W_3W(Type_get_extent)
2740DEFAULT_WRAPPER_W_3W(Type_get_name)
2741DEFAULT_WRAPPER_W_3W(Type_get_true_extent)
2742DEFAULT_WRAPPER_W_5W(Type_hindexed)
2743DEFAULT_WRAPPER_W_5W(Type_hvector)
2744DEFAULT_WRAPPER_W_5W(Type_indexed)
2745DEFAULT_WRAPPER_W_2W(Type_lb)
2746DEFAULT_WRAPPER_W_3W(Type_match_size)
2747DEFAULT_WRAPPER_W_3W(Type_set_attr)
2748DEFAULT_WRAPPER_W_2W(Type_set_name)
2749DEFAULT_WRAPPER_W_2W(Type_size)
2750DEFAULT_WRAPPER_W_5W(Type_struct)
2751DEFAULT_WRAPPER_W_2W(Type_ub)
2752DEFAULT_WRAPPER_W_5W(Type_vector)
2753/* DEFAULT_WRAPPER_W_7W(Unpack) */
2754DEFAULT_WRAPPER_W_3W(Unpublish_name)
2755DEFAULT_WRAPPER_W_7W(Unpack_external)
2756/* DEFAULT_WRAPPER_W_3W(Waitall) */
2757/* DEFAULT_WRAPPER_W_4W(Waitany) */
2758/* DEFAULT_WRAPPER_W_2W(Wait) */
2759DEFAULT_WRAPPER_W_5W(Waitsome)
2760DEFAULT_WRAPPER_W_1W(Win_c2f)
2761DEFAULT_WRAPPER_W_2W(Win_call_errhandler)
2762DEFAULT_WRAPPER_W_1W(Win_complete)
2763DEFAULT_WRAPPER_W_6W(Win_create)
2764DEFAULT_WRAPPER_W_2W(Win_create_errhandler)
2765DEFAULT_WRAPPER_W_4W(Win_create_keyval)
2766DEFAULT_WRAPPER_W_2W(Win_delete_attr)
2767DEFAULT_WRAPPER_W_1W(Win_f2c)
2768DEFAULT_WRAPPER_W_2W(Win_fence)
2769DEFAULT_WRAPPER_W_1W(Win_free)
2770DEFAULT_WRAPPER_W_1W(Win_free_keyval)
2771DEFAULT_WRAPPER_W_4W(Win_get_attr)
2772DEFAULT_WRAPPER_W_2W(Win_get_errhandler)
2773DEFAULT_WRAPPER_W_2W(Win_get_group)
2774DEFAULT_WRAPPER_W_3W(Win_get_name)
2775DEFAULT_WRAPPER_W_4W(Win_lock)
2776DEFAULT_WRAPPER_W_3W(Win_post)
2777DEFAULT_WRAPPER_W_3W(Win_set_attr)
2778DEFAULT_WRAPPER_W_2W(Win_set_errhandler)
2779DEFAULT_WRAPPER_W_2W(Win_set_name)
2780DEFAULT_WRAPPER_W_3W(Win_start)
2781DEFAULT_WRAPPER_W_2W(Win_test)
2782DEFAULT_WRAPPER_W_2W(Win_unlock)
2783DEFAULT_WRAPPER_W_1W(Win_wait)
2784/* double MPI_Wtick(void) */
2785/* double MPI_Wtime(void) */
2786
2787
2788/*------------------------------------------------------------*/
2789/*---                                                      ---*/
2790/*---                                                      ---*/
2791/*---                                                      ---*/
2792/*------------------------------------------------------------*/
2793
2794/*---------------------------------------------------------------*/
2795/*--- end                                           mpiwrap.c ---*/
2796/*---------------------------------------------------------------*/
2797