X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/b113c052994d9c4ffdf4b886b65f733fcb66b556..453d43c197818b5469f79845e522f5451c811791:/src/smpi/smpi_f77.c diff --git a/src/smpi/smpi_f77.c b/src/smpi/smpi_f77.c index 61d4b4639c..aa9af8c26e 100644 --- a/src/smpi/smpi_f77.c +++ b/src/smpi/smpi_f77.c @@ -1,8 +1,8 @@ -/* Copyright (c) 2010. The SimGrid Team. +/* Copyright (c) 2010-2014. The SimGrid Team. * All rights reserved. */ /* This program is free software; you can redistribute it and/or modify it - * under the terms of the license (GNU LGPL) which comes with this package. */ + * under the terms of the license (GNU LGPL) which comes with this package. */ #include #include @@ -20,11 +20,27 @@ static xbt_dict_t datatype_lookup = NULL; static xbt_dict_t op_lookup = NULL; static int running_processes = 0; - - -/* Convert between Fortran and C MPI_BOTTOM */ -#define F2C_BOTTOM(addr) ((addr!=MPI_IN_PLACE && *(int*)addr == MPI_FORTRAN_BOTTOM) ? MPI_BOTTOM : (addr)) -#define F2C_IN_PLACE(addr) ((addr!=MPI_BOTTOM &&*(int*)addr == MPI_FORTRAN_IN_PLACE) ? MPI_IN_PLACE : (addr)) +/* Bindings for MPI special values */ +union u_smpi_common { + struct s_smpi_common { + integer _MPI_IN_PLACE; + integer _MPI_BOTTOM; + integer _MPI_STATUS_IGNORE; + integer _MPI_STATUSES_IGNORE; + } *f77; /* with f2c, remains NULL with gfortran */ + struct s_smpi_common f90; /* with gftortran */ +} smpi_ = { NULL }; + +/* Convert between Fortran and C */ +#define F2C_ADDR(addr, val) \ + (((void *)(addr) == (void *)(smpi_.f77 \ + ? &smpi_.f77[smpi_current_rank]._ ## val \ + : &smpi_.f90._ ## val)) \ + ? (val) : (void *)(addr)) +#define F2C_BOTTOM(addr) F2C_ADDR(addr, MPI_BOTTOM) +#define F2C_IN_PLACE(addr) F2C_ADDR(addr, MPI_IN_PLACE) +#define F2C_STATUS_IGNORE(addr) F2C_ADDR(addr, MPI_STATUS_IGNORE) +#define F2C_STATUSES_IGNORE(addr) F2C_ADDR(addr, MPI_STATUSES_IGNORE) #define KEY_SIZE (sizeof(int) * 2 + 1) @@ -211,13 +227,10 @@ void mpi_finalize_(int* ierr) { running_processes--; if(running_processes==0){ xbt_dict_free(&op_lookup); - op_lookup = NULL; xbt_dict_free(&datatype_lookup); - datatype_lookup = NULL; xbt_dict_free(&request_lookup); - request_lookup = NULL; + xbt_dict_free(&group_lookup); xbt_dict_free(&comm_lookup); - comm_lookup = NULL; } } @@ -353,7 +366,7 @@ void mpi_sendrecv_(void* sendbuf, int* sendcount, int* sendtype, int* dst, int* comm, MPI_Status* status, int* ierr) { *ierr = MPI_Sendrecv(sendbuf, *sendcount, get_datatype(*sendtype), *dst, *sendtag, recvbuf, *recvcount,get_datatype(*recvtype), *src, *recvtag, - get_comm(*comm), status); + get_comm(*comm), F2C_STATUS_IGNORE(status)); } void mpi_recv_init_(void *buf, int* count, int* datatype, int* src, int* tag, @@ -405,7 +418,7 @@ void mpi_startall_(int* count, int* requests, int* ierr) { void mpi_wait_(int* request, MPI_Status* status, int* ierr) { MPI_Request req = find_request(*request); - *ierr = MPI_Wait(&req, status); + *ierr = MPI_Wait(&req, F2C_STATUS_IGNORE(status)); if(req==MPI_REQUEST_NULL){ free_request(*request); *request=MPI_FORTRAN_REQUEST_NULL; @@ -436,7 +449,7 @@ void mpi_waitall_(int* count, int* requests, MPI_Status* status, int* ierr) { for(i = 0; i < *count; i++) { reqs[i] = find_request(requests[i]); } - *ierr = MPI_Waitall(*count, reqs, status); + *ierr = MPI_Waitall(*count, reqs, F2C_STATUSES_IGNORE(status)); for(i = 0; i < *count; i++) { if(reqs[i]==MPI_REQUEST_NULL){ free_request(requests[i]); @@ -551,7 +564,7 @@ void mpi_alltoallv_(void* sendbuf, int* sendcounts, int* senddisps, int* sendtyp void mpi_test_ (int * request, int *flag, MPI_Status * status, int* ierr){ MPI_Request req = find_request(*request); - *ierr= MPI_Test(&req, flag, status); + *ierr= MPI_Test(&req, flag, F2C_STATUS_IGNORE(status)); if(req==MPI_REQUEST_NULL){ free_request(*request); *request=MPI_FORTRAN_REQUEST_NULL; @@ -566,7 +579,7 @@ void mpi_testall_ (int* count, int * requests, int *flag, MPI_Status * statuses for(i = 0; i < *count; i++) { reqs[i] = find_request(requests[i]); } - *ierr= MPI_Testall(*count, reqs, flag, statuses); + *ierr= MPI_Testall(*count, reqs, flag, F2C_STATUSES_IGNORE(statuses)); for(i = 0; i < *count; i++) { if(reqs[i]==MPI_REQUEST_NULL){ free_request(requests[i]); @@ -581,7 +594,7 @@ void mpi_get_processor_name_(char *name, int *resultlen, int* ierr){ } void mpi_get_count_(MPI_Status * status, int* datatype, int *count, int* ierr){ - *ierr = MPI_Get_count(status, get_datatype(*datatype), count); + *ierr = MPI_Get_count(F2C_STATUS_IGNORE(status), get_datatype(*datatype), count); } void mpi_attr_get_(int* comm, int* keyval, void* attr_value, int* flag, int* ierr ){ @@ -966,7 +979,7 @@ void mpi_sendrecv_replace_ (void *buf, int* count, int* datatype, int* dst, int* { *ierr = MPI_Sendrecv_replace(buf, *count, get_datatype(*datatype), *dst, *sendtag, *src, - *recvtag, get_comm(*comm), status); + *recvtag, get_comm(*comm), F2C_STATUS_IGNORE(status)); } void mpi_testany_ (int* count, int* requests, int *index, int *flag, MPI_Status* status, int* ierr) @@ -978,7 +991,7 @@ void mpi_testany_ (int* count, int* requests, int *index, int *flag, MPI_Status* for(i = 0; i < *count; i++) { reqs[i] = find_request(requests[i]); } - *ierr = MPI_Testany(*count, reqs, index, flag, status); + *ierr = MPI_Testany(*count, reqs, index, flag, F2C_STATUS_IGNORE(status)); if(*index!=MPI_UNDEFINED) if(reqs[*index]==MPI_REQUEST_NULL){ free_request(requests[*index]); @@ -1154,7 +1167,7 @@ void mpi_testsome_ (int* incount, int* requests, int* outcount, int* indices, M reqs[i] = find_request(requests[i]); indices[i]=0; } - *ierr = MPI_Testsome(*incount, reqs, outcount, indices, statuses); + *ierr = MPI_Testsome(*incount, reqs, outcount, indices, F2C_STATUSES_IGNORE(statuses)); for(i=0;i<*incount;i++){ if(indices[i]){ if(reqs[indices[i]]==MPI_REQUEST_NULL){ @@ -1311,7 +1324,7 @@ void mpi_issend_ (void* buf, int* count, int* datatype, int *dest, int* tag, int } void mpi_probe_ (int* source, int* tag, int* comm, MPI_Status* status, int* ierr) { - *ierr = MPI_Probe(*source, *tag, get_comm(*comm), status); + *ierr = MPI_Probe(*source, *tag, get_comm(*comm), F2C_STATUS_IGNORE(status)); } void mpi_attr_delete_ (int* comm, int* keyval, int* ierr) {