[patch, fortran] Load scalar intent-in variables at the beginning of procedures

[patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas König]

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

Hello world,

the attached patch loads scalar INTENT(IN) variables to a local
variable at the start of a procedure, as suggested in PR 67202, in
order to aid optimization.  This is controlled by front-end
optimization so it is easier to catch if any bugs should turn up :-)

This is done to make optimization by the middle-end easier.

I left in the parts for debugging that I added for this patch.
Seeing the difference between EXEC_INIT_ASSIGN and EXEC_ASSIGN was
particularly instructive.

Regression-tested. OK for trunk?

Regards

	Thomas

[-- Attachment #2: p6.diff --]
[-- Type: text/x-patch, Size: 5672 bytes --]

Index: dump-parse-tree.c
===================================================================
--- dump-parse-tree.c	(Revision 278025)
+++ dump-parse-tree.c	(Arbeitskopie)
@@ -57,6 +57,15 @@ static void show_attr (symbol_attribute *, const c
 /* Allow dumping of an expression in the debugger.  */
 void gfc_debug_expr (gfc_expr *);
 
+void debug (gfc_namespace *ns)
+{
+  FILE *tmp = dumpfile;
+  dumpfile = stderr;
+  show_namespace (ns);
+  fputc ('\n', dumpfile);
+  dumpfile = tmp;
+}
+
 void debug (symbol_attribute *attr)
 {
   FILE *tmp = dumpfile;
@@ -1889,6 +1898,9 @@ show_code_node (int level, gfc_code *c)
       break;
 
     case EXEC_INIT_ASSIGN:
+      fputs ("INIT_", dumpfile);
+      /* Fallthrough */
+
     case EXEC_ASSIGN:
       fputs ("ASSIGN ", dumpfile);
       show_expr (c->expr1);
Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 278025)
+++ frontend-passes.c	(Arbeitskopie)
@@ -57,6 +57,7 @@ static int call_external_blas (gfc_code **, int *,
 static int matmul_temp_args (gfc_code **, int *,void *data);
 static int index_interchange (gfc_code **, int*, void *);
 static bool is_fe_temp (gfc_expr *e);
+static void replace_intent_in (gfc_namespace *);
 
 #ifdef CHECKING_P
 static void check_locus (gfc_namespace *);
@@ -1467,6 +1468,7 @@ optimize_namespace (gfc_namespace *ns)
 
   if (flag_frontend_optimize)
     {
+      replace_intent_in (ns);
       gfc_code_walker (&ns->code, simplify_io_impl_do, dummy_expr_callback, NULL);
       gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
       gfc_code_walker (&ns->code, convert_elseif, dummy_expr_callback, NULL);
@@ -5503,3 +5505,132 @@ gfc_check_externals (gfc_namespace *ns)
 
   gfc_errors_to_warnings (false);
 }
+
+/*  For scalar INTENT(IN) variables or for variables where we know
+    their value is not changed, we can replace them by an auxiliary
+    variable whose value is set on procedure entry.  */
+
+typedef struct sym_replacement
+{
+  gfc_symbol *original;
+  gfc_symtree *replacement_symtree;
+  bool referenced;
+
+} sym_replace;
+
+/* Callback function - replace expression if possible, and set
+   sr->referenced if this was done (so we know we need to generate
+   the assignment statement).  */
+
+static int
+replace_symbol_in_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+			void *data)
+{
+  gfc_expr *expr = *e;
+  sym_replacement *sr;
+
+  if (expr->expr_type != EXPR_VARIABLE || expr->symtree == NULL)
+    return 0;
+
+  sr = (sym_replacement *) data;
+
+  if (expr->symtree->n.sym == sr->original)
+    {
+      expr->symtree = sr->replacement_symtree;
+      sr->referenced = true;
+    }
+
+  return 0;
+}
+
+/* Replace INTENT(IN) scalar variables by assigning their values to
+   temporary variables.  We really only want to use this for the
+   simplest cases, all the fancy stuff is excluded.  */
+
+static void
+replace_intent_in (gfc_namespace *ns)
+{
+  gfc_formal_arglist *f;
+  gfc_namespace *ns_c;
+
+  if (ns == NULL || ns->proc_name == NULL || gfc_elemental (ns->proc_name)
+      || ns->proc_name->attr.entry_master)
+    return;
+
+  for (f = ns->proc_name->formal; f; f = f->next)
+    {
+      if (f->sym == NULL || f->sym->attr.dimension || f->sym->attr.allocatable
+	  || f->sym->attr.optional || f->sym->attr.pointer
+	  || f->sym->attr.codimension || f->sym->attr.value
+	  || f->sym->attr.proc_pointer || f->sym->attr.target
+	  || f->sym->attr.asynchronous
+	  || f->sym->ts.type == BT_CHARACTER || f->sym->ts.type == BT_DERIVED
+	  || f->sym->ts.type == BT_CLASS)
+	continue;
+
+      /* TODO: It could also be possible to check if the variable can
+	 actually not be changed by appearing in a variable
+	 definition context or by being passed as an argument to a
+	 procedure where it could be changed.  */
+
+      if (f->sym->attr.intent == INTENT_IN)
+	{
+	  gfc_symtree *symtree;
+	  gfc_symbol *replacement;
+	  sym_replace sr;
+
+	  char name[GFC_MAX_SYMBOL_LEN + 1];
+	  snprintf (name, GFC_MAX_SYMBOL_LEN, "__dummy_%d_%s", var_num++,
+		    f->sym->name);
+
+	  if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
+	    gcc_unreachable ();
+
+	  replacement = symtree->n.sym;
+	  replacement->ts = f->sym->ts;
+	  replacement->attr.flavor = FL_VARIABLE;
+	  replacement->attr.fe_temp = 1;
+	  replacement->attr.referenced = 1;
+	  replacement->declared_at = f->sym->declared_at;
+	  gfc_commit_symbol (replacement);
+
+	  sr.original = f->sym;
+	  sr.replacement_symtree = symtree;
+	  sr.referenced = false;
+
+	  gfc_code_walker (&ns->code, gfc_dummy_code_callback,
+			   replace_symbol_in_expr, (void *) &sr);
+
+	  for (ns_c = ns->contained; ns_c != NULL; ns_c = ns_c->sibling)
+	    gfc_code_walker (&ns_c->code, gfc_dummy_code_callback,
+			     replace_symbol_in_expr, (void *) &sr);
+
+	  if (sr.referenced)
+	    {
+	      gfc_code *n;
+	      gfc_symtree *formal_symtree;
+	      gfc_code **c;
+
+	      /* Generate statement __tmp_42_foo = foo .   */
+	      n = XCNEW (gfc_code);
+	      n->op = EXEC_ASSIGN;
+	      n->expr1 = gfc_lval_expr_from_sym (replacement);
+	      n->expr1->where = f->sym->declared_at;
+	      formal_symtree = gfc_find_symtree (ns->sym_root, f->sym->name);
+	      n->expr2 = gfc_get_variable_expr (formal_symtree);
+	      n->expr2->where = f->sym->declared_at;
+	      n->loc = f->sym->declared_at;
+
+	      /* Put this statement after the initialization
+		 assignment statements.  */
+	      
+	      for (c = &ns->code; *c != NULL && (*c)->op == EXEC_INIT_ASSIGN;
+		   c = &(*c)->next)
+		;
+
+	      n->next = (*c);
+	      (*c) = n;
+	    }
+	}
+    }
+}

[-- Attachment #3: intent_optimize_3.f90 --]
[-- Type: text/x-fortran, Size: 486 bytes --]

! { dg-do compile }
! { dg-options "-fdump-tree-original -ffrontend-optimize" }
! PR 67202 - load INTENT(IN) scalars to a variable.
module x
contains
  subroutine foo (i, j, k1, k2)
    integer, intent(in) :: i,j
    integer, intent(out) :: k1, k2
    k1 = i + j
    block
      k2 = i
    end block      
  end subroutine foo
end module x
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_i" 4 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_j" 3 "original" } }

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas Koenig]

Am 11.11.19 um 22:55 schrieb Thomas König:
> Regression-tested. OK for trunk?

Of course, better with a ChangeLog entry.

2019-11-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/67202
	* dump-parse-tree.c (debug): Add for gfc_namespace.
	(show_code_node): Add INIT_ on dumping EXEC_INIT_ASSIGN.
	* frontent-passes.c (replace_intent_in): Add prototype.  New function.
	(optimize_namespace): Call it.
	(sym_replacement): New struct.
	(replace_symbol_in_expr): New function.

2019-11-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/67202
	* gfortran.dg/intent_optimize_3.f90: New test.

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Janne Blomqvist]

On Mon, Nov 11, 2019 at 11:56 PM Thomas König <tk@tkoenig.net> wrote:
>
> Hello world,
>
> the attached patch loads scalar INTENT(IN) variables to a local
> variable at the start of a procedure, as suggested in PR 67202, in
> order to aid optimization.  This is controlled by front-end
> optimization so it is easier to catch if any bugs should turn up :-)
>
> This is done to make optimization by the middle-end easier.
>
> I left in the parts for debugging that I added for this patch.
> Seeing the difference between EXEC_INIT_ASSIGN and EXEC_ASSIGN was
> particularly instructive.
>
> Regression-tested. OK for trunk?

Wouldn't it be even better to pass scalar intent(in) variables by
value? The obvious objection of course is ABI, but for procedures with
an explicit interface we're not following any particular ABI anyways?


-- 
Janne Blomqvist

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas König]

Hi Janne,

> Wouldn't it be even better to pass scalar intent(in) variables by
> value? The obvious objection of course is ABI, but for procedures with
> an explicit interface we're not following any particular ABI anyways?

The problem with that is that we don't know when we compile a procedure
if it will be called with an explicit interface or not.

The user can always add an interface block for a stand-alone procedure.

Regards

	Thomas

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Janne Blomqvist]

On Tue, Nov 12, 2019 at 12:53 AM Thomas König <tk@tkoenig.net> wrote:
>
> Hi Janne,
>
> > Wouldn't it be even better to pass scalar intent(in) variables by
> > value? The obvious objection of course is ABI, but for procedures with
> > an explicit interface we're not following any particular ABI anyways?
>
> The problem with that is that we don't know when we compile a procedure
> if it will be called with an explicit interface or not.
>
> The user can always add an interface block for a stand-alone procedure.

Ah, of course. I should have said module procedures. Or even module
procedures without bind(C)?

That being said, I've seen examples where people have figured out the
symbol mangling and are calling module procedures directly from C, so
will breaking such code (even if not officially supported) be an
issue?


-- 
Janne Blomqvist

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas König]

Hi Janne,

> Ah, of course. I should have said module procedures. Or even module
> procedures without bind(C)?

It would probably be the latter.

The change would actually be rather small: If conditions are met, just add attr.value for INTENT(IN).

This is something we should probably do when we are forced into doing an ABI change by other circumstances.

Regards, Thomad

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Tobias Burnus]

