[Patch] Fortran: -fno-automatic and -fopenacc / recusion check cleanup

[Patch] Fortran: -fno-automatic and -fopenacc / recusion check cleanup

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 2647 bytes --]

Two fixes – simple, see patch + commit text.

Longer description:

* options:
Background:
- OpenMP, OpenACC and imply that a function is called
concurrently and -frecursive implies recusive. In all those
cases, the code may fail if a local variable is in static memory
instead of stack or heap. – If a user specified 'save', we
can assume/hope that they will deal with it - but with
-fno-automatic (→ 'save' implied), the flags clash.

- Additionally, to avoid placing local arrays in static memory,
for -fopenmp/-fopenacc -frecursive and 'unlimited' stack size
use for const-size arrays is implied.

This patch:
- Handle OpenACC as OpenMP (before it didn't imply -frecursive.


* Recursive run-time check. The current code currently generates:

   subroutine foo()
     logical, save :: currently_called = .false.
     if (currently_called) error_stop "No recursive but called"
     currently_called = .true.
     ...
     ... ! Rest of code, which could indirectly call this proc again
     ...
     currently_called = .false.
   end

This works well for recursive calls but less so for concurrency
(→ OpenMP, OpenACC).
As noted above, by default OpenMP/OpenACC implies -frecursive
and, hence, there is no recursive check generated.
The question is what code should be generated for, e.g.
   -fno-automatic -fopenmp or -fopenacc -fmax-stack-var-size=20

In that case, -frecursive is unset. We have two choices:
- Either still always reset, which may not detect concurrent
   use (including recursive + concurrent use) do to a race condition.
- Or avoid resetting the flag
   But then calling the procedure twice (e.g. beginning + end of the
   program) will generate a bogus error.

The current code does the second – at least for -fopenmp.

→ PATCH: Simply use the same condition twice instead of a complicated
   test; do so via: 'if (recurcheckvar == NULL_TREE)'.

Current code:

tree recurcheckvar = NULL_TREE;
...
   if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
       && !is_recursive && !flag_recursive && !sym->attr.artificial)
     ...  // declare 'recurcheckvar', generate error-message code etc.
...
   /* Reset recursion-check variable.  */
   if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
        && !is_recursive && !flag_openmp && recurcheckvar != NULL_TREE)


Comments? Suggestions? – If not, I will commit it as obvious in the next
days.

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter

[-- Attachment #2: oacc-cleanup.diff --]
[-- Type: text/x-patch, Size: 3573 bytes --]

Fortran: -fno-automatic and -fopenacc / recusion check cleanup

Options: -fopenmp and -fopenacc imply concurrent calls to a
procedure; now also -fopenacc implies -frecursive, disabling
that larger local const-size array variables use static memory.

Run-time recursion check: Always reset the check variable at the
end of the procedure; this avoids a bogus error with -fopenmp
when called twice nonconcurrently/nonrecursively. (Issue requires
using -fno-automatic or -fmax-stack-var-size= to trigger.)

gcc/fortran/ChangeLog:

	PR fortran/98010
	PR fortran/98013
	* options.c (gfc_post_options): Also imply recursive with
	-fopenacc.
	* trans-decl.c (gfc_generate_function_code): Simplify condition.

 gcc/fortran/options.c    | 16 +++++++++-------
 gcc/fortran/trans-decl.c |  3 +--
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index d844fa93115..66be1d586fb 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -407,32 +407,34 @@ gfc_post_options (const char **pfilename)
 
   if (!flag_automatic && flag_max_stack_var_size != -2
       && flag_max_stack_var_size != 0)
     gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
 		     flag_max_stack_var_size);
   else if (!flag_automatic && flag_recursive)
     gfc_warning_now (OPT_Woverwrite_recursive, "Flag %<-fno-automatic%> "
 		     "overwrites %<-frecursive%>");
-  else if (!flag_automatic && flag_openmp)
-    gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by "
-		     "%<-fopenmp%>");
+  else if (!flag_automatic && (flag_openmp || flag_openacc))
+    gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> "
+		     "implied by %qs", flag_openmp ? "-fopenmp" : "-fopenacc");
   else if (flag_max_stack_var_size != -2 && flag_recursive)
     gfc_warning_now (0, "Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
 		     flag_max_stack_var_size);
