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-2010 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
102 /*------------------------------------------------------------*/
103 /*--- Connect to MPI library ---*/
104 /*------------------------------------------------------------*/
105
106 /* Include headers for whatever MPI implementation the wrappers are to
107 be used with. The configure system will tell us what the path to
108 the chosen MPI implementation is, via -I.. to the compiler. */
109 #include "mpi.h"
110
111 /* Where are API symbols?
112 Open MPI lib/libmpi.so, soname = libmpi.so.0
113 Quadrics MPI lib/libmpi.so, soname = libmpi.so.0
114 MPICH libmpich.so.1.0, soname = libmpich.so.1.0
115 AIX: in /usr/lpp/ppe.poe/lib/libmpi_r.a(mpicore*_r.o)
116
117 For the non-AIX targets, a suitable soname to match with
118 is "libmpi*.so*".
119 */
120 #if defined(_AIX)
121 # define I_WRAP_FNNAME_U(_name) \
122 I_WRAP_SONAME_FNNAME_ZU(libmpiZurZdaZLmpicoreZaZurZdoZR,_name)
123 /* Don't change this without also changing all the names in
124 libmpiwrap.exp. */
125 #else
126 # define I_WRAP_FNNAME_U(_name) \
127 I_WRAP_SONAME_FNNAME_ZU(libmpiZaZdsoZa,_name)
128
129 #endif
130
131
132 /* Define HAVE_MPI_STATUS_IGNORE iff we have to deal with
133 MPI_STATUS{ES}_IGNORE. */
134 #if MPI_VERSION >= 2 \
135 || (defined(MPI_STATUS_IGNORE) && defined(MPI_STATUSES_IGNORE))
136 # undef HAVE_MPI_STATUS_IGNORE
137 # define HAVE_MPI_STATUS_IGNORE 1
138 #else
139 # undef HAVE_MPI_STATUS_IGNORE
140 #endif
141
142
143 /*------------------------------------------------------------*/
144 /*--- Decls ---*/
145 /*------------------------------------------------------------*/
146
147 typedef unsigned char Bool;
148 #define False ((Bool)0)
149 #define True ((Bool)1)
150
151 /* Word, UWord are machine words - same size as a pointer. This is
152 checked at startup. The wrappers below use 'long' to mean a
153 machine word - this too is tested at startup. */
154 typedef signed long Word;
155 typedef unsigned long UWord;
156
157 #if !defined(offsetof)
158 # define offsetof(type,memb) ((int)&((type*)0)->memb)
159 #endif
160
161 /* Find the size of long double image (not 'sizeof(long double)').
162 See comments in sizeofOneNamedTy. */
163 static long sizeof_long_double_image ( void );
164
165
166 /*------------------------------------------------------------*/
167 /*--- Simple helpers ---*/
168 /*------------------------------------------------------------*/
169
170 /* ------ Helpers for debug printing ------ */
171
172 /* constant */
173 static const char* preamble = "valgrind MPI wrappers";
174
175 /* established at startup */
176 static pid_t my_pid = -1;
177 static char* options_str = NULL;
178 static int opt_verbosity = 1;
179 static Bool opt_missing = 0; /* 0:silent; 1:warn; 2:abort */
180 static Bool opt_help = False;
181 static Bool opt_initkludge = False;
182
before(char * fnname)183 static void before ( char* fnname )
184 {
185 /* This isn't thread-safe wrt 'done' (no locking). It's not
186 critical. */
187 static int done = 0;
188 if (done == 0) {
189 done = 1;
190 my_pid = getpid();
191 options_str = getenv("MPIWRAP_DEBUG");
192 if (options_str) {
193 if (NULL != strstr(options_str, "warn"))
194 opt_missing = 1;
195 if (NULL != strstr(options_str, "strict"))
196 opt_missing = 2;
197 if (NULL != strstr(options_str, "verbose"))
198 opt_verbosity++;
199 if (NULL != strstr(options_str, "quiet"))
200 opt_verbosity--;
201 if (NULL != strstr(options_str, "help"))
202 opt_help = True;
203 if (NULL != strstr(options_str, "initkludge"))
204 opt_initkludge = True;
205 }
206 if (opt_verbosity > 0)
207 fprintf(stderr, "%s %5d: Active for pid %d\n",
208 preamble, my_pid, my_pid);
209 /* Sanity check - that Word/UWord really are machine words. */
210 assert(sizeof(Word) == sizeof(void*));
211 assert(sizeof(UWord) == sizeof(void*));
212 /* Sanity check - char is byte-sized (else address calculations
213 in walk_type don't work. */
214 assert(sizeof(char) == 1);
215 if (opt_help) {
216 fprintf(stderr, "\n");
217 fprintf(stderr, "Valid options for the MPIWRAP_DEBUG environment"
218 " variable are:\n");
219 fprintf(stderr, "\n");
220 fprintf(stderr, " quiet be silent except for errors\n");
221 fprintf(stderr, " verbose show wrapper entries/exits\n");
222 fprintf(stderr, " strict abort the program if a function"
223 " with no wrapper is used\n");
224 fprintf(stderr, " warn give a warning if a function"
225 " with no wrapper is used\n");
226 fprintf(stderr, " help display this message, then exit\n");
227 fprintf(stderr, " initkludge debugging hack; do not use\n");
228 fprintf(stderr, "\n");
229 fprintf(stderr, "Multiple options are allowed, eg"
230 " MPIWRAP_DEBUG=strict,verbose\n");
231 fprintf(stderr, "Note: 'warn' generates output even if 'quiet'"
232 " is also specified\n");
233 fprintf(stderr, "\n");
234 fprintf(stderr, "%s %5d: exiting now\n", preamble, my_pid );
235 exit(1);
236 }
237 if (opt_verbosity > 0)
238 fprintf(stderr,
239 "%s %5d: Try MPIWRAP_DEBUG=help for possible options\n",
240 preamble, my_pid);
241
242 }
243 if (opt_verbosity > 1)
244 fprintf(stderr, "%s %5d: enter PMPI_%s\n", preamble, my_pid, fnname );
245 }
246
after(char * fnname,int err)247 static __inline__ void after ( char* fnname, int err )
248 {
249 if (opt_verbosity > 1)
250 fprintf(stderr, "%s %5d: exit PMPI_%s (err = %d)\n",
251 preamble, my_pid, fnname, err );
252 }
253
barf(char * msg)254 static void barf ( char* msg )
255 {
256 fprintf(stderr, "%s %5d: fatal: %s\n", preamble, my_pid, msg);
257 fprintf(stderr, "%s %5d: exiting now\n", preamble, my_pid );
258 exit(1);
259 }
260
261 /* Half-hearted type-showing function (for debugging). */
showTy(FILE * f,MPI_Datatype ty)262 static void showTy ( FILE* f, MPI_Datatype ty )
263 {
264 if (ty == MPI_DATATYPE_NULL) fprintf(f,"DATATYPE_NULL");
265 else if (ty == MPI_BYTE) fprintf(f,"BYTE");
266 else if (ty == MPI_PACKED) fprintf(f,"PACKED");
267 else if (ty == MPI_CHAR) fprintf(f,"CHAR");
268 else if (ty == MPI_SHORT) fprintf(f,"SHORT");
269 else if (ty == MPI_INT) fprintf(f,"INT");
270 else if (ty == MPI_LONG) fprintf(f,"LONG");
271 else if (ty == MPI_FLOAT) fprintf(f,"FLOAT");
272 else if (ty == MPI_DOUBLE) fprintf(f,"DOUBLE");
273 else if (ty == MPI_LONG_DOUBLE) fprintf(f,"LONG_DOUBLE");
274 else if (ty == MPI_UNSIGNED_CHAR) fprintf(f,"UNSIGNED_CHAR");
275 else if (ty == MPI_UNSIGNED_SHORT) fprintf(f,"UNSIGNED_SHORT");
276 else if (ty == MPI_UNSIGNED_LONG) fprintf(f,"UNSIGNED_LONG");
277 else if (ty == MPI_UNSIGNED) fprintf(f,"UNSIGNED");
278 else if (ty == MPI_FLOAT_INT) fprintf(f,"FLOAT_INT");
279 else if (ty == MPI_DOUBLE_INT) fprintf(f,"DOUBLE_INT");
280 else if (ty == MPI_LONG_DOUBLE_INT) fprintf(f,"LONG_DOUBLE_INT");
281 else if (ty == MPI_LONG_INT) fprintf(f,"LONG_INT");
282 else if (ty == MPI_SHORT_INT) fprintf(f,"SHORT_INT");
283 else if (ty == MPI_2INT) fprintf(f,"2INT");
284 else if (ty == MPI_UB) fprintf(f,"UB");
285 else if (ty == MPI_LB) fprintf(f,"LB");
286 # if defined(MPI_WCHAR)
287 else if (ty == MPI_WCHAR) fprintf(f,"WCHAR");
288 # endif
289 else if (ty == MPI_LONG_LONG_INT) fprintf(f,"LONG_LONG_INT");
290 # if defined(MPI_LONG_LONG)
291 else if (ty == MPI_LONG_LONG) fprintf(f,"LONG_LONG");
292 # endif
293 # if defined(MPI_UNSIGNED_LONG_LONG)
294 else if (ty == MPI_UNSIGNED_LONG_LONG) fprintf(f,"UNSIGNED_LONG_LONG");
295 # endif
296 # if defined(MPI_REAL8)
297 else if (ty == MPI_REAL8) fprintf(f, "REAL8");
298 # endif
299 # if defined(MPI_REAL4)
300 else if (ty == MPI_REAL4) fprintf(f, "REAL4");
301 # endif
302 # if defined(MPI_REAL)
303 else if (ty == MPI_REAL) fprintf(f, "REAL");
304 # endif
305 # if defined(MPI_INTEGER8)
306 else if (ty == MPI_INTEGER8) fprintf(f, "INTEGER8");
307 # endif
308 # if defined(MPI_INTEGER4)
309 else if (ty == MPI_INTEGER4) fprintf(f, "INTEGER4");
310 # endif
311 # if defined(MPI_INTEGER)
312 else if (ty == MPI_INTEGER) fprintf(f, "INTEGER");
313 # endif
314 # if defined(MPI_DOUBLE_PRECISION)
315 else if (ty == MPI_DOUBLE_PRECISION) fprintf(f, "DOUBLE_PRECISION");
316 # endif
317 # if defined(MPI_COMPLEX)
318 else if (ty == MPI_COMPLEX) fprintf(f, "COMPLEX");
319 # endif
320 # if defined(MPI_DOUBLE_COMPLEX)
321 else if (ty == MPI_DOUBLE_COMPLEX) fprintf(f, "DOUBLE_COMPLEX");
322 # endif
323 # if defined(MPI_LOGICAL)
324 else if (ty == MPI_LOGICAL) fprintf(f, "LOGICAL");
325 # endif
326 # if defined(MPI_2INTEGER)
327 else if (ty == MPI_2INTEGER) fprintf(f, "2INTEGER");
328 # endif
329 # if defined(MPI_2COMPLEX)
330 else if (ty == MPI_2COMPLEX) fprintf(f, "2COMPLEX");
331 # endif
332 # if defined(MPI_2DOUBLE_COMPLEX)
333 else if (ty == MPI_2DOUBLE_COMPLEX) fprintf(f, "2DOUBLE_COMPLEX");
334 # endif
335 # if defined(MPI_2REAL)
336 else if (ty == MPI_2REAL) fprintf(f, "2REAL");
337 # endif
338 # if defined(MPI_2DOUBLE_PRECISION)
339 else if (ty == MPI_2DOUBLE_PRECISION) fprintf(f, "2DOUBLE_PRECISION");
340 # endif
341 # if defined(MPI_CHARACTER)
342 else if (ty == MPI_CHARACTER) fprintf(f, "CHARACTER");
343 # endif
344 else fprintf(f,"showTy:???");
345 }
346
showCombiner(FILE * f,int combiner)347 static void showCombiner ( FILE* f, int combiner )
348 {
349 switch (combiner) {
350 case MPI_COMBINER_NAMED: fprintf(f, "NAMED"); break;
351 #if defined(MPI_COMBINER_DUP)
352 case MPI_COMBINER_DUP: fprintf(f, "DUP"); break;
353 # endif
354 case MPI_COMBINER_CONTIGUOUS: fprintf(f, "CONTIGUOUS"); break;
355 case MPI_COMBINER_VECTOR: fprintf(f, "VECTOR"); break;
356 #if defined(MPI_COMBINER_HVECTOR_INTEGER)
357 case MPI_COMBINER_HVECTOR_INTEGER: fprintf(f, "HVECTOR_INTEGER"); break;
358 # endif
359 case MPI_COMBINER_HVECTOR: fprintf(f, "HVECTOR"); break;
360 case MPI_COMBINER_INDEXED: fprintf(f, "INDEXED"); break;
361 #if defined(MPI_COMBINER_HINDEXED_INTEGER)
362 case MPI_COMBINER_HINDEXED_INTEGER: fprintf(f, "HINDEXED_INTEGER"); break;
363 # endif
364 case MPI_COMBINER_HINDEXED: fprintf(f, "HINDEXED"); break;
365 #if defined(MPI_COMBINER_INDEXED_BLOCK)
366 case MPI_COMBINER_INDEXED_BLOCK: fprintf(f, "INDEXED_BLOCK"); break;
367 # endif
368 #if defined(MPI_COMBINER_STRUCT_INTEGER)
369 case MPI_COMBINER_STRUCT_INTEGER: fprintf(f, "STRUCT_INTEGER"); break;
370 # endif
371 case MPI_COMBINER_STRUCT: fprintf(f, "STRUCT"); break;
372 #if defined(MPI_COMBINER_SUBARRAY)
373 case MPI_COMBINER_SUBARRAY: fprintf(f, "SUBARRAY"); break;
374 # endif
375 #if defined(MPI_COMBINER_DARRAY)
376 case MPI_COMBINER_DARRAY: fprintf(f, "DARRAY"); break;
377 # endif
378 #if defined(MPI_COMBINER_F90_REAL)
379 case MPI_COMBINER_F90_REAL: fprintf(f, "F90_REAL"); break;
380 # endif
381 #if defined(MPI_COMBINER_F90_COMPLEX)
382 case MPI_COMBINER_F90_COMPLEX: fprintf(f, "F90_COMPLEX"); break;
383 # endif
384 #if defined(MPI_COMBINER_F90_INTEGER)
385 case MPI_COMBINER_F90_INTEGER: fprintf(f, "F90_INTEGER"); break;
386 # endif
387 #if defined(MPI_COMBINER_RESIZED)
388 case MPI_COMBINER_RESIZED: fprintf(f, "RESIZED"); break;
389 # endif
390 default: fprintf(f, "showCombiner:??"); break;
391 }
392 }
393
394
395 /* ------ Get useful bits of info ------ */
396
397 /* Note, PMPI_Comm_rank/size are themselves wrapped. Should work
398 fine. */
399
comm_rank(MPI_Comm comm)400 static __inline__ int comm_rank ( MPI_Comm comm )
401 {
402 int err, r;
403 err = PMPI_Comm_rank(comm, &r);
404 return err ? 0/*arbitrary*/ : r;
405 }
406
comm_size(MPI_Comm comm)407 static __inline__ int comm_size ( MPI_Comm comm )
408 {
409 int err, r;
410 err = PMPI_Comm_size(comm, &r);
411 return err ? 0/*arbitrary*/ : r;
412 }
413
count_from_Status(int * recv_count,MPI_Datatype datatype,MPI_Status * status)414 static __inline__ Bool count_from_Status( /*OUT*/int* recv_count,
415 MPI_Datatype datatype,
416 MPI_Status* status)
417 {
418 int n;
419 int err = PMPI_Get_count(status, datatype, &n);
420 if (err == MPI_SUCCESS) {
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. */
435 static __inline__
eq_MPI_Request(MPI_Request r1,MPI_Request r2)436 Bool 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. */
445 static __inline__
isMSI(MPI_Status * status)446 Bool 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. */
extentOfTy(MPI_Datatype ty)458 static 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 */
maybeFreeTy(MPI_Datatype * ty)468 static 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 */
sizeofOneNamedTy(MPI_Datatype ty)512 static 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 */
sizeof_long_double_image(void)605 static 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
660 static __inline__
661 void 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. */
668 static
walk_type(void (* f)(void *,long),char * base,MPI_Datatype ty)669 void 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. */
890 static __inline__
walk_type_array(void (* f)(void *,long),char * base,MPI_Datatype elemTy,long count)891 void 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) */
mpiwrap_walk_type_EXTERNALLY_VISIBLE(void (* f)(void *,long),char * base,MPI_Datatype ty)932 void 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
949 static __inline__
check_mem_is_defined_untyped(void * buffer,long nbytes)950 void 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
957 static __inline__
check_mem_is_addressable_untyped(void * buffer,long nbytes)958 void 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
965 static __inline__
make_mem_defined_if_addressable_untyped(void * buffer,long nbytes)966 void 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
973 static __inline__
make_mem_defined_if_addressable_if_success_untyped(int err,void * buffer,long nbytes)974 void 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
992 static __inline__
check_mem_is_defined(char * buffer,long count,MPI_Datatype datatype)993 void 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
1003 static __inline__
check_mem_is_addressable(void * buffer,long count,MPI_Datatype datatype)1004 void 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
1013 static __inline__
make_mem_defined_if_addressable(void * buffer,int count,MPI_Datatype datatype)1014 void 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
1020 static __inline__
1021 void
make_mem_defined_if_addressable_if_success(int err,void * buffer,int count,MPI_Datatype datatype)1022 make_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) */
1059 static
generic_Send(void * buf,int count,MPI_Datatype datatype,int dest,int tag,MPI_Comm comm)1060 int 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 CALL_FN_W_6W(err, fn, buf,count,datatype,dest,tag,comm);
1069 after("{,B,S,R}Send", err);
1070 return err;
1071 }
WRAPPER_FOR(PMPI_Send)1072 int WRAPPER_FOR(PMPI_Send)(void *buf, int count, MPI_Datatype datatype,
1073 int dest, int tag, MPI_Comm comm) {
1074 return generic_Send(buf,count,datatype, dest,tag,comm);
1075 }
WRAPPER_FOR(PMPI_Bsend)1076 int WRAPPER_FOR(PMPI_Bsend)(void *buf, int count, MPI_Datatype datatype,
1077 int dest, int tag, MPI_Comm comm) {
1078 return generic_Send(buf,count,datatype, dest,tag,comm);
1079 }
WRAPPER_FOR(PMPI_Ssend)1080 int WRAPPER_FOR(PMPI_Ssend)(void *buf, int count, MPI_Datatype datatype,
1081 int dest, int tag, MPI_Comm comm) {
1082 return generic_Send(buf,count,datatype, dest,tag,comm);
1083 }
WRAPPER_FOR(PMPI_Rsend)1084 int WRAPPER_FOR(PMPI_Rsend)(void *buf, int count, MPI_Datatype datatype,
1085 int dest, int tag, MPI_Comm comm) {
1086 return generic_Send(buf,count,datatype, dest,tag,comm);
1087 }
1088
1089 /* --- Recv --- */
1090 /* pre: must be writable: (buf,count,datatype)
1091 must be writable: status
1092 post: make readable: (buf,recv_count,datatype)
1093 where recv_count is determined from *status
1094 */
WRAPPER_FOR(PMPI_Recv)1095 int WRAPPER_FOR(PMPI_Recv)(void *buf, int count, MPI_Datatype datatype,
1096 int source, int tag,
1097 MPI_Comm comm, MPI_Status *status)
1098 {
1099 OrigFn fn;
1100 int err, recv_count = 0;
1101 MPI_Status fake_status;
1102 VALGRIND_GET_ORIG_FN(fn);
1103 before("Recv");
1104 if (isMSI(status))
1105 status = &fake_status;
1106 check_mem_is_addressable(buf, count, datatype);
1107 check_mem_is_addressable_untyped(status, sizeof(*status));
1108 CALL_FN_W_7W(err, fn, buf,count,datatype,source,tag,comm,status);
1109 if (err == MPI_SUCCESS && count_from_Status(&recv_count,datatype,status)) {
1110 make_mem_defined_if_addressable(buf, recv_count, datatype);
1111 }
1112 after("Recv", err);
1113 return err;
1114 }
1115
1116 /* --- Get_count --- */
1117 /* pre: must be readable: *status
1118 post: make defined: *count -- don't bother, libmpi will surely do this
1119 */
WRAPPER_FOR(PMPI_Get_count)1120 int WRAPPER_FOR(PMPI_Get_count)(MPI_Status* status,
1121 MPI_Datatype ty, int* count )
1122 {
1123 OrigFn fn;
1124 int err;
1125 VALGRIND_GET_ORIG_FN(fn);
1126 before("Get_count");
1127 # if defined(_AIX)
1128 check_mem_is_addressable_untyped(status, sizeof(*status));
1129 # else
1130 check_mem_is_defined_untyped(status, sizeof(*status));
1131 # endif
1132 CALL_FN_W_WWW(err, fn, status,ty,count);
1133 after("Get_count", err);
1134 return err;
1135 }
1136
1137
1138 /*------------------------------------------------------------*/
1139 /*--- ---*/
1140 /*--- Sec 3.7, Nonblocking communication ---*/
1141 /*--- ---*/
1142 /*------------------------------------------------------------*/
1143
1144 /* Maintain a table that makes it possible for the wrappers to
1145 complete MPI_Irecv successfully.
1146
1147 The issue is that MPI_Irecv states the recv buffer and returns
1148 immediately, giving a handle (MPI_Request) for the transaction.
1149 Later the user will have to poll for completion with MPI_Wait etc,
1150 and at that point these wrappers have to paint the recv buffer.
1151 But the recv buffer details are not presented to MPI_Wait - only
1152 the handle is. We therefore have to use a shadow table
1153 (sReqs{,_size,_used,_lock}) which associates uncompleted
1154 MPI_Requests with the corresponding buffer address/count/type.
1155
1156 Only read requests are placed in the table, since there is no need
1157 to do any buffer painting following completion of an Isend - all
1158 the checks for that are done at the time Isend is called.
1159
1160 Care has to be take to remove completed requests from the table.
1161
1162 Access to the table is guarded by sReqs_lock so as to make it
1163 thread-safe.
1164 */
1165
1166 typedef
1167 struct {
1168 Bool inUse;
1169 MPI_Request key;
1170 void* buf;
1171 int count;
1172 MPI_Datatype datatype;
1173 }
1174 ShadowRequest;
1175
1176 static ShadowRequest* sReqs = NULL;
1177 static int sReqs_size = 0;
1178 static int sReqs_used = 0;
1179 static pthread_mutex_t sReqs_lock = PTHREAD_MUTEX_INITIALIZER;
1180
1181 #define LOCK_SREQS \
1182 do { int pr = pthread_mutex_lock(&sReqs_lock); \
1183 assert(pr == 0); \
1184 } while (0)
1185
1186 #define UNLOCK_SREQS \
1187 do { int pr = pthread_mutex_unlock(&sReqs_lock); \
1188 assert(pr == 0); \
1189 } while (0)
1190
1191
1192 /* Ensure the sReqs expandable array has at least one free slot, by
1193 copying it into a larger one if necessary. NOTE: sReqs_lock is
1194 held throughout this procedure.*/
ensure_sReq_space(void)1195 static void ensure_sReq_space ( void )
1196 {
1197 int i;
1198 ShadowRequest* sReqs2;
1199 if (sReqs_used == sReqs_size) {
1200 sReqs_size = sReqs_size==0 ? 2 : 2*sReqs_size;
1201 sReqs2 = malloc( sReqs_size * sizeof(ShadowRequest) );
1202 if (sReqs2 == NULL) {
1203 UNLOCK_SREQS;
1204 barf("add_shadow_Request: malloc failed.\n");
1205 }
1206 for (i = 0; i < sReqs_used; i++)
1207 sReqs2[i] = sReqs[i];
1208 if (sReqs)
1209 free(sReqs);
1210 sReqs = sReqs2;
1211 }
1212 assert(sReqs_used < sReqs_size);
1213 }
1214
1215
1216 /* Find shadow info for 'request', or NULL if none. */
1217
1218 static
find_shadow_Request(MPI_Request request)1219 ShadowRequest* find_shadow_Request ( MPI_Request request )
1220 {
1221 ShadowRequest* ret = NULL;
1222 int i;
1223 LOCK_SREQS;
1224 for (i = 0; i < sReqs_used; i++) {
1225 if (sReqs[i].inUse && eq_MPI_Request(sReqs[i].key,request)) {
1226 ret = &sReqs[i];
1227 break;
1228 }
1229 }
1230 UNLOCK_SREQS;
1231 return ret;
1232 }
1233
1234
1235 /* Delete shadow info for 'request', if any. */
1236
delete_shadow_Request(MPI_Request request)1237 static void delete_shadow_Request ( MPI_Request request )
1238 {
1239 int i;
1240 LOCK_SREQS;
1241 for (i = 0; i < sReqs_used; i++) {
1242 if (sReqs[i].inUse && eq_MPI_Request(sReqs[i].key,request)) {
1243 sReqs[i].inUse = False;
1244 break;
1245 }
1246 }
1247 UNLOCK_SREQS;
1248 }
1249
1250
1251 /* Add a shadow for 'request', overwriting any old binding for it. */
1252
1253 static
add_shadow_Request(MPI_Request request,void * buf,int count,MPI_Datatype datatype)1254 void add_shadow_Request( MPI_Request request,
1255 void* buf, int count,
1256 MPI_Datatype datatype )
1257 {
1258 int i, ix = -1;
1259 LOCK_SREQS;
1260 assert(sReqs_used >= 0);
1261 assert(sReqs_size >= 0);
1262 assert(sReqs_used <= sReqs_size);
1263 if (sReqs == NULL) assert(sReqs_size == 0);
1264
1265 /* First of all see if we already have a binding for this key; if
1266 so just replace it, and have done. */
1267 for (i = 0; i < sReqs_used; i++) {
1268 if (sReqs[i].inUse && eq_MPI_Request(sReqs[i].key,request)) {
1269 ix = i;
1270 break;
1271 }
1272 }
1273
1274 if (ix < 0) {
1275 /* Ok, we don't have it, so will have to add it. First search
1276 to see if there is an existing empty slot. */
1277 for (i = 0; i < sReqs_used; i++) {
1278 if (!sReqs[i].inUse) {
1279 ix = i;
1280 break;
1281 }
1282 }
1283 }
1284
1285 /* No empty slots. Allocate a new one. */
1286 if (ix < 0) {
1287 ensure_sReq_space();
1288 assert(sReqs_used < sReqs_size);
1289 ix = sReqs_used;
1290 sReqs_used++;
1291 }
1292
1293 assert(ix >= 0 && ix < sReqs_used);
1294 assert(sReqs_used <= sReqs_size);
1295
1296 sReqs[ix].inUse = True;
1297 sReqs[ix].key = request;
1298 sReqs[ix].buf = buf;
1299 sReqs[ix].count = count;
1300 sReqs[ix].datatype = datatype;
1301
1302 UNLOCK_SREQS;
1303 if (opt_verbosity > 1)
1304 fprintf(stderr, "%s %5d: sReq+ 0x%lx -> b/c/d %p/%d/0x%lx [slot %d]\n",
1305 preamble, my_pid, (unsigned long)request,
1306 buf, count, (long)datatype, ix);
1307 }
1308
1309 static
clone_Request_array(int count,MPI_Request * orig)1310 MPI_Request* clone_Request_array ( int count, MPI_Request* orig )
1311 {
1312 MPI_Request* copy;
1313 int i;
1314 LOCK_SREQS;
1315 if (count < 0)
1316 count = 0; /* Hmm. Call Mulder and Scully. */
1317 copy = malloc( count * sizeof(MPI_Request) );
1318 if (copy == NULL && count > 0) {
1319 UNLOCK_SREQS;
1320 barf("clone_Request_array: malloc failed");
1321 }
1322 for (i = 0; i < count; i++)
1323 copy[i] = orig[i];
1324 UNLOCK_SREQS;
1325 return copy;
1326 }
1327
1328 #undef LOCK_SREQS
1329 #undef UNLOCK_SREQS
1330
1331
maybe_complete(Bool error_in_status,MPI_Request request_before,MPI_Request request_after,MPI_Status * status)1332 static void maybe_complete ( Bool error_in_status,
1333 MPI_Request request_before,
1334 MPI_Request request_after,
1335 MPI_Status* status )
1336 {
1337 int recv_count = 0;
1338 ShadowRequest* shadow;
1339 /* How do we know if this is an Irecv request that has now
1340 finished successfully?
1341
1342 request_before isn't MPI_REQUEST_NULL
1343 and request_before is found in the shadow table
1344 and request_after *is* MPI_REQUEST_NULL
1345 and (if error_in_status then status.MPI_ERROR is MPI_SUCCESS)
1346
1347 (when error_in_status == False, then we expect not to get
1348 called at all if there was an error.)
1349 */
1350 if (request_before != MPI_REQUEST_NULL
1351 && request_after == MPI_REQUEST_NULL
1352 && (error_in_status ? status->MPI_ERROR == MPI_SUCCESS : True)
1353 && ( (shadow=find_shadow_Request(request_before)) != NULL) ) {
1354 /* The Irecv detailed in 'shadow' completed. Paint the result
1355 buffer, and delete the entry. */
1356 if (count_from_Status(&recv_count, shadow->datatype, status)) {
1357 make_mem_defined_if_addressable(shadow->buf, recv_count, shadow->datatype);
1358 if (opt_verbosity > 1)
1359 fprintf(stderr, "%s %5d: sReq- %p (completed)\n",
1360 preamble, my_pid, request_before);
1361 }
1362 delete_shadow_Request(request_before);
1363 }
1364 }
1365
1366
1367 /* --- Isend --- */
1368 /* rd: (buf,count,datatype) */
1369 /* wr: *request */
1370 static __inline__
generic_Isend(void * buf,int count,MPI_Datatype datatype,int dest,int tag,MPI_Comm comm,MPI_Request * request)1371 int generic_Isend(void *buf, int count, MPI_Datatype datatype,
1372 int dest, int tag, MPI_Comm comm,
1373 MPI_Request* request)
1374 {
1375 OrigFn fn;
1376 int err;
1377 VALGRIND_GET_ORIG_FN(fn);
1378 before("{,B,S,R}Isend");
1379 check_mem_is_defined(buf, count, datatype);
1380 check_mem_is_addressable_untyped(request, sizeof(*request));
1381 CALL_FN_W_7W(err, fn, buf,count,datatype,dest,tag,comm,request);
1382 make_mem_defined_if_addressable_if_success_untyped(err, request, sizeof(*request));
1383 after("{,B,S,R}Isend", err);
1384 return err;
1385 }
WRAPPER_FOR(PMPI_Isend)1386 int WRAPPER_FOR(PMPI_Isend)(void *buf, int count, MPI_Datatype datatype,
1387 int dest, int tag, MPI_Comm comm,
1388 MPI_Request* request) {
1389 return generic_Isend(buf,count,datatype, dest,tag,comm, request);
1390 }
WRAPPER_FOR(PMPI_Ibsend)1391 int WRAPPER_FOR(PMPI_Ibsend)(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 }
WRAPPER_FOR(PMPI_Issend)1396 int WRAPPER_FOR(PMPI_Issend)(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 }
WRAPPER_FOR(PMPI_Irsend)1401 int WRAPPER_FOR(PMPI_Irsend)(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 }
1406
1407
1408 /* --- Irecv --- */
1409 /* pre: must be writable: (buf,count,datatype), *request
1410 post: make readable *request
1411 add a request->(buf,count,ty) binding to the
1412 shadow request table.
1413 */
WRAPPER_FOR(PMPI_Irecv)1414 int WRAPPER_FOR(PMPI_Irecv)( void* buf, int count, MPI_Datatype datatype,
1415 int source, int tag, MPI_Comm comm,
1416 MPI_Request* request )
1417 {
1418 OrigFn fn;
1419 int err;
1420 VALGRIND_GET_ORIG_FN(fn);
1421 before("Irecv");
1422 check_mem_is_addressable(buf, count, datatype);
1423 check_mem_is_addressable_untyped(request, sizeof(*request));
1424 CALL_FN_W_7W(err, fn, buf,count,datatype,source,tag,comm,request);
1425 if (err == MPI_SUCCESS) {
1426 make_mem_defined_if_addressable_untyped(request, sizeof(*request));
1427 add_shadow_Request( *request, buf,count,datatype );
1428 }
1429 after("Irecv", err);
1430 return err;
1431 }
1432
1433 /* --- Wait --- */
1434 /* The MPI1 spec (imprecisely) defines 3 request states:
1435 - "null" if the request is MPI_REQUEST_NULL
1436 - "inactive" if not "null" and not associated with ongoing comms
1437 - "active" if not "null" and is associated with ongoing comms
1438 */
WRAPPER_FOR(PMPI_Wait)1439 int WRAPPER_FOR(PMPI_Wait)( MPI_Request* request,
1440 MPI_Status* status )
1441 {
1442 MPI_Request request_before;
1443 MPI_Status fake_status;
1444 OrigFn fn;
1445 int err;
1446 VALGRIND_GET_ORIG_FN(fn);
1447 before("Wait");
1448 if (isMSI(status))
1449 status = &fake_status;
1450 check_mem_is_addressable_untyped(status, sizeof(MPI_Status));
1451 check_mem_is_defined_untyped(request, sizeof(MPI_Request));
1452 request_before = *request;
1453 CALL_FN_W_WW(err, fn, request,status);
1454 if (err == MPI_SUCCESS) {
1455 maybe_complete(False/*err in status?*/,
1456 request_before, *request, status);
1457 make_mem_defined_if_addressable_untyped(status, sizeof(MPI_Status));
1458 }
1459 after("Wait", err);
1460 return err;
1461 }
1462
1463 /* --- Waitany --- */
WRAPPER_FOR(PMPI_Waitany)1464 int WRAPPER_FOR(PMPI_Waitany)( int count,
1465 MPI_Request* requests,
1466 int* index,
1467 MPI_Status* status )
1468 {
1469 MPI_Request* requests_before = NULL;
1470 MPI_Status fake_status;
1471 OrigFn fn;
1472 int err, i;
1473 VALGRIND_GET_ORIG_FN(fn);
1474 before("Waitany");
1475 if (isMSI(status))
1476 status = &fake_status;
1477 if (0) fprintf(stderr, "Waitany: %d\n", count);
1478 check_mem_is_addressable_untyped(index, sizeof(int));
1479 check_mem_is_addressable_untyped(status, sizeof(MPI_Status));
1480 for (i = 0; i < count; i++) {
1481 check_mem_is_defined_untyped(&requests[i], sizeof(MPI_Request));
1482 }
1483 requests_before = clone_Request_array( count, requests );
1484 CALL_FN_W_WWWW(err, fn, count,requests,index,status);
1485 if (err == MPI_SUCCESS && *index >= 0 && *index < count) {
1486 maybe_complete(False/*err in status?*/,
1487 requests_before[*index], requests[*index], status);
1488 make_mem_defined_if_addressable_untyped(status, sizeof(MPI_Status));
1489 }
1490 if (requests_before)
1491 free(requests_before);
1492 after("Waitany", err);
1493 return err;
1494 }
1495
1496 /* --- Waitall --- */
WRAPPER_FOR(PMPI_Waitall)1497 int WRAPPER_FOR(PMPI_Waitall)( int count,
1498 MPI_Request* requests,
1499 MPI_Status* statuses )
1500 {
1501 MPI_Request* requests_before = NULL;
1502 OrigFn fn;
1503 int err, i;
1504 Bool free_sta = False;
1505 VALGRIND_GET_ORIG_FN(fn);
1506 before("Waitall");
1507 if (0) fprintf(stderr, "Waitall: %d\n", count);
1508 if (isMSI(statuses)) {
1509 free_sta = True;
1510 statuses = malloc( (count < 0 ? 0 : count) * sizeof(MPI_Status) );
1511 }
1512 for (i = 0; i < count; i++) {
1513 check_mem_is_addressable_untyped(&statuses[i], sizeof(MPI_Status));
1514 check_mem_is_defined_untyped(&requests[i], sizeof(MPI_Request));
1515 }
1516 requests_before = clone_Request_array( count, requests );
1517 CALL_FN_W_WWW(err, fn, count,requests,statuses);
1518 if (err == MPI_SUCCESS /*complete success*/
1519 || err == MPI_ERR_IN_STATUS /* partial success */) {
1520 Bool e_i_s = err == MPI_ERR_IN_STATUS;
1521 for (i = 0; i < count; i++) {
1522 maybe_complete(e_i_s, requests_before[i], requests[i],
1523 &statuses[i]);
1524 make_mem_defined_if_addressable_untyped(&statuses[i],
1525 sizeof(MPI_Status));
1526 }
1527 }
1528 if (requests_before)
1529 free(requests_before);
1530 if (free_sta)
1531 free(statuses);
1532 after("Waitall", err);
1533 return err;
1534 }
1535
1536 /* --- Test --- */
1537 /* nonblocking version of Wait */
WRAPPER_FOR(PMPI_Test)1538 int WRAPPER_FOR(PMPI_Test)( MPI_Request* request, int* flag,
1539 MPI_Status* status )
1540 {
1541 MPI_Request request_before;
1542 MPI_Status fake_status;
1543 OrigFn fn;
1544 int err;
1545 VALGRIND_GET_ORIG_FN(fn);
1546 before("Test");
1547 if (isMSI(status))
1548 status = &fake_status;
1549 check_mem_is_addressable_untyped(status, sizeof(MPI_Status));
1550 check_mem_is_addressable_untyped(flag, sizeof(int));
1551 check_mem_is_defined_untyped(request, sizeof(MPI_Request));
1552 request_before = *request;
1553 CALL_FN_W_WWW(err, fn, request,flag,status);
1554 if (err == MPI_SUCCESS && *flag) {
1555 maybe_complete(False/*err in status?*/,
1556 request_before, *request, status);
1557 make_mem_defined_if_addressable_untyped(status, sizeof(MPI_Status));
1558 }
1559 after("Test", err);
1560 return err;
1561 }
1562
1563 /* --- Testall --- */
1564 /* nonblocking version of Waitall */
WRAPPER_FOR(PMPI_Testall)1565 int WRAPPER_FOR(PMPI_Testall)( int count, MPI_Request* requests,
1566 int* flag, MPI_Status* statuses )
1567 {
1568 MPI_Request* requests_before = NULL;
1569 OrigFn fn;
1570 int err, i;
1571 Bool free_sta = False;
1572 VALGRIND_GET_ORIG_FN(fn);
1573 before("Testall");
1574 if (0) fprintf(stderr, "Testall: %d\n", count);
1575 if (isMSI(statuses)) {
1576 free_sta = True;
1577 statuses = malloc( (count < 0 ? 0 : count) * sizeof(MPI_Status) );
1578 }
1579 check_mem_is_addressable_untyped(flag, sizeof(int));
1580 for (i = 0; i < count; i++) {
1581 check_mem_is_addressable_untyped(&statuses[i], sizeof(MPI_Status));
1582 check_mem_is_defined_untyped(&requests[i], sizeof(MPI_Request));
1583 }
1584 requests_before = clone_Request_array( count, requests );
1585 CALL_FN_W_WWWW(err, fn, count,requests,flag,statuses);
1586 /* Urk. Is the following "if (...)" really right? I don't know. */
1587 if (*flag
1588 && (err == MPI_SUCCESS /*complete success*/
1589 || err == MPI_ERR_IN_STATUS /* partial success */)) {
1590 Bool e_i_s = err == MPI_ERR_IN_STATUS;
1591 for (i = 0; i < count; i++) {
1592 maybe_complete(e_i_s, requests_before[i], requests[i],
1593 &statuses[i]);
1594 make_mem_defined_if_addressable_untyped(&statuses[i],
1595 sizeof(MPI_Status));
1596 }
1597 }
1598 if (requests_before)
1599 free(requests_before);
1600 if (free_sta)
1601 free(statuses);
1602 after("Testall", err);
1603 return err;
1604 }
1605
1606 /* --- Iprobe --- */
1607 /* pre: must-be-writable: *flag, *status */
1608 /* post: make-readable *flag
1609 if *flag==True make-defined *status */
WRAPPER_FOR(PMPI_Iprobe)1610 int WRAPPER_FOR(PMPI_Iprobe)(int source, int tag,
1611 MPI_Comm comm,
1612 int* flag, MPI_Status* status)
1613 {
1614 MPI_Status fake_status;
1615 OrigFn fn;
1616 int err;
1617 VALGRIND_GET_ORIG_FN(fn);
1618 before("Iprobe");
1619 if (isMSI(status))
1620 status = &fake_status;
1621 check_mem_is_addressable_untyped(flag, sizeof(*flag));
1622 check_mem_is_addressable_untyped(status, sizeof(*status));
1623 CALL_FN_W_5W(err, fn, source,tag,comm,flag,status);
1624 if (err == MPI_SUCCESS) {
1625 make_mem_defined_if_addressable_untyped(flag, sizeof(*flag));
1626 if (*flag)
1627 make_mem_defined_if_addressable_untyped(status, sizeof(*status));
1628 }
1629 after("Iprobe", err);
1630 return err;
1631 }
1632
1633 /* --- Probe --- */
1634 /* pre: must-be-writable *status */
1635 /* post: make-defined *status */
WRAPPER_FOR(PMPI_Probe)1636 int WRAPPER_FOR(PMPI_Probe)(int source, int tag,
1637 MPI_Comm comm, MPI_Status* status)
1638 {
1639 MPI_Status fake_status;
1640 OrigFn fn;
1641 int err;
1642 VALGRIND_GET_ORIG_FN(fn);
1643 before("Probe");
1644 if (isMSI(status))
1645 status = &fake_status;
1646 check_mem_is_addressable_untyped(status, sizeof(*status));
1647 CALL_FN_W_WWWW(err, fn, source,tag,comm,status);
1648 make_mem_defined_if_addressable_if_success_untyped(err, status, sizeof(*status));
1649 after("Probe", err);
1650 return err;
1651 }
1652
1653 /* --- Cancel --- */
1654 /* Wrapping PMPI_Cancel is interesting only to the extent that we need
1655 to be able to detect when a request should be removed from our
1656 shadow table due to cancellation. */
WRAPPER_FOR(PMPI_Cancel)1657 int WRAPPER_FOR(PMPI_Cancel)(MPI_Request* request)
1658 {
1659 OrigFn fn;
1660 int err;
1661 MPI_Request tmp;
1662 VALGRIND_GET_ORIG_FN(fn);
1663 before("Cancel");
1664 check_mem_is_addressable_untyped(request, sizeof(*request));
1665 tmp = *request;
1666 CALL_FN_W_W(err, fn, request);
1667 if (err == MPI_SUCCESS)
1668 delete_shadow_Request(tmp);
1669 after("Cancel", err);
1670 return err;
1671 }
1672
1673
1674 /*------------------------------------------------------------*/
1675 /*--- ---*/
1676 /*--- Sec 3.10, Send-receive ---*/
1677 /*--- ---*/
1678 /*------------------------------------------------------------*/
1679
1680 /* --- Sendrecv --- */
1681 /* pre: must be readable: (sendbuf,sendcount,sendtype)
1682 must be writable: (recvbuf,recvcount,recvtype)
1683 post: make readable: (recvbuf,recvcount_actual,datatype)
1684 where recvcount_actual is determined from *status
1685 */
WRAPPER_FOR(PMPI_Sendrecv)1686 int WRAPPER_FOR(PMPI_Sendrecv)(
1687 void *sendbuf, int sendcount, MPI_Datatype sendtype,
1688 int dest, int sendtag,
1689 void *recvbuf, int recvcount, MPI_Datatype recvtype,
1690 int source, int recvtag,
1691 MPI_Comm comm, MPI_Status *status)
1692 {
1693 MPI_Status fake_status;
1694 OrigFn fn;
1695 int err, recvcount_actual = 0;
1696 VALGRIND_GET_ORIG_FN(fn);
1697 before("Sendrecv");
1698 if (isMSI(status))
1699 status = &fake_status;
1700 check_mem_is_defined(sendbuf, sendcount, sendtype);
1701 check_mem_is_addressable(recvbuf, recvcount, recvtype);
1702 check_mem_is_addressable_untyped(status, sizeof(*status));
1703 CALL_FN_W_12W(err, fn, sendbuf,sendcount,sendtype,dest,sendtag,
1704 recvbuf,recvcount,recvtype,source,recvtag,
1705 comm,status);
1706 if (err == MPI_SUCCESS
1707 && count_from_Status(&recvcount_actual,recvtype,status)) {
1708 make_mem_defined_if_addressable(recvbuf, recvcount_actual, recvtype);
1709 }
1710 after("Sendrecv", err);
1711 return err;
1712 }
1713
1714
1715 /*------------------------------------------------------------*/
1716 /*--- ---*/
1717 /*--- Sec 3.12, Derived datatypes ---*/
1718 /*--- ---*/
1719 /*------------------------------------------------------------*/
1720
1721 /* --- Address --- */
1722 /* Does this have anything worth checking? */
1723 HAS_NO_WRAPPER(Address)
1724
1725 /* --- MPI 2 stuff --- */
1726 /* Type_extent, Type_get_contents and Type_get_envelope sometimes get
1727 used intensively by the type walker (walk_type). There's no reason
1728 why they couldn't be properly wrapped if needed, but doing so slows
1729 everything down, so don't bother until needed. */
HAS_NO_WRAPPER(Type_extent)1730 HAS_NO_WRAPPER(Type_extent)
1731 HAS_NO_WRAPPER(Type_get_contents)
1732 HAS_NO_WRAPPER(Type_get_envelope)
1733
1734 /* --- Type_commit --- */
1735 int WRAPPER_FOR(PMPI_Type_commit)( MPI_Datatype* ty )
1736 {
1737 OrigFn fn;
1738 int err;
1739 VALGRIND_GET_ORIG_FN(fn);
1740 before("Type_commit");
1741 check_mem_is_defined_untyped(ty, sizeof(*ty));
1742 CALL_FN_W_W(err, fn, ty);
1743 after("Type_commit", err);
1744 return err;
1745 }
1746
1747 /* --- Type_free --- */
WRAPPER_FOR(PMPI_Type_free)1748 int WRAPPER_FOR(PMPI_Type_free)( MPI_Datatype* ty )
1749 {
1750 OrigFn fn;
1751 int err;
1752 VALGRIND_GET_ORIG_FN(fn);
1753 before("Type_free");
1754 check_mem_is_defined_untyped(ty, sizeof(*ty));
1755 CALL_FN_W_W(err, fn, ty);
1756 after("Type_free", err);
1757 return err;
1758 }
1759
1760
1761 /*------------------------------------------------------------*/
1762 /*--- ---*/
1763 /*--- Sec 3.13, Pack and unpack ---*/
1764 /*--- ---*/
1765 /*------------------------------------------------------------*/
1766
1767 /* --- Pack --- */
1768 /* pre: must be readable: position
1769 must be readable: (inbuf,incount,datatype)
1770 must be writable: outbuf[0 .. outsize-1]
1771 must be writable: outbuf[*position ..
1772 *position - 1
1773 + however much space PMPI_Pack_size
1774 says we will need]
1775 post: make readable: outbuf[old *position .. new *position]
1776 */
WRAPPER_FOR(PMPI_Pack)1777 int WRAPPER_FOR(PMPI_Pack)( void* inbuf, int incount, MPI_Datatype datatype,
1778 void* outbuf, int outsize,
1779 int* position, MPI_Comm comm )
1780 {
1781 OrigFn fn;
1782 int err, szB = 0;
1783 int position_ORIG = *position;
1784 VALGRIND_GET_ORIG_FN(fn);
1785 before("Pack");
1786 /* stay sane */
1787 check_mem_is_defined_untyped(position, sizeof(*position));
1788 /* check input */
1789 check_mem_is_defined(inbuf, incount, datatype);
1790 /* check output area's stated bounds make sense */
1791 check_mem_is_addressable_untyped(outbuf, outsize);
1792 /* check output area's actual used size properly */
1793 err = PMPI_Pack_size( incount, datatype, comm, &szB );
1794 if (err == MPI_SUCCESS && szB > 0) {
1795 check_mem_is_addressable_untyped(
1796 ((char*)outbuf) + position_ORIG, szB
1797 );
1798 }
1799
1800 CALL_FN_W_7W(err, fn, inbuf,incount,datatype, outbuf,outsize,position, comm);
1801
1802 if (err == MPI_SUCCESS && (*position) > position_ORIG) {
1803 /* paint output */
1804 make_mem_defined_if_addressable_untyped(
1805 ((char*)outbuf) + position_ORIG, *position - position_ORIG
1806 );
1807 }
1808 after("Pack", err);
1809 return err;
1810 }
1811
1812 /* --- Unpack --- */
1813 /* pre: must be readable: position
1814 must be writable: (outbuf,outcount,datatype)
1815 must be writable: outbuf[0 .. outsize-1]
1816 must be writable: outbuf[*position ..
1817 *position - 1
1818 + however much space PMPI_Pack_size
1819 says we will need]
1820 post: make readable: (outbuf,outcount,datatype)
1821 and also do a readability check of
1822 inbuf[old *position .. new *position]
1823 */
WRAPPER_FOR(PMPI_Unpack)1824 int WRAPPER_FOR(PMPI_Unpack)( void* inbuf, int insize, int* position,
1825 void* outbuf, int outcount, MPI_Datatype datatype,
1826 MPI_Comm comm )
1827 {
1828 OrigFn fn;
1829 int err, szB = 0;
1830 int position_ORIG = *position;
1831 VALGRIND_GET_ORIG_FN(fn);
1832 before("Unpack");
1833 /* stay sane */
1834 check_mem_is_defined_untyped(position, sizeof(*position));
1835 /* check output area is accessible */
1836 check_mem_is_addressable(outbuf, outcount, datatype);
1837 /* check input area's stated bounds make sense */
1838 check_mem_is_addressable_untyped(inbuf, insize);
1839 /* check input area's actual used size properly */
1840 err = PMPI_Pack_size( outcount, datatype, comm, &szB );
1841 if (err == MPI_SUCCESS && szB > 0) {
1842 check_mem_is_addressable_untyped(
1843 ((char*)inbuf) + position_ORIG, szB
1844 );
1845 }
1846
1847 CALL_FN_W_7W(err, fn, inbuf,insize,position, outbuf,outcount,datatype, comm);
1848
1849 if (err == MPI_SUCCESS && (*position) > position_ORIG) {
1850 /* recheck input more carefully */
1851 check_mem_is_defined_untyped(
1852 ((char*)inbuf) + position_ORIG, *position - position_ORIG
1853 );
1854 /* paint output */
1855 make_mem_defined_if_addressable( outbuf, outcount, datatype );
1856 }
1857 after("Unpack", err);
1858 return err;
1859 }
1860
1861
1862 /*------------------------------------------------------------*/
1863 /*--- ---*/
1864 /*--- Sec 4.4, Broadcast ---*/
1865 /*--- ---*/
1866 /*------------------------------------------------------------*/
1867
1868 /* --- Bcast --- */
1869 /* pre: must-be-readable (buffer,count,datatype) for rank==root
1870 must-be-writable (buffer,count,datatype) for rank!=root
1871 post: make-readable (buffer,count,datatype) for all
1872
1873 Resulting behaviour is: if root sends uninitialised stuff, then
1874 V complains, but then all ranks, including itself, see the buffer
1875 as initialised after that.
1876 */
WRAPPER_FOR(PMPI_Bcast)1877 int WRAPPER_FOR(PMPI_Bcast)(void *buffer, int count,
1878 MPI_Datatype datatype,
1879 int root, MPI_Comm comm)
1880 {
1881 OrigFn fn;
1882 int err;
1883 Bool i_am_sender;
1884 VALGRIND_GET_ORIG_FN(fn);
1885 before("Bcast");
1886 i_am_sender = root == comm_rank(comm);
1887 if (i_am_sender) {
1888 check_mem_is_defined(buffer, count, datatype);
1889 } else {
1890 check_mem_is_addressable(buffer, count, datatype);
1891 }
1892 CALL_FN_W_5W(err, fn, buffer,count,datatype,root,comm);
1893 make_mem_defined_if_addressable_if_success(err, buffer, count, datatype);
1894 after("Bcast", err);
1895 return err;
1896 }
1897
1898
1899 /*------------------------------------------------------------*/
1900 /*--- ---*/
1901 /*--- Sec 4.5, Gather ---*/
1902 /*--- ---*/
1903 /*------------------------------------------------------------*/
1904
1905 /* --- Gather --- */
1906 /* JRS 20060217: I don't really understand this. Each process is
1907 going to send sendcount items of type sendtype to the root. So
1908 the root is going to receive comm_size*sendcount items of type
1909 sendtype (right?) So why specify recvcount and recvtype?
1910
1911 Anyway, assuming the MPI Spec is correct (seems likely :-) we have:
1912
1913 pre: (all) must be readable: (sendbuf,sendcount,sendtype)
1914 (root only): must be writable: (recvbuf,recvcount * comm_size,recvtype)
1915 post: (root only): make readable: (recvbuf,recvcount * comm_size,recvtype)
1916 */
WRAPPER_FOR(PMPI_Gather)1917 int WRAPPER_FOR(PMPI_Gather)(
1918 void *sendbuf, int sendcount, MPI_Datatype sendtype,
1919 void *recvbuf, int recvcount, MPI_Datatype recvtype,
1920 int root, MPI_Comm comm)
1921 {
1922 OrigFn fn;
1923 int err, me, sz;
1924 VALGRIND_GET_ORIG_FN(fn);
1925 before("Gather");
1926 me = comm_rank(comm);
1927 sz = comm_size(comm);
1928 check_mem_is_defined(sendbuf, sendcount, sendtype);
1929 if (me == root)
1930 check_mem_is_addressable(recvbuf, recvcount * sz, recvtype);
1931 CALL_FN_W_8W(err, fn, sendbuf,sendcount,sendtype,
1932 recvbuf,recvcount,recvtype,
1933 root,comm);
1934 if (me == root)
1935 make_mem_defined_if_addressable_if_success(err, recvbuf, recvcount * sz, recvtype);
1936 after("Gather", err);
1937 return err;
1938 }
1939
1940
1941 /*------------------------------------------------------------*/
1942 /*--- ---*/
1943 /*--- Sec 4.6, Scatter ---*/
1944 /*--- ---*/
1945 /*------------------------------------------------------------*/
1946
1947 /* pre: (root only): must be readable: (sendbuf,sendcount * comm_size,sendtype)
1948 (all): must be writable: (recvbuf,recvbuf,recvtype)
1949 post: (all): make defined: (recvbuf,recvbuf,recvtype)
1950 */
WRAPPER_FOR(PMPI_Scatter)1951 int WRAPPER_FOR(PMPI_Scatter)(
1952 void* sendbuf, int sendcount, MPI_Datatype sendtype,
1953 void* recvbuf, int recvcount, MPI_Datatype recvtype,
1954 int root, MPI_Comm comm)
1955 {
1956 OrigFn fn;
1957 int err, me, sz;
1958 VALGRIND_GET_ORIG_FN(fn);
1959 before("Scatter");
1960 me = comm_rank(comm);
1961 sz = comm_size(comm);
1962 check_mem_is_addressable(recvbuf, recvcount, recvtype);
1963 if (me == root)
1964 check_mem_is_defined(sendbuf, sendcount * sz, sendtype);
1965 CALL_FN_W_8W(err, fn, sendbuf,sendcount,sendtype,
1966 recvbuf,recvcount,recvtype,
1967 root,comm);
1968 make_mem_defined_if_addressable_if_success(err, recvbuf, recvcount, recvtype);
1969 after("Scatter", err);
1970 return err;
1971 }
1972
1973
1974 /*------------------------------------------------------------*/
1975 /*--- ---*/
1976 /*--- Sec 4.8, All-to-All Scatter/Gather ---*/
1977 /*--- ---*/
1978 /*------------------------------------------------------------*/
1979
1980 /* pre: (all) must be readable: (sendbuf,sendcount * comm_size,sendtype)
1981 (all) must be writable: (recvbuf,recvcount * comm_size,recvtype)
1982 post: (all) make defined: (recvbuf,recvcount * comm_size,recvtype)
1983 */
WRAPPER_FOR(PMPI_Alltoall)1984 int WRAPPER_FOR(PMPI_Alltoall)(
1985 void* sendbuf, int sendcount, MPI_Datatype sendtype,
1986 void* recvbuf, int recvcount, MPI_Datatype recvtype,
1987 MPI_Comm comm)
1988 {
1989 OrigFn fn;
1990 int err, sz;
1991 VALGRIND_GET_ORIG_FN(fn);
1992 before("Alltoall");
1993 sz = comm_size(comm);
1994 check_mem_is_defined(sendbuf, sendcount * sz, sendtype);
1995 check_mem_is_addressable(recvbuf, recvcount * sz, recvtype);
1996 CALL_FN_W_7W(err, fn, sendbuf,sendcount,sendtype,
1997 recvbuf,recvcount,recvtype,
1998 comm);
1999 make_mem_defined_if_addressable_if_success(err, recvbuf, recvcount * sz, recvtype);
2000 after("Alltoall", err);
2001 return err;
2002 }
2003
2004
2005 /*------------------------------------------------------------*/
2006 /*--- ---*/
2007 /*--- Sec 4.9, Global Reduction Operations ---*/
2008 /*--- ---*/
2009 /*------------------------------------------------------------*/
2010
2011 /* --- Reduce --- */
2012 /* rd: (sendbuf,count,datatype) for all
2013 wr: (recvbuf,count,datatype) but only for rank == root
2014 */
WRAPPER_FOR(PMPI_Reduce)2015 int WRAPPER_FOR(PMPI_Reduce)(void *sendbuf, void *recvbuf,
2016 int count,
2017 MPI_Datatype datatype, MPI_Op op,
2018 int root, MPI_Comm comm)
2019 {
2020 OrigFn fn;
2021 int err;
2022 Bool i_am_root;
2023 VALGRIND_GET_ORIG_FN(fn);
2024 before("Reduce");
2025 i_am_root = root == comm_rank(comm);
2026 check_mem_is_defined(sendbuf, count, datatype);
2027 if (i_am_root)
2028 check_mem_is_addressable(recvbuf, count, datatype);
2029 CALL_FN_W_7W(err, fn, sendbuf,recvbuf,count,datatype,op,root,comm);
2030 if (i_am_root)
2031 make_mem_defined_if_addressable_if_success(err, recvbuf, count, datatype);
2032 after("Reduce", err);
2033 return err;
2034 }
2035
2036
2037 /* --- Allreduce --- */
2038 /* rd: (sendbuf,count,datatype) for all
2039 wr: (recvbuf,count,datatype) for all
2040 */
WRAPPER_FOR(PMPI_Allreduce)2041 int WRAPPER_FOR(PMPI_Allreduce)(void *sendbuf, void *recvbuf,
2042 int count,
2043 MPI_Datatype datatype, MPI_Op op,
2044 MPI_Comm comm)
2045 {
2046 OrigFn fn;
2047 int err;
2048 VALGRIND_GET_ORIG_FN(fn);
2049 before("Allreduce");
2050 check_mem_is_defined(sendbuf, count, datatype);
2051 check_mem_is_addressable(recvbuf, count, datatype);
2052 CALL_FN_W_6W(err, fn, sendbuf,recvbuf,count,datatype,op,comm);
2053 make_mem_defined_if_addressable_if_success(err, recvbuf, count, datatype);
2054 after("Allreduce", err);
2055 return err;
2056 }
2057
2058
2059 /* --- Op_create --- */
2060 /* This is a bit dubious. I suppose it takes 'function' and
2061 writes something at *op, but who knows what an MPI_Op is?
2062 Can we safely do 'sizeof' on it? */
WRAPPER_FOR(PMPI_Op_create)2063 int WRAPPER_FOR(PMPI_Op_create)( MPI_User_function* function,
2064 int commute,
2065 MPI_Op* op )
2066 {
2067 OrigFn fn;
2068 int err;
2069 VALGRIND_GET_ORIG_FN(fn);
2070 before("Op_create");
2071 check_mem_is_addressable_untyped(op, sizeof(*op));
2072 CALL_FN_W_WWW(err, fn, function,commute,op);
2073 make_mem_defined_if_addressable_if_success_untyped(err, op, sizeof(*op));
2074 after("Op_create", err);
2075 return err;
2076 }
2077
2078
2079 /*------------------------------------------------------------*/
2080 /*--- ---*/
2081 /*--- Sec 5.4, Communicator management ---*/
2082 /*--- ---*/
2083 /*------------------------------------------------------------*/
2084
2085 /* Hardly seems worth wrapping Comm_rank and Comm_size, but
2086 since it's done now .. */
2087
2088 /* --- Comm_create --- */
2089 /* Let normal memcheck tracking handle this. */
WRAPPER_FOR(PMPI_Comm_create)2090 int WRAPPER_FOR(PMPI_Comm_create)(MPI_Comm comm, MPI_Group group,
2091 MPI_Comm* newcomm)
2092 {
2093 OrigFn fn;
2094 int err;
2095 VALGRIND_GET_ORIG_FN(fn);
2096 before("Comm_create");
2097 CALL_FN_W_WWW(err, fn, comm,group,newcomm);
2098 after("Comm_create", err);
2099 return err;
2100 }
2101
2102 /* --- Comm_dup --- */
2103 /* Let normal memcheck tracking handle this. */
WRAPPER_FOR(PMPI_Comm_dup)2104 int WRAPPER_FOR(PMPI_Comm_dup)(MPI_Comm comm, MPI_Comm* newcomm)
2105 {
2106 OrigFn fn;
2107 int err;
2108 VALGRIND_GET_ORIG_FN(fn);
2109 before("Comm_dup");
2110 CALL_FN_W_WW(err, fn, comm,newcomm);
2111 after("Comm_dup", err);
2112 return err;
2113 }
2114
2115 /* --- Comm_free --- */
2116 /* Let normal memcheck tracking handle this. */
WRAPPER_FOR(PMPI_Comm_free)2117 int WRAPPER_FOR(PMPI_Comm_free)(MPI_Comm* comm)
2118 {
2119 OrigFn fn;
2120 int err;
2121 VALGRIND_GET_ORIG_FN(fn);
2122 before("Comm_free");
2123 CALL_FN_W_W(err, fn, comm);
2124 after("Comm_free", err);
2125 return err;
2126 }
2127
2128 /* --- Comm_rank --- */
2129 /* wr: (rank, sizeof(*rank)) */
WRAPPER_FOR(PMPI_Comm_rank)2130 int WRAPPER_FOR(PMPI_Comm_rank)(MPI_Comm comm, int *rank)
2131 {
2132 OrigFn fn;
2133 int err;
2134 VALGRIND_GET_ORIG_FN(fn);
2135 before("Comm_rank");
2136 check_mem_is_addressable_untyped(rank, sizeof(*rank));
2137 CALL_FN_W_WW(err, fn, comm,rank);
2138 make_mem_defined_if_addressable_if_success_untyped(err, rank, sizeof(*rank));
2139 after("Comm_rank", err);
2140 return err;
2141 }
2142
2143 /* --- Comm_size --- */
2144 /* wr: (size, sizeof(*size)) */
WRAPPER_FOR(PMPI_Comm_size)2145 int WRAPPER_FOR(PMPI_Comm_size)(MPI_Comm comm, int *size)
2146 {
2147 OrigFn fn;
2148 int err;
2149 VALGRIND_GET_ORIG_FN(fn);
2150 before("Comm_size");
2151 check_mem_is_addressable_untyped(size, sizeof(*size));
2152 CALL_FN_W_WW(err, fn, comm,size);
2153 make_mem_defined_if_addressable_if_success_untyped(err, size, sizeof(*size));
2154 after("Comm_size", err);
2155 return err;
2156 }
2157
2158
2159 /*------------------------------------------------------------*/
2160 /*--- ---*/
2161 /*--- Sec 5.7, Caching ---*/
2162 /*--- ---*/
2163 /*------------------------------------------------------------*/
2164
2165
2166 /*------------------------------------------------------------*/
2167 /*--- ---*/
2168 /*--- Sec 7.3, Error codes and classes ---*/
2169 /*--- ---*/
2170 /*------------------------------------------------------------*/
2171
2172 /* --- Error_string --- */
WRAPPER_FOR(PMPI_Error_string)2173 int WRAPPER_FOR(PMPI_Error_string)( int errorcode, char* string,
2174 int* resultlen )
2175 {
2176 OrigFn fn;
2177 int err;
2178 VALGRIND_GET_ORIG_FN(fn);
2179 before("Error_string");
2180 check_mem_is_addressable_untyped(resultlen, sizeof(int));
2181 check_mem_is_addressable_untyped(string, MPI_MAX_ERROR_STRING);
2182 CALL_FN_W_WWW(err, fn, errorcode,string,resultlen);
2183 /* Don't bother to paint the result; we assume the real function
2184 will have filled it with defined characters :-) */
2185 after("Error_string", err);
2186 return err;
2187 }
2188
2189
2190 /*------------------------------------------------------------*/
2191 /*--- ---*/
2192 /*--- Sec 7.5, Startup ---*/
2193 /*--- ---*/
2194 /*------------------------------------------------------------*/
2195
2196 /* --- Init --- */
2197 /* rd: *argc, *argv[0 .. *argc-1] */
WRAPPER_FOR(PMPI_Init)2198 long WRAPPER_FOR(PMPI_Init)(int *argc, char ***argv)
2199 {
2200 OrigFn fn;
2201 int err;
2202 VALGRIND_GET_ORIG_FN(fn);
2203 before("Init");
2204 if (argc) {
2205 check_mem_is_defined_untyped(argc, sizeof(int));
2206 }
2207 if (argc && argv) {
2208 check_mem_is_defined_untyped(*argv, *argc * sizeof(char**));
2209 }
2210 CALL_FN_W_WW(err, fn, argc,argv);
2211 after("Init", err);
2212 if (opt_initkludge)
2213 return (long)(void*)&mpiwrap_walk_type_EXTERNALLY_VISIBLE;
2214 else
2215 return (long)err;
2216 }
2217
2218 /* --- Initialized --- */
WRAPPER_FOR(PMPI_Initialized)2219 int WRAPPER_FOR(PMPI_Initialized)(int* flag)
2220 {
2221 OrigFn fn;
2222 int err;
2223 VALGRIND_GET_ORIG_FN(fn);
2224 before("Initialized");
2225 check_mem_is_addressable_untyped(flag, sizeof(int));
2226 CALL_FN_W_W(err, fn, flag);
2227 make_mem_defined_if_addressable_if_success_untyped(err, flag, sizeof(int));
2228 after("Initialized", err);
2229 return err;
2230 }
2231
2232 /* --- Finalize --- */
WRAPPER_FOR(PMPI_Finalize)2233 int WRAPPER_FOR(PMPI_Finalize)(void)
2234 {
2235 OrigFn fn;
2236 int err;
2237 VALGRIND_GET_ORIG_FN(fn);
2238 before("Finalize");
2239 CALL_FN_W_v(err, fn);
2240 after("Finalize", err);
2241 return err;
2242 }
2243
2244
2245 /*------------------------------------------------------------*/
2246 /*--- ---*/
2247 /*--- Default wrappers for all remaining functions ---*/
2248 /*--- ---*/
2249 /*------------------------------------------------------------*/
2250
2251 /* Boilerplate for default wrappers. */
2252 #define DEFAULT_WRAPPER_PREAMBLE(basename) \
2253 OrigFn fn; \
2254 UWord res; \
2255 static int complaints = 1; \
2256 VALGRIND_GET_ORIG_FN(fn); \
2257 before(#basename); \
2258 if (opt_missing >= 2) { \
2259 barf("no wrapper for PMPI_" #basename \
2260 ",\n\t\t\t and you have " \
2261 "requested strict checking"); \
2262 } \
2263 if (opt_missing == 1 && complaints > 0) { \
2264 fprintf(stderr, "%s %5d: warning: no wrapper " \
2265 "for PMPI_" #basename "\n", \
2266 preamble, my_pid); \
2267 complaints--; \
2268 } \
2269
2270 #define DEFAULT_WRAPPER_W_0W(basename) \
2271 UWord WRAPPER_FOR(PMPI_##basename)( void ) \
2272 { \
2273 DEFAULT_WRAPPER_PREAMBLE(basename) \
2274 CALL_FN_W_v(res, fn); \
2275 return res; \
2276 }
2277
2278 #define DEFAULT_WRAPPER_W_1W(basename) \
2279 UWord WRAPPER_FOR(PMPI_##basename)( UWord a1 ) \
2280 { \
2281 DEFAULT_WRAPPER_PREAMBLE(basename) \
2282 CALL_FN_W_W(res, fn, a1); \
2283 return res; \
2284 }
2285
2286 #define DEFAULT_WRAPPER_W_2W(basename) \
2287 UWord WRAPPER_FOR(PMPI_##basename)( UWord a1, UWord a2 ) \
2288 { \
2289 DEFAULT_WRAPPER_PREAMBLE(basename) \
2290 CALL_FN_W_WW(res, fn, a1,a2); \
2291 return res; \
2292 }
2293
2294 #define DEFAULT_WRAPPER_W_3W(basename) \
2295 UWord WRAPPER_FOR(PMPI_##basename) \
2296 ( UWord a1, UWord a2, UWord a3 ) \
2297 { \
2298 DEFAULT_WRAPPER_PREAMBLE(basename) \
2299 CALL_FN_W_WWW(res, fn, a1,a2,a3); \
2300 return res; \
2301 }
2302
2303 #define DEFAULT_WRAPPER_W_4W(basename) \
2304 UWord WRAPPER_FOR(PMPI_##basename) \
2305 ( UWord a1, UWord a2, UWord a3, UWord a4 ) \
2306 { \
2307 DEFAULT_WRAPPER_PREAMBLE(basename) \
2308 CALL_FN_W_WWWW(res, fn, a1,a2,a3,a4); \
2309 return res; \
2310 }
2311
2312 #define DEFAULT_WRAPPER_W_5W(basename) \
2313 UWord WRAPPER_FOR(PMPI_##basename) \
2314 ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5 ) \
2315 { \
2316 DEFAULT_WRAPPER_PREAMBLE(basename) \
2317 CALL_FN_W_5W(res, fn, a1,a2,a3,a4,a5); \
2318 return res; \
2319 }
2320
2321 #define DEFAULT_WRAPPER_W_6W(basename) \
2322 UWord WRAPPER_FOR(PMPI_##basename) \
2323 ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5, \
2324 UWord a6 ) \
2325 { \
2326 DEFAULT_WRAPPER_PREAMBLE(basename) \
2327 CALL_FN_W_6W(res, fn, a1,a2,a3,a4,a5,a6); \
2328 return res; \
2329 }
2330
2331 #define DEFAULT_WRAPPER_W_7W(basename) \
2332 UWord WRAPPER_FOR(PMPI_##basename) \
2333 ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5, \
2334 UWord a6, UWord a7 ) \
2335 { \
2336 DEFAULT_WRAPPER_PREAMBLE(basename) \
2337 CALL_FN_W_7W(res, fn, a1,a2,a3,a4,a5,a6,a7); \
2338 return res; \
2339 }
2340
2341 #define DEFAULT_WRAPPER_W_8W(basename) \
2342 UWord WRAPPER_FOR(PMPI_##basename) \
2343 ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5, \
2344 UWord a6, UWord a7, UWord a8 ) \
2345 { \
2346 DEFAULT_WRAPPER_PREAMBLE(basename) \
2347 CALL_FN_W_8W(res, fn, a1,a2,a3,a4,a5,a6,a7,a8); \
2348 return res; \
2349 }
2350
2351 #define DEFAULT_WRAPPER_W_9W(basename) \
2352 UWord WRAPPER_FOR(PMPI_##basename) \
2353 ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5, \
2354 UWord a6, UWord a7, UWord a8, UWord a9 ) \
2355 { \
2356 DEFAULT_WRAPPER_PREAMBLE(basename) \
2357 CALL_FN_W_9W(res, fn, a1,a2,a3,a4,a5,a6,a7,a8,a9); \
2358 return res; \
2359 }
2360
2361 #define DEFAULT_WRAPPER_W_10W(basename) \
2362 UWord WRAPPER_FOR(PMPI_##basename) \
2363 ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5, \
2364 UWord a6, UWord a7, UWord a8, UWord a9, UWord a10 ) \
2365 { \
2366 DEFAULT_WRAPPER_PREAMBLE(basename) \
2367 CALL_FN_W_10W(res, fn, a1,a2,a3,a4,a5,a6,a7,a8,a9,a10); \
2368 return res; \
2369 }
2370
2371 #define DEFAULT_WRAPPER_W_12W(basename) \
2372 UWord WRAPPER_FOR(PMPI_##basename) \
2373 ( UWord a1, UWord a2, UWord a3, UWord a4, UWord a5, \
2374 UWord a6, UWord a7, UWord a8, UWord a9, UWord a10, \
2375 UWord a11, UWord a12 ) \
2376 { \
2377 DEFAULT_WRAPPER_PREAMBLE(basename) \
2378 CALL_FN_W_12W(res, fn, a1,a2,a3,a4,a5,a6, \
2379 a7,a8,a9,a10,a11,a12); \
2380 return res; \
2381 }
2382
2383
2384 /* Canned summary of MPI-1.1/MPI-2 entry points, as derived from mpi.h
2385 from Open MPI svn rev 9191 (somewhere between Open MPI versions
2386 1.0.1 and 1.1.0). */
2387
2388 /* If a function is commented out in this list, it's because it has a
2389 proper wrapper written elsewhere (above here). */
2390
2391 DEFAULT_WRAPPER_W_2W(Abort)
2392 DEFAULT_WRAPPER_W_9W(Accumulate)
2393 DEFAULT_WRAPPER_W_1W(Add_error_class)
2394 DEFAULT_WRAPPER_W_2W(Add_error_code)
2395 DEFAULT_WRAPPER_W_2W(Add_error_string)
2396 /* DEFAULT_WRAPPER_W_2W(Address) */
2397 DEFAULT_WRAPPER_W_7W(Allgather)
2398 DEFAULT_WRAPPER_W_8W(Allgatherv)
2399 DEFAULT_WRAPPER_W_3W(Alloc_mem)
2400 /* DEFAULT_WRAPPER_W_6W(Allreduce) */
2401 /* DEFAULT_WRAPPER_W_7W(Alltoall) */
2402 DEFAULT_WRAPPER_W_9W(Alltoallv)
2403 DEFAULT_WRAPPER_W_9W(Alltoallw)
2404 DEFAULT_WRAPPER_W_2W(Attr_delete)
2405 DEFAULT_WRAPPER_W_4W(Attr_get)
2406 DEFAULT_WRAPPER_W_3W(Attr_put)
2407 DEFAULT_WRAPPER_W_1W(Barrier)
2408 /* DEFAULT_WRAPPER_W_5W(Bcast) */
2409 /* DEFAULT_WRAPPER_W_6W(Bsend) */
2410 DEFAULT_WRAPPER_W_7W(Bsend_init)
2411 DEFAULT_WRAPPER_W_2W(Buffer_attach)
2412 DEFAULT_WRAPPER_W_2W(Buffer_detach)
2413 /* DEFAULT_WRAPPER_W_1W(Cancel) */
2414 DEFAULT_WRAPPER_W_4W(Cart_coords)
2415 DEFAULT_WRAPPER_W_6W(Cart_create)
2416 DEFAULT_WRAPPER_W_5W(Cart_get)
2417 DEFAULT_WRAPPER_W_5W(Cart_map)
2418 DEFAULT_WRAPPER_W_3W(Cart_rank)
2419 DEFAULT_WRAPPER_W_5W(Cart_shift)
2420 DEFAULT_WRAPPER_W_3W(Cart_sub)
2421 DEFAULT_WRAPPER_W_2W(Cartdim_get)
2422 DEFAULT_WRAPPER_W_1W(Close_port)
2423 DEFAULT_WRAPPER_W_5W(Comm_accept)
2424 DEFAULT_WRAPPER_W_1W(Comm_c2f)
2425 DEFAULT_WRAPPER_W_2W(Comm_call_errhandler)
2426 DEFAULT_WRAPPER_W_3W(Comm_compare)
2427 DEFAULT_WRAPPER_W_5W(Comm_connect)
2428 DEFAULT_WRAPPER_W_2W(Comm_create_errhandler)
2429 DEFAULT_WRAPPER_W_4W(Comm_create_keyval)
2430 /* DEFAULT_WRAPPER_W_3W(Comm_create) */
2431 DEFAULT_WRAPPER_W_2W(Comm_delete_attr)
2432 DEFAULT_WRAPPER_W_1W(Comm_disconnect)
2433 /* DEFAULT_WRAPPER_W_2W(Comm_dup) */
2434 DEFAULT_WRAPPER_W_1W(Comm_f2c)
2435 DEFAULT_WRAPPER_W_1W(Comm_free_keyval)
2436 /* DEFAULT_WRAPPER_W_1W(Comm_free) */
2437 DEFAULT_WRAPPER_W_4W(Comm_get_attr)
2438 DEFAULT_WRAPPER_W_2W(Comm_get_errhandler)
2439 DEFAULT_WRAPPER_W_3W(Comm_get_name)
2440 DEFAULT_WRAPPER_W_1W(Comm_get_parent)
2441 DEFAULT_WRAPPER_W_2W(Comm_group)
2442 DEFAULT_WRAPPER_W_2W(Comm_join)
2443 /* DEFAULT_WRAPPER_W_2W(Comm_rank) */
2444 DEFAULT_WRAPPER_W_2W(Comm_remote_group)
2445 DEFAULT_WRAPPER_W_2W(Comm_remote_size)
2446 DEFAULT_WRAPPER_W_3W(Comm_set_attr)
2447 DEFAULT_WRAPPER_W_2W(Comm_set_errhandler)
2448 DEFAULT_WRAPPER_W_2W(Comm_set_name)
2449 /* DEFAULT_WRAPPER_W_2W(Comm_size) */
2450 DEFAULT_WRAPPER_W_8W(Comm_spawn)
2451 DEFAULT_WRAPPER_W_9W(Comm_spawn_multiple)
2452 DEFAULT_WRAPPER_W_4W(Comm_split)
2453 DEFAULT_WRAPPER_W_2W(Comm_test_inter)
2454 DEFAULT_WRAPPER_W_3W(Dims_create)
2455 DEFAULT_WRAPPER_W_1W(Errhandler_c2f)
2456 DEFAULT_WRAPPER_W_2W(Errhandler_create)
2457 DEFAULT_WRAPPER_W_1W(Errhandler_f2c)
2458 DEFAULT_WRAPPER_W_1W(Errhandler_free)
2459 DEFAULT_WRAPPER_W_2W(Errhandler_get)
2460 DEFAULT_WRAPPER_W_2W(Errhandler_set)
2461 DEFAULT_WRAPPER_W_2W(Error_class)
2462 /* DEFAULT_WRAPPER_W_3W(Error_string) */
2463 DEFAULT_WRAPPER_W_6W(Exscan)
2464 DEFAULT_WRAPPER_W_1W(File_c2f)
2465 DEFAULT_WRAPPER_W_1W(File_f2c)
2466 DEFAULT_WRAPPER_W_2W(File_call_errhandler)
2467 DEFAULT_WRAPPER_W_2W(File_create_errhandler)
2468 DEFAULT_WRAPPER_W_2W(File_set_errhandler)
2469 DEFAULT_WRAPPER_W_2W(File_get_errhandler)
2470 DEFAULT_WRAPPER_W_5W(File_open)
2471 DEFAULT_WRAPPER_W_1W(File_close)
2472 DEFAULT_WRAPPER_W_2W(File_delete)
2473 DEFAULT_WRAPPER_W_2W(File_set_size)
2474 DEFAULT_WRAPPER_W_2W(File_preallocate)
2475 DEFAULT_WRAPPER_W_2W(File_get_size)
2476 DEFAULT_WRAPPER_W_2W(File_get_group)
2477 DEFAULT_WRAPPER_W_2W(File_get_amode)
2478 DEFAULT_WRAPPER_W_2W(File_set_info)
2479 DEFAULT_WRAPPER_W_2W(File_get_info)
2480 DEFAULT_WRAPPER_W_6W(File_set_view)
2481 DEFAULT_WRAPPER_W_5W(File_get_view)
2482 DEFAULT_WRAPPER_W_6W(File_read_at)
2483 DEFAULT_WRAPPER_W_6W(File_read_at_all)
2484 DEFAULT_WRAPPER_W_6W(File_write_at)
2485 DEFAULT_WRAPPER_W_6W(File_write_at_all)
2486 DEFAULT_WRAPPER_W_6W(File_iread_at)
2487 DEFAULT_WRAPPER_W_6W(File_iwrite_at)
2488 DEFAULT_WRAPPER_W_5W(File_read)
2489 DEFAULT_WRAPPER_W_5W(File_read_all)
2490 DEFAULT_WRAPPER_W_5W(File_write)
2491 DEFAULT_WRAPPER_W_5W(File_write_all)
2492 DEFAULT_WRAPPER_W_5W(File_iread)
2493 DEFAULT_WRAPPER_W_5W(File_iwrite)
2494 DEFAULT_WRAPPER_W_3W(File_seek)
2495 DEFAULT_WRAPPER_W_2W(File_get_position)
2496 DEFAULT_WRAPPER_W_3W(File_get_byte_offset)
2497 DEFAULT_WRAPPER_W_5W(File_read_shared)
2498 DEFAULT_WRAPPER_W_5W(File_write_shared)
2499 DEFAULT_WRAPPER_W_5W(File_iread_shared)
2500 DEFAULT_WRAPPER_W_5W(File_iwrite_shared)
2501 DEFAULT_WRAPPER_W_5W(File_read_ordered)
2502 DEFAULT_WRAPPER_W_5W(File_write_ordered)
2503 DEFAULT_WRAPPER_W_3W(File_seek_shared)
2504 DEFAULT_WRAPPER_W_2W(File_get_position_shared)
2505 DEFAULT_WRAPPER_W_5W(File_read_at_all_begin)
2506 DEFAULT_WRAPPER_W_3W(File_read_at_all_end)
2507 DEFAULT_WRAPPER_W_5W(File_write_at_all_begin)
2508 DEFAULT_WRAPPER_W_3W(File_write_at_all_end)
2509 DEFAULT_WRAPPER_W_4W(File_read_all_begin)
2510 DEFAULT_WRAPPER_W_3W(File_read_all_end)
2511 DEFAULT_WRAPPER_W_4W(File_write_all_begin)
2512 DEFAULT_WRAPPER_W_3W(File_write_all_end)
2513 DEFAULT_WRAPPER_W_4W(File_read_ordered_begin)
2514 DEFAULT_WRAPPER_W_3W(File_read_ordered_end)
2515 DEFAULT_WRAPPER_W_4W(File_write_ordered_begin)
2516 DEFAULT_WRAPPER_W_3W(File_write_ordered_end)
2517 DEFAULT_WRAPPER_W_3W(File_get_type_extent)
2518 DEFAULT_WRAPPER_W_2W(File_set_atomicity)
2519 DEFAULT_WRAPPER_W_2W(File_get_atomicity)
2520 DEFAULT_WRAPPER_W_1W(File_sync)
2521 /* DEFAULT_WRAPPER_W_0W(Finalize) */
2522 DEFAULT_WRAPPER_W_1W(Finalized)
2523 DEFAULT_WRAPPER_W_1W(Free_mem)
2524 /* DEFAULT_WRAPPER_W_8W(Gather) */
2525 DEFAULT_WRAPPER_W_9W(Gatherv)
2526 DEFAULT_WRAPPER_W_2W(Get_address)
2527 /* DEFAULT_WRAPPER_W_3W(Get_count) */
2528 DEFAULT_WRAPPER_W_3W(Get_elements)
2529 DEFAULT_WRAPPER_W_8W(Get)
2530 DEFAULT_WRAPPER_W_2W(Get_processor_name)
2531 DEFAULT_WRAPPER_W_2W(Get_version)
2532 DEFAULT_WRAPPER_W_6W(Graph_create)
2533 DEFAULT_WRAPPER_W_5W(Graph_get)
2534 DEFAULT_WRAPPER_W_5W(Graph_map)
2535 DEFAULT_WRAPPER_W_3W(Graph_neighbors_count)
2536 DEFAULT_WRAPPER_W_4W(Graph_neighbors)
2537 DEFAULT_WRAPPER_W_3W(Graphdims_get)
2538 DEFAULT_WRAPPER_W_1W(Grequest_complete)
2539 DEFAULT_WRAPPER_W_5W(Grequest_start)
2540 DEFAULT_WRAPPER_W_1W(Group_c2f)
2541 DEFAULT_WRAPPER_W_3W(Group_compare)
2542 DEFAULT_WRAPPER_W_3W(Group_difference)
2543 DEFAULT_WRAPPER_W_4W(Group_excl)
2544 DEFAULT_WRAPPER_W_1W(Group_f2c)
2545 DEFAULT_WRAPPER_W_1W(Group_free)
2546 DEFAULT_WRAPPER_W_4W(Group_incl)
2547 DEFAULT_WRAPPER_W_3W(Group_intersection)
2548 DEFAULT_WRAPPER_W_4W(Group_range_excl)
2549 DEFAULT_WRAPPER_W_4W(Group_range_incl)
2550 DEFAULT_WRAPPER_W_2W(Group_rank)
2551 DEFAULT_WRAPPER_W_2W(Group_size)
2552 DEFAULT_WRAPPER_W_5W(Group_translate_ranks)
2553 DEFAULT_WRAPPER_W_3W(Group_union)
2554 /* DEFAULT_WRAPPER_W_7W(Ibsend) */
2555 DEFAULT_WRAPPER_W_1W(Info_c2f)
2556 DEFAULT_WRAPPER_W_1W(Info_create)
2557 DEFAULT_WRAPPER_W_2W(Info_delete)
2558 DEFAULT_WRAPPER_W_2W(Info_dup)
2559 DEFAULT_WRAPPER_W_1W(Info_f2c)
2560 DEFAULT_WRAPPER_W_1W(Info_free)
2561 DEFAULT_WRAPPER_W_5W(Info_get)
2562 DEFAULT_WRAPPER_W_2W(Info_get_nkeys)
2563 DEFAULT_WRAPPER_W_3W(Info_get_nthkey)
2564 DEFAULT_WRAPPER_W_4W(Info_get_valuelen)
2565 DEFAULT_WRAPPER_W_3W(Info_set)
2566 /* DEFAULT_WRAPPER_W_2W(Init) */
2567 /* DEFAULT_WRAPPER_W_1W(Initialized) */
2568 DEFAULT_WRAPPER_W_4W(Init_thread)
2569 DEFAULT_WRAPPER_W_6W(Intercomm_create)
2570 DEFAULT_WRAPPER_W_3W(Intercomm_merge)
2571 /* DEFAULT_WRAPPER_W_5W(Iprobe) */
2572 /* DEFAULT_WRAPPER_W_7W(Irecv) */
2573 /* DEFAULT_WRAPPER_W_7W(Irsend) */
2574 /* DEFAULT_WRAPPER_W_7W(Isend) */
2575 /* DEFAULT_WRAPPER_W_7W(Issend) */
2576 DEFAULT_WRAPPER_W_1W(Is_thread_main)
2577 DEFAULT_WRAPPER_W_4W(Keyval_create)
2578 DEFAULT_WRAPPER_W_1W(Keyval_free)
2579 DEFAULT_WRAPPER_W_3W(Lookup_name)
2580 DEFAULT_WRAPPER_W_1W(Op_c2f)
2581 /* DEFAULT_WRAPPER_W_3W(Op_create) */
2582 DEFAULT_WRAPPER_W_2W(Open_port)
2583 DEFAULT_WRAPPER_W_1W(Op_f2c)
2584 DEFAULT_WRAPPER_W_1W(Op_free)
2585 DEFAULT_WRAPPER_W_7W(Pack_external)
2586 DEFAULT_WRAPPER_W_4W(Pack_external_size)
2587 /* DEFAULT_WRAPPER_W_7W(Pack) */
2588 DEFAULT_WRAPPER_W_4W(Pack_size)
2589 /* int MPI_Pcontrol(const int level, ...) */
2590 /* DEFAULT_WRAPPER_W_4W(Probe) */
2591 DEFAULT_WRAPPER_W_3W(Publish_name)
2592 DEFAULT_WRAPPER_W_8W(Put)
2593 DEFAULT_WRAPPER_W_1W(Query_thread)
2594 DEFAULT_WRAPPER_W_7W(Recv_init)
2595 /* DEFAULT_WRAPPER_W_7W(Recv) */
2596 /* DEFAULT_WRAPPER_W_7W(Reduce) */
2597 DEFAULT_WRAPPER_W_6W(Reduce_scatter)
2598 DEFAULT_WRAPPER_W_5W(Register_datarep)
2599 DEFAULT_WRAPPER_W_1W(Request_c2f)
2600 DEFAULT_WRAPPER_W_1W(Request_f2c)
2601 DEFAULT_WRAPPER_W_1W(Request_free)
2602 DEFAULT_WRAPPER_W_3W(Request_get_status)
2603 /* DEFAULT_WRAPPER_W_6W(Rsend) */
2604 DEFAULT_WRAPPER_W_7W(Rsend_init)
2605 DEFAULT_WRAPPER_W_6W(Scan)
2606 /* DEFAULT_WRAPPER_W_8W(Scatter) */
2607 DEFAULT_WRAPPER_W_9W(Scatterv)
2608 DEFAULT_WRAPPER_W_7W(Send_init)
2609 /* DEFAULT_WRAPPER_W_6W(Send) */
2610 /* DEFAULT_WRAPPER_W_12W(Sendrecv) */
2611 DEFAULT_WRAPPER_W_9W(Sendrecv_replace)
2612 DEFAULT_WRAPPER_W_7W(Ssend_init)
2613 /* DEFAULT_WRAPPER_W_6W(Ssend) */
2614 DEFAULT_WRAPPER_W_1W(Start)
2615 DEFAULT_WRAPPER_W_2W(Startall)
2616 DEFAULT_WRAPPER_W_2W(Status_c2f)
2617 DEFAULT_WRAPPER_W_2W(Status_f2c)
2618 DEFAULT_WRAPPER_W_2W(Status_set_cancelled)
2619 DEFAULT_WRAPPER_W_3W(Status_set_elements)
2620 /* DEFAULT_WRAPPER_W_4W(Testall) */
2621 DEFAULT_WRAPPER_W_5W(Testany)
2622 /* DEFAULT_WRAPPER_W_3W(Test) */
2623 DEFAULT_WRAPPER_W_2W(Test_cancelled)
2624 DEFAULT_WRAPPER_W_5W(Testsome)
2625 DEFAULT_WRAPPER_W_2W(Topo_test)
2626 DEFAULT_WRAPPER_W_1W(Type_c2f)
2627 /* DEFAULT_WRAPPER_W_1W(Type_commit) */
2628 DEFAULT_WRAPPER_W_3W(Type_contiguous)
2629 DEFAULT_WRAPPER_W_10W(Type_create_darray)
2630 DEFAULT_WRAPPER_W_3W(Type_create_f90_complex)
2631 DEFAULT_WRAPPER_W_2W(Type_create_f90_integer)
2632 DEFAULT_WRAPPER_W_3W(Type_create_f90_real)
2633 DEFAULT_WRAPPER_W_5W(Type_create_hindexed)
2634 DEFAULT_WRAPPER_W_5W(Type_create_hvector)
2635 DEFAULT_WRAPPER_W_4W(Type_create_keyval)
2636 DEFAULT_WRAPPER_W_5W(Type_create_indexed_block)
2637 DEFAULT_WRAPPER_W_5W(Type_create_struct)
2638 DEFAULT_WRAPPER_W_7W(Type_create_subarray)
2639 DEFAULT_WRAPPER_W_4W(Type_create_resized)
2640 DEFAULT_WRAPPER_W_2W(Type_delete_attr)
2641 DEFAULT_WRAPPER_W_2W(Type_dup)
2642 /* DEFAULT_WRAPPER_W_2W(Type_extent) */
2643 /* DEFAULT_WRAPPER_W_1W(Type_free) */
2644 DEFAULT_WRAPPER_W_1W(Type_free_keyval)
2645 DEFAULT_WRAPPER_W_1W(Type_f2c)
2646 DEFAULT_WRAPPER_W_4W(Type_get_attr)
2647 /* DEFAULT_WRAPPER_W_7W(Type_get_contents) */
2648 /* DEFAULT_WRAPPER_W_5W(Type_get_envelope) */
2649 DEFAULT_WRAPPER_W_3W(Type_get_extent)
2650 DEFAULT_WRAPPER_W_3W(Type_get_name)
2651 DEFAULT_WRAPPER_W_3W(Type_get_true_extent)
2652 DEFAULT_WRAPPER_W_5W(Type_hindexed)
2653 DEFAULT_WRAPPER_W_5W(Type_hvector)
2654 DEFAULT_WRAPPER_W_5W(Type_indexed)
2655 DEFAULT_WRAPPER_W_2W(Type_lb)
2656 DEFAULT_WRAPPER_W_3W(Type_match_size)
2657 DEFAULT_WRAPPER_W_3W(Type_set_attr)
2658 DEFAULT_WRAPPER_W_2W(Type_set_name)
2659 DEFAULT_WRAPPER_W_2W(Type_size)
2660 DEFAULT_WRAPPER_W_5W(Type_struct)
2661 DEFAULT_WRAPPER_W_2W(Type_ub)
2662 DEFAULT_WRAPPER_W_5W(Type_vector)
2663 /* DEFAULT_WRAPPER_W_7W(Unpack) */
2664 DEFAULT_WRAPPER_W_3W(Unpublish_name)
2665 DEFAULT_WRAPPER_W_7W(Unpack_external)
2666 /* DEFAULT_WRAPPER_W_3W(Waitall) */
2667 /* DEFAULT_WRAPPER_W_4W(Waitany) */
2668 /* DEFAULT_WRAPPER_W_2W(Wait) */
2669 DEFAULT_WRAPPER_W_5W(Waitsome)
2670 DEFAULT_WRAPPER_W_1W(Win_c2f)
2671 DEFAULT_WRAPPER_W_2W(Win_call_errhandler)
2672 DEFAULT_WRAPPER_W_1W(Win_complete)
2673 DEFAULT_WRAPPER_W_6W(Win_create)
2674 DEFAULT_WRAPPER_W_2W(Win_create_errhandler)
2675 DEFAULT_WRAPPER_W_4W(Win_create_keyval)
2676 DEFAULT_WRAPPER_W_2W(Win_delete_attr)
2677 DEFAULT_WRAPPER_W_1W(Win_f2c)
2678 DEFAULT_WRAPPER_W_2W(Win_fence)
2679 DEFAULT_WRAPPER_W_1W(Win_free)
2680 DEFAULT_WRAPPER_W_1W(Win_free_keyval)
2681 DEFAULT_WRAPPER_W_4W(Win_get_attr)
2682 DEFAULT_WRAPPER_W_2W(Win_get_errhandler)
2683 DEFAULT_WRAPPER_W_2W(Win_get_group)
2684 DEFAULT_WRAPPER_W_3W(Win_get_name)
2685 DEFAULT_WRAPPER_W_4W(Win_lock)
2686 DEFAULT_WRAPPER_W_3W(Win_post)
2687 DEFAULT_WRAPPER_W_3W(Win_set_attr)
2688 DEFAULT_WRAPPER_W_2W(Win_set_errhandler)
2689 DEFAULT_WRAPPER_W_2W(Win_set_name)
2690 DEFAULT_WRAPPER_W_3W(Win_start)
2691 DEFAULT_WRAPPER_W_2W(Win_test)
2692 DEFAULT_WRAPPER_W_2W(Win_unlock)
2693 DEFAULT_WRAPPER_W_1W(Win_wait)
2694 /* double MPI_Wtick(void) */
2695 /* double MPI_Wtime(void) */
2696
2697
2698 /*------------------------------------------------------------*/
2699 /*--- ---*/
2700 /*--- ---*/
2701 /*--- ---*/
2702 /*------------------------------------------------------------*/
2703
2704 /*---------------------------------------------------------------*/
2705 /*--- end mpiwrap.c ---*/
2706 /*---------------------------------------------------------------*/
2707