1 /*
2 * Copyright (C) by Argonne National Laboratory
3 * See COPYRIGHT in top-level directory
4 */
5
6 #include "mpiimpl.h"
7
8 /* -- Begin Profiling Symbol Block for routine MPI_Free_mem */
9 #if defined(HAVE_PRAGMA_WEAK)
10 #pragma weak MPI_Free_mem = PMPI_Free_mem
11 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
12 #pragma _HP_SECONDARY_DEF PMPI_Free_mem MPI_Free_mem
13 #elif defined(HAVE_PRAGMA_CRI_DUP)
14 #pragma _CRI duplicate MPI_Free_mem as PMPI_Free_mem
15 #elif defined(HAVE_WEAK_ATTRIBUTE)
16 int MPI_Free_mem(void *base) __attribute__ ((weak, alias("PMPI_Free_mem")));
17 #endif
18 /* -- End Profiling Symbol Block */
19
20 /* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
21 the MPI routines */
22 #ifndef MPICH_MPI_FROM_PMPI
23 #undef MPI_Free_mem
24 #define MPI_Free_mem PMPI_Free_mem
25
26 #endif
27
28 /*@
29 MPI_Free_mem - Free memory allocated with MPI_Alloc_mem
30
31 Input Parameters:
32 . base - initial address of memory segment allocated by 'MPI_ALLOC_MEM'
33 (choice)
34
35 .N ThreadSafe
36
37 .N Fortran
38
39 .N Errors
40 .N MPI_SUCCESS
41 @*/
MPI_Free_mem(void * base)42 int MPI_Free_mem(void *base)
43 {
44 int mpi_errno = MPI_SUCCESS;
45 MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_FREE_MEM);
46
47 MPIR_ERRTEST_INITIALIZED_ORDIE();
48
49 MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
50 MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_FREE_MEM);
51
52 /* ... body of routine ... */
53
54 if (base == NULL)
55 goto fn_exit;
56
57 mpi_errno = MPID_Free_mem(base);
58 if (mpi_errno)
59 goto fn_fail;
60
61 /* ... end of body of routine ... */
62
63 fn_exit:
64 MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_FREE_MEM);
65 MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
66 return mpi_errno;
67
68 fn_fail:
69 /* --BEGIN ERROR HANDLING-- */
70 #ifdef HAVE_ERROR_CHECKING
71 {
72 mpi_errno =
73 MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, __func__, __LINE__, MPI_ERR_OTHER,
74 "**mpi_free_mem", "**mpi_free_mem %p", base);
75 }
76 #endif
77 /* MPI_Free_mem must invoke the error handler on MPI_COMM_WORLD if there
78 * is an error */
79 mpi_errno = MPIR_Err_return_comm(NULL, __func__, mpi_errno);
80 goto fn_exit;
81 /* --END ERROR HANDLING-- */
82 }
83