aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog37
-rw-r--r--gcc/fortran/trans-array.c4
-rw-r--r--gcc/fortran/trans-decl.c180
-rw-r--r--gcc/fortran/trans-types.c7
-rw-r--r--gcc/fortran/trans.h3
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/registering_1.f9041
7 files changed, 264 insertions, 13 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e8a0084..79d4a25 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,30 @@
+2011-05-26 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/18918
+ * trans-array.c (gfc_conv_array_ref): Handle pointer coarrays.
+ * trans-decl.c (has_coarray_vars, caf_init_block,
+ gfor_fndecl_caf_register): New file-global variables.
+ (gfc_finish_var_decl): Make sure that coarrays in main are static.
+ (gfc_build_qualified_array): Generate coarray token variable.
+ (gfc_get_symbol_decl): Don't use a static initializer for coarrays.
+ (gfc_build_builtin_function_decls): Set gfor_fndecl_caf_register.
+ (gfc_trans_deferred_vars, gfc_emit_parameter_debug_info): Skip for
+ static coarrays.
+ (generate_local_decl): Check for local coarrays.
+ (create_main_function): SYNC ALL before calling MAIN.
+ (generate_coarray_sym_init): Register static coarray.
+ (generate_coarray_init): Generate CAF registering constructor
+ function.
+ (gfc_generate_function_code): Call it, if needed, do not create
+ cgraph twice.
+ (gfc_generate_module_vars, gfc_process_block_locals): Call
+ generate_coarray_init.
+ * trans-types.c (gfc_get_nodesc_array_type): Generate pointers for
+ -fcoarray=lib.
+ * trans.h (gfor_fndecl_caf_register): New variable.
+ (lang_type): New element caf_token.
+ (GFC_TYPE_ARRAY_CAF_TOKEN): New macro.
+
2011-05-24 Joseph Myers <joseph@codesourcery.com>
* Make-lang.in (GFORTRAN_D_OBJS): Remove prefix.o.
@@ -27,11 +54,11 @@
2011-05-20 Janne Blomqvist <jb@gcc.gnu.org>
- * gfortran.texi (set_fpe): Update documentation.
- * invoke.texi (-ffpe-trap): Likewise.
- * libgfortran.h (GFC_FPE_PRECISION): Rename to GFC_FPE_INEXACT.
- * options.c (gfc_handle_fpe_trap_option): Handle inexact and make
- precision an alias for it.
+ * gfortran.texi (set_fpe): Update documentation.
+ * invoke.texi (-ffpe-trap): Likewise.
+ * libgfortran.h (GFC_FPE_PRECISION): Rename to GFC_FPE_INEXACT.
+ * options.c (gfc_handle_fpe_trap_option): Handle inexact and make
+ precision an alias for it.
2011-05-19 Tobias Burnus <burnus@net-b.de>
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 78d65a6..29c7f83 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2623,6 +2623,10 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
if (ar->dimen == 0)
{
gcc_assert (ar->codimen);
+ if (GFC_ARRAY_TYPE_P (TREE_TYPE (se->expr))
+ && TREE_CODE (TREE_TYPE (se->expr)) == POINTER_TYPE)
+ se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+
/* Use the actual tree type and not the wrapped coarray. */
se->expr = fold_convert (TREE_TYPE (TREE_TYPE (se->expr)), se->expr);
return;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index d771484..299f224 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -78,6 +78,12 @@ static gfc_namespace *module_namespace;
static gfc_symbol* current_procedure_symbol = NULL;
+/* With -fcoarray=lib: For generating the registering call
+ of static coarrays. */
+static bool has_coarray_vars;
+static stmtblock_t caf_init_block;
+
+
/* List of static constructor functions. */
tree gfc_static_ctors;
@@ -114,6 +120,7 @@ tree gfor_fndecl_associated;
/* Coarray run-time library function decls. */
tree gfor_fndecl_caf_init;
tree gfor_fndecl_caf_finalize;
+tree gfor_fndecl_caf_register;
tree gfor_fndecl_caf_critical;
tree gfor_fndecl_caf_end_critical;
tree gfor_fndecl_caf_sync_all;
@@ -566,7 +573,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
SAVE_EXPLICIT. */
if (!sym->attr.use_assoc
&& (sym->attr.save != SAVE_NONE || sym->attr.data
- || (sym->value && sym->ns->proc_name->attr.is_main_program)))
+ || (sym->value && sym->ns->proc_name->attr.is_main_program)
+ || (gfc_option.coarray == GFC_FCOARRAY_LIB
+ && sym->attr.codimension && !sym->attr.allocatable)))
TREE_STATIC (decl) = 1;
if (sym->attr.volatile_)
@@ -745,6 +754,18 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
nest = (procns->proc_name->backend_decl != current_function_decl)
&& !sym->attr.contained;
+ if (sym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB
+ && GFC_TYPE_ARRAY_CAF_TOKEN (type) == NULL_TREE)
+ {
+ tree token;
+
+ token = gfc_create_var_np (pvoid_type_node, "caf_token");
+ GFC_TYPE_ARRAY_CAF_TOKEN (type) = token;
+ DECL_ARTIFICIAL (token) = 1;
+ TREE_STATIC (token) = 1;
+ gfc_add_decl_to_function (token);
+ }
+
for (dim = 0; dim < GFC_TYPE_ARRAY_RANK (type); dim++)
{
if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
@@ -1403,7 +1424,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
&& !(sym->attr.use_assoc && !intrinsic_array_parameter)
&& (sym->attr.save || sym->ns->proc_name->attr.is_main_program
|| gfc_option.flag_max_stack_var_size == 0
- || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE))
+ || sym->attr.data || sym->ns->proc_name->attr.flavor == FL_MODULE)
+ && (gfc_option.coarray != GFC_FCOARRAY_LIB || !sym->attr.codimension))
{
/* Add static initializer. For procedures, it is only needed if
SAVE is specified otherwise they need to be reinitialized
@@ -3025,6 +3047,11 @@ 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_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,
+ build_pointer_type (pchar_type_node), integer_type_node);
+
gfor_fndecl_caf_critical = gfc_build_library_function_decl (
get_identifier (PREFIX("caf_critical")), void_type_node, 0);
@@ -3458,7 +3485,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
gfc_trans_deferred_array (sym, block);
}
}
- else
+ else if (gfc_option.coarray != GFC_FCOARRAY_LIB)
{
gfc_save_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
@@ -3864,6 +3891,10 @@ gfc_create_module_variable (gfc_symbol * sym)
rest_of_decl_compilation (length, 1, 0);
}
}
+
+ if (sym->attr.codimension && !sym->attr.dummy && !sym->attr.allocatable
+ && sym->attr.referenced && !sym->attr.use_assoc)
+ has_coarray_vars = true;
}
/* Emit debug information for USE statements. */
@@ -4066,6 +4097,9 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym)
sym->attr.dimension, false))
return;
+ if (gfc_option.coarray == GFC_FCOARRAY_LIB && sym->attr.codimension)
+ return;
+
/* Create the decl for the variable or constant. */
decl = build_decl (input_location,
sym->attr.flavor == FL_PARAMETER ? CONST_DECL : VAR_DECL,
@@ -4087,6 +4121,120 @@ gfc_emit_parameter_debug_info (gfc_symbol *sym)
debug_hooks->global_decl (decl);
}
+
+static void
+generate_coarray_sym_init (gfc_symbol *sym)
+{
+ tree tmp, size, decl, token;
+
+ if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension
+ || sym->attr.use_assoc || !sym->attr.referenced)
+ return;
+
+ decl = sym->backend_decl;
+ TREE_USED(decl) = 1;
+ gcc_assert (GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
+
+ /* FIXME: Workaround for PR middle-end/49106, cf. also PR middle-end/49108
+ to make sure the variable is not optimized away. */
+ DECL_PRESERVE_P (DECL_CONTEXT (decl)) = 1;
+
+ size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (decl)));
+
+ if (GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)))
+ {
+ tmp = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (decl));
+ size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+ fold_convert (size_type_node, tmp),
+ fold_convert (size_type_node, size));
+ }
+
+ gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (decl)) != NULL_TREE);
+ token = gfc_build_addr_expr (ppvoid_type_node,
+ GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE(decl)));
+
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register, 6, size,
+ build_int_cst (integer_type_node, 0), /* type. */
+ token, null_pointer_node, /* token, stat. */
+ null_pointer_node, /* errgmsg, errmsg_len. */
+ build_int_cst (integer_type_node, 0));
+
+ gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), tmp));
+
+
+ /* Handle "static" initializer. */
+ if (sym->value)
+ {
+ sym->attr.pointer = 1;
+ tmp = gfc_trans_assignment (gfc_lval_expr_from_sym (sym), sym->value,
+ true, false);
+ sym->attr.pointer = 0;
+ gfc_add_expr_to_block (&caf_init_block, tmp);
+ }
+}
+
+
+/* Generate constructor function to initialize static, nonallocatable
+ coarrays. */
+
+static void
+generate_coarray_init (gfc_namespace * ns __attribute((unused)))
+{
+ tree fndecl, tmp, decl, save_fn_decl;
+
+ save_fn_decl = current_function_decl;
+ push_function_context ();
+
+ tmp = build_function_type_list (void_type_node, NULL_TREE);
+ fndecl = build_decl (input_location, FUNCTION_DECL,
+ create_tmp_var_name ("_caf_init"), tmp);
+
+ DECL_STATIC_CONSTRUCTOR (fndecl) = 1;
+ SET_DECL_INIT_PRIORITY (fndecl, DEFAULT_INIT_PRIORITY);
+
+ decl = build_decl (input_location, RESULT_DECL, NULL_TREE, void_type_node);
+ DECL_ARTIFICIAL (decl) = 1;
+ DECL_IGNORED_P (decl) = 1;
+ DECL_CONTEXT (decl) = fndecl;
+ DECL_RESULT (fndecl) = decl;
+
+ pushdecl (fndecl);
+ current_function_decl = fndecl;
+ announce_function (fndecl);
+
+ rest_of_decl_compilation (fndecl, 0, 0);
+ make_decl_rtl (fndecl);
+ init_function_start (fndecl);
+
+ pushlevel (0);
+ gfc_init_block (&caf_init_block);
+
+ gfc_traverse_ns (ns, generate_coarray_sym_init);
+
+ DECL_SAVED_TREE (fndecl) = gfc_finish_block (&caf_init_block);
+ decl = getdecls ();
+
+ poplevel (1, 0, 1);
+ BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
+
+ DECL_SAVED_TREE (fndecl)
+ = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
+ DECL_INITIAL (fndecl));
+ dump_function (TDI_original, fndecl);
+
+ cfun->function_end_locus = input_location;
+ set_cfun (NULL);
+
+ if (decl_function_context (fndecl))
+ (void) cgraph_create_node (fndecl);
+ else
+ cgraph_finalize_function (fndecl, true);
+
+ pop_function_context ();
+ current_function_decl = save_fn_decl;
+}
+
+
/* Generate all the required code for module variables. */
void
@@ -4101,9 +4249,14 @@ gfc_generate_module_vars (gfc_namespace * ns)
/* Generate COMMON blocks. */
gfc_trans_common (ns);
+ has_coarray_vars = false;
+
/* Create decls for all the module variables. */
gfc_traverse_ns (ns, gfc_create_module_variable);
+ if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+ generate_coarray_init (ns);
+
cur_module = NULL;
gfc_trans_use_stmts (ns);
@@ -4200,6 +4353,10 @@ generate_local_decl (gfc_symbol * sym)
{
if (sym->attr.flavor == FL_VARIABLE)
{
+ if (sym->attr.codimension && !sym->attr.dummy && !sym->attr.allocatable
+ && sym->attr.referenced && !sym->attr.use_assoc)
+ has_coarray_vars = true;
+
if (!sym->attr.dummy && !sym->ns->proc_name->attr.entry_master)
generate_dependency_declarations (sym);
@@ -4897,8 +5054,12 @@ gfc_generate_function_code (gfc_namespace * ns)
nonlocal_dummy_decls = NULL;
nonlocal_dummy_decl_pset = NULL;
+ has_coarray_vars = false;
generate_local_vars (ns);
+ if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+ generate_coarray_init (ns);
+
/* Keep the parent fake result declaration in module functions
or external procedures. */
if ((ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE)
@@ -5062,9 +5223,13 @@ gfc_generate_function_code (gfc_namespace * ns)
}
current_function_decl = old_context;
- if (decl_function_context (fndecl))
+ if (decl_function_context (fndecl) && !gfc_option.coarray == GFC_FCOARRAY_LIB
+ && has_coarray_vars)
/* Register this function with cgraph just far enough to get it
- added to our parent's nested function list. */
+ added to our parent's nested function list.
+ If there are static coarrays in this function, the nested _caf_init
+ function has already called cgraph_create_node, which also created
+ the cgraph node for this function. */
(void) cgraph_create_node (fndecl);
else
cgraph_finalize_function (fndecl, true);
@@ -5190,8 +5355,13 @@ gfc_process_block_locals (gfc_namespace* ns)
tree decl;
gcc_assert (saved_local_decls == NULL_TREE);
+ has_coarray_vars = false;
+
generate_local_vars (ns);
+ if (gfc_option.coarray == GFC_FCOARRAY_LIB && has_coarray_vars)
+ generate_coarray_init (ns);
+
decl = saved_local_decls;
while (decl)
{
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 1165926..9c4f5f6 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1542,13 +1542,13 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
if (as->rank == 0)
{
- if (packed != PACKED_STATIC)
+ if (packed != PACKED_STATIC || gfc_option.coarray == GFC_FCOARRAY_LIB)
type = build_pointer_type (type);
if (restricted)
type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
- if (packed != PACKED_STATIC)
+ if (packed != PACKED_STATIC || gfc_option.coarray == GFC_FCOARRAY_LIB)
{
GFC_ARRAY_TYPE_P (type) = 1;
TYPE_LANG_SPECIFIC (type) = TYPE_LANG_SPECIFIC (TREE_TYPE (type));
@@ -1596,7 +1596,8 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
DECL_ORIGINAL_TYPE (type_decl) = gtype;
}
- if (packed != PACKED_STATIC || !known_stride)
+ if (packed != PACKED_STATIC || !known_stride
+ || (as->corank && gfc_option.coarray == GFC_FCOARRAY_LIB))
{
/* For dummy arrays and automatic (heap allocated) arrays we
want a pointer to the array. */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 2b06d80..95cd9fb 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -617,6 +617,7 @@ 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_register;
extern GTY(()) tree gfor_fndecl_caf_critical;
extern GTY(()) tree gfor_fndecl_caf_end_critical;
extern GTY(()) tree gfor_fndecl_caf_sync_all;
@@ -722,6 +723,7 @@ struct GTY((variable_size)) lang_type {
tree span;
tree base_decl[2];
tree nonrestricted_type;
+ tree caf_token;
};
struct GTY((variable_size)) lang_decl {
@@ -766,6 +768,7 @@ struct GTY((variable_size)) lang_decl {
(TYPE_LANG_SPECIFIC(node)->stride[dim])
#define GFC_TYPE_ARRAY_RANK(node) (TYPE_LANG_SPECIFIC(node)->rank)
#define GFC_TYPE_ARRAY_CORANK(node) (TYPE_LANG_SPECIFIC(node)->corank)
+#define GFC_TYPE_ARRAY_CAF_TOKEN(node) (TYPE_LANG_SPECIFIC(node)->caf_token)
#define GFC_TYPE_ARRAY_SIZE(node) (TYPE_LANG_SPECIFIC(node)->size)
#define GFC_TYPE_ARRAY_OFFSET(node) (TYPE_LANG_SPECIFIC(node)->offset)
#define GFC_TYPE_ARRAY_AKIND(node) (TYPE_LANG_SPECIFIC(node)->akind)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7e71ee2..eec8fa7 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2011-05-26 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/18918
+ * gfortran.dg/coarray/registering_1.f90: New.
+
2011-05-26 Jason Merrill <jason@redhat.com>
* g++.dg/cpp0x/variadic111.C: New.
diff --git a/gcc/testsuite/gfortran.dg/coarray/registering_1.f90 b/gcc/testsuite/gfortran.dg/coarray/registering_1.f90
new file mode 100644
index 0000000..a18ba61
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/registering_1.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! PR fortran/18918
+!
+! Check whether registering coarrays works
+!
+module m
+ integer :: a(1)[*] = 7
+end module m
+
+use m
+if (any (a /= 7)) call abort()
+a = 88
+if (any (a /= 88)) call abort()
+
+ block
+ integer :: b[*] = 8494
+ if (b /= 8494) call abort()
+ end block
+
+if (any (a /= 88)) call abort()
+call test ()
+end
+
+subroutine test()
+ real :: z[*] = sqrt(2.0)
+ if (z /= sqrt(2.0)) call abort()
+ call sub1()
+contains
+ subroutine sub1
+ real :: r[4,*] = -1
+ if (r /= -1) call abort
+ r = 10
+ if (r /= 10) call abort
+ end subroutine sub1
+
+ subroutine uncalled()
+ integer :: not_refed[2:*] = 784
+ if (not_refed /= 784) call abort()
+ end subroutine uncalled
+end subroutine test
generated by cgit v1.1 at 2025-04-09 07:04:13 +0000