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/message/message.h"
30 #include "ompi/memchecker.h"
31
32 #if OMPI_BUILD_MPI_PROFILING
33 #if OPAL_HAVE_WEAK_SYMBOLS
34 #pragma weak MPI_Message_c2f = PMPI_Message_c2f
35 #endif
36 #define MPI_Message_c2f PMPI_Message_c2f
37 #endif
38
39 static const char FUNC_NAME[] = "MPI_Message_c2f";
40
41
42 MPI_Fint MPI_Message_c2f(MPI_Message message)
43 {
44 MEMCHECKER(
45 memchecker_message(&message);
46 );
47
48 OPAL_CR_NOOP_PROGRESS();
49
50 if ( MPI_PARAM_CHECK ) {
51 OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
52
53 if (NULL == message) {
54 return OMPI_INT_2_FINT(-1);
55 }
56 }
57
58 /* We only put messages in the f2c table when this function is
59 invoked. This is because putting messages 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_Message_c2f in order to
67 transmorgify the C MPI_Message that they got back into a
68 fortran integer.
69 */
70
71 if (MPI_UNDEFINED == message->m_f_to_c_index) {
72 message->m_f_to_c_index =
73 opal_pointer_array_add(&ompi_message_f_to_c_table, message);
74 }
75
76 return OMPI_INT_2_FINT(message->m_f_to_c_index) ;
77 }