-  else if (flag_max_stack_var_size != -2 && flag_openmp)
-    gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites %<-frecursive%> "
-		     "implied by %<-fopenmp%>", flag_max_stack_var_size);
+  else if (flag_max_stack_var_size != -2 && (flag_openmp || flag_openacc))
+    gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites "
+		     "%<-frecursive%> implied by %qs", flag_max_stack_var_size,
+		     flag_openmp ? "-fopenmp" : "-fopenacc");
 
   /* Implement -frecursive as -fmax-stack-var-size=-1.  */
   if (flag_recursive)
     flag_max_stack_var_size = -1;
 
   /* Implied -frecursive; implemented as -fmax-stack-var-size=-1.  */
-  if (flag_max_stack_var_size == -2 && flag_openmp && flag_automatic)
+  if (flag_max_stack_var_size == -2 && flag_automatic
+      && (flag_openmp || flag_openacc))
     {
       flag_recursive = 1;
       flag_max_stack_var_size = -1;
     }
 
   /* Set flag_stack_arrays correctly.  */
   if (flag_stack_arrays == -1)
     flag_stack_arrays = 0;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 71d5c670e55..d45900a5ca5 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -6965,8 +6965,7 @@ gfc_generate_function_code (gfc_namespace * ns)
   gfc_init_block (&cleanup);
 
   /* Reset recursion-check variable.  */
-  if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
-      && !is_recursive && !flag_openmp && recurcheckvar != NULL_TREE)
+  if (recurcheckvar != NULL_TREE)
     {
       gfc_add_modify (&cleanup, recurcheckvar, logical_false_node);
       recurcheckvar = NULL;

Re: [Patch] Fortran: -fno-automatic and -fopenacc / recusion check cleanup

[Tobias Burnus]

Now installed as r11-5571-gf4e7ea81d1369d4d6cb6d8e440aefb3407142e05.

Tobias

On 27.11.20 11:16, Tobias Burnus wrote:
> Two fixes – simple, see patch + commit text.
>
> Longer description:
>
> * options:
> Background:
> - OpenMP, OpenACC and imply that a function is called
> concurrently and -frecursive implies recusive. In all those
> cases, the code may fail if a local variable is in static memory
> instead of stack or heap. – If a user specified 'save', we
> can assume/hope that they will deal with it - but with
> -fno-automatic (→ 'save' implied), the flags clash.
>
> - Additionally, to avoid placing local arrays in static memory,
> for -fopenmp/-fopenacc -frecursive and 'unlimited' stack size
> use for const-size arrays is implied.
>
> This patch:
> - Handle OpenACC as OpenMP (before it didn't imply -frecursive.
>
>
> * Recursive run-time check. The current code currently generates:
>
>   subroutine foo()
>     logical, save :: currently_called = .false.
>     if (currently_called) error_stop "No recursive but called"
>     currently_called = .true.
>     ...
>     ... ! Rest of code, which could indirectly call this proc again
>     ...
>     currently_called = .false.
>   end
>
> This works well for recursive calls but less so for concurrency
> (→ OpenMP, OpenACC).
> As noted above, by default OpenMP/OpenACC implies -frecursive
> and, hence, there is no recursive check generated.
> The question is what code should be generated for, e.g.
>   -fno-automatic -fopenmp or -fopenacc -fmax-stack-var-size=20
>
> In that case, -frecursive is unset. We have two choices:
> - Either still always reset, which may not detect concurrent
>   use (including recursive + concurrent use) do to a race condition.
> - Or avoid resetting the flag
>   But then calling the procedure twice (e.g. beginning + end of the
>   program) will generate a bogus error.
>
> The current code does the second – at least for -fopenmp.
>
> → PATCH: Simply use the same condition twice instead of a complicated
>   test; do so via: 'if (recurcheckvar == NULL_TREE)'.
>
> Current code:
>
> tree recurcheckvar = NULL_TREE;
> ...
>   if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
>       && !is_recursive && !flag_recursive && !sym->attr.artificial)
>     ...  // declare 'recurcheckvar', generate error-message code etc.
> ...
>   /* Reset recursion-check variable.  */
>   if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION)
>        && !is_recursive && !flag_openmp && recurcheckvar != NULL_TREE)
>
>
> Comments? Suggestions? – If not, I will commit it as obvious in the next
> days.
>
> Tobias
>
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter