The current coarray implementation uses a global static variable for
this_image() and num_images(), which is set by the CAF init function,
which is called by before the Fortran main function.
I somehow had the thinko that this permits for better optimizations than
a library call. However, global variables are not really optimization
friendly and I failed to come up with a scenario, where a global
variable works better.
In addition, there are two problems with a global variable: If the code
uses coarrays in a library but no in the main code (e.g. the main
program is written in C), the variable won't be initialized at all.
And the second problem relates to the upcoming Technical Specification
(TS) 18508 on Additional Parallel Features in Fortran. That TS
introduces teams - and calling this_image() from within a team will give
a different result to this_image(distance=1), which applies to the
parent's team.
Hence, the attached patch adds a this_image() and num_images() library
function. As the library is only build statically and -fcoarray=lib is
not widely used due to lacking communication support, I wouldn't count
this patch as real ABI break and there shouldn't be a problem from that
side.
I do include the distance= argument for both intrinsics and for
num_images also a failed= argument. Those have been proposed in TS18508.
I think it makes sense to prepare for that TS - if it won't be accepted,
one can still remove it (cf. argument above). Regarding the failed: One
needs to support three states: Unset (-1, all images); set to .false.
(0, all nonfailed images), and .true. (1, all failed images).
Additionally, I have changed the "size" argument to the unsigned size_t,
which matches both the current type in the front-end and the
conventional type for malloc calls.
Built and currently regtesting on x86-64-gnu-linux. When successful:
OK for the trunk? (It should be localized enough for 4.9 but 4.10 is
probably more appropriate.)
Tobias
PS: Regarding TS18508: My impression is that the current draft (14-130 /
N2007) is quite well shaped and will be accepted with only minor
modifications. There will be soon a WG5 letter ballot, after which it
should be even clearer where the standard is heading to.
PPS: I intent to create an SVN branch to collect the coarray changes.
gcc/fortran/
2014-03-07 Tobias Burnus <bur...@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.
libgfortran/
2014-03-07 Tobias Burnus <bur...@net-b.de>
* caf/libcaf.h (_gfortran_caf_this_image, _gfortran_caf_num_images):
New prototypes.
(_gfortran_caf_init): Change prototype.
* caf/mpi.c (_gfortran_caf_this_image, _gfortran_caf_num_images):
New functions.
(_gfortran_caf_init): Update.
* caf/single.c (_gfortran_caf_this_image, _gfortran_caf_num_images):
New functions.
(_gfortran_caf_init): Update.
gcc/fortran/gfortran.h | 1 -
gcc/fortran/parse.c | 10 ++----
gcc/fortran/trans-decl.c | 77 ++++++++-----------------------------------
gcc/fortran/trans-intrinsic.c | 41 +++++++++++++----------
gcc/fortran/trans-stmt.c | 5 ++-
gcc/fortran/trans.h | 6 ++--
libgfortran/caf/libcaf.h | 9 +++--
libgfortran/caf/mpi.c | 22 +++++++++----
libgfortran/caf/single.c | 22 ++++++++++---
9 files changed, 83 insertions(+), 110 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cd2a913..ccdba35 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2947,7 +2947,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 d9af60e..c55a02e 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4496,19 +4496,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. */
@@ -4730,7 +4724,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 cf7b661..b124c7ca 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_this_image")), 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 75bd20a..31883ee 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). */
@@ -1245,8 +1246,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);
@@ -1265,9 +1268,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);
}
@@ -1608,13 +1612,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,
@@ -1625,11 +1629,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 c7ff7a8..91d5a63 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.h b/gcc/fortran/trans.h
index 5fb0cbf..13719c2 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -694,6 +694,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;
@@ -703,10 +705,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/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 7ecd76f..7acf4ae 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -27,7 +27,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#define LIBCAF_H
#include <stdint.h> /* For int32_t. */
-#include <stddef.h> /* For ptrdiff_t. */
+#include <stddef.h> /* For size_t. */
#ifndef __GNUC__
#define __attribute__(x)
@@ -63,10 +63,13 @@ typedef struct caf_static_t {
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 *,
+int _gfortran_caf_this_image (int);
+int _gfortran_caf_num_images (int, int);
+
+void * _gfortran_caf_register (size_t, caf_register_t, void ***, int *,
char *, int);
void _gfortran_caf_deregister (void ***, int *, char *, int);
diff --git a/libgfortran/caf/mpi.c b/libgfortran/caf/mpi.c
index da7185e..fcf8fb6 100644
--- a/libgfortran/caf/mpi.c
+++ b/libgfortran/caf/mpi.c
@@ -87,11 +87,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;
}
@@ -117,8 +112,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)),
+ int 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, void ***token,
int *stat, char *errmsg, int errmsg_len)
{
void *local;
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 551b9aa..300e19d 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -57,11 +57,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;
}
@@ -79,8 +76,23 @@ _gfortran_caf_finalize (void)
}
+int
+_gfortran_caf_this_image(int distance __attribute__ ((unused)))
+{
+ return 1;
+}
+
+
+int
+_gfortran_caf_num_images(int distance __attribute__ ((unused)),
+ int 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, void ***token,
int *stat, char *errmsg, int errmsg_len)
{
void *local;
