Skip to content

Commit 8e7fd62

Browse files
vehrezbeekman
vehre
authored and
zbeekman
committed
Adding basic async allocatable component support.
(cherry picked from commit 49bf756)
1 parent 635f4db commit 8e7fd62

File tree

2 files changed

+183
-63
lines changed

2 files changed

+183
-63
lines changed

‎src/libcaf.h

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -73,10 +73,20 @@ typedef enum caf_register_t {
7373
CAF_REGTYPE_LOCK_ALLOC,
7474
CAF_REGTYPE_CRITICAL,
7575
CAF_REGTYPE_EVENT_STATIC,
76-
CAF_REGTYPE_EVENT_ALLOC
76+
CAF_REGTYPE_EVENT_ALLOC,
77+
CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY,
78+
CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY
7779
}
7880
caf_register_t;
7981

82+
/* Describes the action to take on _caf_deregister. Keep in sync with
83+
gcc/fortran/trans.h. */
84+
typedef enum caf_deregister_t {
85+
CAF_DEREGTYPE_COARRAY_DEREGISTER,
86+
CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY
87+
}
88+
caf_deregister_t;
89+
8090
typedef void* caf_token_t;
8191

8292

@@ -203,11 +213,12 @@ int PREFIX (num_images) (int, int);
203213
#ifdef GCC_GE_7
204214
void PREFIX (register) (size_t, caf_register_t, caf_token_t *,
205215
gfc_descriptor_t *, int *, char *, int);
216+
void PREFIX (deregister) (caf_token_t *, int, int *, char *, int);
206217
#else
207218
void * PREFIX (register) (size_t, caf_register_t, caf_token_t *,
208219
int *, char *, int);
209-
#endif
210220
void PREFIX (deregister) (caf_token_t *, int *, char *, int);
221+
#endif
211222

212223
void PREFIX (caf_get) (caf_token_t, size_t, int, gfc_descriptor_t *,
213224
caf_vector_t *, gfc_descriptor_t *, int, int, int);

‎src/mpi/mpi_caf.c

Lines changed: 170 additions & 61 deletions
Original file line numberDiff line numberDiff line change
@@ -124,6 +124,20 @@ int (*foo_int32_t)(void *, void *);
124124
float (*foo_float)(void *, void *);
125125
double (*foo_double)(void *, void *);
126126

127+
#ifdef CAF_MPI_LOCK_UNLOCK
128+
#define CAF_Win_lock(type, img, win) MPI_Win_lock (type, img, 0, win)
129+
#define CAF_Win_unlock(img, win) MPI_Win_unlock (img, win)
130+
#define CAF_Win_lock_all(win)
131+
#else //CAF_MPI_LOCK_UNLOCK
132+
#define CAF_Win_lock(type, img, win)
133+
#define CAF_Win_unlock(img, win) MPI_Win_flush (img, win)
134+
#if MPI_VERSION >= 3
135+
#define CAF_Win_lock_all(win) MPI_Win_lock_all (MPI_MODE_NOCHECK, win)
136+
#else
137+
#define CAF_Win_lock_all(win)
138+
#endif
139+
#endif //CAF_MPI_LOCK_UNLOCK
140+
127141
#define MIN(X, Y) (((X) < (Y)) ? (X) : (Y))
128142