Hi Thomas,

On 11/12/19 1:42 PM, Thomas König wrote:
>> Ah, of course. I should have said module procedures. Or even module procedures without bind(C)?
> It would probably be the latter. The change would actually be rather small: If conditions are met, just add attr.value for INTENT(IN). This is something we should probably do when we are forced into doing an ABI change by other circumstances.

Will this still work if one does:

module m
contains
integer function val(y)
   integer, intent(in) :: y
   val = 2*y
end function val
end module m

use m
interface
   integer function proc(z)
     integer, intent(in) :: z
   end function proc
end interface
procedure(proc), pointer :: ff
ff => val
print *, ff(10)
end

Tobias

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas König]

Hi Tobias,

> On 11/12/19 1:42 PM, Thomas König wrote:
>>> Ah, of course. I should have said module procedures. Or even module procedures without bind(C)?
>> It would probably be the latter. The change would actually be rather small: If conditions are met, just add attr.value for INTENT(IN). This is something we should probably do when we are forced into doing an ABI change by other circumstances.
> 
> Will this still work if one does:
> 
> module m
> contains
> integer function val(y)
>  integer, intent(in) :: y
>  val = 2*y
> end function val
> end module m
> 
> use m
> interface
>  integer function proc(z)
>    integer, intent(in) :: z
>  end function proc
> end interface
> procedure(proc), pointer :: ff
> ff => val
> print *, ff(10)
> end

You are right, it would not work. So, scratch that idea. Maybe we should commit this as a test case so nobody gets funny ideas in two year‘s time 😉

So, I think we can then discuss the original patch.

Regards

Thomas

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Tobias Burnus]

Hi Thomas,

On 11/11/19 10:55 PM, Thomas König wrote:
> the attached patch loads scalar INTENT(IN) variables to a local
> variable at the start of a procedure, as suggested in PR 67202, in
> order to aid optimization.  This is controlled by front-end
> optimization so it is easier to catch if any bugs should turn up :-)

> +      if (f->sym == NULL || f->sym->attr.dimension || f->sym->attr.allocatable
> +	  || f->sym->attr.optional || f->sym->attr.pointer
> +	  || f->sym->attr.codimension || f->sym->attr.value
> +	  || f->sym->attr.proc_pointer || f->sym->attr.target
> +	  || f->sym->attr.asynchronous
> +	  || f->sym->ts.type == BT_CHARACTER || f->sym->ts.type == BT_DERIVED
> +	  || f->sym->ts.type == BT_CLASS)
> +	continue;
I think you need to add at least VOLATILE to this list – otherwise, I 
have not thought much about corner cases nor have studied the patch, sorry.

Cheers,

Tobias

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas König]

Hi Tobias,

> I think you need to add at least VOLATILE to this list

Yes, I'll do that.

Any other comments?

Regards

	Thomas

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas Koenig]

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

Hello world,

here is an update to the patch.

I have now included variables where the user did not specify INTENT(IN)
by checking that the dummy variables to be replaced by temporaries
are not, indeed, assigned a value. This also includes being passed
as an actual argument to a non-INTENT(IN) dummy argument.

Extending this led to being able to catch a few more bugs.

I have addes one test case to check where the new temporaries are added.

Regression-tested. The only change I see in the testsuite now is

XPASS: gfortran.dg/goacc/kernels-loop-n.f95   -O   scan-tree-dump-times 
parloops1 "(?n)__attribute__\\(\\(oacc kernels parallelized, oacc 
function \\(, , \\), oacc kernels, omp target entrypoint\\)\\)" 1

So, OK for trunk?

Regards

	Thomas

2019-11-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/67202
	* dump-parse-tree.c (debug): Add for gfc_namespace.
	(show_code_node): Add INIT_ on dumping EXEC_INIT_ASSIGN.
	* frontent-passes.c (replace_intent_in): Add prototype.  New
	function.
	(optimize_namespace): Call it.
	(sym_replacement): New struct.
	(defined_code_callback): New function.
	(defined_expr_callback): New function.
	(replace_symbol_in_expr): New function.

2019-11-11  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/67202
	* gfortran.dg/intent_optimize_3.f90: New test.
	* gfortran.dg/intent_optimize_4.f90: New test.
	* gfortran.dg/pr26246_2.f90: Add -fno-frontend-optimize to flags.



