Skip to content

Commit c4481f9

Browse files
vehrezbeekman
vehre
authored and
zbeekman
committed
Reverted change for burgers test in CMakeLists.txt.
Fixed most issues. One still needs a patch to gfortran. Therefore the pde-solver might fail with an unpatched gfortran still.
1 parent a5ccdbb commit c4481f9

File tree

2 files changed

+102
-51
lines changed

2 files changed

+102
-51
lines changed

‎CMakeLists.txt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -206,7 +206,7 @@ if(opencoarrays_aware_compiler)
206206

207207
# Integration tests verifying the use of libcaf_mpi in applications
208208
add_mpi_test(hello_multiverse 2 ${tests_root}/integration/coarrayHelloWorld/hello_multiverse)
209-
add_mpi_test(coarray_burgers_pde 4 ${tests_root}/integration/pde_solvers/coarrayBurgers/coarray_burgers_pde)
209+
add_mpi_test(coarray_burgers_pde 2 ${tests_root}/integration/pde_solvers/coarrayBurgers/coarray_burgers_pde)
210210
add_mpi_test(co_heat 2 ${tests_root}/integration/pde_solvers/coarrayHeatSimplified/co_heat)
211211
if ( ("${CMAKE_SYSTEM_PROCESSOR}" MATCHES "x86_64") AND ("${CMAKE_SYSTEM_NAME}" MATCHES "Linux") )
212212
if ( NOT (DEFINED ENV{TRAVIS}))

‎src/mpi/mpi_caf.c‎

