[PATCH 2/5, OpenACC] Support Fortran optional arguments in the firstprivate clause

Kwok Cheung Yeung kcy@codesourcery.com
Mon Jul 29 20:56:00 GMT 2019


On 12/07/2019 12:41 pm, Jakub Jelinek wrote:
>> +/* Return true if DECL is a Fortran optional argument.  */
>> +
>> +bool
>> +omp_is_optional_argument (tree decl)
>> +{
>> +  /* A passed-by-reference Fortran optional argument is similar to
>> +     a normal argument, but since it can be null the type is a
>> +     POINTER_TYPE rather than a REFERENCE_TYPE.  */
>> +  return lang_GNU_Fortran ()
>> +        && TREE_CODE (decl) == PARM_DECL
>> +        && DECL_BY_REFERENCE (decl)
>> +	 && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE;
>> +}
> 
> This should be done through a langhook.
> Are really all PARM_DECLs wtih DECL_BY_REFERENCE and pointer type optional
> arguments?  I mean, POINTER_TYPE is used for a lot of cases.
> 

I have now added a language hook for omp_is_optional_argument, implemented only 
for Fortran. In the Fortran FE, I have introduced a language-specific decl flag 
that is set to true during the construction of the PARM_DECLs for a function if 
the symbol for the parameter has attr.optional set. The implementation of 
omp_is_optional_argument checks this flag - this way, there should be no false 
positives.

This implementation of omp_is_optional_argument returns true for both 
by-reference and by-value optional arguments, so an extra check of the type is 
needed to differentiate between the two. I have also made by-reference optional 
arguments return true for gfc_omp_privatize_by_reference (since they should 
behave like regular arguments if present), which simplifies the code a little.

 >  		if (omp_is_reference (new_var)
 > 		    && TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE)

As is, this code in lower_omp_target will always reject optional arguments, so 
it must be changed. This was introduced in commit r261025 (SVN trunk) as a fix 
for PR 85879, but it also breaks support for arrays in firstprivate, which was 
probably an unintended side-effect. I have found that allowing POINTER_TYPEs 
that are also DECL_BY_REFERENCE through in this condition allows both optional 
arguments and arrays to work without regressing the tests in r261025.

Okay for trunk?

Kwok

	gcc/fortran/
	* f95-lang.c (LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT): Define to
	gfc_omp_is_optional_argument.
	* trans-decl.c (create_function_arglist): Set
	GFC_DECL_OPTIONAL_ARGUMENT in the generated decl if the parameter is
	optional.
	* trans-openmp.c (gfc_omp_is_optional_argument): New.
	(gfc_omp_privatize_by_reference): Return true if the decl is an
	optional pass-by-reference argument.
	* trans.h (gfc_omp_is_optional_argument): New declaration.
	(lang_decl): Add new optional_arg field.
	(GFC_DECL_OPTIONAL_ARGUMENT): New macro.

	gcc/
	* langhooks-def.h (LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT): Default to
	false.
	(LANG_HOOKS_DECLS): Add LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT.
	* langhooks.h (omp_is_optional_argument): New hook.
	* omp-general.c (omp_is_optional_argument): New.
	* omp-general.h (omp_is_optional_argument): New declaration.
	* omp-low.c (lower_omp_target): Create temporary for received value
	and take the address for new_var if the original variable was a
	DECL_BY_REFERENCE.  Use size of referenced object when a
	pass-by-reference optional argument used as argument to firstprivate.
---
  gcc/fortran/f95-lang.c     |  2 ++
  gcc/fortran/trans-decl.c   |  5 +++++
  gcc/fortran/trans-openmp.c | 13 +++++++++++++
  gcc/fortran/trans.h        |  4 ++++
  gcc/langhooks-def.h        |  2 ++
  gcc/langhooks.h            |  3 +++
  gcc/omp-general.c          |  8 ++++++++
  gcc/omp-general.h          |  1 +
  gcc/omp-low.c              |  7 +++++--
  9 files changed, 43 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 6b9f490..2467cd9 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_OPTIONAL_ARGUMENT
  #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
  #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
  #undef LANG_HOOKS_OMP_REPORT_DECL
