summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog21
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/parse.c10
-rw-r--r--gcc/fortran/trans-decl.c77
-rw-r--r--gcc/fortran/trans-intrinsic.c41
-rw-r--r--gcc/fortran/trans-stmt.c5
-rw-r--r--gcc/fortran/trans-types.c15
-rw-r--r--gcc/fortran/trans.h6
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f9027
-rw-r--r--gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f9027
-rw-r--r--libgfortran/ChangeLog18
-rw-r--r--libgfortran/caf/libcaf.h17
-rw-r--r--libgfortran/caf/mpi.c40
-rw-r--r--libgfortran/caf/single.c36
15 files changed, 215 insertions, 131 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 356bb485d15..3502f489f22 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,26 @@
2014-04-30 Tobias Burnus <burnus@net-b.de>
+ * gfortran.h (gfc_init_coarray_decl): Remove.
+ * parse.c (translate_all_program_units): Remove call to it.
+ (gfc_parse_file): Update call.
+ * trans.h (gfor_fndecl_caf_this_image,
+ gfor_fndecl_caf_num_images): Add.
+ (gfort_gvar_caf_num_images,
+ gfort_gvar_caf_this_image): Remove.
+ * trans-decl.c (gfor_fndecl_caf_this_image,
+ gfor_fndecl_caf_num_images): Add.
+ (gfort_gvar_caf_num_images,
+ gfort_gvar_caf_this_image): Remove.
+ (gfc_build_builtin_function_decls): Init new decl.
+ (gfc_init_coarray_dec): Remove.
+ (create_main_function): Change calls.
+ * trans-intrinsic.c (trans_this_image, trans_image_index,
+ conv_intrinsic_cobound): Generate call to new library function
+ instead of to a static variable.
+ * trans-stmt.c (gfc_trans_sync): Ditto.
+
+2014-04-30 Tobias Burnus <burnus@net-b.de>
+
* trans-expr.c (get_tree_for_caf_expr): Fix handling of polymorphic
and derived-type coarrays.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f0eed809ab8..0707b58bd2b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2948,7 +2948,6 @@ bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
/* trans.c */
void gfc_generate_code (gfc_namespace *);
void gfc_generate_module_code (gfc_namespace *);
-void gfc_init_coarray_decl (bool);
/* trans-intrinsic.c */
bool gfc_inline_intrinsic_function_p (gfc_expr *);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0faf47a0041..77667150176 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4495,19 +4495,13 @@ clean_up_modules (gfc_gsymbol *gsym)
/* Translate all the program units. This could be in a different order
to resolution if there are forward references in the file. */
static void
-translate_all_program_units (gfc_namespace *gfc_global_ns_list,
- bool main_in_tu)
+translate_all_program_units (gfc_namespace *gfc_global_ns_list)
{
int errors;
gfc_current_ns = gfc_global_ns_list;
gfc_get_errors (NULL, &errors);
- /* If the main program is in the translation unit and we have
- -fcoarray=libs, generate the static variables. */
- if (gfc_option.coarray == GFC_FCOARRAY_LIB && main_in_tu)
- gfc_init_coarray_decl (true);
-
/* We first translate all modules to make sure that later parts
of the program can use the decl. Then we translate the nonmodules. */
@@ -4729,7 +4723,7 @@ prog_units:
}
/* Do the translation. */
- translate_all_program_units (gfc_global_ns_list, seen_program);
+ translate_all_program_units (gfc_global_ns_list);
gfc_end_source_files ();
return true;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cf7b661d8e9..c835a3b34de 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -121,6 +121,8 @@ tree gfor_fndecl_associated;
/* Coarray run-time library function decls. */
tree gfor_fndecl_caf_init;
tree gfor_fndecl_caf_finalize;
+tree gfor_fndecl_caf_this_image;
+tree gfor_fndecl_caf_num_images;
tree gfor_fndecl_caf_register;
tree gfor_fndecl_caf_deregister;
tree gfor_fndecl_caf_critical;
@@ -130,11 +132,6 @@ tree gfor_fndecl_caf_sync_images;
tree gfor_fndecl_caf_error_stop;
tree gfor_fndecl_caf_error_stop_str;
-/* Coarray global variables for num_images/this_image. */
-
-tree gfort_gvar_caf_num_images;
-tree gfort_gvar_caf_this_image;
-
/* Math functions. Many other math functions are handled in
trans-intrinsic.c. */
@@ -3247,6 +3244,14 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_caf_finalize = gfc_build_library_function_decl (
get_identifier (PREFIX("caf_finalize")), void_type_node, 0);
+ gfor_fndecl_caf_this_image = gfc_build_library_function_decl (
+ get_identifier (PREFIX("caf_this_image")), integer_type_node,
+ 1, integer_type_node);
+
+ gfor_fndecl_caf_num_images = gfc_build_library_function_decl (
+ get_identifier (PREFIX("caf_num_images")), integer_type_node,
+ 2, integer_type_node, boolean_type_node);
+
gfor_fndecl_caf_register = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_register")), "...WWW", pvoid_type_node, 6,
size_type_node, integer_type_node, ppvoid_type_node, pint_type,
@@ -5105,59 +5110,6 @@ add_argument_checking (stmtblock_t *block, gfc_symbol *sym)
}
-/* Generate the _gfortran_caf_this_image and _gfortran_caf_num_images
- global variables for -fcoarray=lib. They are placed into the translation
- unit of the main program. Make sure that in one TU (the one of the main
- program), the first call to gfc_init_coarray_decl is done with true.
- Otherwise, expect link errors. */
-
-void
-gfc_init_coarray_decl (bool main_tu)
-{
- if (gfc_option.coarray != GFC_FCOARRAY_LIB)
- return;
-
- if (gfort_gvar_caf_this_image || gfort_gvar_caf_num_images)
- return;
-
- push_cfun (cfun);
-
- gfort_gvar_caf_this_image
- = build_decl (input_location, VAR_DECL,
- get_identifier (PREFIX("caf_this_image")),
- integer_type_node);
- DECL_ARTIFICIAL (gfort_gvar_caf_this_image) = 1;
- TREE_USED (gfort_gvar_caf_this_image) = 1;
- TREE_PUBLIC (gfort_gvar_caf_this_image) = 1;
- TREE_READONLY (gfort_gvar_caf_this_image) = 0;
-
- if (main_tu)
- TREE_STATIC (gfort_gvar_caf_this_image) = 1;
- else
- DECL_EXTERNAL (gfort_gvar_caf_this_image) = 1;
-
- pushdecl_top_level (gfort_gvar_caf_this_image);
-
- gfort_gvar_caf_num_images
- = build_decl (input_location, VAR_DECL,
- get_identifier (PREFIX("caf_num_images")),
- integer_type_node);
- DECL_ARTIFICIAL (gfort_gvar_caf_num_images) = 1;
- TREE_USED (gfort_gvar_caf_num_images) = 1;
- TREE_PUBLIC (gfort_gvar_caf_num_images) = 1;
- TREE_READONLY (gfort_gvar_caf_num_images) = 0;
-
- if (main_tu)
- TREE_STATIC (gfort_gvar_caf_num_images) = 1;
- else
- DECL_EXTERNAL (gfort_gvar_caf_num_images) = 1;
-
- pushdecl_top_level (gfort_gvar_caf_num_images);
-
- pop_cfun ();
-}
-
-
static void
create_main_function (tree fndecl)
{
@@ -5237,7 +5189,7 @@ create_main_function (tree fndecl)
/* Call some libgfortran initialization routines, call then MAIN__(). */
- /* Call _gfortran_caf_init (*argc, ***argv, *this_image, *num_images). */
+ /* Call _gfortran_caf_init (*argc, ***argv). */
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
{
tree pint_type, pppchar_type;
@@ -5245,12 +5197,9 @@ create_main_function (tree fndecl)
pppchar_type
= build_pointer_type (build_pointer_type (pchar_type_node));
- gfc_init_coarray_decl (true);
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_init, 4,
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_init, 2,
gfc_build_addr_expr (pint_type, argc),
- gfc_build_addr_expr (pppchar_type, argv),
- gfc_build_addr_expr (pint_type, gfort_gvar_caf_this_image),
- gfc_build_addr_expr (pint_type, gfort_gvar_caf_num_images));
+ gfc_build_addr_expr (pppchar_type, argv));
gfc_add_expr_to_block (&body, tmp);
}
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 070b64ed975..e13c0dedd11 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -937,13 +937,13 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
/* The case -fcoarray=single is handled elsewhere. */
gcc_assert (gfc_option.coarray != GFC_FCOARRAY_SINGLE);
- gfc_init_coarray_decl (false);
-
/* Argument-free version: THIS_IMAGE(). */
if (expr->value.function.actual->expr == NULL)
{
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
+ integer_zero_node);
se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
- gfort_gvar_caf_this_image);
+ tmp);
return;
}
@@ -1039,9 +1039,10 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
*/
/* this_image () - 1. */
- tmp = fold_convert (type, gfort_gvar_caf_this_image);
- tmp = fold_build2_loc (input_location, MINUS_EXPR, type, tmp,
- build_int_cst (type, 1));
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image, 1,
+ integer_zero_node);
+ tmp = fold_build2_loc (input_location, MINUS_EXPR, type,
+ fold_convert (type, tmp), build_int_cst (type, 1));
if (corank == 1)
{
/* sub(1) = m + lcobound(corank). */
@@ -1244,8 +1245,10 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
num_images = build_int_cst (type, 1);
else
{
- gfc_init_coarray_decl (false);
- num_images = fold_convert (type, gfort_gvar_caf_num_images);
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
+ integer_zero_node,
+ build_int_cst (integer_type_node, -1));
+ num_images = fold_convert (type, tmp);
}
tmp = gfc_create_var (type, NULL);
@@ -1264,9 +1267,10 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
static void
trans_num_images (gfc_se * se)
{
- gfc_init_coarray_decl (false);
- se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
- gfort_gvar_caf_num_images);
+ tree tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images, 2,
+ integer_zero_node,
+ build_int_cst (integer_type_node, -1));
+ se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp);
}
@@ -1607,13 +1611,13 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
{
tree cosize;
- gfc_init_coarray_decl (false);
cosize = gfc_conv_descriptor_cosize (desc, arg->expr->rank, corank);
-
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
+ 2, integer_zero_node,
+ build_int_cst (integer_type_node, -1));
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
- fold_convert (gfc_array_index_type,
- gfort_gvar_caf_num_images),
+ fold_convert (gfc_array_index_type, tmp),
build_int_cst (gfc_array_index_type, 1));
tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
gfc_array_index_type, tmp,
@@ -1624,11 +1628,12 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
else if (gfc_option.coarray != GFC_FCOARRAY_SINGLE)
{
/* ubound = lbound + num_images() - 1. */
- gfc_init_coarray_decl (false);
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
+ 2, integer_zero_node,
+ build_int_cst (integer_type_node, -1));
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
- fold_convert (gfc_array_index_type,
- gfort_gvar_caf_num_images),
+ fold_convert (gfc_array_index_type, tmp),
build_int_cst (gfc_array_index_type, 1));
resbound = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, resbound, tmp);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 00c99fcfb5b..212a2586d2a 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -784,8 +784,11 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
else
{
tree cond2;
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
+ 2, integer_zero_node,
+ build_int_cst (integer_type_node, -1));
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
- images, gfort_gvar_caf_num_images);
+ images, tmp);
cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
images,
build_int_cst (TREE_TYPE (images), 1));
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 243feb7aedb..f69371288a9 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1303,7 +1303,14 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
{
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
- int n;
+ int n, corank;
+
+ /* Assumed-shape arrays do not have codimension information stored in the
+ descriptor. */
+ corank = as->corank;
+ if (as->type == AS_ASSUMED_SHAPE ||
+ (as->type == AS_ASSUMED_RANK && akind == GFC_ARRAY_ALLOCATABLE))
+ corank = 0;
if (as->type == AS_ASSUMED_RANK)
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
@@ -1322,14 +1329,14 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
ubound[n] = gfc_conv_array_bound (as->upper[n]);
}
- for (n = as->rank; n < as->rank + as->corank; n++)
+ for (n = as->rank; n < as->rank + corank; n++)
{
if (as->type != AS_DEFERRED && as->lower[n] == NULL)
lbound[n] = gfc_index_one_node;
else
lbound[n] = gfc_conv_array_bound (as->lower[n]);
- if (n < as->rank + as->corank - 1)
+ if (n < as->rank + corank - 1)
ubound[n] = gfc_conv_array_bound (as->upper[n]);
}
@@ -1341,7 +1348,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
: GFC_ARRAY_ASSUMED_RANK;
return gfc_get_array_type_bounds (type, as->rank == -1
? GFC_MAX_DIMENSIONS : as->rank,
- as->corank, lbound,
+ corank, lbound,
ubound, 0, akind, restricted);
}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index f8d29ecf2ec..13b0a000544 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -699,6 +699,8 @@ extern GTY(()) tree gfor_fndecl_associated;
/* Coarray run-time library function decls. */
extern GTY(()) tree gfor_fndecl_caf_init;
extern GTY(()) tree gfor_fndecl_caf_finalize;
+extern GTY(()) tree gfor_fndecl_caf_this_image;
+extern GTY(()) tree gfor_fndecl_caf_num_images;
extern GTY(()) tree gfor_fndecl_caf_register;
extern GTY(()) tree gfor_fndecl_caf_deregister;
extern GTY(()) tree gfor_fndecl_caf_critical;
@@ -708,10 +710,6 @@ extern GTY(()) tree gfor_fndecl_caf_sync_images;
extern GTY(()) tree gfor_fndecl_caf_error_stop;
extern GTY(()) tree gfor_fndecl_caf_error_stop_str;
-/* Coarray global variables for num_images/this_image. */
-extern GTY(()) tree gfort_gvar_caf_num_images;
-extern GTY(()) tree gfort_gvar_caf_this_image;
-
/* Math functions. Many other math functions are handled in
trans-intrinsic.c. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d1955b4eb05..74791d9155b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
2014-04-30 Tobias Burnus <burnus@net-b.de>
+ * gfortran.dg/coarray_lib_this_image_1.f90: New.
+ * gfortran.dg/coarray_lib_this_image_2.f90: New.
+
+2014-04-30 Tobias Burnus <burnus@net-b.de>
+
* gfortran.dg/coarray_poly_4.f90: New.
* gfortran.dg/coarray_poly_5.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90
new file mode 100644
index 00000000000..fe565165884
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_1.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+
+ implicit none
+ real :: x(2)[*]
+ call bar(x)
+contains
+ subroutine bar(x)
+ integer :: mylcobound, myucobound, mylbound, mythis_image
+ real :: x(2)[5:*]
+ mylcobound = lcobound(x,dim=1)
+ myucobound = ucobound(x,dim=1)
+ mylbound = lbound(x,dim=1)
+ mythis_image = this_image()
+ end subroutine bar
+end
+
+! { dg-final { scan-tree-dump-times "bar \\(real\\(kind=4\\)\\\[2\\\] \\* restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
+! { dg.final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "myucobound = \\(integer\\(kind=4\\)\\) \\(\\(\\(unsigned int\\) parm...dim\\\[1\\\].lbound \\+ \\(unsigned int\\) _gfortran_caf_num_images \\(0, -1\\)\\) \\+ 4294967295\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylbound = 1;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(x, caf_token.., 0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_init \\(&argc, &argv\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
new file mode 100644
index 00000000000..9219b2a6571
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+
+ implicit none
+ real :: x(2)[*]
+ call bar(x)
+contains
+ subroutine bar(x)
+ integer :: mylcobound, myucobound, mylbound, mythis_image
+ real :: x(:)[5:*]
+ mylcobound = lcobound(x,dim=1)
+ myucobound = ucobound(x,dim=1)
+ mylbound = lbound(x,dim=1)
+ mythis_image = this_image()
+ end subroutine bar
+end
+
+! { dg-final { scan-tree-dump-times "bar \\(struct array2_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "myucobound = \\(integer\\(kind=4\\)\\) \\(\\(\\(unsigned int\\) parm...dim\\\[1\\\].lbound \\+ \\(unsigned int\\) _gfortran_caf_num_images \\(0, -1\\)\\) \\+ 4294967295\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mylbound = parm...dim\\\[0\\\].stride >= 0 && parm...dim\\\[0\\\].ubound >= parm...dim\\\[0\\\].lbound \\|\\| parm...dim\\\[0\\\].stride < 0 \\? \\(integer\\(kind=4\\)\\) parm...dim\\\[0\\\].lbound : 1;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "mythis_image = _gfortran_caf_this_image \\(0\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=8\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=8\\)\\) x\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_init \\(&argc, &argv\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index dc37a861f02..e78a498c7f6 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,21 @@
+2014-04-30 Tobias Burnus <burnus@net-b.de>
+
+ * caf/libcaf.h (_gfortran_caf_this_image, _gfortran_caf_num_images):
+ New prototypes.
+ (_gfortran_caf_init): Change prototype.
+ (mpi_token_t): New typedef.
+ (TOKEN): New define.
+ * caf/mpi.c (_gfortran_caf_this_image, _gfortran_caf_num_images):
+ New functions.
+ (_gfortran_caf_init): Update.
+ (_gfortran_caf_finalize, _gfortran_caf_register,
+ _gfortran_caf_deregister): Use mpi_token_t.
+ * caf/single.c (_gfortran_caf_this_image, _gfortran_caf_num_images):
+ New functions.
+ (_gfortran_caf_init): Update.
+ (_gfortran_caf_finalize, _gfortran_caf_register,
+ _gfortran_caf_deregister): Use mpi_token_t, simplify.
+
2014-04-26 Jerry DeLisle <jvdelisle@gcc.gnu>
PR libfortran/52539
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 7ecd76fcecb..8b8fd3e2b8f 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -26,8 +26,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#ifndef LIBCAF_H
#define LIBCAF_H
+#include <stdbool.h>
+#include <stddef.h> /* For size_t. */
#include <stdint.h> /* For int32_t. */
-#include <stddef.h> /* For ptrdiff_t. */
#ifndef __GNUC__
#define __attribute__(x)
@@ -55,21 +56,25 @@ typedef enum caf_register_t {
}
caf_register_t;
+typedef void* caf_token_t;
+
/* Linked list of static coarrays registered. */
typedef struct caf_static_t {
- void **token;
+ caf_token_t token;
struct caf_static_t *prev;
}
caf_static_t;
-void _gfortran_caf_init (int *, char ***, int *, int *);
+void _gfortran_caf_init (int *, char ***);
void _gfortran_caf_finalize (void);
-void * _gfortran_caf_register (ptrdiff_t, caf_register_t, void ***, int *,
- char *, int);
-void _gfortran_caf_deregister (void ***, int *, char *, int);
+int _gfortran_caf_this_image (int);
+int _gfortran_caf_num_images (int, bool);
+void *_gfortran_caf_register (size_t, caf_register_t, caf_token_t *, int *,
+ char *, int);
+void _gfortran_caf_deregister (caf_token_t *, int *, char *, int);
void _gfortran_caf_sync_all (int *, char *, int);
void _gfortran_caf_sync_images (int, int[], int *, char *, int);
diff --git a/libgfortran/caf/mpi.c b/libgfortran/caf/mpi.c
index da7185ed09f..fe2baf4633c 100644
--- a/libgfortran/caf/mpi.c
+++ b/libgfortran/caf/mpi.c
@@ -34,6 +34,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
/* Define GFC_CAF_CHECK to enable run-time checking. */
/* #define GFC_CAF_CHECK 1 */
+typedef void ** mpi_token_t;
+#define TOKEN(X) ((mpi_token_t) (X))
static void error_stop (int error) __attribute__ ((noreturn));
@@ -73,7 +75,7 @@ caf_runtime_error (const char *message, ...)
libaray is initialized. */
void
-_gfortran_caf_init (int *argc, char ***argv, int *this_image, int *num_images)
+_gfortran_caf_init (int *argc, char ***argv)
{
if (caf_num_images == 0)
{
@@ -87,11 +89,6 @@ _gfortran_caf_init (int *argc, char ***argv, int *this_image, int *num_images)
MPI_Comm_rank (MPI_COMM_WORLD, &caf_this_image);
caf_this_image++;
}
-
- if (this_image)
- *this_image = caf_this_image;
- if (num_images)
- *num_images = caf_num_images;
}
@@ -104,8 +101,8 @@ _gfortran_caf_finalize (void)
{
caf_static_t *tmp = caf_static_list->prev;
- free (caf_static_list->token[caf_this_image-1]);
- free (caf_static_list->token);
+ free (TOKEN (caf_static_list->token)[caf_this_image-1]);
+ free (TOKEN (caf_static_list->token));
free (caf_static_list);
caf_static_list = tmp;
}
@@ -117,8 +114,23 @@ _gfortran_caf_finalize (void)
}
+int
+_gfortran_caf_this_image (int distance __attribute__ ((unused)))
+{
+ return caf_this_image;
+}
+
+
+int
+_gfortran_caf_num_images (int distance __attribute__ ((unused)),
+ bool failed __attribute__ ((unused)))
+{
+ return caf_num_images;
+}
+
+
void *
-_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
+_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
int *stat, char *errmsg, int errmsg_len)
{
void *local;
@@ -129,17 +141,17 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
/* Start MPI if not already started. */
if (caf_num_images == 0)
- _gfortran_caf_init (NULL, NULL, NULL, NULL);
+ _gfortran_caf_init (NULL, NULL);
/* Token contains only a list of pointers. */
local = malloc (size);
- *token = malloc (sizeof (void*) * caf_num_images);
+ *token = malloc (sizeof (mpi_token_t) * caf_num_images);
if (unlikely (local == NULL || *token == NULL))
goto error;
/* token[img-1] is the address of the token in image "img". */
- err = MPI_Allgather (&local, sizeof (void*), MPI_BYTE, *token,
+ err = MPI_Allgather (&local, sizeof (void*), MPI_BYTE, TOKEN (*token),
sizeof (void*), MPI_BYTE, MPI_COMM_WORLD);
if (unlikely (err))
@@ -192,7 +204,7 @@ error:
void
-_gfortran_caf_deregister (void ***token, int *stat, char *errmsg, int errmsg_len)
+_gfortran_caf_deregister (caf_token_t *token, int *stat, char *errmsg, int errmsg_len)
{
if (unlikely (caf_is_finalized))
{
@@ -220,7 +232,7 @@ _gfortran_caf_deregister (void ***token, int *stat, char *errmsg, int errmsg_len
if (stat)
*stat = 0;
- free ((*token)[caf_this_image-1]);
+ free (TOKEN (*token)[caf_this_image-1]);
free (*token);
}
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 551b9aa784d..cf1ced85d90 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -32,6 +32,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
/* Define GFC_CAF_CHECK to enable run-time checking. */
/* #define GFC_CAF_CHECK 1 */
+typedef void* single_token_t;
+#define TOKEN(X) ((single_token_t) (X))
+
/* Single-image implementation of the CAF library.
Note: For performance reasons -fcoarry=single should be used
rather than this library. */
@@ -57,11 +60,8 @@ caf_runtime_error (const char *message, ...)
void
_gfortran_caf_init (int *argc __attribute__ ((unused)),
- char ***argv __attribute__ ((unused)),
- int *this_image, int *num_images)
+ char ***argv __attribute__ ((unused)))
{
- *this_image = 1;
- *num_images = 1;
}
@@ -71,7 +71,6 @@ _gfortran_caf_finalize (void)
while (caf_static_list != NULL)
{
caf_static_t *tmp = caf_static_list->prev;
- free (caf_static_list->token[0]);
free (caf_static_list->token);
free (caf_static_list);
caf_static_list = tmp;
@@ -79,15 +78,29 @@ _gfortran_caf_finalize (void)
}
+int
+_gfortran_caf_this_image (int distance __attribute__ ((unused)))
+{
+ return 1;
+}
+
+
+int
+_gfortran_caf_num_images (int distance __attribute__ ((unused)),
+ bool failed __attribute__ ((unused)))
+{
+ return 1;
+}
+
+
void *
-_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
+_gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
int *stat, char *errmsg, int errmsg_len)
{
void *local;
local = malloc (size);
- *token = malloc (sizeof (void*) * 1);
- (*token)[0] = local;
+ *token = malloc (sizeof (single_token_t));
if (unlikely (local == NULL || token == NULL))
{
@@ -109,6 +122,8 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
caf_runtime_error (msg);
}
+ *token = local;
+
if (stat)
*stat = 0;
@@ -124,12 +139,11 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void ***token,
void
-_gfortran_caf_deregister (void ***token, int *stat,
+_gfortran_caf_deregister (caf_token_t *token, int *stat,
char *errmsg __attribute__ ((unused)),
int errmsg_len __attribute__ ((unused)))
{
- free ((*token)[0]);
- free (*token);
+ free (TOKEN(*token));
if (stat)
*stat = 0;
View Lorry Controller Status