[-- Attachment #2: p10.diff --]
[-- Type: text/x-patch, Size: 11580 bytes --]

Index: fortran/dump-parse-tree.c
===================================================================
--- fortran/dump-parse-tree.c	(Revision 278025)
+++ fortran/dump-parse-tree.c	(Arbeitskopie)
@@ -57,6 +57,15 @@ static void show_attr (symbol_attribute *, const c
 /* Allow dumping of an expression in the debugger.  */
 void gfc_debug_expr (gfc_expr *);
 
+void debug (gfc_namespace *ns)
+{
+  FILE *tmp = dumpfile;
+  dumpfile = stderr;
+  show_namespace (ns);
+  fputc ('\n', dumpfile);
+  dumpfile = tmp;
+}
+
 void debug (symbol_attribute *attr)
 {
   FILE *tmp = dumpfile;
@@ -1889,6 +1898,9 @@ show_code_node (int level, gfc_code *c)
       break;
 
     case EXEC_INIT_ASSIGN:
+      fputs ("INIT_", dumpfile);
+      /* Fallthrough */
+
     case EXEC_ASSIGN:
       fputs ("ASSIGN ", dumpfile);
       show_expr (c->expr1);
Index: fortran/frontend-passes.c
===================================================================
--- fortran/frontend-passes.c	(Revision 278025)
+++ fortran/frontend-passes.c	(Arbeitskopie)
@@ -57,6 +57,7 @@ static int call_external_blas (gfc_code **, int *,
 static int matmul_temp_args (gfc_code **, int *,void *data);
 static int index_interchange (gfc_code **, int*, void *);
 static bool is_fe_temp (gfc_expr *e);
+static void replace_intent_in (gfc_namespace *);
 
 #ifdef CHECKING_P
 static void check_locus (gfc_namespace *);
@@ -1467,6 +1468,7 @@ optimize_namespace (gfc_namespace *ns)
 
   if (flag_frontend_optimize)
     {
+      replace_intent_in (ns);
       gfc_code_walker (&ns->code, simplify_io_impl_do, dummy_expr_callback, NULL);
       gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
       gfc_code_walker (&ns->code, convert_elseif, dummy_expr_callback, NULL);
@@ -4969,7 +4971,7 @@ gfc_expr_walker (gfc_expr **e, walk_expr_fn_t expr
 	    if ((*e)->expr_type != EXPR_ARRAY)
 	      break;
 
-	    /* Fall through to the variable case in order to walk the
+ 	    /* Fall through to the variable case in order to walk the
 	       reference.  */
 	    gcc_fallthrough ();
 
@@ -5503,3 +5505,330 @@ gfc_check_externals (gfc_namespace *ns)
 
   gfc_errors_to_warnings (false);
 }
+
+/*  For scalar INTENT(IN) variables or for variables where we know
+    their value is not changed, we can replace them by an auxiliary
+    variable whose value is set on procedure entry.  */
+
+typedef struct sym_replacement
+{
+  gfc_symbol *original;
+  gfc_symtree *replacement_symtree;
+  bool referenced;
+
+} sym_replace;
+
+/* Callback function - replace expression if possible, and set
+   sr->referenced if this was done (so we know we need to generate
+   the assignment statement).  */
+
+static int
+replace_symbol_in_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+			void *data)
+{
+  gfc_expr *expr = *e;
+  sym_replacement *sr;
+
+  if (expr->expr_type != EXPR_VARIABLE || expr->symtree == NULL)
+    return 0;
+
+  sr = (sym_replacement *) data;
+
+  if (expr->symtree->n.sym == sr->original)
+    {
+      expr->symtree = sr->replacement_symtree;
+      sr->referenced = true;
+    }
+
+  return 0;
+}
+
+/* Callback to check if the symbol passed as data could be redefined.
+   Return 1 if this is the case.  */
+
+#define CHECK_TAG(member,tag)						\
+      do 								\
+	{ 								\
+	  if (co->ext.member->tag && co->ext.member->tag->symtree	\
+	      && co->ext.member->tag->symtree->n.sym == sym)		\
+	  return 1;							\
+	} while (0)
+
+static gfc_exec_op last_readwrite;
+
+/* Callback to determine if the symbol is defined somewhere for a
+   gfc_code.  Passing an argument to a subroutine as an argument
+   which is not an INTENT(IN) counts as being modified.  */
+
+static int
+defined_code_callback (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+		      void *data)
+{
+  gfc_code *co = *c;
+  gfc_symbol *sym;
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+
+  sym = (gfc_symbol *) data;
+
+  switch (co->op)
+    {
+    case EXEC_IOLENGTH:
+      last_readwrite = EXEC_IOLENGTH;
+      /* Fall through.  */
+    case EXEC_ASSIGN:
+    case EXEC_LABEL_ASSIGN:
+      if (co->expr1->symtree->n.sym == sym)
+	return 1;
+      break;
+
+    case EXEC_OPEN:
+      CHECK_TAG (open, iostat);
+      CHECK_TAG (open, iomsg);
+      CHECK_TAG (open, newunit);
+      break;
+      
+    case EXEC_CLOSE:
+      CHECK_TAG (close, iostat);
+      CHECK_TAG (close, iomsg);
+      break;
+
+    case EXEC_BACKSPACE:
+    case EXEC_ENDFILE:
+    case EXEC_REWIND:
+    case EXEC_FLUSH:
+      CHECK_TAG (filepos, iostat);
+      CHECK_TAG (filepos, iomsg);
+      break;
+
+    case EXEC_INQUIRE:
+      CHECK_TAG (inquire, iomsg);
+      CHECK_TAG (inquire, iostat);
+      CHECK_TAG (inquire, exist);
+      CHECK_TAG (inquire, opened);
+      CHECK_TAG (inquire, number);
+      CHECK_TAG (inquire, named);
+      CHECK_TAG (inquire, name);
+      CHECK_TAG (inquire, access);
+      CHECK_TAG (inquire, sequential);
+      CHECK_TAG (inquire, direct);
+      CHECK_TAG (inquire, form);
+      CHECK_TAG (inquire, formatted);
+      CHECK_TAG (inquire, unformatted);
+      CHECK_TAG (inquire, recl);
+      CHECK_TAG (inquire, nextrec);
+      CHECK_TAG (inquire, blank);
+      CHECK_TAG (inquire, position);
+      CHECK_TAG (inquire, action);
+      CHECK_TAG (inquire, read);
+      CHECK_TAG (inquire, write);
+      CHECK_TAG (inquire, readwrite);
+      CHECK_TAG (inquire, delim);
+      CHECK_TAG (inquire, encoding);
+      CHECK_TAG (inquire, pad);
+      CHECK_TAG (inquire, iolength);
+      CHECK_TAG (inquire, convert);
+      CHECK_TAG (inquire, strm_pos);
+      CHECK_TAG (inquire, asynchronous);
+      CHECK_TAG (inquire, decimal);
+      CHECK_TAG (inquire, pending);
+      CHECK_TAG (inquire, id);
+      CHECK_TAG (inquire, sign);
+      CHECK_TAG (inquire, size);
+      CHECK_TAG (inquire, round);
+      break;
+
+    case EXEC_WAIT:
+      CHECK_TAG (wait, iostat);
+      CHECK_TAG (wait, iomsg);
+      break;
+
+    case EXEC_READ:
+      last_readwrite = EXEC_READ;
+      CHECK_TAG (dt, iostat);
+      CHECK_TAG (dt, iomsg);
+      CHECK_TAG (dt, id);
+      break;
+
+    case EXEC_WRITE:
+      last_readwrite = EXEC_WRITE;
+      CHECK_TAG (dt, iostat);
+      CHECK_TAG (dt, iomsg);
+      CHECK_TAG (dt, id);
+      break;
+
+    case EXEC_DT_END:
+      last_readwrite = EXEC_NOP;
+      break;
+
+    case EXEC_TRANSFER:
+      if (last_readwrite == EXEC_READ && co->expr1
+	  && co->expr1->expr_type == EXPR_VARIABLE
+	  && co->expr1->symtree && co->expr1->symtree->n.sym == sym)
+	return 1;
+      break;
+
+    case EXEC_DO:
+      if (co->ext.iterator && co->ext.iterator->var->symtree->n.sym == sym)
+	return 1;
+      break;
+
+    case EXEC_CALL:
+      if (co->resolved_sym == NULL)
+	return 1;
+
+      f = gfc_sym_get_dummy_args (co->resolved_sym);
+      for (a = co->ext.actual; a; a = a->next)
+	{
+	  if (a->expr && a->expr->symtree && a->expr->symtree->n.sym == sym)
+	    {
+	      if (f == NULL || f->sym == NULL)
+		return 1;
+
+	      if (f->sym->attr.intent != INTENT_IN)
+		return 1;
+	    }
+	  if (f)
+	    f = f->next;
+	}
+      break;
+
+    default:
+      break;
+    }
+  return 0;
+
+}
+
+#undef CHECK_TAG
+
+/* Callback to determine if the symbol is defined as an argument to a
+   function.  Passing to a function as an argument which is not an
+   INTENT(IN) counts as being modified.  */
+
+static int
+defined_expr_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+		       void *data)
+{
+  gfc_expr *expr = *e;
+  gfc_symbol *sym;
+  gfc_formal_arglist *f;
+  gfc_actual_arglist *a;
+
+  if (expr->expr_type != EXPR_FUNCTION || expr->value.function.isym)
+    return 0;
+
+  sym = (gfc_symbol *) data;
+  f = gfc_sym_get_dummy_args (expr->symtree->n.sym);
+
+  for (a = expr->value.function.actual; a ; a = a->next)
+    {
+      if (a->expr && a->expr->symtree && a->expr->symtree->n.sym == sym)
+	{
+	  if (f == NULL || f->sym == NULL)
+	    return 1;
+
+	  if (f->sym->attr.intent != INTENT_IN)
+	    return 1;
+	}
+      if (f)
+	f = f->next;
+    }
+  return 0;
+}
+
+/* Replace INTENT(IN) scalar variables by assigning their values to
+   temporary variables.  We really only want to use this for the
+   simplest cases, all the fancy stuff is excluded.  */
+
+static void
+replace_intent_in (gfc_namespace *ns)
+{
+  gfc_formal_arglist *f;
+  gfc_namespace *ns_c;
+  gfc_code **c;
+
+  if (ns == NULL || ns->proc_name == NULL || gfc_elemental (ns->proc_name)
+      || ns->proc_name->attr.entry_master)
+    return;
+
+  for (f = ns->proc_name->formal; f; f = f->next)
+    {
+      if (f->sym == NULL || f->sym->attr.dimension || f->sym->attr.allocatable
+	  || f->sym->attr.optional || f->sym->attr.pointer
+	  || f->sym->attr.codimension || f->sym->attr.value
+	  || f->sym->attr.proc_pointer || f->sym->attr.target
+	  || f->sym->attr.asynchronous || f->sym->attr.volatile_
+	  || f->sym->attr.procedure
+	  || f->sym->ts.type == BT_CHARACTER || f->sym->ts.type == BT_DERIVED
+	  || f->sym->ts.type == BT_CLASS || f->sym->ts.type == BT_UNKNOWN
+	  || f->sym->attr.intent == INTENT_OUT)
+	continue;
+
+      if (f->sym->attr.intent == INTENT_IN
+	  || gfc_code_walker (&ns->code, defined_code_callback,
+			      defined_expr_callback, (void *) f->sym) == 0)
+	{
+	  gfc_symtree *symtree;
+	  gfc_symbol *replacement;
+	  sym_replace sr;
+
+	  char name[GFC_MAX_SYMBOL_LEN + 1];
+	  snprintf (name, GFC_MAX_SYMBOL_LEN, "__dummy_%d_%s", var_num++,
+		    f->sym->name);
+
+	  if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
+	    gcc_unreachable ();
+
+	  replacement = symtree->n.sym;
+	  replacement->ts = f->sym->ts;
+	  replacement->attr.flavor = FL_VARIABLE;
+	  replacement->attr.fe_temp = 1;
+	  replacement->attr.referenced = 1;
+	  replacement->declared_at = f->sym->declared_at;
+	  gfc_commit_symbol (replacement);
+
+	  sr.original = f->sym;
+	  sr.replacement_symtree = symtree;
+	  sr.referenced = false;
+
+	  /* Skip any INIT_ASSIGN statements at the beginning.  */
+	  for (c = &ns->code; *c != NULL && (*c)->op == EXEC_INIT_ASSIGN;
+	       c = &(*c)->next)
+	    ;
+
+	  gfc_code_walker (c, gfc_dummy_code_callback,
+			   replace_symbol_in_expr, (void *) &sr);
+
+	  for (ns_c = ns->contained; ns_c != NULL; ns_c = ns_c->sibling)
+	    {
+	      gfc_code **c_c;
+	      for (c_c = &ns_c->code; *c_c != NULL && (*c_c)->op == EXEC_INIT_ASSIGN;
+		   c_c = &(*c_c)->next)
+		;
+
+	      gfc_code_walker (&ns_c->code, gfc_dummy_code_callback,
+			       replace_symbol_in_expr, (void *) &sr);
+	    }
+
+	  if (sr.referenced)
+	    {
+	      gfc_code *n;
+	      gfc_symtree *formal_symtree;
+
+	      /* Generate statement __tmp_42_foo = foo .   */
+	      n = XCNEW (gfc_code);
+	      n->op = EXEC_ASSIGN;
+	      n->expr1 = gfc_lval_expr_from_sym (replacement);
+	      n->expr1->where = f->sym->declared_at;
+	      formal_symtree = gfc_find_symtree (ns->sym_root, f->sym->name);
+	      n->expr2 = gfc_get_variable_expr (formal_symtree);
+	      n->expr2->where = f->sym->declared_at;
+	      n->loc = f->sym->declared_at;
+
+	      n->next = (*c);
+	      (*c) = n;
+	    }
+	}
+    }
+}
Index: testsuite/gfortran.dg/pr26246_2.f90
===================================================================
--- testsuite/gfortran.dg/pr26246_2.f90	(Revision 278025)
+++ testsuite/gfortran.dg/pr26246_2.f90	(Arbeitskopie)
@@ -1,5 +1,5 @@
 ! PR fortran/26246
-! { dg-options "-fdump-tree-original -fno-automatic" }
+! { dg-options "-fno-frontend-optimize -fdump-tree-original -fno-automatic" }
 ! { dg-do compile }
 
 subroutine foo(string, n)

[-- Attachment #3: intent_optimize_4.f90 --]
[-- Type: text/x-fortran, Size: 1393 bytes --]

! { dg-do compile }
! { dg-options "-fdump-tree-original -ffrontend-optimize" }

! PR 67202 Check different situations for when a local copy of an
! argument passed by references should be made.
module x
  implicit none
contains
  subroutine foo (a, b, c, d, e, f, g, h, ios, recl)
    real :: a, b, c, d, e, f, g, h
    integer :: n, ios, recl
    read (*,*, iostat=ios) a
    write (*,*) b
    inquire (unit=10, recl=recl)
    call bar (c, d)
    write (*,*) baz(e, g), sin(f)
  end subroutine foo
  subroutine bar(x, y)
    real, intent(in) :: x
    real :: y
  end subroutine bar
  real function baz(xx,yy)
    real, intent(inout) :: xx
    real, intent(in) :: yy
    baz = 42.
    xx = yy + 1.
  end function baz
end module x
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_a" 0 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_ios" 0 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_b" 3 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_recl" 0 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_c" 3 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_d" 0 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_e" 0 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_f" 3 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_g" 3 "original" } }

[-- Attachment #4: intent_optimize_3.f90 --]
[-- Type: text/x-fortran, Size: 486 bytes --]

! { dg-do compile }
! { dg-options "-fdump-tree-original -ffrontend-optimize" }
! PR 67202 - load INTENT(IN) scalars to a variable.
module x
contains
  subroutine foo (i, j, k1, k2)
    integer, intent(in) :: i,j
    integer, intent(out) :: k1, k2
    k1 = i + j
    block
      k2 = i
    end block      
  end subroutine foo
end module x
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_i" 4 "original" } }
! { dg-final { scan-tree-dump-times "__dummy_\[0-9\]_j" 3 "original" } }

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Bernhard Reutner-Fischer]

On 16 November 2019 21:33:58 CET, Thomas Koenig <tkoenig@netcologne.de> wrote:
>Hello world,
>
>here is an update to the patch.

+	  char name[GFC_MAX_SYMBOL_LEN + 1];
+	  snprintf (name, GFC_MAX_SYMBOL_LEN, "__dummy_%d_%s", var_num++,
+		    f->sym->name);
+
+	  if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)

(I) you should + sizeof(__dummy__) + 10 for unsigned long %d or the like.
(II) s/__dummy/__intent_in/ for clarity?

thanks,

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas Koenig]

Am 19.11.19 um 11:39 schrieb Bernhard Reutner-Fischer:
> +	  char name[GFC_MAX_SYMBOL_LEN + 1];
> +	  snprintf (name, GFC_MAX_SYMBOL_LEN, "__dummy_%d_%s", var_num++,
> +		    f->sym->name);
> +
> +	  if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
> 
> (I) you should + sizeof(__dummy__) + 10 for unsigned long %d or the like.

GFC_MAX_SYMBOL_LEN is the maximum length of a gfortran symbol. AFAIK, it
is not possible to use a longer symbol name than that, so it needs to be
truncated. Uniqueness of the variable name is guaranteed by the var_num
variable.

If the user puts dummy arguments Supercalifragilisticexpialidociousa and
Supercalifragilisticexpialidociousb into the argument list of a
procedure, he will have to look at the numbers to differentiate them :-)

> (II) s/__dummy/__intent_in/ for clarity?

It's moved away a bit from INTENT(IN) now, because an argument which
cannot be modified (even by passing to a procedure with a dummy argument
with unknown intent) is now also handled.

Regards

	Thomas

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Bernhard Reutner-Fischer]

