Some infrastructure help for the F77 bindings:
- added src/mpi/f77/strings.[ch] for f<-->c string conversions - added src/mpi/f77/constants* for instiantiating and providing macros to check for the various fortran address "constants" (read the comments in this file -- it's quite complicated, unfortunately :-\ ): - MPI_BOTTOM - MPI_ARGV_NULL - MPI_ARGVS_NULL - MPI_ERRCODES_IGNORE - MPI_STATUS_IGNORE - MPI_STATUSES_IGNORE - updated fortran MPI_COMM_SET_NAME and MPI_COMM_GET_NAME to check string handling - updated fortran MPI_RECV to check MPI_STATUS_IGNORE handling - updated fortran MPI_COMM_SPAWN to check string and MPI_ARGV_NULL and MPI_ERRCODES_IGNORE handling - partially modified src/mpi/f77/prototypes_mpi.h to account for string length parameters passed by the fortran compiler; more work to be done there - backed out a silly previous change in send_f.c by me (duh) - updated fortran MPI_COMM_DUP and MPI_COMM_FREE to check int<-->fint macros This commit was SVN r2512.
Этот коммит содержится в:
Jeff Squyres
родитель
494d4428ad
Коммит
2fc9f9181f
@ -113,12 +113,12 @@
|
||||
double complex MPI_BOTTOM, MPI_ARGV_NULL
|
||||
double complex MPI_ARGVS_NULL, MPI_ERRCODES_IGNORE
|
||||
double complex MPI_STATUS_IGNORE, MPI_STATUSES_IGNORE
|
||||
common/mpi_bottom/MPI_BOTTOM
|
||||
common/mpi_argv_null/MPI_ARGV_NULL
|
||||
common/mpi_argvs_null/MPI_ARGVS_NULL
|
||||
common/mpi_errcodes_ignore/MPI_ERRCODES_IGNORE
|
||||
common/mpi_status_ignore/MPI_STATUS_IGNORE
|
||||
common/mpi_statuses_ignore/MPI_STATUSES_IGNORE
|
||||
common/mpi_fortran_bottom/MPI_BOTTOM
|
||||
common/mpi_fortran_argv_null/MPI_ARGV_NULL
|
||||
common/mpi_fortran_argvs_null/MPI_ARGVS_NULL
|
||||
common/mpi_fortran_errcodes_ignore/MPI_ERRCODES_IGNORE
|
||||
common/mpi_fortran_status_ignore/MPI_STATUS_IGNORE
|
||||
common/mpi_fortran_statuses_ignore/MPI_STATUSES_IGNORE
|
||||
!
|
||||
! NULL "handles" (indices)
|
||||
!
|
||||
|
||||
@ -39,7 +39,9 @@ endif
|
||||
|
||||
headers = \
|
||||
bindings.h \
|
||||
prototypes_mpi.h
|
||||
constants.h \
|
||||
prototypes_mpi.h \
|
||||
strings.h
|
||||
|
||||
#
|
||||
# libmpi_f77.la is always build because it contains some non-profilied
|
||||
@ -47,7 +49,9 @@ headers = \
|
||||
#
|
||||
|
||||
libmpi_f77_la_SOURCES = \
|
||||
constants_f.c \
|
||||
attr_fn_f.c \
|
||||
strings.c \
|
||||
wtick_f.c \
|
||||
wtime_f.c
|
||||
|
||||
|
||||
@ -49,9 +49,8 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_DUP,
|
||||
void mpi_comm_dup_f(MPI_Fint *comm, MPI_Fint *newcomm, MPI_Fint *ierr)
|
||||
{
|
||||
MPI_Comm c_newcomm;
|
||||
MPI_Comm c_comm = MPI_Comm_f2c( *comm );
|
||||
MPI_Comm c_comm = MPI_Comm_f2c(*comm);
|
||||
|
||||
*ierr = MPI_Comm_dup ( c_comm, &c_newcomm );
|
||||
|
||||
*newcomm = MPI_Comm_c2f (c_newcomm);
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Comm_dup(c_comm, &c_newcomm));
|
||||
*newcomm = MPI_Comm_c2f(c_newcomm);
|
||||
}
|
||||
|
||||
@ -48,8 +48,8 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_FREE,
|
||||
|
||||
void mpi_comm_free_f(MPI_Fint *comm, MPI_Fint *ierr)
|
||||
{
|
||||
MPI_Comm c_comm = MPI_Comm_f2c (*comm);
|
||||
MPI_Comm c_comm = MPI_Comm_f2c(*comm);
|
||||
|
||||
*ierr = MPI_Comm_free ( &c_comm );
|
||||
*comm = MPI_Comm_c2f (c_comm);
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Comm_free(&c_comm));
|
||||
*comm = OMPI_INT_2_FINT(MPI_Comm_c2f(c_comm));
|
||||
}
|
||||
|
||||
@ -7,7 +7,11 @@
|
||||
#include <stdio.h>
|
||||
|
||||
#include "mpi.h"
|
||||
#include "include/constants.h"
|
||||
#include "errhandler/errhandler.h"
|
||||
#include "communicator/communicator.h"
|
||||
#include "mpi/f77/bindings.h"
|
||||
#include "mpi/f77/strings.h"
|
||||
|
||||
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
|
||||
#pragma weak PMPI_COMM_GET_NAME = mpi_comm_get_name_f
|
||||
@ -47,15 +51,20 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_GET_NAME,
|
||||
#endif
|
||||
|
||||
void mpi_comm_get_name_f(MPI_Fint *comm, char *comm_name,
|
||||
MPI_Fint *resultlen, MPI_Fint *ierr)
|
||||
MPI_Fint *resultlen, MPI_Fint *ierr,
|
||||
int name_len)
|
||||
{
|
||||
MPI_Comm c_comm;
|
||||
OMPI_SINGLE_NAME_DECL(resultlen);
|
||||
int err, c_len;
|
||||
MPI_Comm c_comm = MPI_Comm_f2c(*comm);
|
||||
char c_name[MPI_MAX_OBJECT_NAME];
|
||||
|
||||
c_comm = MPI_Comm_f2c(*comm);
|
||||
|
||||
*ierr =
|
||||
OMPI_INT_2_FINT(MPI_Comm_get_name(c_comm, comm_name,
|
||||
OMPI_SINGLE_NAME_CONVERT(resultlen)));
|
||||
OMPI_SINGLE_INT_2_FINT(resultlen);
|
||||
err = MPI_Comm_get_name(c_comm, c_name, &c_len);
|
||||
if (MPI_SUCCESS == err) {
|
||||
ompi_fortran_string_c2f(c_name, comm_name,
|
||||
OMPI_FINT_2_INT(*resultlen));
|
||||
*resultlen = OMPI_INT_2_FINT(c_len);
|
||||
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
|
||||
} else {
|
||||
*ierr = OMPI_INT_2_FINT(err);
|
||||
}
|
||||
}
|
||||
|
||||
@ -7,7 +7,11 @@
|
||||
#include <stdio.h>
|
||||
|
||||
#include "mpi.h"
|
||||
#include "include/constants.h"
|
||||
#include "errhandler/errhandler.h"
|
||||
#include "communicator/communicator.h"
|
||||
#include "mpi/f77/bindings.h"
|
||||
#include "mpi/f77/strings.h"
|
||||
|
||||
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
|
||||
#pragma weak PMPI_COMM_SET_NAME = mpi_comm_set_name_f
|
||||
@ -46,11 +50,27 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_SET_NAME,
|
||||
#include "mpi/f77/profile/defines.h"
|
||||
#endif
|
||||
|
||||
void mpi_comm_set_name_f(MPI_Fint *comm, char *comm_name, MPI_Fint *ierr)
|
||||
void mpi_comm_set_name_f(MPI_Fint *comm, char *comm_name, MPI_Fint *ierr,
|
||||
int name_len)
|
||||
{
|
||||
MPI_Comm c_comm;
|
||||
int ret;
|
||||
char *c_name;
|
||||
MPI_Comm c_comm = MPI_Comm_f2c(*comm);
|
||||
|
||||
c_comm = MPI_Comm_f2c(*comm);
|
||||
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Comm_set_name(c_comm, comm_name));
|
||||
/* Convert the fortran string */
|
||||
|
||||
if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(comm_name, name_len,
|
||||
&c_name))) {
|
||||
*ierr = OMPI_INT_2_FINT(OMPI_ERRHANDLER_INVOKE(c_comm, ret,
|
||||
"MPI_COMM_SET_NAME"));
|
||||
return;
|
||||
}
|
||||
|
||||
/* Call the C function */
|
||||
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Comm_set_name(c_comm, c_name));
|
||||
|
||||
/* Free the C name */
|
||||
|
||||
free(c_name);
|
||||
}
|
||||
|
||||
@ -7,7 +7,10 @@
|
||||
#include <stdio.h>
|
||||
|
||||
#include "mpi.h"
|
||||
#include "util/argv.h"
|
||||
#include "mpi/f77/bindings.h"
|
||||
#include "mpi/f77/constants.h"
|
||||
#include "mpi/f77/strings.h"
|
||||
|
||||
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
|
||||
#pragma weak PMPI_COMM_SPAWN = mpi_comm_spawn_f
|
||||
@ -49,29 +52,49 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_SPAWN,
|
||||
void mpi_comm_spawn_f(char *command, char *argv, MPI_Fint *maxprocs,
|
||||
MPI_Fint *info, MPI_Fint *root, MPI_Fint *comm,
|
||||
MPI_Fint *intercomm, MPI_Fint *array_of_errcodes,
|
||||
MPI_Fint *ierr)
|
||||
MPI_Fint *ierr, int cmd_len, int argv_len)
|
||||
{
|
||||
|
||||
#if 0
|
||||
MPI_Comm c_comm, c_new_comm;
|
||||
MPI_Info c_info;
|
||||
int size;
|
||||
int *c_errs;
|
||||
char **c_argv;
|
||||
char *c_command;
|
||||
OMPI_ARRAY_NAME_DECL(array_of_errcodes);
|
||||
|
||||
c_comm = MPI_Comm_f2c(*comm);
|
||||
c_info = MPI_Info_f2c(*info);
|
||||
MPI_Comm_size(c_comm, &size);
|
||||
OMPI_ARRAY_FINT_2_INT_ALLOC(array_of_errcodes, size);
|
||||
ompi_fortran_string_f2c(command, cmd_len, &c_command);
|
||||
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Comm_spawn(command, argv,
|
||||
/* It's allowed to ignore the errcodes */
|
||||
|
||||
if (OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_of_errcodes)) {
|
||||
OMPI_ARRAY_FINT_2_INT_ALLOC(array_of_errcodes, size);
|
||||
c_errs = OMPI_ARRAY_NAME_CONVERT(array_of_errcodes);
|
||||
} else {
|
||||
c_errs = MPI_ERRCODES_IGNORE;
|
||||
}
|
||||
|
||||
/* It's allowed to have no argv */
|
||||
|
||||
if (OMPI_IS_FORTRAN_ARGV_NULL(argv)) {
|
||||
ompi_fortran_argv_f2c(argv, argv_len, &c_argv);
|
||||
} else {
|
||||
c_argv = MPI_ARGV_NULL;
|
||||
}
|
||||
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Comm_spawn(command, c_argv,
|
||||
OMPI_FINT_2_INT(*maxprocs),
|
||||
c_info,
|
||||
OMPI_FINT_2_INT(*root),
|
||||
c_comm, &c_new_comm,
|
||||
OMPI_ARRAY_NAME_CONVERT(array_of_errcodes)));
|
||||
c_comm, &c_new_comm, c_errs));
|
||||
|
||||
*intercomm = MPI_Comm_c2f(c_new_comm);
|
||||
free(c_command);
|
||||
if (MPI_ARGV_NULL != c_argv && NULL != c_argv) {
|
||||
ompi_argv_free(c_argv);
|
||||
}
|
||||
OMPI_ARRAY_INT_2_FINT(array_of_errcodes, size);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
184
src/mpi/f77/constants.h
Обычный файл
184
src/mpi/f77/constants.h
Обычный файл
@ -0,0 +1,184 @@
|
||||
/*
|
||||
* $HEADER$
|
||||
*/
|
||||
|
||||
#ifndef OMPI_F77_CONSTANTS_H
|
||||
#define OMPI_F77_CONSTANTS_H
|
||||
|
||||
|
||||
/*
|
||||
* Several variables are used to link against MPI F77 constants which
|
||||
* correspond to addresses, e.g. MPI_BOTTOM, and are implemented via
|
||||
* common blocks. They must have the same size and alignment
|
||||
* constraints as the corresponding F77 common blocks.
|
||||
*
|
||||
* We use common blocks so that in the C wrapper functions, we can
|
||||
* compare the address that comes in against known addresses (e.g., if
|
||||
* the "status" argument in MPI_RECV is the address of the common
|
||||
* block for the fortran equivalent of MPI_STATUS_IGNORE, then we know
|
||||
* to pass the C MPI_STATUS_IGNORE to the C MPI_Recv function.
|
||||
*
|
||||
* This mojo makes a type that will be aligned on 16 bytes (same as
|
||||
* common blocks -- at least it seems to work with all the fortran
|
||||
* compilers that we care about... haven't found one yet that doesn't
|
||||
* work...)
|
||||
*/
|
||||
|
||||
#if defined(HAVE_LONG_DOUBLE) && OMPI_ALIGNMENT_LONG_DOUBLE == 16
|
||||
typedef struct { long double bogus; } ompi_fortran_common_t;
|
||||
#else
|
||||
typedef struct { double bogus[2]; } ompi_fortran_common_t;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* This part sucks. :-(
|
||||
*
|
||||
* Since we made the fundamental decision to support all 4 common
|
||||
* fortran compiler symbol conventions within the same library for
|
||||
* those compilers who support weak symbols, we need to have 4 symbols
|
||||
* for each of the fortran address constants. As described above, we
|
||||
* have to have known *pointer* values for the fortran addresses
|
||||
* (e.g., MPI_STATUS_IGNORE). So when the fortran wrapper for
|
||||
* MPI_RECV gets (MPI_Fint *status), it can check (status ==
|
||||
* some_sentinel_value) to know that it got the Fortran equivalent of
|
||||
* MPI_STATUS_IGNORE and therefore pass the C MPI_STATUS_IGNORE to the
|
||||
* C MPI_Recv.
|
||||
*
|
||||
* We do this by having a "common" block in mpif.h:
|
||||
*
|
||||
* DOUBLE PRECISION MPI_STATUS_IGNORE
|
||||
* common /mpi_fortran_status_ignore/ MPI_STATUS_IGNORE
|
||||
*
|
||||
* This makes the fortran variable MPI_STATUS_IGNORE effectively be an
|
||||
* alias for the C variable "mpi_fortran_status_ignore" -- but the C
|
||||
* symbol name is according to the fortran compiler's naming symbol
|
||||
* convention bais. So it could be MPI_FORTRAN_STATUS_IGNORE,
|
||||
* mpi_fortran_status_ignore, mpi_fortran_status_ignore_, or
|
||||
* mpi_fortran_status_ignore__.
|
||||
*
|
||||
* Hence, we have to have *4* C symbols for this, and them compare for
|
||||
* all of them in the fortran MPI_RECV wrapper. :-( I can't think of
|
||||
* any better way to do this.
|
||||
*
|
||||
* I'm putting these 4 comparisons in macros (on systems where we
|
||||
* don't support the 4 symbols -- e.g., OSX, where we don't have weak
|
||||
* symbols -- it'll only be one comparison), so if anyone things of
|
||||
* something better than this, you should only need to modify this
|
||||
* file.
|
||||
*/
|
||||
|
||||
#define DECL(upper_case, lower_case, single_u, double_u) \
|
||||
extern ompi_fortran_common_t upper_case; \
|
||||
extern ompi_fortran_common_t lower_case; \
|
||||
extern ompi_fortran_common_t single_u; \
|
||||
extern ompi_fortran_common_t double_u
|
||||
|
||||
DECL(MPI_FORTRAN_BOTTOM, mpi_fortran_bottom,
|
||||
mpi_fortran_bottom_, mpi_fortran_bottom__);
|
||||
DECL(MPI_FORTRAN_ARGV_NULL, mpi_fortran_argv_null,
|
||||
mpi_fortran_argv_null_, mpi_fortran_argv_null__);
|
||||
DECL(MPI_FORTRAN_ARGVS_NULL, mpi_fortran_argvs_null,
|
||||
mpi_fortran_argvs_null_, mpi_fortran_argvs_null__);
|
||||
DECL(MPI_FORTRAN_ERRCODES_IGNORE, mpi_fortran_errcodes_ignore,
|
||||
mpi_fortran_errcodes_ignore_, mpi_fortran_errcodes_ignore__);
|
||||
DECL(MPI_FORTRAN_STATUS_IGNORE, mpi_fortran_status_ignore,
|
||||
mpi_fortran_status_ignore_, mpi_fortran_status_ignore__);
|
||||
DECL(MPI_FORTRAN_STATUSES_IGNORE, mpi_fortran_statuses_ignore,
|
||||
mpi_fortran_statuses_ignore_, mpi_fortran_statuses_ignore__);
|
||||
|
||||
/*
|
||||
* Create macros to do the checking. Only check for all 4 if we have
|
||||
* weak symbols. Otherwise, just check for the one relevant symbol.
|
||||
*/
|
||||
|
||||
#if OMPI_HAVE_WEAK_SYMBOLS
|
||||
#define OMPI_IS_FORTRAN_BOTTOM(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_BOTTOM || \
|
||||
addr == (void*) &mpi_fortran_bottom || \
|
||||
addr == (void*) &mpi_fortran_bottom_ || \
|
||||
addr == (void*) &mpi_fortran_bottom__)
|
||||
#define OMPI_IS_FORTRAN_ARGV_NULL(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_ARGV_NULL || \
|
||||
addr == (void*) &mpi_fortran_argv_null || \
|
||||
addr == (void*) &mpi_fortran_argv_null_ || \
|
||||
addr == (void*) &mpi_fortran_argv_null__)
|
||||
#define OMPI_IS_FORTRAN_ARGVS_NULL(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_ARGVS_NULL || \
|
||||
addr == (void*) &mpi_fortran_argvs_null || \
|
||||
addr == (void*) &mpi_fortran_argvs_null_ || \
|
||||
addr == (void*) &mpi_fortran_argvs_null__)
|
||||
#define OMPI_IS_FORTRAN_ERRCODES_IGNORE(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_ERRCODES_IGNORE || \
|
||||
addr == (void*) &mpi_fortran_errcodes_ignore || \
|
||||
addr == (void*) &mpi_fortran_errcodes_ignore_ || \
|
||||
addr == (void*) &mpi_fortran_errcodes_ignore__)
|
||||
#define OMPI_IS_FORTRAN_STATUS_IGNORE(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_STATUS_IGNORE || \
|
||||
addr == (void*) &mpi_fortran_status_ignore || \
|
||||
addr == (void*) &mpi_fortran_status_ignore_ || \
|
||||
addr == (void*) &mpi_fortran_status_ignore__)
|
||||
#define OMPI_IS_FORTRAN_STATUSES_IGNORE(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_STATUSES_IGNORE || \
|
||||
addr == (void*) &mpi_fortran_statuses_ignore || \
|
||||
addr == (void*) &mpi_fortran_statuses_ignore_ || \
|
||||
addr == (void*) &mpi_fortran_statuses_ignore__)
|
||||
|
||||
#elif OMPI_F77_CAPS
|
||||
#define OMPI_IS_FORTRAN_BOTTOM(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_BOTTOM)
|
||||
#define OMPI_IS_FORTRAN_ARGV_NULL(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_ARGV_NULL)
|
||||
#define OMPI_IS_FORTRAN_ARGVS_NULL(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_ARGVS_NULL)
|
||||
#define OMPI_IS_FORTRAN_ERRCODES_IGNORE(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_ERRCODES_IGNORE)
|
||||
#define OMPI_IS_FORTRAN_STATUS_IGNORE(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_STATUS_IGNORE)
|
||||
#define OMPI_IS_FORTRAN_STATUSES_IGNORE(addr) \
|
||||
(addr == (void*) &MPI_FORTRAN_STATUSES_IGNORE)
|
||||
|
||||
#elif OMPI_F77_PLAIN
|
||||
#define OMPI_IS_FORTRAN_BOTTOM(addr) \
|
||||
(addr == (void*) &mpi_fortran_bottom)
|
||||
#define OMPI_IS_FORTRAN_ARGV_NULL(addr) \
|
||||
(addr == (void*) &mpi_fortran_argv_null)
|
||||
#define OMPI_IS_FORTRAN_ARGVS_NULL(addr) \
|
||||
(addr == (void*) &mpi_fortran_argvs_null)
|
||||
#define OMPI_IS_FORTRAN_ERRCODES_IGNORE(addr) \
|
||||
(addr == (void*) &mpi_fortran_errcodes_ignore)
|
||||
#define OMPI_IS_FORTRAN_STATUS_IGNORE(addr) \
|
||||
(addr == (void*) &mpi_fortran_status_ignore)
|
||||
#define OMPI_IS_FORTRAN_STATUSES_IGNORE(addr) \
|
||||
(addr == (void*) &mpi_fortran_statuses_ignore)
|
||||
|
||||
#elif OMPI_F77_SINGLE_UNDERSCORE
|
||||
#define OMPI_IS_FORTRAN_BOTTOM(addr) \
|
||||
(addr == (void*) &mpi_fortran_bottom)
|
||||
#define OMPI_IS_FORTRAN_ARGV_NULL(addr) \
|
||||
(addr == (void*) &mpi_fortran_argv_null)
|
||||
#define OMPI_IS_FORTRAN_ARGVS_NULL(addr) \
|
||||
(addr == (void*) &mpi_fortran_argvs_null)
|
||||
#define OMPI_IS_FORTRAN_ERRCODES_IGNORE(addr) \
|
||||
(addr == (void*) &mpi_fortran_errcodes_ignore)
|
||||
#define OMPI_IS_FORTRAN_STATUS_IGNORE(addr) \
|
||||
(addr == (void*) &mpi_fortran_status_ignore)
|
||||
#define OMPI_IS_FORTRAN_STATUSES_IGNORE(addr) \
|
||||
(addr == (void*) &mpi_fortran_statuses_ignore)
|
||||
|
||||
#else
|
||||
#define OMPI_IS_FORTRAN_BOTTOM(addr) \
|
||||
(addr == (void*) &mpi_fortran_bottom)
|
||||
#define OMPI_IS_FORTRAN_ARGV_NULL(addr) \
|
||||
(addr == (void*) &mpi_fortran_argv_null)
|
||||
#define OMPI_IS_FORTRAN_ARGVS_NULL(addr) \
|
||||
(addr == (void*) &mpi_fortran_argvs_null)
|
||||
#define OMPI_IS_FORTRAN_ERRCODES_IGNORE(addr) \
|
||||
(addr == (void*) &mpi_fortran_errcodes_ignore)
|
||||
#define OMPI_IS_FORTRAN_STATUS_IGNORE(addr) \
|
||||
(addr == (void*) &mpi_fortran_status_ignore)
|
||||
#define OMPI_IS_FORTRAN_STATUSES_IGNORE(addr) \
|
||||
(addr == (void*) &mpi_fortran_statuses_ignore)
|
||||
|
||||
#endif /* weak / specific symbol type */
|
||||
|
||||
#endif /* OMPI_F77_CONSTANTS_H */
|
||||
27
src/mpi/f77/constants_f.c
Обычный файл
27
src/mpi/f77/constants_f.c
Обычный файл
@ -0,0 +1,27 @@
|
||||
/*
|
||||
* $HEADER$
|
||||
*/
|
||||
|
||||
#include "ompi_config.h"
|
||||
|
||||
#include "mpi/f77/bindings.h"
|
||||
#include "constants.h"
|
||||
|
||||
#define INST(upper_case, lower_case, single_u, double_u) \
|
||||
ompi_fortran_common_t upper_case; \
|
||||
ompi_fortran_common_t lower_case; \
|
||||
ompi_fortran_common_t single_u; \
|
||||
ompi_fortran_common_t double_u
|
||||
|
||||
INST(MPI_FORTRAN_STATUS_IGNORE, mpi_fortran_status_ignore,
|
||||
mpi_fortran_status_ignore_, mpi_fortran_status_ignore__);
|
||||
INST(MPI_FORTRAN_ARGV_NULL, mpi_fortran_argv_null,
|
||||
mpi_fortran_argv_null_, mpi_fortran_argv_null__);
|
||||
INST(MPI_FORTRAN_ARGVS_NULL, mpi_fortran_argvs_null,
|
||||
mpi_fortran_argvs_null_, mpi_fortran_argvs_null__);
|
||||
INST(MPI_FORTRAN_ERRCODES_IGNORE, mpi_fortran_errcodes_ignore,
|
||||
mpi_fortran_errcodes_ignore_, mpi_fortran_errcodes_ignore__);
|
||||
INST(MPI_FORTRAN_STATUS_IGNORE, mpi_fortran_status_ignore,
|
||||
mpi_fortran_status_ignore_, mpi_fortran_status_ignore__);
|
||||
INST (MPI_FORTRAN_STATUSES_IGNORE, mpi_fortran_statuses_ignore,
|
||||
mpi_fortran_statuses_ignore_, mpi_fortran_statuses_ignore__);
|
||||
@ -67,7 +67,8 @@ void mpi_comm_free_keyval_f(MPI_Fint *comm_keyval, MPI_Fint *ierr);
|
||||
void mpi_comm_free_f(MPI_Fint *comm, MPI_Fint *ierr);
|
||||
void mpi_comm_get_attr_f(MPI_Fint *comm, MPI_Fint *comm_keyval, char *attribute_val, MPI_Fint *flag, MPI_Fint *ierr);
|
||||
void mpi_comm_get_errhandler_f(MPI_Fint *comm, MPI_Fint *erhandler, MPI_Fint *ierr);
|
||||
void mpi_comm_get_name_f(MPI_Fint *comm, char *comm_name, MPI_Fint *resultlen, MPI_Fint *ierr);
|
||||
void mpi_comm_get_name_f(MPI_Fint *comm, char *comm_name, MPI_Fint *resultlen,
|
||||
MPI_Fint *ierr, int name_len);
|
||||
void mpi_comm_get_parent_f(MPI_Fint *parent, MPI_Fint *ierr);
|
||||
void mpi_comm_group_f(MPI_Fint *comm, MPI_Fint *group, MPI_Fint *ierr);
|
||||
void mpi_comm_join_f(MPI_Fint *fd, MPI_Fint *intercomm, MPI_Fint *ierr);
|
||||
@ -76,9 +77,13 @@ void mpi_comm_remote_group_f(MPI_Fint *comm, MPI_Fint *group, MPI_Fint *ierr);
|
||||
void mpi_comm_remote_size_f(MPI_Fint *comm, MPI_Fint *size, MPI_Fint *ierr);
|
||||
void mpi_comm_set_attr_f(MPI_Fint *comm, MPI_Fint *comm_keyval, char *attribute_val, MPI_Fint *ierr);
|
||||
void mpi_comm_set_errhandler_f(MPI_Fint *comm, MPI_Fint *errhandler, MPI_Fint *ierr);
|
||||
void mpi_comm_set_name_f(MPI_Fint *comm, char *comm_name, MPI_Fint *ierr);
|
||||
void mpi_comm_set_name_f(MPI_Fint *comm, char *comm_name, MPI_Fint *ierr,
|
||||
int name_len);
|
||||
void mpi_comm_size_f(MPI_Fint *comm, MPI_Fint *size, MPI_Fint *ierr);
|
||||
void mpi_comm_spawn_f(char *command, char *argv, MPI_Fint *maxprocs, MPI_Fint *info, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *intercomm, MPI_Fint *array_of_errcodes, MPI_Fint *ierr);
|
||||
void mpi_comm_spawn_f(char *command, char *argv, MPI_Fint *maxprocs,
|
||||
MPI_Fint *info, MPI_Fint *root, MPI_Fint *comm,
|
||||
MPI_Fint *intercomm, MPI_Fint *array_of_errcodes,
|
||||
MPI_Fint *ierr, int command_len, int argv_len);
|
||||
void mpi_comm_spawn_multiple_f(MPI_Fint *count, char *array_of_commands, char *array_of_argv, MPI_Fint *array_of_maxprocs, MPI_Fint *array_of_info, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *intercomm, MPI_Fint *array_of_errcodes, MPI_Fint *ierr);
|
||||
void mpi_comm_split_f(MPI_Fint *comm, MPI_Fint *color, MPI_Fint *key, MPI_Fint *newcomm, MPI_Fint *ierr);
|
||||
void mpi_comm_test_inter_f(MPI_Fint *comm, MPI_Fint *flag, MPI_Fint *ierr);
|
||||
|
||||
@ -8,6 +8,9 @@
|
||||
|
||||
#include "mpi.h"
|
||||
#include "mpi/f77/bindings.h"
|
||||
#include "mpi/f77/constants.h"
|
||||
#include "errhandler/errhandler.h"
|
||||
#include "communicator/communicator.h"
|
||||
|
||||
#if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
|
||||
#pragma weak PMPI_RECV = mpi_recv_f
|
||||
@ -50,11 +53,49 @@ void mpi_recv_f(char *buf, MPI_Fint *count, MPI_Fint *datatype,
|
||||
MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm,
|
||||
MPI_Fint *status, MPI_Fint *ierr)
|
||||
{
|
||||
MPI_Comm c_comm = MPI_Comm_f2c(OMPI_FINT_2_INT(*comm));
|
||||
MPI_Datatype c_type = MPI_Type_f2c(OMPI_FINT_2_INT(*datatype));
|
||||
MPI_Status *c_status;
|
||||
#if OMPI_SIZEOF_FORTRAN_INT != SIZEOF_INT
|
||||
MPI_Stauts c_status2;
|
||||
#endif
|
||||
MPI_Comm c_comm = MPI_Comm_f2c(*comm);
|
||||
MPI_Datatype c_type = MPI_Type_f2c(*datatype);
|
||||
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Recv( buf, OMPI_FINT_2_INT(*count), c_type,
|
||||
OMPI_FINT_2_INT(*source),
|
||||
OMPI_FINT_2_INT(*tag), c_comm,
|
||||
(MPI_Status*) status));
|
||||
/* Only check for the bad value if we're checking MPI parameters */
|
||||
|
||||
if (MPI_PARAM_CHECK) {
|
||||
if (OMPI_IS_FORTRAN_STATUSES_IGNORE(status)) {
|
||||
*ierr = OMPI_INT_2_FINT(OMPI_ERRHANDLER_INVOKE(c_comm, MPI_ERR_ARG,
|
||||
"MPI_RECV"));
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
/* See if we got MPI_STATUS_IGNORE */
|
||||
|
||||
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
|
||||
c_status = MPI_STATUS_IGNORE;
|
||||
} else {
|
||||
|
||||
/* If sizeof(int) == sizeof(INTEGER), then there's no
|
||||
translation necessary -- let the underlying functions write
|
||||
directly into the Fortran status */
|
||||
|
||||
#if OMPI_SIZEOF_FORTRAN_INT == SIZEOF_INT
|
||||
c_status = (MPI_Status *) status;
|
||||
#else
|
||||
c_status = &c_status2;
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Call the C function */
|
||||
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Recv(buf, OMPI_FINT_2_INT(*count), c_type,
|
||||
OMPI_FINT_2_INT(*source),
|
||||
OMPI_FINT_2_INT(*tag), c_comm,
|
||||
c_status));
|
||||
#if OMPI_SIZEOF_FORTRAN_INT != SIZEOF_INT
|
||||
if (MPI_STATUS_IGNORE != c_status) {
|
||||
MPI_Status_c2f(c_status, status);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
@ -49,8 +49,8 @@ OMPI_GENERATE_F77_BINDINGS (MPI_SEND,
|
||||
void mpi_send_f(char *buf, MPI_Fint *count, MPI_Fint *datatype,
|
||||
MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *ierr)
|
||||
{
|
||||
MPI_Comm c_comm = MPI_Comm_f2c(OMPI_FINT_2_INT(*comm));
|
||||
MPI_Datatype c_type = MPI_Type_f2c(OMPI_FINT_2_INT(*datatype));
|
||||
MPI_Comm c_comm = MPI_Comm_f2c(*comm);
|
||||
MPI_Datatype c_type = MPI_Type_f2c(*datatype);
|
||||
|
||||
*ierr = OMPI_INT_2_FINT(MPI_Send(buf, OMPI_FINT_2_INT(*count),
|
||||
c_type, OMPI_FINT_2_INT(*dest),
|
||||
|
||||
108
src/mpi/f77/strings.c
Обычный файл
108
src/mpi/f77/strings.c
Обычный файл
@ -0,0 +1,108 @@
|
||||
/*
|
||||
* $HEADER$
|
||||
*/
|
||||
|
||||
#include "ompi_config.h"
|
||||
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#include "include/constants.h"
|
||||
#include "util/argv.h"
|
||||
#include "mpi/f77/strings.h"
|
||||
|
||||
|
||||
/*
|
||||
* creates a C string from an F77 string
|
||||
*/
|
||||
int ompi_fortran_string_f2c(char *fstr, int len, char **cstr)
|
||||
{
|
||||
char *end;
|
||||
int i;
|
||||
|
||||
/* Leading and trailing blanks are discarded. */
|
||||
|
||||
end = fstr + len - 1;
|
||||
|
||||
for (i = 0; (i < len) && (' ' == *fstr); ++i, ++fstr) {
|
||||
continue;
|
||||
}
|
||||
|
||||
if (i >= len) {
|
||||
len = 0;
|
||||
} else {
|
||||
for (; (end > fstr) && (' ' == *end); --end) {
|
||||
continue;
|
||||
}
|
||||
|
||||
len = end - fstr + 1;
|
||||
}
|
||||
|
||||
/* Allocate space for the C string. */
|
||||
|
||||
if (NULL == (*cstr = malloc(len + 1))) {
|
||||
return OMPI_ERR_OUT_OF_RESOURCE;
|
||||
}
|
||||
|
||||
/* Copy F77 string into C string and NULL terminate it. */
|
||||
|
||||
if (len > 0) {
|
||||
strncpy(*cstr, fstr, len);
|
||||
}
|
||||
(*cstr)[len] = '\0';
|
||||
|
||||
return OMPI_SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* copy a C string into a Fortran string
|
||||
*/
|
||||
int ompi_fortran_string_c2f(char *cstr, char *fstr, int len)
|
||||
{
|
||||
int i;
|
||||
|
||||
strncpy(fstr, cstr, len);
|
||||
for (i = strlen(cstr); i < len; ++i) {
|
||||
fstr[i] = ' ';
|
||||
}
|
||||
|
||||
return OMPI_SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
/*
|
||||
* creates a C argument vector from an F77 array of strings
|
||||
* (terminated by a blank string)
|
||||
*/
|
||||
int ompi_fortran_argv_f2c(char *array, int len, char ***argv)
|
||||
{
|
||||
int err, argc = 0;
|
||||
char *cstr;
|
||||
|
||||
/* Fortran lines up strings in memory, each delimited by \0. So
|
||||
just convert them until we hit an extra \0. */
|
||||
|
||||
*argv = NULL;
|
||||
while (1) {
|
||||
if (OMPI_SUCCESS != (err = ompi_fortran_string_f2c(array, len,
|
||||
&cstr))) {
|
||||
ompi_argv_free(*argv);
|
||||
return err;
|
||||
}
|
||||
|
||||
if ('\0' == *cstr) {
|
||||
break;
|
||||
}
|
||||
|
||||
if (OMPI_SUCCESS != (err = ompi_argv_append(&argc, argv, cstr))) {
|
||||
ompi_argv_free(*argv);
|
||||
return err;
|
||||
}
|
||||
|
||||
free(cstr);
|
||||
array += len;
|
||||
}
|
||||
|
||||
return OMPI_SUCCESS;
|
||||
}
|
||||
68
src/mpi/f77/strings.h
Обычный файл
68
src/mpi/f77/strings.h
Обычный файл
@ -0,0 +1,68 @@
|
||||
/*
|
||||
* $HEADER$
|
||||
*/
|
||||
|
||||
#ifndef OMPI_F77_STRINGS_H
|
||||
#define OMPI_F77_STRINGS_H
|
||||
|
||||
#if defined(c_plusplus) || defined(__cplusplus)
|
||||
extern "C" {
|
||||
#endif
|
||||
/**
|
||||
* Convert a fortran string to a C string.
|
||||
*
|
||||
* @param fstr Fortran string
|
||||
* @param len Fortran string length
|
||||
* @param cstr Pointer to C string that will be created and returned
|
||||
*
|
||||
* @retval OMPI_SUCCESS upon success
|
||||
* @retval OMPI_ERROR upon error
|
||||
*
|
||||
* This function is intended to be used in the MPI F77 bindings to
|
||||
* convert fortran strings to C strings before invoking a back-end
|
||||
* MPI C binding function. It will create a new C string and
|
||||
* assign it to the cstr to return. The caller is responsible for
|
||||
* eventually freeing the C string.
|
||||
*/
|
||||
int ompi_fortran_string_f2c(char *fstr, int len, char **cstr);
|
||||
|
||||
/**
|
||||
* Convert a C string to a fortran string.
|
||||
*
|
||||
* @param cstr C string
|
||||
* @param fstr Fortran string (must already exist and be allocated)
|
||||
* @param len Fortran string length
|
||||
*
|
||||
* @retval OMPI_SUCCESS upon success
|
||||
* @retval OMPI_ERROR upon error
|
||||
*
|
||||
* This function is intended to be used in the MPI F77 bindings to
|
||||
* convert C strings to fortran strings. It is assumed that the
|
||||
* fortran string is already allocated and has a length of len.
|
||||
*/
|
||||
int ompi_fortran_string_c2f(char *cstr, char *fstr, int len);
|
||||
|
||||
/**
|
||||
* Convert an array of Fortran strings to an argv-style array of C
|
||||
* strings.
|
||||
*
|
||||
* @param farray Array of fortran strings
|
||||
* @param len Length of fortran array
|
||||
* @param cargv Returned argv-style array of C strings
|
||||
*
|
||||
* @retval OMPI_SUCCESS upon success
|
||||
* @retval OMPI_ERROR upon error
|
||||
*
|
||||
* This function is intented to be used in the MPI F77 bindings to
|
||||
* convert arrays of fortran strings to argv-style arrays of C
|
||||
* strings. The argv array will be allocated and returned; it is
|
||||
* the caller's responsibility to invoke ompi_argv_free() to free
|
||||
* it later (or equivalent).
|
||||
*/
|
||||
int ompi_fortran_argv_f2c(char *farray, int len, char ***cargv);
|
||||
#if defined(c_plusplus) || defined(__cplusplus)
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
#endif /* OMPI_F77_STRINGS_H */
|
||||
Загрузка…
Ссылка в новой задаче
Block a user