summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorTobias Burnus <tobias@codesourcery.com>2019-10-11 09:17:49 +0000
committerTobias Burnus <burnus@gcc.gnu.org>2019-10-11 11:17:49 +0200
commit08c14aaaab2b01f1a31989a8d94bae312d87c8f7 (patch)
tree57787b2cb0e1cad4b4370339157e8b47155b5e12 /gcc
parentb67e2ad80d3e080c5258ff64ddb6f40e8d783e0b (diff)
[OpenMP,Fortran] Fix several OpenMP use_device_addr/map/update errors
gcc/fortran/ * f95-lang.c (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Re-define to gfc_omp_is_allocatable_or_ptr. * trans-decl.c (create_function_arglist): Set GFC_DECL_OPTIONAL_ARGUMENT only if not passed by value. * trans-openmp.c (gfc_omp_is_allocatable_or_ptr): New. (gfc_trans_omp_clauses): For MAP, handle (present) optional arguments; for target update, handle allocatable/pointer scalars. * trans.h (gfc_omp_is_allocatable_or_ptr): Declare. gcc/ * langhooks-def.h (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Define. (LANG_HOOKS_DECLS): Add it. * langhooks.h (lang_hooks_for_decls): Add omp_is_allocatable_or_ptr; update comment for omp_is_optional_argument. * omp-general.c (omp_is_allocatable_or_ptr): New. * omp-general.h (omp_is_allocatable_or_ptr): Declare. * omp-low.c (scan_sharing_clauses, lower_omp_target): Handle Fortran's optional arguments and allocatable/pointer scalars with use_device_addr. libgomp/ * testsuite/libgomp.fortran/use_device_addr-1.f90: New. * testsuite/libgomp.fortran/use_device_addr-2.f90: New. From-SVN: r276875
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ChangeLog12
-rw-r--r--gcc/fortran/ChangeLog11
-rw-r--r--gcc/fortran/f95-lang.c2
-rw-r--r--gcc/fortran/trans-decl.c3
-rw-r--r--gcc/fortran/trans-openmp.c32
-rw-r--r--gcc/fortran/trans.h1
-rw-r--r--gcc/langhooks-def.h2
-rw-r--r--gcc/langhooks.h9
-rw-r--r--gcc/omp-general.c8
-rw-r--r--gcc/omp-general.h1
-rw-r--r--gcc/omp-low.c38
11 files changed, 105 insertions, 14 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index f48f7f33c5e..cbc0b2fe1d9 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,15 @@
+2019-10-11 Tobias Burnus <tobias@codesourcery.com>
+
+ * langhooks-def.h (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Define.
+ (LANG_HOOKS_DECLS): Add it.
+ * langhooks.h (lang_hooks_for_decls): Add omp_is_allocatable_or_ptr;
+ update comment for omp_is_optional_argument.
+ * omp-general.c (omp_is_allocatable_or_ptr): New.
+ * omp-general.h (omp_is_allocatable_or_ptr): Declare.
+ * omp-low.c (scan_sharing_clauses, lower_omp_target): Handle
+ Fortran's optional arguments and allocatable/pointer scalars
+ with use_device_addr.
+
2019-10-11 Ilya Leoshkevich <iii@linux.ibm.com>
PR target/77918
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0577659778b..82bc450fda6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2019-10-11 Tobias Burnus <tobias@codesourcery.com>
+
+ * f95-lang.c (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Re-define to
+ gfc_omp_is_allocatable_or_ptr.
+ * trans-decl.c (create_function_arglist): Set GFC_DECL_OPTIONAL_ARGUMENT
+ only if not passed by value.
+ * trans-openmp.c (gfc_omp_is_allocatable_or_ptr): New.
+ (gfc_trans_omp_clauses): For MAP, handle (present) optional arguments;
+ for target update, handle allocatable/pointer scalars.
+ * trans.h (gfc_omp_is_allocatable_or_ptr): Declare.
+
2019-10-10 Tobias Burnus <tobias@codesourcery.com>
* trans-openmp.c (gfc_trans_omp_clauses): Actually pass use_device_addr
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 2467cd968af..0f72ab9e3b4 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -113,6 +113,7 @@ static const struct attribute_spec gfc_attribute_table[] =
#undef LANG_HOOKS_TYPE_FOR_MODE
#undef LANG_HOOKS_TYPE_FOR_SIZE
#undef LANG_HOOKS_INIT_TS
+#undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR
#undef LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT
#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
@@ -146,6 +147,7 @@ static const struct attribute_spec gfc_attribute_table[] =
#define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
#define LANG_HOOKS_INIT_TS gfc_init_ts
+#define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR gfc_omp_is_allocatable_or_ptr
#define LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT gfc_omp_is_optional_argument
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
#define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index b701f493440..3ad802e5d83 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2691,8 +2691,9 @@ create_function_arglist (gfc_symbol * sym)
&& (!f->sym->attr.proc_pointer
&& f->sym->attr.flavor != FL_PROCEDURE))
DECL_BY_REFERENCE (parm) = 1;
- if (f->sym->attr.optional)
+ if (f->sym->attr.optional && !f->sym->attr.value)
{
+ /* With value, the argument is passed as is. */
gfc_allocate_lang_decl (parm);
GFC_DECL_OPTIONAL_ARGUMENT (parm) = 1;
}
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 35c2f280fb6..dad11a24430 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -47,7 +47,21 @@ along with GCC; see the file COPYING3. If not see
int ompws_flags;
-/* True if OpenMP should treat this DECL as an optional argument. */
+/* True if OpenMP should regard this DECL as being a scalar which has Fortran's
+ allocatable or pointer attribute. */
+
+bool
+gfc_omp_is_allocatable_or_ptr (const_tree decl)
+{
+ return (DECL_P (decl)
+ && (GFC_DECL_GET_SCALAR_POINTER (decl)
+ || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)));
+}
+
+/* True if OpenMP should treat this DECL as an optional argument; note: for
+ arguments with VALUE attribute, the DECL is identical to nonoptional
+ arguments; hence, we return false here. To check whether the variable is
+ present, use the DECL which is passed as hidden argument. */
bool
gfc_omp_is_optional_argument (const_tree decl)
@@ -2173,7 +2187,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_DECL (node4) = decl;
OMP_CLAUSE_SIZE (node4) = size_int (0);
decl = build_fold_indirect_ref (decl);
- if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
+ if ((TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
+ || gfc_omp_is_optional_argument (orig_decl))
&& (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
|| GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
{
@@ -2417,7 +2432,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
{
tree decl = gfc_trans_omp_variable (n->sym, false);
if (gfc_omp_privatize_by_reference (decl))
- decl = build_fold_indirect_ref (decl);
+ {
+ if (gfc_omp_is_allocatable_or_ptr (decl))
+ decl = build_fold_indirect_ref (decl);
+ decl = build_fold_indirect_ref (decl);
+ }
else if (DECL_P (decl))
TREE_ADDRESSABLE (decl) = 1;
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
@@ -2439,7 +2458,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
OMP_CLAUSE_SIZE (node), elemsz);
}
else
- OMP_CLAUSE_DECL (node) = decl;
+ {
+ OMP_CLAUSE_DECL (node) = decl;
+ if (gfc_omp_is_allocatable_or_ptr (decl))
+ OMP_CLAUSE_SIZE (node)
+ = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (decl)));
+ }
}
else
{
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 405e88dd1c4..e96b22acc68 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -786,6 +786,7 @@ struct array_descr_info;
bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
/* In trans-openmp.c */
+bool gfc_omp_is_allocatable_or_ptr (const_tree);
bool gfc_omp_is_optional_argument (const_tree);
bool gfc_omp_privatize_by_reference (const_tree);
enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index 55d5fe01495..c5dc83d1cc8 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -236,6 +236,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
#define LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL lhd_warn_unused_global_decl
#define LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS NULL
#define LANG_HOOKS_DECL_OK_FOR_SIBCALL lhd_decl_ok_for_sibcall
+#define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR hook_bool_const_tree_false
#define LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT hook_bool_const_tree_false
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE hook_bool_const_tree_false
#define LANG_HOOKS_OMP_PREDETERMINED_SHARING lhd_omp_predetermined_sharing
@@ -262,6 +263,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL, \
LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS, \
LANG_HOOKS_DECL_OK_FOR_SIBCALL, \
+ LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR, \
LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT, \
LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \
LANG_HOOKS_OMP_PREDETERMINED_SHARING, \
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index 9d2714a5b1d..97e3186a41d 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -222,7 +222,14 @@ struct lang_hooks_for_decls
/* True if this decl may be called via a sibcall. */
bool (*ok_for_sibcall) (const_tree);
- /* True if OpenMP should treat DECL as a Fortran optional argument. */
+ /* True if OpenMP should regard this DECL as being a scalar which has Fortran's
+ allocatable or pointer attribute. */
+ bool (*omp_is_allocatable_or_ptr) (const_tree);
+
+ /* True if OpenMP should treat DECL as a Fortran optional argument; note: for
+ arguments with VALUE attribute, the DECL is identical to nonoptional
+ arguments; hence, we return false here. To check whether the variable is
+ present, use the DECL which is passed as hidden argument. */
bool (*omp_is_optional_argument) (const_tree);
/* True if OpenMP should privatize what this DECL points to rather
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 5ef6e251698..1a78a70bd57 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -48,6 +48,14 @@ omp_find_clause (tree clauses, enum omp_clause_code kind)
return NULL_TREE;
}
+/* True if OpenMP should regard this DECL as being a scalar which has Fortran's
+ allocatable or pointer attribute. */
+bool
+omp_is_allocatable_or_ptr (tree decl)
+{
+ return lang_hooks.decls.omp_is_allocatable_or_ptr (decl);
+}
+
/* Return true if DECL is a Fortran optional argument. */
bool
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index bbaa7b11707..7cd1d216fc0 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -73,6 +73,7 @@ struct omp_for_data
#define OACC_FN_ATTRIB "oacc function"
extern tree omp_find_clause (tree clauses, enum omp_clause_code kind);
+extern bool omp_is_allocatable_or_ptr (tree decl);
extern bool omp_is_optional_argument (tree decl);
extern bool omp_is_reference (tree decl);
extern void omp_adjust_for_condition (location_t loc, enum tree_code *cond_code,
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index ca7dfdb83a1..279b6ef893a 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -1241,7 +1241,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
case OMP_CLAUSE_USE_DEVICE_ADDR:
decl = OMP_CLAUSE_DECL (c);
if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
- && !omp_is_reference (decl))
+ && !omp_is_reference (decl)
+ && !omp_is_allocatable_or_ptr (decl))
|| TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
install_var_field (decl, true, 11, ctx);
else
@@ -11483,7 +11484,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
DECL_HAS_VALUE_EXPR_P (new_var) = 1;
}
else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
- && !omp_is_reference (var))
+ && !omp_is_reference (var)
+ && !omp_is_allocatable_or_ptr (var))
|| TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE)
{
tree new_var = lookup_decl (var, ctx);
@@ -11678,7 +11680,18 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
}
else
{
- var = build_fold_addr_expr (var);
+ /* While MAP is handled explicitly by the FE,
+ for 'target update', only the identified is passed. */
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO)
+ && (omp_is_allocatable_or_ptr (var)
+ && omp_is_optional_argument (var)))
+ var = build_fold_indirect_ref (var);
+ else if ((OMP_CLAUSE_CODE (c) != OMP_CLAUSE_FROM
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TO)
+ || (!omp_is_allocatable_or_ptr (var)
+ && !omp_is_optional_argument (var)))
+ var = build_fold_addr_expr (var);
gimplify_assign (x, var, &ilist);
}
}
@@ -11865,16 +11878,22 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
}
type = TREE_TYPE (ovar);
if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
- && !omp_is_reference (ovar))
+ && !omp_is_reference (ovar)
+ && !omp_is_allocatable_or_ptr (ovar))
|| TREE_CODE (type) == ARRAY_TYPE)
var = build_fold_addr_expr (var);
else
{
- if (omp_is_reference (ovar) || omp_is_optional_argument (ovar))
+ if (omp_is_reference (ovar)
+ || omp_is_optional_argument (ovar)
+ || omp_is_allocatable_or_ptr (ovar))
{
type = TREE_TYPE (type);
if (TREE_CODE (type) != ARRAY_TYPE
- && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR)
+ && ((OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR
+ && !omp_is_allocatable_or_ptr (ovar))
+ || (omp_is_reference (ovar)
+ && omp_is_allocatable_or_ptr (ovar))))
var = build_simple_mem_ref (var);
var = fold_convert (TREE_TYPE (x), var);
}
@@ -12045,7 +12064,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gimple_build_assign (new_var, x));
}
else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
- && !omp_is_reference (var))
+ && !omp_is_reference (var)
+ && !omp_is_allocatable_or_ptr (var))
|| TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE)
{
tree new_var = lookup_decl (var, ctx);
@@ -12065,7 +12085,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
{
type = TREE_TYPE (type);
if (TREE_CODE (type) != ARRAY_TYPE
- && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR)
+ && (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR
+ || (omp_is_reference (var)
+ && omp_is_allocatable_or_ptr (var))))
{
tree v = create_tmp_var_raw (type, get_name (var));
gimple_add_tmp_var (v);