On 19 November 2019 23:54:55 CET, Thomas Koenig <tkoenig@netcologne.de> wrote:
>Am 19.11.19 um 11:39 schrieb Bernhard Reutner-Fischer:
>> +	  char name[GFC_MAX_SYMBOL_LEN + 1];
>> +	  snprintf (name, GFC_MAX_SYMBOL_LEN, "__dummy_%d_%s", var_num++,
>> +		    f->sym->name);
>> +
>> +	  if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
>> 
>> (I) you should + sizeof(__dummy__) + 10 for unsigned long %d or the
>like.
>
>GFC_MAX_SYMBOL_LEN is the maximum length of a gfortran symbol. AFAIK,

This is only true for user-provided names in the source code.

Think e.g. class names as can be seen in the dumps..

>it
>is not possible to use a longer symbol name than that, so it needs to
>be
>truncated. Uniqueness of the variable name is guaranteed by the var_num
>variable.
>
>If the user puts dummy arguments Supercalifragilisticexpialidociousa
>and
>Supercalifragilisticexpialidociousb into the argument list of a
>procedure, he will have to look at the numbers to differentiate them
>:-)
>
>> (II) s/__dummy/__intent_in/ for clarity?
>
>It's moved away a bit from INTENT(IN) now, because an argument which
>cannot be modified (even by passing to a procedure with a dummy
>argument
>with unknown intent) is now also handled.

So maybe __readonly_ , __rdonly_, __rd_or the like? dummy is really misleading a name in the dumps..

thanks,

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Janne Blomqvist]

On Wed, Nov 20, 2019 at 8:00 PM Bernhard Reutner-Fischer
<rep.dot.nop@gmail.com> wrote:
>
> On 19 November 2019 23:54:55 CET, Thomas Koenig <tkoenig@netcologne.de> wrote:
> >Am 19.11.19 um 11:39 schrieb Bernhard Reutner-Fischer:
> >> +      char name[GFC_MAX_SYMBOL_LEN + 1];
> >> +      snprintf (name, GFC_MAX_SYMBOL_LEN, "__dummy_%d_%s", var_num++,
> >> +                f->sym->name);
> >> +
> >> +      if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
> >>
> >> (I) you should + sizeof(__dummy__) + 10 for unsigned long %d or the
> >like.
> >
> >GFC_MAX_SYMBOL_LEN is the maximum length of a gfortran symbol. AFAIK,
>
> This is only true for user-provided names in the source code.
>
> Think e.g. class names as can be seen in the dumps..

We have GFC_MAX_MANGLED_SYMBOL_LEN for that. *Insert my standard pet
peeve rant that we should use heap allocated unlimited length strings
for these rather than copying stack allocated strings around, or
preferable a symbol table*

> >it
> >is not possible to use a longer symbol name than that, so it needs to
> >be
> >truncated. Uniqueness of the variable name is guaranteed by the var_num
> >variable.
> >
> >If the user puts dummy arguments Supercalifragilisticexpialidociousa
> >and
> >Supercalifragilisticexpialidociousb into the argument list of a
> >procedure, he will have to look at the numbers to differentiate them
> >:-)
> >
> >> (II) s/__dummy/__intent_in/ for clarity?
> >
> >It's moved away a bit from INTENT(IN) now, because an argument which
> >cannot be modified (even by passing to a procedure with a dummy
> >argument
> >with unknown intent) is now also handled.
>
> So maybe __readonly_ , __rdonly_, __rd_or the like? dummy is really misleading a name in the dumps..

Well, dummy is a term with a precise definition in the Fortran
standard, so in a way it's good so one realizes it has something to do
with a dummy argument. But yes, it's a bit misleading because it's not
the dummy argument itself but rather a dereferenced copy of it. I
suggest __readonly_dereferenced_dummy_copy_yes_this_is_a_really_long_name_.
:)


-- 
Janne Blomqvist

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Steve Kargl]

On Wed, Nov 20, 2019 at 10:38:30PM +0200, Janne Blomqvist wrote:
> On Wed, Nov 20, 2019 at 8:00 PM Bernhard Reutner-Fischer
> <rep.dot.nop@gmail.com> wrote:
> >
> > On 19 November 2019 23:54:55 CET, Thomas Koenig <tkoenig@netcologne.de> wrote:
> > >Am 19.11.19 um 11:39 schrieb Bernhard Reutner-Fischer:
> > >> +      char name[GFC_MAX_SYMBOL_LEN + 1];
> > >> +      snprintf (name, GFC_MAX_SYMBOL_LEN, "__dummy_%d_%s", var_num++,
> > >> +                f->sym->name);
> > >> +
> > >> +      if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
> > >>
> > >> (I) you should + sizeof(__dummy__) + 10 for unsigned long %d or the
> > >like.
> > >
> > >GFC_MAX_SYMBOL_LEN is the maximum length of a gfortran symbol. AFAIK,
> >
> > This is only true for user-provided names in the source code.
> >
> > Think e.g. class names as can be seen in the dumps..
> 
> We have GFC_MAX_MANGLED_SYMBOL_LEN for that. *Insert my standard pet
> peeve rant that we should use heap allocated unlimited length strings
> for these rather than copying stack allocated strings around, or
> preferable a symbol table*
> 

I agree with Janne.  This seems like a very good candidate
for someone that would like to contribute to gfortran, but
does not know where to start.  Any lurkers on the mailing list
care to give it shot?

-- 
Steve

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Bernhard Reutner-Fischer]

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

On Wed, 20 Nov 2019 22:38:30 +0200
Janne Blomqvist <blomqvist.janne@gmail.com> wrote:

> On Wed, Nov 20, 2019 at 8:00 PM Bernhard Reutner-Fischer
> <rep.dot.nop@gmail.com> wrote:
> >
> > On 19 November 2019 23:54:55 CET, Thomas Koenig <tkoenig@netcologne.de> wrote:  
> > >Am 19.11.19 um 11:39 schrieb Bernhard Reutner-Fischer:  
> > >> +      char name[GFC_MAX_SYMBOL_LEN + 1];
> > >> +      snprintf (name, GFC_MAX_SYMBOL_LEN, "__dummy_%d_%s", var_num++,
> > >> +                f->sym->name);
> > >> +
> > >> +      if (gfc_get_sym_tree (name, ns, &symtree, false) != 0)
> > >>
> > >> (I) you should + sizeof(__dummy__) + 10 for unsigned long %d or the  
> > >like.
> > >
> > >GFC_MAX_SYMBOL_LEN is the maximum length of a gfortran symbol. AFAIK,  
> >
> > This is only true for user-provided names in the source code.
> >
> > Think e.g. class names as can be seen in the dumps..  
> 
> We have GFC_MAX_MANGLED_SYMBOL_LEN for that. *Insert my standard pet
> peeve rant that we should use heap allocated unlimited length strings
> for these rather than copying stack allocated strings around, or
> preferable a symbol table*

yea, which i started to lay grounds to address that in
https://gcc.gnu.org/git/?p=gcc.git;a=shortlog;h=refs/heads/aldot/fortran-fe-stringpool
about a year ago ;) Reminds me: i had to change the symbol names that
are persisted in module-files to make it work; Still not sure if that's
acceptable so if somebody would be willing to lend me a hand for
sanity-checking that aspect of the series i'd be glad. Would certainly
help to trick me into continuing the thing now, during winter.

Looks like i've another memory leak plug lying around on that tree that
i didn't try to push yet; It's the hunk in gfc_release_symbol() in the
attached brain-dump i think, don't remember and should revisit to
have it fixed for good i suppose..

> 
> > >it
> > >is not possible to use a longer symbol name than that, so it needs to
> > >be
> > >truncated. Uniqueness of the variable name is guaranteed by the var_num
> > >variable.
> > >
> > >If the user puts dummy arguments Supercalifragilisticexpialidociousa
> > >and
> > >Supercalifragilisticexpialidociousb into the argument list of a
> > >procedure, he will have to look at the numbers to differentiate them
> > >:-)
> > >  
> > >> (II) s/__dummy/__intent_in/ for clarity?  
> > >
> > >It's moved away a bit from INTENT(IN) now, because an argument which
> > >cannot be modified (even by passing to a procedure with a dummy
> > >argument
> > >with unknown intent) is now also handled.  
> >
> > So maybe __readonly_ , __rdonly_, __rd_or the like? dummy is really misleading a name in the dumps..  
> 
> Well, dummy is a term with a precise definition in the Fortran
> standard, so in a way it's good so one realizes it has something to do
> with a dummy argument. But yes, it's a bit misleading because it's not
> the dummy argument itself but rather a dereferenced copy of it. I
> suggest __readonly_dereferenced_dummy_copy_yes_this_is_a_really_long_name_.
> :)

:) __rodummy_ then?

but bikeshedding either way, so, Thomas, please go for __dummy_ short of
sensible alternatives.

cheers,