129143
#if defined(NONBLOCKING_PUT) && !defined(CAF_MPI_LOCK_UNLOCK)
@@ -492,16 +506,138 @@ PREFIX (num_images)(int distance __attribute__ ((unused)),
492506

493507

494508
#ifdef GCC_GE_7
495-
#ifdef COMPILER_SUPPORTS_CAF_INTRINSICS
496509
void
497-
_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
498-
gfc_descriptor_t *desc, int *stat, char *errmsg, int errmsg_len)
499-
#else
500-
void
501-
PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
502-
gfc_descriptor_t *desc, int *stat, char *errmsg, int errmsg_len)
503-
#endif
504-
#else
510+
PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
511+
gfc_descriptor_t *desc, int *stat, char *errmsg,
512+
int errmsg_len)
513+
{
514+
/* int ierr; */
515+
void *mem;
516+
size_t actual_size;
517+
int l_var=0, *init_array=NULL;
518+
519+
if (unlikely (caf_is_finalized))
520+
goto error;
521+
522+
/* Start GASNET if not already started. */
523+
if (caf_num_images == 0)
524+
PREFIX (init) (NULL, NULL);
525+
526+
if(type == CAF_REGTYPE_LOCK_STATIC || type == CAF_REGTYPE_LOCK_ALLOC ||
527+
type == CAF_REGTYPE_CRITICAL || type == CAF_REGTYPE_EVENT_STATIC ||
528+
type == CAF_REGTYPE_EVENT_ALLOC)
529+
{
530+
actual_size = size * sizeof(int);
531+
l_var = 1;
532+
}
533+
else
534+
actual_size = size;
535+
536+
mpi_caf_token_t *mpi_token;
537+
MPI_Win *p;
538+
if (!(type == CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY
539+
|| (type == CAF_REGTYPE_COARRAY_ALLOC && *token != NULL)))
540+
*token = malloc (sizeof (mpi_caf_token_t));
541+
542+
mpi_token = (mpi_caf_token_t *) *token;
543+
p = TOKEN(mpi_token);
544+
fprintf (stderr, "%d: _caf_register(type = %d, token = %p)!\n", caf_this_image, type, *token);
545+
546+
if (type == CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY
547+
|| type == CAF_REGTYPE_COARRAY_ALLOC
548+
|| type == CAF_REGTYPE_COARRAY_STATIC)
549+
{
550+
if (GFC_DESCRIPTOR_RANK (desc) == 0)
551+
mpi_token->desc = NULL;
552+
else
553+
{
554+
int ierr;
555+
size_t desc_size = sizeof (gfc_descriptor_t) + /*GFC_DESCRIPTOR_RANK (desc)*/
556+
GFC_MAX_DIMENSIONS * sizeof (descriptor_dimension);
557+
mpi_token->desc = (MPI_Win *)malloc (sizeof (MPI_Win));
558+
ierr = MPI_Win_create (desc, desc_size, 1, mpi_info_same_size,
559+
CAF_COMM_WORLD, mpi_token->desc);
560+
CAF_Win_lock_all (*(mpi_token->desc));
561+
}
562+
}
563+
564+
#if MPI_VERSION >= 3
565+
if (type != CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)
566+
{
567+
fprintf (stderr, "%d: Adding memory to token %p, desc = %p.\n",
568+
caf_this_image, token, mpi_token->desc);
569+
MPI_Win_allocate (actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, &mem, p);
570+
CAF_Win_lock_all (*p);
571+
}
572+
else
573+
mem = NULL;
574+
#else // MPI_VERSION
575+
MPI_Alloc_mem(actual_size, MPI_INFO_NULL, &mem);
576+
MPI_Win_create(mem, actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, p);
577+
#endif // MPI_VERSION
578+
579+
if(l_var)
580+
{
581+
init_array = (int *)calloc(size, sizeof(int));
582+
CAF_Win_lock (MPI_LOCK_EXCLUSIVE, caf_this_image - 1, *p);
583+
MPI_Put (init_array, size, MPI_INT, caf_this_image-1,
584+
0, size, MPI_INT, *p);
585+
CAF_Win_unlock (caf_this_image - 1, *p);
586+
free(init_array);
587+
}
588+
589+
if (type != CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)
590+
{
591+
PREFIX(sync_all) (NULL,NULL,0);
592+
593+
caf_static_t *tmp = malloc (sizeof (caf_static_t));
594+
tmp->prev = caf_tot;
595+
tmp->token = *token;
596+
caf_tot = tmp;
597+
}
598+
599+
if (type == CAF_REGTYPE_COARRAY_STATIC)
600+
{
601+
caf_static_t *tmp = malloc (sizeof (caf_static_t));
602+
tmp->prev = caf_static_list;
603+
tmp->token = *token;
604+
caf_static_list = tmp;
605+
}
606+
607+
if (stat)
608+
*stat = 0;
609+
610+
/* The descriptor will be initialized only after the call to register. */
611+
mpi_token->local_memptr = mem;
612+
desc->base_addr = mem;
613+
return;
614+
615+
error:
616+
{
617+
char *msg;
618+
619+
if (caf_is_finalized)
620+
msg = "Failed to allocate coarray - there are stopped images";
621+
else
622+
msg = "Failed to allocate coarray";
623+
624+
if (stat)
625+
{
626+
*stat = caf_is_finalized ? STAT_STOPPED_IMAGE : 1;
627+
if (errmsg_len > 0)
628+
{
629+
int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len
630+
: (int) strlen (msg);
631+
memcpy (errmsg, msg, len);
632+
if (errmsg_len > len)
633+
memset (&errmsg[len], ' ', errmsg_len-len);
634+
}
635+
}
636+
else
637+
caf_runtime_error (msg);
638+
}
639+
}
640+
#else // GCC_GE_7
505641
#ifdef COMPILER_SUPPORTS_CAF_INTRINSICS
506642
void *
507643
_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
@@ -511,7 +647,6 @@ void *
511647
PREFIX (register) (size_t size, caf_register_t type, caf_token_t *token,
512648
int *stat, char *errmsg, int errmsg_len)
513649
#endif
514-
#endif
515650
{
516651
/* int ierr; */
517652
void *mem;
@@ -539,36 +674,12 @@ void *
539674
else
540675
actual_size = size;
541676

542-
#ifdef GCC_GE_7
543-
*token = malloc (sizeof (mpi_caf_token_t));
544-
mpi_caf_token_t *mpi_token = (mpi_caf_token_t *) *token;
545-
MPI_Win *p = TOKEN(mpi_token);
546-
if (GFC_DESCRIPTOR_RANK (desc) == 0)
547-
mpi_token->desc = NULL;
548-
else
549-
{
550-
int ierr;
551-
size_t desc_size = sizeof (gfc_descriptor_t) + /*GFC_DESCRIPTOR_RANK (desc)*/
552-
GFC_MAX_DIMENSIONS * sizeof (descriptor_dimension);
553-
mpi_token->desc = (MPI_Win *)malloc (sizeof (MPI_Win));
554-
ierr = MPI_Win_create (desc, desc_size, 1, mpi_info_same_size,
555-
CAF_COMM_WORLD, mpi_token->desc);
556-
#if MPI_VERSION >= 3 && !defined(CAF_MPI_LOCK_UNLOCK)
557-
MPI_Win_lock_all(MPI_MODE_NOCHECK, *(mpi_token->desc));
558-
# endif
559-
}
560-
#else
561677
/* Token contains only a list of pointers. */
562678
*token = malloc (sizeof(MPI_Win));
563679
MPI_Win *p = *token;
564-
#endif
565680

566681
#if MPI_VERSION >= 3
567-
#ifdef GCC_GE_7
568-
MPI_Win_allocate(actual_size, 1, MPI_INFO_NULL, CAF_COMM_WORLD, &mem, p);
569-
#else
570682
MPI_Win_allocate(actual_size, 1, mpi_info_same_size, CAF_COMM_WORLD, &mem, p);
571-
#endif
572683
# ifndef CAF_MPI_LOCK_UNLOCK
573684
MPI_Win_lock_all(MPI_MODE_NOCHECK, *p);
574685
# endif // CAF_MPI_LOCK_UNLOCK
@@ -602,7 +713,7 @@ void *
602713

603714
if (type == CAF_REGTYPE_COARRAY_STATIC)
604715
{
605-
tmp = malloc (sizeof (caf_static_t));
716+
caf_static_t *tmp = malloc (sizeof (caf_static_t));
606717
tmp->prev = caf_static_list;
607718
tmp->token = *token;
608719
caf_static_list = tmp;
@@ -611,14 +722,7 @@ void *
611722
if (stat)
612723
*stat = 0;
613724

614-
#ifdef GCC_GE_7
615-
/* The descriptor will be initialized only after the call to register. */
616-
mpi_token->local_memptr = mem;
617-
desc->base_addr = mem;
618-
return;
619-
#else
620725
return mem;
621-
#endif
622726

623727
error:
624728
{
@@ -644,17 +748,24 @@ void *
644748
else
645749
caf_runtime_error (msg);
646750
}
647-
#ifndef GCC_GE_7
648751
return NULL;
649-
#endif
650752
}
753+
#endif
651754

652755

756+
#ifdef GCC_GE_7
757+
void
758+
PREFIX (deregister) (caf_token_t *token, int type, int *stat, char *errmsg,
759+
int errmsg_len)
760+
#else
653761
void
654762
PREFIX (deregister) (caf_token_t *token, int *stat, char *errmsg, int errmsg_len)
763+
#endif
655764
{
656765
/* int ierr; */
657766

767+
fprintf (stderr, "%d: deregistering token = %p, type = %d.\n", caf_this_image,
768+
*token, type);
658769
if (unlikely (caf_is_finalized))
659770
{
660771
const char msg[] = "Failed to deallocate coarray - "
@@ -691,17 +802,24 @@ PREFIX (deregister) (caf_token_t *token, int *stat, char *errmsg, int errmsg_len
691802
# ifndef CAF_MPI_LOCK_UNLOCK
692803
MPI_Win_unlock_all(*p);
693804
# endif // CAF_MPI_LOCK_UNLOCK
694-
MPI_Win_free(p);
695805
#ifdef GCC_GE_7
696-
if ((*(mpi_caf_token_t **)token)->desc)
806+
mpi_caf_token_t *mpi_token = *(mpi_caf_token_t **)token;
807+
if (mpi_token->local_memptr)
808+
{
809+
MPI_Win_free(p);
810+
mpi_token->local_memptr = NULL;
811+
}
812+
if ((*(mpi_caf_token_t **)token)->desc
813+
&& type != CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY)
697814
{
698-
mpi_caf_token_t *mpi_token = *(mpi_caf_token_t **)token;
699815
# ifndef CAF_MPI_LOCK_UNLOCK
700816
MPI_Win_unlock_all(*(mpi_token->desc));
701817
# endif // CAF_MPI_LOCK_UNLOCK
702818
MPI_Win_free (mpi_token->desc);
703819
free (mpi_token->desc);
704820
}
821+
#else
822+
MPI_Win_free(p);
705823
#endif
706824

707825
if(prev)
@@ -1965,15 +2083,6 @@ convert_type (void *dst, int dst_type, int dst_kind, void *src, int src_type,
19652083
}
19662084

19672085

1968-
#ifdef CAF_MPI_LOCK_UNLOCK
1969-
#define CAF_Win_lock(img, win) MPI_Win_lock (MPI_LOCK_SHARED, img, 0, win)
1970-
#define CAF_Win_unlock(img, win) MPI_Win_unlock (img, win)
1971-
#else //CAF_MPI_LOCK_UNLOCK
1972-
#define CAF_Win_lock(img, win)
1973-
#define CAF_Win_unlock(img, win) MPI_Win_flush (img, win)
1974-
#endif //CAF_MPI_LOCK_UNLOCK
1975-
1976-
19772086
static void
19782087
copy_data (void *ds, mpi_caf_token_t *token, ptrdiff_t offset, int dst_type,
19792088
int src_type, int dst_kind, int src_kind, size_t dst_size,
@@ -1983,7 +2092,7 @@ copy_data (void *ds, mpi_caf_token_t *token, ptrdiff_t offset, int dst_type,
19832092
if (dst_type == src_type && dst_kind == src_kind)
19842093
{
19852094
size_t sz = (dst_size > src_size ? src_size : dst_size) * num;
1986-
CAF_Win_lock (image_index, token->memptr);
2095+
CAF_Win_lock (MPI_LOCK_SHARED, image_index, token->memptr);
19872096
MPI_Get (ds, sz, MPI_BYTE, image_index, offset, sz, MPI_BYTE,
19882097
token->memptr);
19892098
CAF_Win_unlock (image_index, token->memptr);
@@ -2001,7 +2110,7 @@ copy_data (void *ds, mpi_caf_token_t *token, ptrdiff_t offset, int dst_type,
20012110
{
20022111
/* Get the required amount of memory on the stack. */
20032112
void *srh = alloca (src_size);
2004-
CAF_Win_lock (image_index, token->memptr);
2113+
CAF_Win_lock (MPI_LOCK_SHARED, image_index, token->memptr);
20052114
MPI_Get (srh, src_size, MPI_BYTE, image_index, offset,
20062115
src_size, MPI_BYTE, token->memptr);
20072116
CAF_Win_unlock (image_index, token->memptr);
@@ -2011,7 +2120,7 @@ copy_data (void *ds, mpi_caf_token_t *token, ptrdiff_t offset, int dst_type,
20112120
{
20122121
/* Get the required amount of memory on the stack. */
20132122
void *srh = alloca (src_size);
2014-
CAF_Win_lock (image_index, token->memptr);
2123+
CAF_Win_lock (MPI_LOCK_SHARED, image_index, token->memptr);
20152124
MPI_Get (srh, src_size, MPI_BYTE, image_index, offset,
20162125
src_size, MPI_BYTE, token->memptr);
20172126
CAF_Win_unlock (image_index, token->memptr);
@@ -2021,7 +2130,7 @@ copy_data (void *ds, mpi_caf_token_t *token, ptrdiff_t offset, int dst_type,
20212130
{
20222131
/* Get the required amount of memory on the stack. */
20232132
void *srh = alloca (src_size * num);
2024-
CAF_Win_lock (image_index, token->memptr);
2133+
CAF_Win_lock (MPI_LOCK_SHARED, image_index, token->memptr);
20252134
MPI_Get (srh, src_size * num, MPI_BYTE, image_index, offset,
20262135
src_size * num, MPI_BYTE, token->memptr);
20272136
CAF_Win_unlock (image_index, token->memptr);
@@ -2054,7 +2163,7 @@ copy_data (void *ds, mpi_caf_token_t *token, ptrdiff_t offset, int dst_type,
20542163
size_t desc_size = sizeof (gfc_descriptor_t) + GFC_MAX_DIMENSIONS /* rank */ \
20552164
* sizeof (descriptor_dimension); \
20562165
int err; \
2057-
CAF_Win_lock (image_index, *(mpi_token->desc)); \
2166+
CAF_Win_lock (MPI_LOCK_SHARED, image_index, *(mpi_token->desc)); \
20582167
MPI_Get (&src_desc_data, desc_size, MPI_BYTE, \
20592168
image_index, 0, desc_size, MPI_BYTE, *(mpi_token->desc)); \
20602169
err = CAF_Win_unlock (image_index, *(mpi_token->desc)); \

0 commit comments

Comments
 (0)