1 /* -*- Mode: C; c-basic-offset:4 ; -*- */ 2 /* 3 * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana 4 * University Research and Technology 5 * Corporation. All rights reserved. 6 * Copyright (c) 2004-2007 The University of Tennessee and The University 7 * of Tennessee Research Foundation. All rights 8 * reserved. 9 * Copyright (c) 2004-2008 High Performance Computing Center Stuttgart, 10 * University of Stuttgart. All rights reserved. 11 * Copyright (c) 2004-2005 The Regents of the University of California. 12 * All rights reserved. 13 * Copyright (c) 2006-2012 Cisco Systems, Inc. All rights reserved. 14 * Copyright (c) 2015 Research Organization for Information Science 15 * and Technology (RIST). All rights reserved. 16 * $COPYRIGHT$ 17 * 18 * Additional copyrights may follow 19 * 20 * $HEADER$ 21 */ 22 #include "ompi_config.h" 23 #include <stdio.h> 24 25 #include "ompi/mpi/c/bindings.h" 26 #include "ompi/runtime/params.h" 27 #include "ompi/errhandler/errhandler.h" 28 #include "ompi/mpi/fortran/base/fint_2_int.h" 29 #include "ompi/request/request.h" 30 #include "ompi/memchecker.h" 31 32 #if OMPI_BUILD_MPI_PROFILING 33 #if OPAL_HAVE_WEAK_SYMBOLS 34 #pragma weak MPI_Request_c2f = PMPI_Request_c2f 35 #endif 36 #define MPI_Request_c2f PMPI_Request_c2f 37 #endif 38 39 static const char FUNC_NAME[] = "MPI_Request_c2f"; 40 41 42 MPI_Fint MPI_Request_c2f(MPI_Request request) 43 { 44 MEMCHECKER( 45 memchecker_request(&request); 46 ); 47 48 OPAL_CR_NOOP_PROGRESS(); 49 50 if ( MPI_PARAM_CHECK ) { 51 OMPI_ERR_INIT_FINALIZE(FUNC_NAME); 52 53 if (NULL == request) { 54 return OMPI_INT_2_FINT(-1); 55 } 56 } 57 58 /* We only put requests in the f2c table when this function is 59 invoked. This is because putting requests in the table 60 involves locking and unlocking the table, which would incur a 61 performance penalty (in the critical performance path) for C 62 applications. In this way, at least only Fortran applications 63 are penalized. :-\ 64 65 Modifying this one function neatly fixes up all the Fortran 66 bindings because they all call MPI_Request_c2f in order to 67 transmorgify the C MPI_Request that they got back into a 68 fortran integer. 69 */ 70 71 if (MPI_UNDEFINED == request->req_f_to_c_index) { 72 request->req_f_to_c_index = 73 opal_pointer_array_add(&ompi_request_f_to_c_table, request); 74 } 75 76 return OMPI_INT_2_FINT(request->req_f_to_c_index) ; 77 }