gcc/fortran/
2014-03-07 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.
libgfortran/
2014-03-07 Tobias Burnus <burnus@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(-)
@@ -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 *);
@@ -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;
@@ -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);
}
@@ -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);
@@ -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));
@@ -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. */
@@ -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);
@@ -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;
@@ -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;