[-- Attachment #2: abstr_t_derived_decl_leak.00.patch --]
[-- Type: text/x-patch, Size: 15895 bytes --]

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index e0bb381a55f..30b2a517246 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -680,6 +680,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       c->ts.type = BT_DERIVED;
       c->attr.access = ACCESS_PRIVATE;
       c->ts.u.derived = ts->u.derived;
+      c->attr.artificial = 1;
       c->attr.class_pointer = attr->pointer;
       c->attr.pointer = attr->pointer || (attr->dummy && !attr->allocatable)
 			|| attr->select_type_temporary;
@@ -687,7 +688,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       c->attr.dimension = attr->dimension;
       c->attr.codimension = attr->codimension;
       c->attr.abstract = fclass->attr.abstract;
-      c->as = (*as);
+      c->as = *as;
       c->initializer = NULL;
 
       /* Add component '_vptr'.  */
@@ -696,6 +697,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
       c->ts.type = BT_DERIVED;
       c->attr.access = ACCESS_PRIVATE;
       c->attr.pointer = 1;
+      c->attr.artificial = 1;
 
       if (ts->u.derived->attr.unlimited_polymorphic)
 	{
@@ -2296,6 +2298,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 		goto cleanup;
 	      vtype->attr.access = ACCESS_PUBLIC;
 	      vtype->attr.vtype = 1;
+	      vtype->attr.artificial = 1;
 	      gfc_set_sym_referenced (vtype);
 
 	      /* Add component '_hash'.  */
@@ -2304,6 +2307,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	      c->ts.type = BT_INTEGER;
 	      c->ts.kind = 4;
 	      c->attr.access = ACCESS_PRIVATE;
+	      c->attr.artificial = 1;
 	      c->initializer = gfc_get_int_expr (gfc_default_integer_kind,
 						 NULL, derived->hash_value);
 
@@ -2313,6 +2317,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	      c->ts.type = BT_INTEGER;
 	      c->ts.kind = gfc_size_kind;
 	      c->attr.access = ACCESS_PRIVATE;
+	      c->attr.artificial = 1;
 	      /* Remember the derived type in ts.u.derived,
 		 so that the correct initializer can be set later on
 		 (in gfc_conv_structure).  */
@@ -2323,6 +2328,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	      /* Add component _extends.  */
 	      if (!gfc_add_component (vtype, "_extends", &c))
 		goto cleanup;
+	      c->attr.artificial = 1;
 	      c->attr.pointer = 1;
 	      c->attr.access = ACCESS_PRIVATE;
 	      if (!derived->attr.unlimited_polymorphic)
@@ -2337,6 +2343,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 		  c->ts.u.derived = parent_vtab->ts.u.derived;
 		  c->initializer = gfc_get_expr ();
 		  c->initializer->expr_type = EXPR_VARIABLE;
+		  c->attr.artificial = 1;
 		  gfc_find_sym_tree (parent_vtab->name, parent_vtab->ns,
 				     0, &c->initializer->symtree);
 		}
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index f6f4a37d357..a3ae50d6985 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -4071,7 +4071,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
 	      upe->attr.zero_comp = 1;
 	      if (!gfc_add_flavor (&upe->attr, FL_DERIVED, NULL,
 				   &gfc_current_locus))
-	      return MATCH_ERROR;
+		return MATCH_ERROR;
 	    }
 	  else
 	    {
@@ -7852,7 +7852,7 @@ gfc_match_end (gfc_statement *st)
     case COMP_SUBROUTINE:
       *st = ST_END_SUBROUTINE;
       if (!abreviated_modproc_decl)
-      target = " subroutine";
+	target = " subroutine";
       else
 	target = " procedure";
       eos_ok = !contained_procedure ();
@@ -7861,7 +7861,7 @@ gfc_match_end (gfc_statement *st)
     case COMP_FUNCTION:
       *st = ST_END_FUNCTION;
       if (!abreviated_modproc_decl)
-      target = " function";
+	target = " function";
       else
 	target = " procedure";
       eos_ok = !contained_procedure ();
@@ -9920,7 +9920,7 @@ gfc_match_derived_decl (void)
   match m;
   match is_type_attr_spec = MATCH_NO;
   bool seen_attr = false;
-  gfc_interface *intr = NULL, *head;
+  gfc_interface *intr = NULL;
   bool parameterized_type = false;
   bool seen_colons = false;
 
@@ -9943,16 +9943,15 @@ gfc_match_derived_decl (void)
      been added to 'attr' but now the parent type must be found and
      checked.  */
   if (parent != NULL)
-    extended = check_extended_derived_type (parent);
-
-  if (parent != NULL && !extended)
-    return MATCH_ERROR;
+    {
+      extended = check_extended_derived_type (parent);
+      if (extended == NULL)
+	return MATCH_ERROR;
+    }
 
   m = gfc_match (" ::");
   if (m == MATCH_YES)
-    {
-      seen_colons = true;
-    }
+    seen_colons = true;
   else if (seen_attr)
     {
       gfc_error ("Expected :: in TYPE definition at %C");
@@ -9991,23 +9990,25 @@ gfc_match_derived_decl (void)
   if (gfc_get_symbol (name, NULL, &gensym))
     return MATCH_ERROR;
 
+  //gfc_new_block = gensym;
+
   if (!gensym->attr.generic && gensym->ts.type != BT_UNKNOWN)
     {
       if (gensym->ts.u.derived)
 	gfc_error ("Derived type name %qs at %C already has a basic type "
-		   "of %s", gensym->name, gfc_typename (&gensym->ts));
+		   "of %s", name, gfc_typename (&gensym->ts));
       else
 	gfc_error ("Derived type name %qs at %C already has a basic type",
-		   gensym->name);
+		   name);
       return MATCH_ERROR;
     }
 
   if (!gensym->attr.generic
-      && !gfc_add_generic (&gensym->attr, gensym->name, NULL))
+      && !gfc_add_generic (&gensym->attr, name, NULL))
     return MATCH_ERROR;
 
   if (!gensym->attr.function
-      && !gfc_add_function (&gensym->attr, gensym->name, NULL))
+      && !gfc_add_function (&gensym->attr, name, NULL))
     return MATCH_ERROR;
 
   sym = gfc_find_dt_in_generic (gensym);
@@ -10022,14 +10023,12 @@ gfc_match_derived_decl (void)
   if (!sym)
     {
       /* Use upper case to save the actual derived-type symbol.  */
-      gfc_get_symbol (gfc_dt_upper_string (gensym->name), NULL, &sym);
-      sym->name = gfc_get_string ("%s", gensym->name);
-      head = gensym->generic;
+      gfc_get_symbol (gfc_dt_upper_string (name), NULL, &sym);
+      sym->name = gensym->name;
       intr = gfc_get_interface ();
       intr->sym = sym;
       intr->where = gfc_current_locus;
-      intr->sym->declared_at = gfc_current_locus;
-      intr->next = head;
+      intr->next = gensym->generic;
       gensym->generic = intr;
       gensym->attr.if_source = IFSRC_DECL;
     }
@@ -10040,16 +10039,16 @@ gfc_match_derived_decl (void)
      derived type that is a pointer.  The first part of the AND clause
      is true if the symbol is not the return value of a function.  */
   if (sym->attr.flavor != FL_DERIVED
-      && !gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL))
+      && !gfc_add_flavor (&sym->attr, FL_DERIVED, name, NULL))
     return MATCH_ERROR;
 
   if (attr.access != ACCESS_UNKNOWN
-      && !gfc_add_access (&sym->attr, attr.access, sym->name, NULL))
+      && !gfc_add_access (&sym->attr, attr.access, name, NULL))
     return MATCH_ERROR;
   else if (sym->attr.access == ACCESS_UNKNOWN
 	   && gensym->attr.access != ACCESS_UNKNOWN
 	   && !gfc_add_access (&sym->attr, gensym->attr.access,
-			       sym->name, NULL))
+			       name, NULL))
     return MATCH_ERROR;
 
   if (sym->attr.access != ACCESS_UNKNOWN
@@ -10085,15 +10084,6 @@ gfc_match_derived_decl (void)
       gfc_component *p;
       gfc_formal_arglist *f, *g, *h;
 
-      /* Add the extended derived type as the first component.  */
-      gfc_add_component (sym, parent, &p);
-      extended->refs++;
-      gfc_set_sym_referenced (extended);
-
-      p->ts.type = BT_DERIVED;
-      p->ts.u.derived = extended;
-      p->initializer = gfc_default_initializer (&p->ts);
-
       /* Set extension level.  */
       if (extended->attr.extension == 255)
 	{
@@ -10103,6 +10093,16 @@ gfc_match_derived_decl (void)
 		     extended->name, &extended->declared_at);
 	  return MATCH_ERROR;
 	}
+
+      /* Add the extended derived type as the first component.  */
+      gfc_add_component (sym, parent, &p);
+      extended->refs++;
+      gfc_set_sym_referenced (extended);
+
+      p->ts.type = BT_DERIVED;
+      p->ts.u.derived = extended;
+      p->initializer = gfc_default_initializer (&p->ts);
+
       sym->attr.extension = extended->attr.extension + 1;
 
       /* Provide the links between the extended type and its extension.  */
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index f7c369a17ac..3467d4a6780 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -3264,6 +3264,8 @@ parse_derived (void)
   gfc_component *c, *lock_comp = NULL, *event_comp = NULL;
 
   accept_statement (ST_DERIVED_DECL);
+
+  //push_state (&s, COMP_DERIVED, gfc_new_block->generic->sym);
   push_state (&s, COMP_DERIVED, gfc_new_block);
 
   gfc_new_block->component_access = ACCESS_PUBLIC;
@@ -3280,6 +3282,7 @@ parse_derived (void)
 	{
 	case ST_NONE:
 	  unexpected_eof ();
+	  break; /* never reached */
 
 	case ST_DATA_DECL:
 	case ST_PROCEDURE:
@@ -3339,9 +3342,7 @@ endType:
 			 "TYPE statement");
 
 	  if (seen_sequence)
-	    {
-	      gfc_error ("Duplicate SEQUENCE statement at %C");
-	    }
+	    gfc_error ("Duplicate SEQUENCE statement at %C");
 
 	  seen_sequence = 1;
 	  gfc_add_sequence (&gfc_current_block ()->attr,
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7a87f2c0ad4..058f71e41a5 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2489,7 +2489,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 
   gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name);
 
