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
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;
+ }
+ }
+ }
+}
! { 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" } }
