summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTobias Burnus <burnus@net-b.de>2011-05-07 07:38:08 +0200
committerTobias Burnus <burnus@gcc.gnu.org>2011-05-07 07:38:08 +0200
commit6f4d39bb3f20a2bdf5e8767596557030241f9219 (patch)
tree5f68d70948ef0ed456c9d5d7318754f161728822
parent9142588a737852f26d123802a1df171ef4ee0893 (diff)
downloadgcc-6f4d39bb3f20a2bdf5e8767596557030241f9219.tar.gz
re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])
2011-05-07 Tobias Burnus <burnus@net-b.de> PR fortran/18918 PR fortran/48919 * trans.h: Move gfc_init_coarray_decl prototype ... * gfortran.h: ... to here. * parse.c (translate_all_program_units): Call * gfc_init_coarray_decl. (gfc_parse_file): Update translate_all_program_units call. * trans-decl.c (gfc_init_coarray_decl): Fix variable * declaration, new argument whether DECL_EXTERNAL should be used. (create_main_function): Update gfc_init_coarray_decl call. * trans-intrinsic.c (trans_this_image, trans_image_index, conv_intrinsic_cobound): Ditto. From-SVN: r173528
-rw-r--r--gcc/fortran/ChangeLog14
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/parse.c10
-rw-r--r--gcc/fortran/trans-decl.c42
-rw-r--r--gcc/fortran/trans-intrinsic.c10
-rw-r--r--gcc/fortran/trans.h3
6 files changed, 61 insertions, 19 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e80bfd34a8f..0a392c54412 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2011-05-07 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/18918
+ PR fortran/48919
+ * trans.h: Move gfc_init_coarray_decl prototype ...
+ * gfortran.h: ... to here.
+ * parse.c (translate_all_program_units): Call gfc_init_coarray_decl.
+ (gfc_parse_file): Update translate_all_program_units call.
+ * trans-decl.c (gfc_init_coarray_decl): Fix variable declaration,
+ new argument whether DECL_EXTERNAL should be used.
+ (create_main_function): Update gfc_init_coarray_decl call.
+ * trans-intrinsic.c (trans_this_image, trans_image_index,
+ conv_intrinsic_cobound): Ditto.
+
2011-05-06 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b127f6f50a3..92adf72e8af 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2851,6 +2851,7 @@ bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
/* trans.c */
void gfc_generate_code (gfc_namespace *);
void gfc_generate_module_code (gfc_namespace *);
+void gfc_init_coarray_decl (bool);
/* bbt.c */
typedef int (*compare_fn) (void *, void *);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index ff029bf18f7..80fcf001430 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4231,13 +4231,19 @@ clean_up_modules (gfc_gsymbol *gsym)
is active. 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)
+translate_all_program_units (gfc_namespace *gfc_global_ns_list,
+ bool main_in_tu)
{
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. */
@@ -4475,7 +4481,7 @@ prog_units:
}
/* Do the translation. */
- translate_all_program_units (gfc_global_ns_list);
+ translate_all_program_units (gfc_global_ns_list, seen_program);
termination:
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 63f03de5ae1..77e2a594ee2 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4454,10 +4454,16 @@ 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 (void)
+gfc_init_coarray_decl (bool main_tu)
{
- tree save_fn_decl = current_function_decl;
+ tree save_fn_decl;
if (gfc_option.coarray != GFC_FCOARRAY_LIB)
return;
@@ -4469,19 +4475,37 @@ gfc_init_coarray_decl (void)
current_function_decl = NULL_TREE;
push_cfun (cfun);
- gfort_gvar_caf_this_image = gfc_create_var (integer_type_node,
- PREFIX("caf_this_image"));
+ 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_STATIC (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 = gfc_create_var (integer_type_node,
- PREFIX("caf_num_images"));
+ 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_STATIC (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 ();
current_function_decl = save_fn_decl;
@@ -4575,7 +4599,7 @@ create_main_function (tree fndecl)
pppchar_type
= build_pointer_type (build_pointer_type (pchar_type_node));
- gfc_init_coarray_decl ();
+ gfc_init_coarray_decl (true);
tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_init, 4,
gfc_build_addr_expr (pint_type, argc),
gfc_build_addr_expr (pppchar_type, argv),
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 345b45082f9..fa5d3cfc5df 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -952,7 +952,7 @@ 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 ();
+ gfc_init_coarray_decl (false);
/* Argument-free version: THIS_IMAGE(). */
if (expr->value.function.actual->expr == NULL)
@@ -1252,7 +1252,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
num_images = build_int_cst (type, 1);
else
{
- gfc_init_coarray_decl ();
+ gfc_init_coarray_decl (false);
num_images = gfort_gvar_caf_num_images;
}
@@ -1272,7 +1272,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
static void
trans_num_images (gfc_se * se)
{
- gfc_init_coarray_decl ();
+ gfc_init_coarray_decl (false);
se->expr = gfort_gvar_caf_num_images;
}
@@ -1575,7 +1575,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
{
tree cosize;
- gfc_init_coarray_decl ();
+ gfc_init_coarray_decl (false);
cosize = gfc_conv_descriptor_cosize (desc, arg->expr->rank, corank);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1591,7 +1591,7 @@ 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 ();
+ gfc_init_coarray_decl (false);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
gfort_gvar_caf_num_images,
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 7bf58e493d6..2b06d80a942 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -449,9 +449,6 @@ bool gfc_get_module_backend_decl (gfc_symbol *);
/* Return the variable decl for a symbol. */
tree gfc_get_symbol_decl (gfc_symbol *);
-/* Initialize coarray global variables. */
-void gfc_init_coarray_decl (void);
-
/* Build a static initializer. */
tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool, bool);