-  if ((gsym->type != GSYM_UNKNOWN && gsym->type != type))
+  if (gsym->type != GSYM_UNKNOWN && gsym->type != type)
     gfc_global_used (gsym, where);
 
   if ((sym->attr.if_source == IFSRC_UNKNOWN
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index c99c106a0c0..4dd871d50cb 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1759,8 +1759,8 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name,
   /* Copying a procedure dummy argument for a module procedure in a
      submodule results in the flavor being copied and would result in
      an error without this.  */
-  if (gfc_new_block && gfc_new_block->abr_modproc_decl
-      && attr->flavor == f && f == FL_PROCEDURE)
+  if (f == FL_PROCEDURE && attr->flavor == f
+      && gfc_new_block && gfc_new_block->abr_modproc_decl)
     return true;
 
   if (attr->flavor != FL_UNKNOWN)
@@ -2319,6 +2319,8 @@ gfc_use_derived (gfc_symbol *sym)
   gfc_symbol *s;
   gfc_typespec *t;
   gfc_symtree *st;
+  gfc_interface *inter;
+  gfc_formal_arglist *f;
   int i;
 
   if (!sym)
@@ -2362,7 +2364,22 @@ gfc_use_derived (gfc_symbol *sym)
   gfc_commit_symbol (sym);
 
   switch_types (sym->ns->sym_root, sym, s);
-
+#if 1
+  /* Replace old sym with new one in generic and formal interfaces */
+  if (sym->attr.generic)
+    for (inter = sym->generic; inter; inter = inter->next)
+      if (inter->sym == sym)
+	{
+gcc_unreachable ();
+	inter->sym = s;
+	}
+  for (f = sym->formal; f; f = f->next)
+      if (f->sym == sym)
+	{
+gcc_unreachable ();
+	f->sym = s;
+	}
+#endif
   /* TODO: Also have to replace sym -> s in other lists like
      namelists, common lists and interface lists.  */
   gfc_free_symbol (sym);
@@ -3086,6 +3103,8 @@ gfc_free_symbol (gfc_symbol *&sym)
   if (sym->ns != sym->formal_ns)
     gfc_free_namespace (sym->formal_ns);
 
+  free_components (sym->components);
+
   if (!sym->attr.generic_copy)
     gfc_free_interface (sym->generic);
 
@@ -3093,8 +3112,6 @@ gfc_free_symbol (gfc_symbol *&sym)
 
   gfc_free_namespace (sym->f2k_derived);
 
-  free_components (sym->components);
-
   set_symbol_common_block (sym, NULL);
 
   if (sym->param_list)
@@ -3123,6 +3140,21 @@ gfc_release_symbol (gfc_symbol *&sym)
       gfc_free_namespace (ns);
     }
 
+  /* Free the symbol for the abstract type of derived decls.  */
+  if (sym->attr.flavor == FL_DERIVED
+      && sym->attr.if_source == IFSRC_UNKNOWN
+      && !sym->attr.artificial
+      && !sym->attr.generic
+      && !sym->attr.is_class
+      && !sym->attr.zero_comp
+      && !sym->attr.alloc_comp
+      && !sym->attr.proc_pointer_comp
+      && sym->refs == 2
+      && ((sym->attr.abstract && !sym->attr.extension)
+	  || (!sym->attr.abstract && sym->attr.extension))
+      )
+    sym->refs--;
+
   sym->refs--;
   if (sym->refs > 0)
     return;
@@ -3140,7 +3172,6 @@ gfc_new_symbol (const char *name, gfc_namespace *ns)
   gfc_symbol *p;
 
   p = XCNEW (gfc_symbol);
-
   gfc_clear_ts (&p->ts);
   gfc_clear_attr (&p->attr);
   p->ns = ns;
@@ -3376,7 +3407,6 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result,
       p = gfc_new_symbol (name, ns);
 
       /* Add to the list of tentative symbols.  */
-      p->old_symbol = NULL;
       p->mark = 1;
       p->gfc_new = 1;
       latest_undo_chgset->syms.safe_push (p);
@@ -3384,7 +3414,6 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result,
       st = gfc_new_symtree (&ns->sym_root, name);
       st->n.sym = p;
       p->refs++;
-
     }
   else
     {
@@ -3889,16 +3918,21 @@ free_uop_tree (gfc_symtree *uop_tree)
    that it contains.  */
 
 static void
-free_sym_tree (gfc_symtree *sym_tree)
+free_sym_tree (gfc_symtree **sym_tree)
 {
-  if (sym_tree == NULL)
+  if (!sym_tree || !*sym_tree)
     return;
 
-  free_sym_tree (sym_tree->left);
-  free_sym_tree (sym_tree->right);
+  free_sym_tree (&(*sym_tree)->left);
+  free_sym_tree (&(*sym_tree)->right);
+
+  gfc_release_symbol ((*sym_tree)->n.sym);
 
-  gfc_release_symbol (sym_tree->n.sym);
-  free (sym_tree);
+//  if ((*sym_tree)->n.sym == NULL)
+    {
+      free (*sym_tree);
+      *sym_tree = NULL;
+    }
 }
 
 
@@ -4035,21 +4069,35 @@ gfc_free_namespace (gfc_namespace *&ns)
 
   gfc_free_statements (ns->code);
 
-  free_sym_tree (ns->sym_root);
+  free_sym_tree (&ns->sym_root);
+  ns->sym_root = NULL;
   free_uop_tree (ns->uop_root);
+  ns->uop_root = NULL;
   free_common_tree (ns->common_root);
+  ns->common_root = NULL;
   free_omp_udr_tree (ns->omp_udr_root);
+  ns->omp_udr_root = NULL;
   free_tb_tree (ns->tb_sym_root);
+  ns->tb_sym_root = NULL;
   free_tb_tree (ns->tb_uop_root);
+  ns->tb_uop_root = NULL;
   gfc_free_finalizer_list (ns->finalizers);
+  ns->finalizers = NULL;
   gfc_free_omp_declare_simd_list (ns->omp_declare_simd);
+  ns->omp_declare_simd = NULL;
   gfc_free_charlen (ns->cl_list, NULL);
+  ns->cl_list = NULL;
   free_st_labels (ns->st_labels);
+  ns->st_labels = NULL;
 
   free_entry_list (ns->entries);
+  ns->entries = NULL;
   gfc_free_equiv (ns->equiv);
+  ns->equiv = NULL;
   gfc_free_equiv_lists (ns->equiv_lists);
+  ns->equiv_lists = NULL;
   gfc_free_use_stmts (ns->use_stmts);
+  ns->use_stmts = NULL;
 
   for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++)
     gfc_free_interface (ns->op[i]);
@@ -4777,9 +4825,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 	      gfc_derived_types->dt_next = tmp_sym;
 	    }
 	  else
-	    {
-	      tmp_sym->dt_next = tmp_sym;
-	    }
+	    tmp_sym->dt_next = tmp_sym;
 	  gfc_derived_types = tmp_sym;
         }
 
@@ -4955,9 +5001,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
 	      gfc_derived_types->dt_next = dt_sym;
 	    }
 	  else
-	    {
-	      dt_sym->dt_next = dt_sym;
-	    }
+	    dt_sym->dt_next = dt_sym;
 	  gfc_derived_types = dt_sym;
 
 	  gfc_add_component (dt_sym, "c_address", &tmp_comp);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b202469bc40..8f2bdf96b2e 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7648,7 +7648,7 @@ gfc_trans_subcomponent_assign (tree dest, gfc_component * cm, gfc_expr * expr,
 	  gfc_add_expr_to_block (&block, tmp);
 	}
     }
-  else if (!cm->attr.artificial)
+  else //if (!cm->attr.artificial)
     {
       /* Scalar component (excluding deferred parameters).  */
       gfc_init_se (&se, NULL);

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Janne Blomqvist]

On Sat, Nov 16, 2019 at 10:34 PM Thomas Koenig <tkoenig@netcologne.de> wrote:
>
> Hello world,
>
> here is an update to the patch.
>
> I have now included variables where the user did not specify INTENT(IN)
> by checking that the dummy variables to be replaced by temporaries
> are not, indeed, assigned a value. This also includes being passed
> as an actual argument to a non-INTENT(IN) dummy argument.
>
> Extending this led to being able to catch a few more bugs.
>
> I have addes one test case to check where the new temporaries are added.
>
> Regression-tested. The only change I see in the testsuite now is
>
> XPASS: gfortran.dg/goacc/kernels-loop-n.f95   -O   scan-tree-dump-times
> parloops1 "(?n)__attribute__\\(\\(oacc kernels parallelized, oacc
> function \\(, , \\), oacc kernels, omp target entrypoint\\)\\)" 1

BTW, since this is done for the purpose of optimization, have you done
testing on some suitable benchmark suite such as polyhedron, whether
it a) generates any different code b) does it make it go faster?

Is there a risk of performance regressions due to higher register pressure?

-- 
Janne Blomqvist

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas König]

Am 20.11.19 um 21:45 schrieb Janne Blomqvist:
> BTW, since this is done for the purpose of optimization, have you done
> testing on some suitable benchmark suite such as polyhedron, whether
> it a) generates any different code b) does it make it go faster?

I haven't run any actual benchmarks.

However, there is a simple example which shows its advantages.
Consider

       subroutine foo(n,m)
       m = 0
       do 100 i=1,100
         call bar
         m = m + n
  100  continue
       end

(I used old-style DO loops just because :-)

Without the optimization, the inner loop is translated to

.L2:
         xorl    %eax, %eax
         call    bar_
         movl    (%r12), %eax
         addl    %eax, 0(%rbp)
         subl    $1, %ebx
         jne     .L2

and with the optimization to

.L2:
         xorl    %eax, %eax
         call    bar_
         addl    %r12d, 0(%rbp)
         subl    $1, %ebx
         jne     .L2

so the load of the address is missing.  (Why do we zero %eax
before each call? It should not be a variadic call right?)

Of course, Fortran language rules specify that the call to bar
cannot do anything to n, but apparently we do not tell the gcc
middle end that this is the case, or maybe that there is
no way to really specify this.

(Actually, I just tried out

       subroutine foo(n,m)
       integer :: dummy_n, dummy_m
       dummy_n = n
       dummy_m = 0
       do 100 i=1,100
          call bar
          dummy_m = dummy_m + dummy_n
  100  continue
       m = dummy_m
       end

This is optimized even further:

.L2:
         xorl    %eax, %eax
         call    bar_
         subl    $1, %ebx
         jne     .L2
         imull   $100, %r12d, %r12d

So, a copy in / copy out for variables where we can not be sure that
no value is assigned?  Does anybody see a downside for that?)

> Is there a risk of performance regressions due to higher register pressure?

I don't think so. Either the compiler realizes that it can
keep the variable in a register (then it makes no difference),
or it has to load it fresh from its address (then there is
one additional register needed).

Regards

	Thomas

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Janne Blomqvist]

On Wed, Nov 20, 2019 at 11:35 PM Thomas König <tk@tkoenig.net> wrote:
>
> Am 20.11.19 um 21:45 schrieb Janne Blomqvist:
> > BTW, since this is done for the purpose of optimization, have you done
> > testing on some suitable benchmark suite such as polyhedron, whether
> > it a) generates any different code b) does it make it go faster?
>
> I haven't run any actual benchmarks.
>
> However, there is a simple example which shows its advantages.
> Consider
>
>        subroutine foo(n,m)
>        m = 0
>        do 100 i=1,100
>          call bar
>          m = m + n
>   100  continue
>        end
>
> (I used old-style DO loops just because :-)
>
> Without the optimization, the inner loop is translated to
>
> .L2:
>          xorl    %eax, %eax
>          call    bar_
>          movl    (%r12), %eax
>          addl    %eax, 0(%rbp)
>          subl    $1, %ebx
>          jne     .L2
>
> and with the optimization to
>
> .L2:
>          xorl    %eax, %eax
>          call    bar_
>          addl    %r12d, 0(%rbp)
>          subl    $1, %ebx
>          jne     .L2
>
> so the load of the address is missing.  (Why do we zero %eax
> before each call? It should not be a variadic call right?)

Not sure. Maybe some belt and suspenders thing? I guess someone better
versed in ABI minutiae knows better. It's not Fortran-specific though,
the C frontend does the same when calling a void function.

AFAIK on reasonably current OoO CPU's xor'ing a register with itself
is handled by the renamer and doesn't consume an execute slot, so it's
in effect a zero-cycle instruction. Still bloats the code slightly,
though.

> Of course, Fortran language rules specify that the call to bar
> cannot do anything to n

Hmm, does it? What about the following modification to your testcase:

module nmod
  integer :: n
end module nmod

subroutine foo(n,m)
  m = 0
  do 100 i=1,100
     call bar
     m = m + n
100  continue
end subroutine foo

subroutine bar()
  use nmod
  n = 0
end subroutine bar

program main
  use nmod
  implicit none
  integer :: m
  n = 1
  m = 0
  call foo(n, m)
  print *, m
end program main


> So, a copy in / copy out for variables where we can not be sure that
> no value is assigned?  Does anybody see a downside for that?)

