aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/dump-parse-tree.c38
-rw-r--r--gcc/fortran/f95-lang.c4
-rw-r--r--gcc/fortran/gfortran.h26
-rw-r--r--gcc/fortran/openmp.c84
-rw-r--r--gcc/fortran/trans-decl.c5
-rw-r--r--gcc/fortran/trans-openmp.c97
-rw-r--r--gcc/fortran/trans.h9
7 files changed, 247 insertions, 16 deletions
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 141101e..07e98b7 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1751,7 +1751,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
}
if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE)
{
- fprintf (dumpfile, " DIST_SCHEDULE (STATIC");
+ fputs (" DIST_SCHEDULE (STATIC", dumpfile);
if (omp_clauses->dist_chunk_size)
{
fputc (',', dumpfile);
@@ -1759,8 +1759,40 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
}
fputc (')', dumpfile);
}
- if (omp_clauses->defaultmap)
- fputs (" DEFALTMAP (TOFROM: SCALAR)", dumpfile);
+ for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
+ {
+ const char *dfltmap;
+ if (omp_clauses->defaultmap[i] == OMP_DEFAULTMAP_UNSET)
+ continue;
+ fputs (" DEFAULTMAP (", dumpfile);
+ switch (omp_clauses->defaultmap[i])
+ {
+ case OMP_DEFAULTMAP_ALLOC: dfltmap = "ALLOC"; break;
+ case OMP_DEFAULTMAP_TO: dfltmap = "TO"; break;
+ case OMP_DEFAULTMAP_FROM: dfltmap = "FROM"; break;
+ case OMP_DEFAULTMAP_TOFROM: dfltmap = "TOFROM"; break;
+ case OMP_DEFAULTMAP_FIRSTPRIVATE: dfltmap = "FIRSTPRIVATE"; break;
+ case OMP_DEFAULTMAP_NONE: dfltmap = "NONE"; break;
+ case OMP_DEFAULTMAP_DEFAULT: dfltmap = "DEFAULT"; break;
+ case OMP_DEFAULTMAP_PRESENT: dfltmap = "PRESENT"; break;
+ default: gcc_unreachable ();
+ }
+ fputs (dfltmap, dumpfile);
+ if (i != OMP_DEFAULTMAP_CAT_UNCATEGORIZED)
+ {
+ fputc (':', dumpfile);
+ switch ((enum gfc_omp_defaultmap) i)
+ {
+ case OMP_DEFAULTMAP_CAT_SCALAR: dfltmap = "SCALAR"; break;
+ case OMP_DEFAULTMAP_CAT_AGGREGATE: dfltmap = "AGGREGATE"; break;
+ case OMP_DEFAULTMAP_CAT_ALLOCATABLE: dfltmap = "ALLOCATABLE"; break;
+ case OMP_DEFAULTMAP_CAT_POINTER: dfltmap = "POINTER"; break;
+ default: gcc_unreachable ();
+ }
+ fputs (dfltmap, dumpfile);
+ }
+ fputc (')', dumpfile);
+ }
if (omp_clauses->nogroup)
fputs (" NOGROUP", dumpfile);
if (omp_clauses->simd)
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index a346457..5fc8481 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -126,6 +126,8 @@ static const struct attribute_spec gfc_attribute_table[] =
#undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
#undef LANG_HOOKS_OMP_CLAUSE_DTOR
#undef LANG_HOOKS_OMP_FINISH_CLAUSE
+#undef LANG_HOOKS_OMP_ALLOCATABLE_P
+#undef LANG_HOOKS_OMP_SCALAR_TARGET_P
#undef LANG_HOOKS_OMP_SCALAR_P
#undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
#undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
@@ -162,7 +164,9 @@ static const struct attribute_spec gfc_attribute_table[] =
#define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR gfc_omp_clause_linear_ctor
#define LANG_HOOKS_OMP_CLAUSE_DTOR gfc_omp_clause_dtor
#define LANG_HOOKS_OMP_FINISH_CLAUSE gfc_omp_finish_clause
+#define LANG_HOOKS_OMP_ALLOCATABLE_P gfc_omp_allocatable_p
#define LANG_HOOKS_OMP_SCALAR_P gfc_omp_scalar_p
+#define LANG_HOOKS_OMP_SCALAR_TARGET_P gfc_omp_scalar_target_p
#define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR gfc_omp_disregard_value_expr
#define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE gfc_omp_private_debug_clause
#define LANG_HOOKS_OMP_PRIVATE_OUTER_REF gfc_omp_private_outer_ref
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cbc95d3..f4a50d7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1241,6 +1241,29 @@ enum gfc_omp_map_op
OMP_MAP_ALWAYS_TOFROM
};
+enum gfc_omp_defaultmap
+{
+ OMP_DEFAULTMAP_UNSET,
+ OMP_DEFAULTMAP_ALLOC,
+ OMP_DEFAULTMAP_TO,
+ OMP_DEFAULTMAP_FROM,
+ OMP_DEFAULTMAP_TOFROM,
+ OMP_DEFAULTMAP_FIRSTPRIVATE,
+ OMP_DEFAULTMAP_NONE,
+ OMP_DEFAULTMAP_DEFAULT,
+ OMP_DEFAULTMAP_PRESENT
+};
+
+enum gfc_omp_defaultmap_category
+{
+ OMP_DEFAULTMAP_CAT_UNCATEGORIZED,
+ OMP_DEFAULTMAP_CAT_SCALAR,
+ OMP_DEFAULTMAP_CAT_AGGREGATE,
+ OMP_DEFAULTMAP_CAT_ALLOCATABLE,
+ OMP_DEFAULTMAP_CAT_POINTER,
+ OMP_DEFAULTMAP_CAT_NUM
+};
+
enum gfc_omp_linear_op
{
OMP_LINEAR_DEFAULT,
@@ -1423,9 +1446,10 @@ typedef struct gfc_omp_clauses
enum gfc_omp_device_type device_type;
struct gfc_expr *chunk_size;
enum gfc_omp_default_sharing default_sharing;
+ enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
int collapse, orderedc;
bool nowait, ordered, untied, mergeable;
- bool inbranch, notinbranch, defaultmap, nogroup;
+ bool inbranch, notinbranch, nogroup;
bool sched_simd, sched_monotonic, sched_nonmonotonic;
bool simd, threads, depend_source, destroy, order_concurrent, capture;
enum gfc_omp_atomic_op atomic_op;
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 638a823..357a1e1 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1539,10 +1539,87 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
continue;
}
if ((mask & OMP_CLAUSE_DEFAULTMAP)
- && !c->defaultmap
- && gfc_match ("defaultmap ( tofrom : scalar )") == MATCH_YES)
+ && gfc_match ("defaultmap ( ") == MATCH_YES)
{
- c->defaultmap = true;
+ enum gfc_omp_defaultmap behavior;
+ gfc_omp_defaultmap_category category
+ = OMP_DEFAULTMAP_CAT_UNCATEGORIZED;
+ if (gfc_match ("alloc ") == MATCH_YES)
+ behavior = OMP_DEFAULTMAP_ALLOC;
+ else if (gfc_match ("tofrom ") == MATCH_YES)
+ behavior = OMP_DEFAULTMAP_TOFROM;
+ else if (gfc_match ("to ") == MATCH_YES)
+ behavior = OMP_DEFAULTMAP_TO;
+ else if (gfc_match ("from ") == MATCH_YES)
+ behavior = OMP_DEFAULTMAP_FROM;
+ else if (gfc_match ("firstprivate ") == MATCH_YES)
+ behavior = OMP_DEFAULTMAP_FIRSTPRIVATE;
+ else if (gfc_match ("none ") == MATCH_YES)
+ behavior = OMP_DEFAULTMAP_NONE;
+ else if (gfc_match ("default ") == MATCH_YES)
+ behavior = OMP_DEFAULTMAP_DEFAULT;
+ else
+ {
+ gfc_error ("Expected ALLOC, TO, FROM, TOFROM, FIRSTPRIVATE, "
+ "NONE or DEFAULT at %C");
+ break;
+ }
+ if (')' == gfc_peek_ascii_char ())
+ ;
+ else if (gfc_match (": ") != MATCH_YES)
+ break;
+ else
+ {
+ if (gfc_match ("scalar ") == MATCH_YES)
+ category = OMP_DEFAULTMAP_CAT_SCALAR;
+ else if (gfc_match ("aggregate ") == MATCH_YES)
+ category = OMP_DEFAULTMAP_CAT_AGGREGATE;
+ else if (gfc_match ("allocatable ") == MATCH_YES)
+ category = OMP_DEFAULTMAP_CAT_ALLOCATABLE;
+ else if (gfc_match ("pointer ") == MATCH_YES)
+ category = OMP_DEFAULTMAP_CAT_POINTER;
+ else
+ {
+ gfc_error ("Expected SCALAR, AGGREGATE, ALLOCATABLE or "
+ "POINTER at %C");
+ break;
+ }
+ }
+ for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; ++i)
+ {
+ if (i != category
+ && category != OMP_DEFAULTMAP_CAT_UNCATEGORIZED)
+ continue;
+ if (c->defaultmap[i] != OMP_DEFAULTMAP_UNSET)
+ {
+ const char *pcategory = NULL;
+ switch (i)
+ {
+ case OMP_DEFAULTMAP_CAT_UNCATEGORIZED: break;
+ case OMP_DEFAULTMAP_CAT_SCALAR: pcategory = "SCALAR"; break;
+ case OMP_DEFAULTMAP_CAT_AGGREGATE:
+ pcategory = "AGGREGATE";
+ break;
+ case OMP_DEFAULTMAP_CAT_ALLOCATABLE:
+ pcategory = "ALLOCATABLE";
+ break;
+ case OMP_DEFAULTMAP_CAT_POINTER:
+ pcategory = "POINTER";
+ break;
+ default: gcc_unreachable ();
+ }
+ if (i == OMP_DEFAULTMAP_CAT_UNCATEGORIZED)
+ gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP with "
+ "unspecified category");
+ else
+ gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP for "
+ "category %s", pcategory);
+ goto end;
+ }
+ }
+ c->defaultmap[category] = behavior;
+ if (gfc_match (")") != MATCH_YES)
+ break;
continue;
}
if ((mask & OMP_CLAUSE_DELETE)
@@ -2459,6 +2536,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
break;
}
+end:
if (gfc_match_omp_eos () != MATCH_YES)
{
if (!gfc_error_flag_test ())
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c32bd05..479ba6f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -605,6 +605,11 @@ gfc_finish_decl_attrs (tree decl, symbol_attribute *attr)
gfc_allocate_lang_decl (decl);
GFC_DECL_SCALAR_POINTER (decl) = 1;
}
+ if (attr->target)
+ {
+ gfc_allocate_lang_decl (decl);
+ GFC_DECL_SCALAR_TARGET (decl) = 1;
+ }
}
}
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index f466ab6..ce1991e 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -393,6 +393,28 @@ gfc_is_unlimited_polymorphic_nonptr (tree type)
return true;
}
+/* Return true if the DECL is for an allocatable array or scalar. */
+
+bool
+gfc_omp_allocatable_p (tree decl)
+{
+ if (!DECL_P (decl))
+ return false;
+
+ if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
+ return true;
+
+ tree type = TREE_TYPE (decl);
+ if (gfc_omp_privatize_by_reference (decl))
+ type = TREE_TYPE (type);
+
+ if (GFC_DESCRIPTOR_TYPE_P (type)
+ && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
+ return true;
+
+ return false;
+}
+
/* Return true if DECL in private clause needs
OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */
@@ -1663,10 +1685,11 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
/* Return true if DECL is a scalar variable (for the purpose of
- implicit firstprivatization). */
+ implicit firstprivatization/mapping). Only if 'ptr_alloc_ok.'
+ is true, allocatables and pointers are permitted. */
bool
-gfc_omp_scalar_p (tree decl)
+gfc_omp_scalar_p (tree decl, bool ptr_alloc_ok)
{
tree type = TREE_TYPE (decl);
if (TREE_CODE (type) == REFERENCE_TYPE)
@@ -1675,7 +1698,11 @@ gfc_omp_scalar_p (tree decl)
{
if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
|| GFC_DECL_GET_SCALAR_POINTER (decl))
- type = TREE_TYPE (type);
+ {
+ if (!ptr_alloc_ok)
+ return false;
+ type = TREE_TYPE (type);
+ }
if (GFC_ARRAY_TYPE_P (type)
|| GFC_CLASS_TYPE_P (type))
return false;
@@ -1691,6 +1718,17 @@ gfc_omp_scalar_p (tree decl)
}
+/* Return true if DECL is a scalar with target attribute but does not have the
+ allocatable (or pointer) attribute (for the purpose of implicit mapping). */
+
+bool
+gfc_omp_scalar_target_p (tree decl)
+{
+ return (DECL_P (decl) && GFC_DECL_GET_SCALAR_TARGET (decl)
+ && gfc_omp_scalar_p (decl, false));
+}
+
+
/* Return true if DECL's DECL_VALUE_EXPR (if any) should be
disregarded in OpenMP construct, because it is going to be
remapped during OpenMP lowering. SHARED is true if DECL
@@ -4036,13 +4074,55 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
- if (clauses->defaultmap)
+
+ for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
{
+ if (clauses->defaultmap[i] == OMP_DEFAULTMAP_UNSET)
+ continue;
+ enum omp_clause_defaultmap_kind behavior, category;
+ switch ((gfc_omp_defaultmap_category) i)
+ {
+ case OMP_DEFAULTMAP_CAT_UNCATEGORIZED:
+ category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED;
+ break;
+ case OMP_DEFAULTMAP_CAT_SCALAR:
+ category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR;
+ break;
+ case OMP_DEFAULTMAP_CAT_AGGREGATE:
+ category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_AGGREGATE;
+ break;
+ case OMP_DEFAULTMAP_CAT_ALLOCATABLE:
+ category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_ALLOCATABLE;
+ break;
+ case OMP_DEFAULTMAP_CAT_POINTER:
+ category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_POINTER;
+ break;
+ default: gcc_unreachable ();
+ }
+ switch (clauses->defaultmap[i])
+ {
+ case OMP_DEFAULTMAP_ALLOC:
+ behavior = OMP_CLAUSE_DEFAULTMAP_ALLOC;
+ break;
+ case OMP_DEFAULTMAP_TO: behavior = OMP_CLAUSE_DEFAULTMAP_TO; break;
+ case OMP_DEFAULTMAP_FROM: behavior = OMP_CLAUSE_DEFAULTMAP_FROM; break;
+ case OMP_DEFAULTMAP_TOFROM:
+ behavior = OMP_CLAUSE_DEFAULTMAP_TOFROM;
+ break;
+ case OMP_DEFAULTMAP_FIRSTPRIVATE:
+ behavior = OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE;
+ break;
+ case OMP_DEFAULTMAP_NONE: behavior = OMP_CLAUSE_DEFAULTMAP_NONE; break;
+ case OMP_DEFAULTMAP_DEFAULT:
+ behavior = OMP_CLAUSE_DEFAULTMAP_DEFAULT;
+ break;
+ default: gcc_unreachable ();
+ }
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP);
- OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, OMP_CLAUSE_DEFAULTMAP_TOFROM,
- OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR);
+ OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, behavior, category);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+
if (clauses->depend_source)
{
c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND);
@@ -5672,8 +5752,9 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR];
clausesa[GFC_OMP_SPLIT_TARGET].device
= code->ext.omp_clauses->device;
- clausesa[GFC_OMP_SPLIT_TARGET].defaultmap
- = code->ext.omp_clauses->defaultmap;
+ for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
+ clausesa[GFC_OMP_SPLIT_TARGET].defaultmap[i]
+ = code->ext.omp_clauses->defaultmap[i];
clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET]
= code->ext.omp_clauses->if_exprs[OMP_IF_TARGET];
/* And this is copied to all. */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index d1d4a1d..78578cf 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -823,7 +823,9 @@ tree gfc_omp_clause_assign_op (tree, tree, tree);
tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree);
tree gfc_omp_clause_dtor (tree, tree);
void gfc_omp_finish_clause (tree, gimple_seq *, bool);
-bool gfc_omp_scalar_p (tree);
+bool gfc_omp_allocatable_p (tree);
+bool gfc_omp_scalar_p (tree, bool);
+bool gfc_omp_scalar_target_p (tree);
bool gfc_omp_disregard_value_expr (tree, bool);
bool gfc_omp_private_debug_clause (tree, bool);
bool gfc_omp_private_outer_ref (tree);
@@ -1030,6 +1032,7 @@ struct GTY(()) lang_decl {
tree token, caf_offset;
unsigned int scalar_allocatable : 1;
unsigned int scalar_pointer : 1;
+ unsigned int scalar_target : 1;
unsigned int optional_arg : 1;
};
@@ -1044,12 +1047,16 @@ struct GTY(()) lang_decl {
(DECL_LANG_SPECIFIC (node)->scalar_allocatable)
#define GFC_DECL_SCALAR_POINTER(node) \
(DECL_LANG_SPECIFIC (node)->scalar_pointer)
+#define GFC_DECL_SCALAR_TARGET(node) \
+ (DECL_LANG_SPECIFIC (node)->scalar_target)
#define GFC_DECL_OPTIONAL_ARGUMENT(node) \
(DECL_LANG_SPECIFIC (node)->optional_arg)
#define GFC_DECL_GET_SCALAR_ALLOCATABLE(node) \
(DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_ALLOCATABLE (node) : 0)
#define GFC_DECL_GET_SCALAR_POINTER(node) \
(DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_POINTER (node) : 0)
+#define GFC_DECL_GET_SCALAR_TARGET(node) \
+ (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_TARGET (node) : 0)
#define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node)
#define GFC_DECL_PARTIAL_PACKED_ARRAY(node) DECL_LANG_FLAG_1(node)
#define GFC_DECL_ASSIGN(node) DECL_LANG_FLAG_2(node)
generated by cgit v1.1 at 2025-04-06 12:00:45 +0000