@@ -121,6 +121,11 @@ typedef struct mpi_caf_token_t
121
121
/* The pointer to the primary array, i.e., to coarrays that are arrays and
122
122
* not a derived type. */
123
123
gfc_descriptor_t * desc ;
124
+ #ifdef GCC_GE_15
125
+ /* Only set to false, when this token maps memory into another token's
126
+ * memory segment. This only happens when in an associate or a change team. */
127
+ int owning_memory ;
128
+ #endif
124
129
} mpi_caf_token_t ;
125
130
126
131
/* For components of derived type coarrays a slave_token is needed when the
@@ -2147,6 +2152,38 @@ void PREFIX(register)(size_t size, caf_register_t type, caf_token_t *token,
2147
2152
slave_token , slave_token -> memptr , slave_token -> desc );
2148
2153
}
2149
2154
break ;
2155
+ #ifdef GCC_GE_15
2156
+ case CAF_REGTYPE_COARRAY_MAP_EXISTING :
2157
+ {
2158
+ mpi_caf_token_t * mpi_token ;
2159
+ MPI_Win * p ;
2160
+
2161
+ * token = calloc (1 , sizeof (mpi_caf_token_t ));
2162
+ mpi_token = (mpi_caf_token_t * )(* token );
2163
+ p = TOKEN (mpi_token );
2164
+ mem = desc -> base_addr ;
2165
+ ierr = MPI_Win_create (mem , actual_size , 1 , MPI_INFO_NULL ,
2166
+ CAF_COMM_WORLD , p );
2167
+ chk_err (ierr );
2168
+ CAF_Win_lock_all (* p );
2169
+ mpi_token -> owning_memory = 0 ;
2170
+
2171
+ struct allocated_tokens_t * allocated_token
2172
+ = malloc (sizeof (struct allocated_tokens_t ));
2173
+ allocated_token -> next = current_team -> allocated_tokens ;
2174
+ allocated_token -> token = * token ;
2175
+ current_team -> allocated_tokens = allocated_token ;
2176
+
2177
+ if (stat )
2178
+ * stat = 0 ;
2179
+
2180
+ mpi_token -> memptr = mem ;
2181
+ dprint ("Token %p on exit of mapping: mpi_caf_token_t "
2182
+ "{ (local_)memptr: %p (size: %zd), memptr_win: %d }\n" ,
2183
+ mpi_token , mpi_token -> memptr , size , mpi_token -> memptr_win );
2184
+ break ;
2185
+ }
2186
+ #endif
2150
2187
default :
2151
2188
{
2152
2189
mpi_caf_token_t * mpi_token ;
@@ -2168,6 +2205,9 @@ void PREFIX(register)(size_t size, caf_register_t type, caf_token_t *token,
2168
2205
CAF_COMM_WORLD , p );
2169
2206
chk_err (ierr );
2170
2207
#endif // MPI_VERSION
2208
+ #ifdef GCC_GE_15
2209
+ mpi_token -> owning_memory = 1 ;
2210
+ #endif
2171
2211
2172
2212
#ifndef GCC_GE_8
2173
2213
if (GFC_DESCRIPTOR_RANK (desc ) != 0 )
@@ -10601,9 +10641,20 @@ PREFIX(end_team)(int *stat, char *errmsg, charlen_t errmsg_len)
10601
10641
{
10602
10642
struct allocated_tokens_t * nac = ac -> next ;
10603
10643
10604
- PREFIX (deregister )((void * * )& ac -> token ,
10605
- CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY , stat , errmsg ,
10606
- errmsg_len );
10644
+ if (((mpi_caf_token_t * )ac -> token )-> owning_memory )
10645
+ PREFIX (deregister )((void * * )& ac -> token ,
10646
+ CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY , stat , errmsg ,
10647
+ errmsg_len );
10648
+ else
10649
+ {
10650
+ MPI_Win * p = TOKEN (ac -> token );
10651
+
10652
+ CAF_Win_unlock_all (* p );
10653
+ ierr = MPI_Win_free (p );
10654
+ chk_err (ierr );
10655
+
10656
+ free (ac -> token );
10657
+ }
10607
10658
free (ac );
10608
10659
ac = nac ;
10609
10660
}
0 commit comments