In principle sounds good, unless my concerns above are real and affect
this case too.

> > Is there a risk of performance regressions due to higher register pressure?
>
> I don't think so. Either the compiler realizes that it can
> keep the variable in a register (then it makes no difference),
> or it has to load it fresh from its address (then there is
> one additional register needed).

Yes, true. Good point.


-- 
Janne Blomqvist

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Janne Blomqvist]

On Thu, Nov 21, 2019 at 12:18 AM Janne Blomqvist
<blomqvist.janne@gmail.com> wrote:
>
> On Wed, Nov 20, 2019 at 11:35 PM Thomas König <tk@tkoenig.net> wrote:
> > (Why do we zero %eax
> > before each call? It should not be a variadic call right?)
>
> Not sure. Maybe some belt and suspenders thing? I guess someone better
> versed in ABI minutiae knows better. It's not Fortran-specific though,
> the C frontend does the same when calling a void function.

Ah, scratch that, it is some varargs-thing, I had forgot that a C
function with no arguments or lacking a prototype is considered a
varargs. The code

void foo();
void bar(void);

void testfoo()
{
foo();
}

void testbar()
{
bar();
}

void testunprototyped()
{
baz();
}


generates code (elided scaffolding):

testfoo:
    xorl %eax, %eax
    jmp foo
testbar:
    jmp bar
testunprototyped:
    xorl %eax, %eax
    jmp baz


So probably this is due to the Fortran procedures lacking an interface
being considered varargs by the caller.  Starts to smell like some
leftover from PR 87689?

-- 
Janne Blomqvist

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Janne Blomqvist]

On Thu, Nov 21, 2019 at 12:31 AM Janne Blomqvist
<blomqvist.janne@gmail.com> wrote:
>
> On Thu, Nov 21, 2019 at 12:18 AM Janne Blomqvist
> <blomqvist.janne@gmail.com> wrote:
> >
> > On Wed, Nov 20, 2019 at 11:35 PM Thomas König <tk@tkoenig.net> wrote:
> > > (Why do we zero %eax
> > > before each call? It should not be a variadic call right?)
> >
> > Not sure. Maybe some belt and suspenders thing? I guess someone better
> > versed in ABI minutiae knows better. It's not Fortran-specific though,
> > the C frontend does the same when calling a void function.
>
> Ah, scratch that, it is some varargs-thing, I had forgot that a C
> function with no arguments or lacking a prototype is considered a
> varargs. The code
>
> void foo();
> void bar(void);
>
> void testfoo()
> {
> foo();
> }
>
> void testbar()
> {
> bar();
> }
>
> void testunprototyped()
> {
> baz();
> }
>
>
> generates code (elided scaffolding):
>
> testfoo:
>     xorl %eax, %eax
>     jmp foo
> testbar:
>     jmp bar
> testunprototyped:
>     xorl %eax, %eax
>     jmp baz
>
>
> So probably this is due to the Fortran procedures lacking an interface
> being considered varargs by the caller.  Starts to smell like some
> leftover from PR 87689?

Thinking some more about it, I'm thinking we should leave it as is,
even though it's a (small) code bloat. So Fortran calling a procedure
with an implicit interface most closely resembles the C unprototyped
function call. The problem is that we don't know much about the
callee. What if a Fortran procedure calls a C varargs procedure? In
the Fortran caller, we don't know whether the callee is varargs or
not, but if we don't zero %eax all hell could break loose if it
happened to be a varargs function. Yes, we could hide behind Fortran
not supporting varargs, and it's all the users fault, but is it really
worth it? I'd say no.

(in some cases zeroing a register is used to tell the OoO hw to kill a
dependency, so it can be beneficial for performance even if not
strictly required for correctness)

-- 
Janne Blomqvist

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Tobias Burnus]

On 11/20/19 11:18 PM, Janne Blomqvist wrote:

>> Of course, Fortran language rules specify that the call to bar
>> cannot do anything to n
> Hmm, does it? What about the following modification to your testcase:

This code violates (quote from F2018):

"15.5.2.13  Restrictions on entities associated with dummy arguments"
"While an entity is associated with a dummy argument, the following 
restrictions hold."
"[…] (3)   Action that affects the value of the entity or any subobject 
of it shall be taken only through the dummy argument unless"
"(a) the dummy argument has the POINTER attribute, […]"
(Some more related to TARGET attribute and to coarrays, which also do 
not apply here.)

Not listed there, but the asynchronous attribute (Section 8.5.4) would 
be also a way to disable the optimization we are talking about.

Cheers,

Tobias

> module nmod
>    integer :: n
> end module nmod
>
> subroutine foo(n,m)
>    m = 0
>    do 100 i=1,100
>       call bar
>       m = m + n
> 100  continue
> end subroutine foo
>
> subroutine bar()
>    use nmod
>    n = 0
> end subroutine bar
>
> program main
>    use nmod
>    implicit none
>    integer :: m
>    n = 1
>    m = 0
>    call foo(n, m)
>    print *, m
> end program main
>
>
>> So, a copy in / copy out for variables where we can not be sure that
>> no value is assigned?  Does anybody see a downside for that?)
> In principle sounds good, unless my concerns above are real and affect
> this case too.
>
>>> Is there a risk of performance regressions due to higher register pressure?
>> I don't think so. Either the compiler realizes that it can
>> keep the variable in a register (then it makes no difference),
>> or it has to load it fresh from its address (then there is
>> one additional register needed).
> Yes, true. Good point.
>
>

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Thomas König]

Am 20.11.19 um 23:18 schrieb Janne Blomqvist:
> On Wed, Nov 20, 2019 at 11:35 PM Thomas König <tk@tkoenig.net> wrote:
>>
>> Am 20.11.19 um 21:45 schrieb Janne Blomqvist:
>>> BTW, since this is done for the purpose of optimization, have you done
>>> testing on some suitable benchmark suite such as polyhedron, whether
>>> it a) generates any different code b) does it make it go faster?
>>
>> I haven't run any actual benchmarks.
>>
>> However, there is a simple example which shows its advantages.
>> Consider
>>
>>         subroutine foo(n,m)
>>         m = 0
>>         do 100 i=1,100
>>           call bar
>>           m = m + n
>>    100  continue
>>         end
>>
>> (I used old-style DO loops just because :-)
>>
>> Without the optimization, the inner loop is translated to
>>
>> .L2:
>>           xorl    %eax, %eax
>>           call    bar_
>>           movl    (%r12), %eax
>>           addl    %eax, 0(%rbp)
>>           subl    $1, %ebx
>>           jne     .L2
>>
>> and with the optimization to
>>
>> .L2:
>>           xorl    %eax, %eax
>>           call    bar_
>>           addl    %r12d, 0(%rbp)
>>           subl    $1, %ebx
>>           jne     .L2
>>
>> so the load of the address is missing.  (Why do we zero %eax
>> before each call? It should not be a variadic call right?)
> 
> Not sure. Maybe some belt and suspenders thing? I guess someone better
> versed in ABI minutiae knows better. It's not Fortran-specific though,
> the C frontend does the same when calling a void function.

OK, so considering your other e-mail, this is a separate issue that
we can fix another time.

> AFAIK on reasonably current OoO CPU's xor'ing a register with itself
> is handled by the renamer and doesn't consume an execute slot, so it's
> in effect a zero-cycle instruction. Still bloats the code slightly,
> though.
> 
>> Of course, Fortran language rules specify that the call to bar
>> cannot do anything to n
> 
> Hmm, does it? What about the following modification to your testcase:
> 
> module nmod
>    integer :: n
> end module nmod
> 
> subroutine foo(n,m)
>    m = 0
>    do 100 i=1,100
>       call bar
>       m = m + n
> 100  continue
> end subroutine foo
> 
> subroutine bar()
>    use nmod
>    n = 0
> end subroutine bar
> 
> program main
>    use nmod
>    implicit none
>    integer :: m
>    n = 1
>    m = 0
>    call foo(n, m)
>    print *, m
> end program main

That is not allowed:

# 15.5.2.13  Restrictions on entities associated with dummy arguments

[...]

# (3) Action that affects the value of the entity or any subobject of it
# shall be taken only through the dummy argument unless

[none of the restrictions apply].

> 
>> So, a copy in / copy out for variables where we can not be sure that
>> no value is assigned?  Does anybody see a downside for that?)
> 
> In principle sounds good, unless my concerns above are real and affect
> this case too.

So, how to proceed?  Commit the patch with the maximum length for a
mangled symbol, and then maybe try for the copy-out variant in a
follow-up patch?

I agree with Tobias that dealing with this in the middle end is probably
the right thing to do in the long run (especially since we could also
handle arrays and structs this way). Until we get around to doing this
(gcc 11 at earliest), we could still profit somewhat from this
optimization in the meantime.

Regards

	Thomas

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Tobias Burnus]

On 11/20/19 10:35 PM, Thomas König wrote:

> I haven't run any actual benchmarks.
I think it would be interesting – I think there can be quite some 
advantages in some cases, while in most cases, it is not really noticable.
> Of course, Fortran language rules specify that the call to bar cannot 
> do anything to n, but apparently we do not tell the gcc middle end 
> that this is the case, or maybe that there is no way to really specify 
> this.

To my knowledge, the ME does not support the Fortran semantics but 
assumes that once a pointer escapes in one procedure call, any other 
procedure might have access to it and modify it as well. This matches 
(effectively) the Fortran semantics of asynchronous. See also PR 49733.

The only thing we can do currently is to specify the intent via 'fn 
spec' which helps a bit – but not if the pointer has already escaped.

Maybe we should think again about handling this properly in the ME.

Cheers,

Tobias

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Tobias Burnus]

On 11/20/19 10:35 PM, Thomas König wrote:
>> Is there a risk of performance regressions due to higher register 
>> pressure?

richi points out (on IRC) that ideally LTO IPA opts would promote the 
call-by reference to call-by value – but is not sure that it indeed 
happens. [In any case, Linux distros have started to compile packages 
with LTO.]

One could try and see whether that indeed happens. – Still, I think the 
real solution is to teach the middle end about the Fortran semantics.

Cheers,

Tobia

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Richard Biener]

On Thu, Nov 21, 2019 at 10:35 AM Tobias Burnus <tobias@codesourcery.com> wrote:
>
> On 11/20/19 10:35 PM, Thomas König wrote:
> >> Is there a risk of performance regressions due to higher register
> >> pressure?
>
> richi points out (on IRC) that ideally LTO IPA opts would promote the
> call-by reference to call-by value – but is not sure that it indeed
> happens. [In any case, Linux distros have started to compile packages
> with LTO.]
>
> One could try and see whether that indeed happens. – Still, I think the
> real solution is to teach the middle end about the Fortran semantics.