Lines changed: 101 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -455,10 +455,23 @@ PREFIX (finalize) (void)
455455
{
456456
prev = tmp_tot->prev;
457457
p = TOKEN(tmp_tot->token);
458+
#ifdef GCC_GE_7
459+
# ifndef CAF_MPI_LOCK_UNLOCK
460+
MPI_Win_unlock_all(*p);
461+
# endif // CAF_MPI_LOCK_UNLOCK
462+
if (((mpi_caf_token_t *)tmp_tot->token)->desc)
463+
{
464+
mpi_caf_token_t *mpi_token = (mpi_caf_token_t *)tmp_tot->token;
465+
# ifndef CAF_MPI_LOCK_UNLOCK
466+
MPI_Win_unlock_all(*(mpi_token->desc));
467+
# endif // CAF_MPI_LOCK_UNLOCK
468+
MPI_Win_free (mpi_token->desc);
469+
free (mpi_token->desc);
470+
}
471+
#else
458472
# ifndef CAF_MPI_LOCK_UNLOCK
459473
MPI_Win_unlock_all(*p);
460474
# endif // CAF_MPI_LOCK_UNLOCK
461-
#if ! GCC_GE_7
462475
MPI_Win_free(p);
463476
#endif
464477
free(tmp_tot);
@@ -553,13 +566,14 @@ void *
553566
else
554567
{
555568
int ierr;
569+
size_t desc_size = sizeof (gfc_descriptor_t) + /*GFC_DESCRIPTOR_RANK (desc)*/
570+
GFC_MAX_DIMENSIONS * sizeof (descriptor_dimension);
556571
mpi_token->desc = (MPI_Win *)malloc (sizeof (MPI_Win));
557-
ierr = MPI_Win_create (desc, sizeof (gfc_descriptor_t), 1, MPI_INFO_NULL,
572+
ierr = MPI_Win_create (desc, desc_size, 1, mpi_info_same_size,
558573
CAF_COMM_WORLD, mpi_token->desc);
559574
#if MPI_VERSION >= 3 && !defined(CAF_MPI_LOCK_UNLOCK)
560575
MPI_Win_lock_all(MPI_MODE_NOCHECK, *(mpi_token->desc));
561576
# endif
562-
fprintf(stderr, "Descriptor %p registered at: %p (%p)\n", desc, mpi_token->desc, *(mpi_token->desc));
563577
}
564578
#else
565579
/* Token contains only a list of pointers. */
@@ -568,7 +582,11 @@ void *
568582
#endif
569583

570584
#if MPI_VERSION >= 3
585+
#if GCC_GE_7
586+
MPI_Win_allocate(actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, &mem, p);
587+
#else
571588
MPI_Win_allocate(actual_size, 1, mpi_info_same_size, CAF_COMM_WORLD, &mem, p);
589+
#endif
572590
# ifndef CAF_MPI_LOCK_UNLOCK
573591
MPI_Win_lock_all(MPI_MODE_NOCHECK, *p);
574592
# endif // CAF_MPI_LOCK_UNLOCK
@@ -614,6 +632,7 @@ void *
614632
*stat = 0;
615633

616634
#ifdef GCC_GE_7
635+
/* The descriptor will be initialized only after the call to register. */
617636
mpi_token->local_memptr = mem;
618637
desc->base_addr = mem;
619638
return;
@@ -694,13 +713,14 @@ PREFIX (deregister) (caf_token_t *token, int *stat, char *errmsg, int errmsg_len
694713
# endif // CAF_MPI_LOCK_UNLOCK
695714
MPI_Win_free(p);
696715
#ifdef GCC_GE_7
697-
if ((*(mpi_caf_token_t **)(token))->desc)
716+
if ((*(mpi_caf_token_t **)token)->desc)
698717
{
699-
mpi_caf_token_t *mpi_token = *(mpi_caf_token_t **)(token);
718+
mpi_caf_token_t *mpi_token = *(mpi_caf_token_t **)token;
700719
# ifndef CAF_MPI_LOCK_UNLOCK
701720
MPI_Win_unlock_all(*(mpi_token->desc));
702721
# endif // CAF_MPI_LOCK_UNLOCK
703722
MPI_Win_free (mpi_token->desc);
723+
free (mpi_token->desc);
704724
}
705725
#endif
706726

@@ -1996,12 +2016,33 @@ copy_data (void *ds, mpi_caf_token_t *sr, ptrdiff_t offset, int dst_type, int sr
19962016
}
19972017
}
19982018
else if (dst_type == BT_CHARACTER && dst_kind == 1)
1999-
assign_char1_from_char4 (dst_size, src_size, ds, sr->local_memptr);
2019+
{
2020+
/* Get the required amount of memory on the stack. */
2021+
void *srh = alloca (src_size);
2022+
CAF_Win_lock (image_index, *TOKEN(sr));
2023+
MPI_Get (srh, src_size, MPI_BYTE, image_index, offset,
2024+
src_size, MPI_BYTE, *TOKEN(sr));
2025+
CAF_Win_unlock (image_index, *TOKEN(sr));
2026+
assign_char1_from_char4 (dst_size, src_size, ds, srh);
2027+
}
20002028
else if (dst_type == BT_CHARACTER)
2001-
assign_char4_from_char1 (dst_size, src_size, ds, sr->local_memptr);
2029+
{
2030+
/* Get the required amount of memory on the stack. */
2031+
void *srh = alloca (src_size);
2032+
CAF_Win_lock (image_index, *TOKEN(sr));
2033+
MPI_Get (srh, src_size, MPI_BYTE, image_index, offset,
2034+
src_size, MPI_BYTE, *TOKEN(sr));
2035+
CAF_Win_unlock (image_index, *TOKEN(sr));
2036+
assign_char4_from_char1 (dst_size, src_size, ds, srh);
2037+
}
20022038
else
20032039
{
2004-
void *srh = sr->local_memptr;
2040+
/* Get the required amount of memory on the stack. */
2041+
void *srh = alloca (src_size * num);
2042+
CAF_Win_lock (image_index, *TOKEN(sr));
2043+
MPI_Get (srh, src_size * num, MPI_BYTE, image_index, offset,
2044+
src_size * num, MPI_BYTE, *TOKEN(sr));
2045+
CAF_Win_unlock (image_index, *TOKEN(sr));
20052046
for (k = 0; k < num; ++k)
20062047
{
20072048
convert_type (ds, dst_type, dst_kind, srh, src_type, src_kind, stat);
@@ -2028,29 +2069,38 @@ copy_data (void *ds, mpi_caf_token_t *sr, ptrdiff_t offset, int dst_type, int sr
20282069
#define GET_REMOTE_DESC(mpi_token, src, src_desc_data, image_index) \
20292070
if (mpi_token->desc) \
20302071
{ \
2031-
fprintf(stderr, "Getting descriptor from img: %d => %p\n", image_index, mpi_token->desc); \
2072+
size_t desc_size = sizeof (gfc_descriptor_t) + GFC_MAX_DIMENSIONS /* rank */ \
2073+
* sizeof (descriptor_dimension); \
2074+
int err; \
20322075
CAF_Win_lock (image_index, *(mpi_token->desc)); \
2033-
MPI_Get (&src_desc_data, sizeof (gfc_descriptor_t), MPI_BYTE, \
2034-
image_index, 0, sizeof (gfc_descriptor_t), \
2035-
MPI_BYTE, *(mpi_token->desc)); \
2036-
CAF_Win_unlock (image_index, *(mpi_token->desc)); \
2037-
src = &src_desc_data; \
2076+
MPI_Get (&src_desc_data, desc_size, MPI_BYTE, \
2077+
image_index, 0, desc_size, MPI_BYTE, *(mpi_token->desc)); \
2078+
err = CAF_Win_unlock (image_index, *(mpi_token->desc)); \
2079+
src = (gfc_descriptor_t *)&src_desc_data; \
20382080
} \
20392081
else \
20402082
src = NULL
20412083

20422084

2085+
typedef struct gfc_max_dim_descriptor_t {
2086+
void *base_addr;
2087+
size_t offset;
2088+
ptrdiff_t dtype;
2089+
descriptor_dimension dim[GFC_MAX_DIMENSIONS];
2090+
} gfc_max_dim_descriptor_t;
2091+
20432092
static void
20442093
get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
20452094
mpi_caf_token_t *mpi_token, gfc_descriptor_t *dst,
20462095
gfc_descriptor_t *src, void *ds, void *sr,
2096+
ptrdiff_t sr_byte_offset,
20472097
int dst_kind, int src_kind, size_t dst_dim, size_t src_dim,
20482098
size_t num, int *stat, int image_index)
20492099
/* !!! The image_index is zero-base here. */
20502100
{
20512101
ptrdiff_t extent_src = 1, array_offset_src = 0, stride_src;
20522102
size_t next_dst_dim;
2053-
gfc_descriptor_t src_desc_data;
2103+
gfc_max_dim_descriptor_t src_desc_data;
20542104

20552105
if (unlikely (ref == NULL))
20562106
/* May be we should issue an error here, because this case should not
@@ -2089,8 +2139,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
20892139
{
20902140
for (size_t d = 0; d < dst_rank; ++d)
20912141
array_offset_dst += dst_index[d];
2092-
copy_data (ds + array_offset_dst * dst_size, mpi_token, 0,
2093-
GFC_DESCRIPTOR_TYPE (dst),
2142+
copy_data (ds + array_offset_dst * dst_size, mpi_token,
2143+
sr_byte_offset, GFC_DESCRIPTOR_TYPE (dst),
20942144
src_type == -1 ? GFC_DESCRIPTOR_TYPE (src) : src_type,
20952145
dst_kind, src_kind, dst_size, ref->item_size, num,
20962146
stat, image_index);
@@ -2111,27 +2161,30 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
21112161
mpi_token = *(mpi_caf_token_t**)(sr + ref->u.c.caf_token_offset);
21122162
GET_REMOTE_DESC (mpi_token, src, src_desc_data, image_index);
21132163
get_for_ref (ref->next, i, dst_index, mpi_token, dst, src,
2114-
ds, sr + ref->u.c.offset, dst_kind, src_kind, dst_dim, 0,
2164+
ds, sr, ref->u.c.offset, dst_kind, src_kind, dst_dim, 0,
21152165
1, stat, image_index);
21162166
}
21172167
else
21182168
get_for_ref (ref->next, i, dst_index, mpi_token, dst,
21192169
(gfc_descriptor_t *)(sr + ref->u.c.offset), ds,
2120-
sr + ref->u.c.offset, dst_kind, src_kind, dst_dim, 0, 1,
2170+
sr, ref->u.c.offset, dst_kind, src_kind, dst_dim, 0, 1,
21212171
stat, image_index);
21222172
return;
21232173
case CAF_REF_ARRAY:
21242174
if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
21252175
{
21262176
get_for_ref (ref->next, i, dst_index, mpi_token, dst,
2127-
src, ds, sr, dst_kind, src_kind,
2177+
src, ds, sr, sr_byte_offset, dst_kind, src_kind,
21282178
dst_dim, 0, 1, stat, image_index);
21292179
return;
21302180
}
21312181
/* Only when on the left most index switch the data pointer to
21322182
the array's data pointer. */
21332183
if (src_dim == 0)
2134-
sr = src->base_addr;
2184+
{
2185+
sr = src->base_addr;
2186+
sr_byte_offset = 0;
2187+
}
21352188
switch (ref->u.a.mode[src_dim])
21362189
{
21372190
case CAF_ARR_REF_VECTOR:
@@ -2163,8 +2216,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
21632216
}
21642217
#undef KINDCASE
21652218

2166-
get_for_ref (ref, i, dst_index, mpi_token, dst, src,
2167-
ds, sr + array_offset_src * ref->item_size,
2219+
get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
2220+
sr_byte_offset + array_offset_src * ref->item_size,
21682221
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
21692222
1, stat, image_index);
21702223
dst_index[dst_dim] += dst->dim[dst_dim]._stride;
@@ -2182,8 +2235,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
21822235
for (ptrdiff_t idx = 0; idx < extent_src;
21832236
++idx, array_offset_src += stride_src)
21842237
{
2185-
get_for_ref (ref, i, dst_index, mpi_token, dst, src,
2186-
ds, sr + array_offset_src * ref->item_size,
2238+
get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
2239+
sr_byte_offset + array_offset_src * ref->item_size,
21872240
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
21882241
1, stat, image_index);
21892242
dst_index[dst_dim] += dst->dim[dst_dim]._stride;
@@ -2208,8 +2261,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
22082261
&& extent_src == 1) ? (dst_dim + 1) : dst_dim;
22092262
for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
22102263
{
2211-
get_for_ref (ref, i, dst_index, mpi_token, dst, src,
2212-
ds, sr + array_offset_src * ref->item_size,
2264+
get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
2265+
sr_byte_offset + array_offset_src * ref->item_size,
22132266
dst_kind, src_kind, next_dst_dim, src_dim + 1,
22142267
1, stat, image_index);
22152268
dst_index[dst_dim] += dst->dim[dst_dim]._stride;
@@ -2221,8 +2274,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
22212274
- src->dim[src_dim].lower_bound)
22222275
* src->dim[src_dim]._stride;
22232276
dst_index[dst_dim] = 0;
2224-
get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds,
2225-
sr + array_offset_src * ref->item_size,
2277+
get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
2278+
sr_byte_offset + array_offset_src * ref->item_size,
22262279
dst_kind, src_kind, dst_dim, src_dim + 1, 1,
22272280
stat, image_index);
22282281
return;
@@ -2239,8 +2292,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
22392292
dst_index[dst_dim] = 0;
22402293
for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
22412294
{
2242-
get_for_ref (ref, i, dst_index, mpi_token, dst, src,
2243-
ds, sr + array_offset_src * ref->item_size,
2295+
get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
2296+
sr_byte_offset + array_offset_src * ref->item_size,
22442297
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
22452298
1, stat, image_index);
22462299
dst_index[dst_dim] += dst->dim[dst_dim]._stride;
@@ -2258,8 +2311,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
22582311
dst_index[dst_dim] = 0;
22592312
for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
22602313
{
2261-
get_for_ref (ref, i, dst_index, mpi_token, dst, src,
2262-
ds, sr + array_offset_src * ref->item_size,
2314+
get_for_ref (ref, i, dst_index, mpi_token, dst, src, ds, sr,
2315+
sr_byte_offset + array_offset_src * ref->item_size,
22632316
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
22642317
1, stat, image_index);
22652318
dst_index[dst_dim] += dst->dim[dst_dim]._stride;
@@ -2273,8 +2326,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
22732326
case CAF_REF_STATIC_ARRAY:
22742327
if (ref->u.a.mode[src_dim] == CAF_ARR_REF_NONE)
22752328
{
2276-
get_for_ref (ref->next, i, dst_index, mpi_token, dst,
2277-
NULL, ds, sr, dst_kind, src_kind,
2329+
get_for_ref (ref->next, i, dst_index, mpi_token, dst, NULL, ds, sr,
2330+
sr_byte_offset, dst_kind, src_kind,
22782331
dst_dim, 0, 1, stat, image_index);
22792332
return;
22802333
}
@@ -2305,8 +2358,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
23052358
}
23062359
#undef KINDCASE
23072360

2308-
get_for_ref (ref, i, dst_index, mpi_token, dst, NULL,
2309-
ds, sr + array_offset_src * ref->item_size,
2361+
get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds, sr,
2362+
sr_byte_offset + array_offset_src * ref->item_size,
23102363
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
23112364
1, stat, image_index);
23122365
dst_index[dst_dim] += dst->dim[dst_dim]._stride;
@@ -2318,8 +2371,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
23182371
array_offset_src <= ref->u.a.dim[src_dim].s.end;
23192372
array_offset_src += ref->u.a.dim[src_dim].s.stride)
23202373
{
2321-
get_for_ref (ref, i, dst_index, mpi_token, dst, NULL,
2322-
ds, sr + array_offset_src * ref->item_size,
2374+
get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds, sr,
2375+
sr_byte_offset + array_offset_src * ref->item_size,
23232376
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
23242377
1, stat, image_index);
23252378
dst_index[dst_dim] += dst->dim[dst_dim]._stride;
@@ -2334,8 +2387,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
23342387
dst_index[dst_dim] = 0;
23352388
for (ptrdiff_t idx = 0; idx < extent_src; ++idx)
23362389
{
2337-
get_for_ref (ref, i, dst_index, mpi_token, dst, NULL,
2338-
ds, sr + array_offset_src * ref->item_size,
2390+
get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds, sr,
2391+
sr_byte_offset + array_offset_src * ref->item_size,
23392392
dst_kind, src_kind, dst_dim + 1, src_dim + 1,
23402393
1, stat, image_index);
23412394
dst_index[dst_dim] += dst->dim[dst_dim]._stride;
@@ -2344,8 +2397,8 @@ get_for_ref (caf_reference_t *ref, size_t *i, size_t *dst_index,
23442397
return;
23452398
case CAF_ARR_REF_SINGLE:
23462399
array_offset_src = ref->u.a.dim[src_dim].s.start;
2347-
get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds,
2348-
sr + array_offset_src * ref->item_size,
2400+
get_for_ref (ref, i, dst_index, mpi_token, dst, NULL, ds, sr,
2401+
sr_byte_offset + array_offset_src * ref->item_size,
23492402
dst_kind, src_kind, dst_dim, src_dim + 1, 1,
23502403
stat, image_index);
23512404
return;
@@ -2393,7 +2446,7 @@ _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
23932446
mpi_caf_token_t *mpi_token = (mpi_caf_token_t *) token;
23942447
void *local_memptr = mpi_token->local_memptr;
23952448
gfc_descriptor_t *src;
2396-
gfc_descriptor_t src_desc_data;
2449+
gfc_max_dim_descriptor_t src_desc_data, primary_src_desc_data;
23972450
caf_reference_t *riter = refs;
23982451
long delta;
23992452
/* Reallocation of dst.data is needed (e.g., array to small). */
@@ -2410,8 +2463,7 @@ _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
24102463
if (stat)
24112464
*stat = 0;
24122465

2413-
GET_REMOTE_DESC (mpi_token, src, src_desc_data, image_index - 1);
2414-
2466+
GET_REMOTE_DESC (mpi_token, src, primary_src_desc_data, image_index - 1);
24152467
/* Compute the size of the result. In the beginning size just counts the
24162468
number of elements. */
24172469
size = 1;
@@ -2423,7 +2475,7 @@ _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
24232475
if (riter->u.c.caf_token_offset)
24242476
{
24252477
mpi_token = *(mpi_caf_token_t**)
2426-
(local_memptr + riter->u.c.caf_token_offset);
2478+
(local_memptr + riter->u.c.caf_token_offset);
24272479
local_memptr = mpi_token->local_memptr;
24282480
GET_REMOTE_DESC (mpi_token, src, src_desc_data, image_index - 1);
24292481
}
@@ -2797,7 +2849,6 @@ _gfortran_caf_get_by_ref (caf_token_t token, int image_index,
27972849
dst->dim[dst_cur_dim]._stride = 1;
27982850
}
27992851
}
2800-
fprintf(stderr, "Mem to alloc: %d of %d\n", size, GFC_DESCRIPTOR_SIZE (dst));
28012852
dst->base_addr = malloc (size * GFC_DESCRIPTOR_SIZE (dst));
28022853
if (unlikely (dst->base_addr == NULL))
28032854
{
@@ -2809,11 +2860,11 @@ fprintf(stderr, "Mem to alloc: %d of %d\n", size, GFC_DESCRIPTOR_SIZE (dst));
28092860
/* Reset the token. */
28102861
mpi_token = (mpi_caf_token_t *) token;
28112862
local_memptr = mpi_token->local_memptr;
2812-
GET_REMOTE_DESC (mpi_token, src, src_desc_data, image_index - 1);
2863+
src = (gfc_descriptor_t *)&primary_src_desc_data;
28132864
memset(dst_index, 0, sizeof (dst_index));
28142865
i = 0;
28152866
get_for_ref (refs, &i, dst_index, mpi_token, dst, src,
2816-
dst->base_addr, local_memptr, dst_kind, src_kind, 0, 0,
2867+
dst->base_addr, local_memptr, 0, dst_kind, src_kind, 0, 0,
28172868
1, stat, image_index - 1);
28182869
}
28192870

0 commit comments

Comments
 (0)