@@ -145,6 +146,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_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
  #define LANG_HOOKS_OMP_REPORT_DECL		gfc_omp_report_decl
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 64ce4bb..14f4d21 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2632,6 +2632,11 @@ 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)
+	{
+	  gfc_allocate_lang_decl (parm);
+	  GFC_DECL_OPTIONAL_ARGUMENT (parm) = 1;
+	}

        gfc_finish_decl (parm);
        gfc_finish_decl_attrs (parm, &f->sym->attr);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 8eae7bc..a117bcc 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -47,6 +47,15 @@ along with GCC; see the file COPYING3.  If not see

  int ompws_flags;

+/* True if OpenMP should treat this DECL as an optional argument.  */
+
+bool
+gfc_omp_is_optional_argument (const_tree decl)
+{
+  return DECL_LANG_SPECIFIC (decl)
+	 && GFC_DECL_OPTIONAL_ARGUMENT (decl);
+}
+
  /* True if OpenMP should privatize what this DECL points to rather
     than the DECL itself.  */

@@ -59,6 +68,10 @@ gfc_omp_privatize_by_reference (const_tree decl)
        && (!DECL_ARTIFICIAL (decl) || TREE_CODE (decl) == PARM_DECL))
      return true;

+  if (TREE_CODE (type) == POINTER_TYPE
+      && gfc_omp_is_optional_argument (decl))
+    return true;
+
    if (TREE_CODE (type) == POINTER_TYPE)
      {
        /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 0305d33..7f9f6e8 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -776,6 +776,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_optional_argument (const_tree);
  bool gfc_omp_privatize_by_reference (const_tree);
  enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
  tree gfc_omp_report_decl (tree);
@@ -989,6 +990,7 @@ struct GTY(()) lang_decl {
    tree token, caf_offset;
    unsigned int scalar_allocatable : 1;
    unsigned int scalar_pointer : 1;
+  unsigned int optional_arg : 1;
  };


@@ -1003,6 +1005,8 @@ 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_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) \
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index a059841..55d5fe0 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_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
  #define LANG_HOOKS_OMP_REPORT_DECL lhd_pass_through_t
@@ -261,6 +262,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_OPTIONAL_ARGUMENT, \
    LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \
    LANG_HOOKS_OMP_PREDETERMINED_SHARING, \
    LANG_HOOKS_OMP_REPORT_DECL, \
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index a45579b..9d2714a 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -222,6 +222,9 @@ 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.  */
+  bool (*omp_is_optional_argument) (const_tree);
+
    /* True if OpenMP should privatize what this DECL points to rather
       than the DECL itself.  */
    bool (*omp_privatize_by_reference) (const_tree);
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 8086f9a..1a09dc1 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;
  }

+/* Return true if DECL is a Fortran optional argument.  */
+
+bool
+omp_is_optional_argument (tree decl)
+{
+  return lang_hooks.decls.omp_is_optional_argument (decl);
+}
+
  /* Return true if DECL is a reference type.  */

  bool
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 80d42af..bbaa7b1 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_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,
  				      tree *n2, tree v, tree step);
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index a855c5b..1c7b43b 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -11173,7 +11173,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, 
omp_context *ctx)
  	      {
  		gcc_assert (is_gimple_omp_oacc (ctx->stmt));
  		if (omp_is_reference (new_var)
-		    && TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE)
+		    && (TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE
+		        || DECL_BY_REFERENCE (var)))
  		  {
  		    /* Create a local object to hold the instance
  		       value.  */
@@ -11461,7 +11462,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, 
omp_context *ctx)
  	      {
  		gcc_checking_assert (is_gimple_omp_oacc (ctx->stmt));
  		s = TREE_TYPE (ovar);
-		if (TREE_CODE (s) == REFERENCE_TYPE)
+		if (TREE_CODE (s) == REFERENCE_TYPE
+		    || (TREE_CODE (s) == POINTER_TYPE
+			&& omp_is_optional_argument (ovar)))
  		  s = TREE_TYPE (s);
  		s = TYPE_SIZE_UNIT (s);
  	      }
-- 
2.8.1



More information about the Fortran mailing list