OK, so I found it, it's handled via SSA_NAME_POINTS_TO_READONLY_MEMORY
which is initialized during the rewrite into SSA form from the information
given by the "fn spec" attribute:

      for (tree arg = DECL_ARGUMENTS (cfun->decl);
           arg; arg = DECL_CHAIN (arg), ++i)
        {
          if (i >= (unsigned) TREE_STRING_LENGTH (fnspec))
            break;
          if (TREE_STRING_POINTER (fnspec)[i]  == 'R'
              || TREE_STRING_POINTER (fnspec)[i] == 'r')

so when the frontend sets "fn spec" from the intent it should already work.
But the examples I saw above didn't use INTENT(IN) for the scalar parameters.

Richard.

> Cheers,
>
> Tobia
>
>

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Tobias Burnus]

Hi Richard,

On 11/21/19 1:16 PM, Richard Biener wrote:
> OK, so I found it, it's handled via SSA_NAME_POINTS_TO_READONLY_MEMORY 
> which is initialized during the rewrite into SSA form from the 
> information given by the "fn spec" attribute […] so when the frontend 
> sets "fn spec" from the intent it should already work.

Which I can confirm for the following made-up example:

real function foo(n)
   implicit none (type)
   integer, intent(in) :: n
   integer :: i
   foo = 0.5
   if (n /= 0) return
   call bar()
   do i = 1, n
     foo = foo + sin(foo)
   end do
end

The optimized dump shows the following, i.e. GCC nicely optimizes both the loop and the 'sin' call away:

foo (integer(kind=4) & restrict n)
{
   integer(kind=4) _1;
   <bb 2> [local count: 241635843]:
   _1 = *n_9(D);
   if (_1 != 0)
     goto <bb 4>; [51.12%]
   else
     goto <bb 3>; [48.88%]

   <bb 3> [local count: 118111600]:
   bar ();

   <bb 4> [local count: 241635844]:
   return 5.0e-1;
}

I think this optimization permits some crucial optimizations.
I have not fully followed the later versions of the patch whether
they exploit some additional language semantics to permit optimizations
even without intent(in), but the initial discussion started with intent(in).

> But the examples I saw above didn't use INTENT(IN) for the scalar 
> parameters.

I concur that a well-written program should make use of intent(in) where 
sensible.

There are cases, which could be optimized likewise – but based on the 
case that the pointer address cannot escape instead of just assuming 
that the argument cannot change. – The question is how to convey this to 
the middle end.

I wonder whether there is a 'fn attr' which can tell that the first 
argument of 'print_i' does not cause the address of 'i' escape. If so, 
one could mark all procedure arguments such – unless they have the 
pointer, target or asynchronous attribute or are coarrays. [Probably 
needs some fine tuning.]

In this example, variable values do change, but only in a controlled way 
('print_i' could change it, 'bar' cannot). The semantic is also mainly a 
property of the (local) variable (or dummy argument) declaration and not 
of the functions which are called – although, if 'i' has no target 
attribute, print_i's argument cannot have neither – hence, one could 
generated a function interface

real function foo(i, y)
   implicit none (type)
   integer :: i
   real :: y
   foo = 0.0
   call print_i(i)
   i = 5
   call bar()  ! < this prevents optimizing the sin(y) away
   if (i == 5) return
   foo = sin(y)
end

Fortran semantics implies that 'i' can only change after the 'i = 5' if: 
'i' has the TARGET (or POINTER) attribute. Or it is possible if 'i' has 
the ASYNCHRONOUS or VOLATILE attribute – or it is a coarray (where a 
remote image can modify the local value).

For asynchronous, it would be something like "call read_i(i); call 
wait()" which is structurally the same as above.

TARGET: "An object without the TARGET attribute shall not have a pointer 
associated with it."
VOLATILE: "may be referenced, defined, or become undefined, by 
means20not specified by the program"
ASYNCHRONOUS: "An entity with the ASYNCHRONOUS attribute is a variable, 
and may be subject to asynchronous input/output or asynchronous 
communication."

Tobias

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Tobias Burnus]

Hi Richard, hi all,

On 11/21/19 2:16 PM, Tobias Burnus wrote:
> I wonder whether there is a 'fn attr' which can tell that the first 
> argument of 'print_i' does not cause the address of 'i' escape.

I think one needs two attributes, one which tells that the address of 
the object itself does not escape. I think that covers all scalars and, 
hence, things which can then easily optimized.

And another one which tells (for a struct) that this address and all 
pointers in that struct do not escape – or something like that. Here, I 
am many thinking of arrays with array descriptors. There one has a 
struct consisting of the meta data (array bounds) and of one element 
called 'data' which points to the actual array data. There might be 
fewer optimization possibilities in general (as keeping track of a whole 
array is more involved), but there should be still some important ones.

Cheers,

Tobias

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Richard Biener]

On Thu, Nov 21, 2019 at 2:16 PM Tobias Burnus <tobias@codesourcery.com> wrote:
>
> Hi Richard,
>
> On 11/21/19 1:16 PM, Richard Biener wrote:
> > OK, so I found it, it's handled via SSA_NAME_POINTS_TO_READONLY_MEMORY
> > which is initialized during the rewrite into SSA form from the
> > information given by the "fn spec" attribute […] so when the frontend
> > sets "fn spec" from the intent it should already work.
>
> Which I can confirm for the following made-up example:
>
> real function foo(n)
>    implicit none (type)
>    integer, intent(in) :: n
>    integer :: i
>    foo = 0.5
>    if (n /= 0) return
>    call bar()
>    do i = 1, n
>      foo = foo + sin(foo)
>    end do
> end
>
> The optimized dump shows the following, i.e. GCC nicely optimizes both the loop and the 'sin' call away:
>
> foo (integer(kind=4) & restrict n)
> {
>    integer(kind=4) _1;
>    <bb 2> [local count: 241635843]:
>    _1 = *n_9(D);
>    if (_1 != 0)
>      goto <bb 4>; [51.12%]
>    else
>      goto <bb 3>; [48.88%]
>
>    <bb 3> [local count: 118111600]:
>    bar ();
>
>    <bb 4> [local count: 241635844]:
>    return 5.0e-1;
> }
>
> I think this optimization permits some crucial optimizations.
> I have not fully followed the later versions of the patch whether
> they exploit some additional language semantics to permit optimizations
> even without intent(in), but the initial discussion started with intent(in).
>
> > But the examples I saw above didn't use INTENT(IN) for the scalar
> > parameters.
>
> I concur that a well-written program should make use of intent(in) where
> sensible.
>
> There are cases, which could be optimized likewise – but based on the
> case that the pointer address cannot escape instead of just assuming
> that the argument cannot change. – The question is how to convey this to
> the middle end.
>
> I wonder whether there is a 'fn attr' which can tell that the first
> argument of 'print_i' does not cause the address of 'i' escape. If so,
> one could mark all procedure arguments such – unless they have the
> pointer, target or asynchronous attribute or are coarrays. [Probably
> needs some fine tuning.]
>
> In this example, variable values do change, but only in a controlled way
> ('print_i' could change it, 'bar' cannot). The semantic is also mainly a
> property of the (local) variable (or dummy argument) declaration and not
> of the functions which are called – although, if 'i' has no target
> attribute, print_i's argument cannot have neither – hence, one could
> generated a function interface
>
> real function foo(i, y)
>    implicit none (type)
>    integer :: i
>    real :: y
>    foo = 0.0
>    call print_i(i)
>    i = 5
>    call bar()  ! < this prevents optimizing the sin(y) away
>    if (i == 5) return
>    foo = sin(y)
> end
>
> Fortran semantics implies that 'i' can only change after the 'i = 5' if:
> 'i' has the TARGET (or POINTER) attribute. Or it is possible if 'i' has
> the ASYNCHRONOUS or VOLATILE attribute – or it is a coarray (where a
> remote image can modify the local value).

So I think what you'd need to do is make 'i' marked as TYPE_RESTRICT
then.  I think we don't yet handle it but it means that bar() may not
modify 'i' but via 'i' (but it doesn't get 'i' as a parameter).

> For asynchronous, it would be something like "call read_i(i); call
> wait()" which is structurally the same as above.
>
> TARGET: "An object without the TARGET attribute shall not have a pointer
> associated with it."
> VOLATILE: "may be referenced, defined, or become undefined, by
> means20not specified by the program"
> ASYNCHRONOUS: "An entity with the ASYNCHRONOUS attribute is a variable,
> and may be subject to asynchronous input/output or asynchronous
> communication."

I think for GIMPLE everything not obviously on the stack is ASYNCHRONOUS.

Richard.

> Tobias
>

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Tobias Burnus]

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

Hi Richard,

On 11/21/19 3:09 PM, Richard Biener wrote:
> So I think what you'd need to do is make 'i' marked as TYPE_RESTRICT 
> then. I think we don't yet handle it but it means that bar() may not 
> modify 'i' but via 'i' (but it doesn't get 'i' as a parameter). 

Okay, that would be then the attached patch. – I can confirm that it 
does not work.

Tobias


[-- Attachment #2: foo.diff --]
[-- Type: text/x-patch, Size: 865 bytes --]

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 82666c48bec..2ffb8cf7529 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -3056,7 +3056,16 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args)
 	      type = build_pointer_type (type);
 	    }
 	  else
-	    type = gfc_sym_type (arg);
+	    {
+	      type = gfc_sym_type (arg);
+	      /* FIXME: There can be some fine tuning, see fine print regarding
+		 argument handling in the Fortran standard. Check whether
+		 CLASS is handle correctly; check whether something goes wrong
+		 if used with asynchronous I/O or ...  */
+	      if (!arg->attr.target && !arg->attr.pointer
+		  && !arg->attr.asynchronous && !arg->attr.codimension)
+		type = build_qualified_type (type, TYPE_QUAL_RESTRICT);
+	    }
 
 	  /* Parameter Passing Convention
 

[-- Attachment #3: foo.f90 --]
[-- Type: text/x-fortran, Size: 333 bytes --]

real function foo(i, y)
  implicit none (type, external)
  interface
    subroutine print_i(i); integer, intent(in) :: i; end
    subroutine bar(); end
  end interface 
  integer :: i
  real :: y
  foo = 0.0
  call print_i(i)
  i = 5
  call bar()  ! < this prevents optimizing the sin(y) away
  if (i == 5) return
  foo = sin(y)
end

Re: [patch, fortran] Load scalar intent-in variables at the beginning of procedures

[Tobias Burnus]

I have now filled https://gcc.gnu.org/PR92628 as ME bug to track this 
(i.e. honor TYPE_RESTRICT for pointer-escape analysis).

Cheers,

Tobias

On 11/21/19 3:36 PM, Tobias Burnus wrote:
> On 11/21/19 3:09 PM, Richard Biener wrote:
>> So I think what you'd need to do is make 'i' marked as TYPE_RESTRICT 
>> then. I think we don't yet handle it but it means that bar() may not 
>> modify 'i' but via 'i' (but it doesn't get 'i' as a parameter). 
> Okay, that would be then the attached patch. – I can confirm that it 
> does not work.