OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

gfortran.h (walk_code_fn_t, [...]): New types.

Browse Source 
* gfortran.h (walk_code_fn_t, walk_expr_fn_t): New types.
	(gfc_expr_walker, gfc_code_walker): New prototypes.
	* frontend-passes.c (gfc_expr_walker, gfc_code_walker): New functions.
	(WALK_SUBEXPR, WALK_SUBEXPR_TAIL, WALK_SUBCODE): Define.
	(optimize_namespace): Use gfc_code_walker.
	(optimize_code, optimize_expr): Rewritten as gfc_code_walker hooks.
	(optimize_expr_0, optimize_code_node,
	optimize_actual_arglist): Removed.
	(optimize_assignment): Don't call optimize_expr_0.

From-SVN: r164342
This commit is contained in:
Jakub Jelinek 2010-09-16 18:53:35 +02:00 committed by Jakub Jelinek
parent 815248b197
commit 4d42b5cd6f
3 changed files with 288 additions and 255 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -1,3 +1,15 @@
2010-09-16 Jakub Jelinek <jakub@redhat.com>
* gfortran.h (walk_code_fn_t, walk_expr_fn_t): New types.
(gfc_expr_walker, gfc_code_walker): New prototypes.
* frontend-passes.c (gfc_expr_walker, gfc_code_walker): New functions.
(WALK_SUBEXPR, WALK_SUBEXPR_TAIL, WALK_SUBCODE): Define.
(optimize_namespace): Use gfc_code_walker.
(optimize_code, optimize_expr): Rewritten as gfc_code_walker hooks.
(optimize_expr_0, optimize_code_node,
optimize_actual_arglist): Removed.
(optimize_assignment): Don't call optimize_expr_0.
2010-09-16 Janus Weil <janus@gcc.gnu.org>
PR fortran/45674

525
gcc/fortran/frontend-passes.c
View File

@ -30,13 +30,8 @@ along with GCC; see the file COPYING3. If not see
static void strip_function_call (gfc_expr *);
static void optimize_namespace (gfc_namespace *);
static void optimize_assignment (gfc_code *);
static void optimize_expr_0 (gfc_expr *);
static bool optimize_expr (gfc_expr *);
static bool optimize_op (gfc_expr *);
static bool optimize_equality (gfc_expr *, bool);
static void optimize_code (gfc_code *);
static void optimize_code_node (gfc_code *);
static void optimize_actual_arglist (gfc_actual_arglist *);
/* Entry point - run all passes for a namespace. So far, only an
optimization pass is run. */
@ -48,197 +43,41 @@ gfc_run_passes (gfc_namespace *ns)
optimize_namespace (ns);
}
/* Callback for each gfc_code node invoked through gfc_code_walker
from optimize_namespace. */
static int
optimize_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
void *data ATTRIBUTE_UNUSED)
{
if ((*c)->op == EXEC_ASSIGN)
optimize_assignment (*c);
return 0;
}
/* Callback for each gfc_expr node invoked through gfc_code_walker
from optimize_namespace. */
static int
optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
void *data ATTRIBUTE_UNUSED)
{
if ((*e)->expr_type == EXPR_OP && optimize_op (*e))
gfc_simplify_expr (*e, 0);
return 0;
}
/* Optimize a namespace, including all contained namespaces. */
static void
optimize_namespace (gfc_namespace *ns)
{
optimize_code (ns->code);
gfc_code_walker (&ns->code, optimize_code, optimize_expr, NULL);
for (ns = ns->contained; ns; ns = ns->sibling)
optimize_namespace (ns);
}
static void
optimize_code (gfc_code *c)
{
for (; c; c = c->next)
optimize_code_node (c);
}
/* Do the optimizations for a code node. */
static void
optimize_code_node (gfc_code *c)
{
gfc_forall_iterator *fa;
gfc_code *d;
gfc_alloc *a;
switch (c->op)
{
case EXEC_ASSIGN:
optimize_assignment (c);
break;
case EXEC_CALL:
case EXEC_ASSIGN_CALL:
case EXEC_CALL_PPC:
optimize_actual_arglist (c->ext.actual);
break;
case EXEC_ARITHMETIC_IF:
optimize_expr_0 (c->expr1);
break;
case EXEC_PAUSE:
case EXEC_RETURN:
case EXEC_ERROR_STOP:
case EXEC_STOP:
case EXEC_COMPCALL:
optimize_expr_0 (c->expr1);
break;
case EXEC_SYNC_ALL:
case EXEC_SYNC_MEMORY:
case EXEC_SYNC_IMAGES:
optimize_expr_0 (c->expr2);
break;
case EXEC_IF:
d = c->block;
optimize_expr_0 (d->expr1);
optimize_code (d->next);
for (d = d->block; d; d = d->block)
{
optimize_expr_0 (d->expr1);
optimize_code (d->next);
}
break;
case EXEC_SELECT:
case EXEC_SELECT_TYPE:
d = c->block;
optimize_expr_0 (c->expr1);
for (; d; d = d->block)
optimize_code (d->next);
break;
case EXEC_WHERE:
d = c->block;
optimize_expr_0 (d->expr1);
optimize_code (d->next);
for (d = d->block; d; d = d->block)
{
optimize_expr_0 (d->expr1);
optimize_code (d->next);
}
break;
case EXEC_FORALL:
for (fa = c->ext.forall_iterator; fa; fa = fa->next)
{
optimize_expr_0 (fa->start);
optimize_expr_0 (fa->end);
optimize_expr_0 (fa->stride);
}
if (c->expr1 != NULL)
optimize_expr_0 (c->expr1);
optimize_code (c->block->next);
break;
case EXEC_CRITICAL:
optimize_code (c->block->next);
break;
case EXEC_DO:
optimize_expr_0 (c->ext.iterator->start);
optimize_expr_0 (c->ext.iterator->end);
optimize_expr_0 (c->ext.iterator->step);
optimize_code (c->block->next);
break;
case EXEC_DO_WHILE:
optimize_expr_0 (c->expr1);
optimize_code (c->block->next);
break;
case EXEC_ALLOCATE:
for (a = c->ext.alloc.list; a; a = a->next)
optimize_expr_0 (a->expr);
break;
/* Todo: Some of these may need to be optimized, as well. */
case EXEC_WRITE:
case EXEC_READ:
case EXEC_OPEN:
case EXEC_INQUIRE:
case EXEC_REWIND:
case EXEC_ENDFILE:
case EXEC_BACKSPACE:
case EXEC_CLOSE:
case EXEC_WAIT:
case EXEC_TRANSFER:
case EXEC_FLUSH:
case EXEC_IOLENGTH:
case EXEC_END_PROCEDURE:
case EXEC_NOP:
case EXEC_CONTINUE:
case EXEC_ENTRY:
case EXEC_INIT_ASSIGN:
case EXEC_LABEL_ASSIGN:
case EXEC_POINTER_ASSIGN:
case EXEC_GOTO:
case EXEC_CYCLE:
case EXEC_EXIT:
case EXEC_BLOCK:
case EXEC_END_BLOCK:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_FLUSH:
case EXEC_OMP_DO:
case EXEC_OMP_MASTER:
case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
case EXEC_OMP_TASK:
case EXEC_OMP_TASKWAIT:
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_END_NOWAIT:
case EXEC_OMP_END_SINGLE:
case EXEC_DEALLOCATE:
case EXEC_DT_END:
for (d = c->block; d; d = d->block)
optimize_code (d->next);
break;
default:
gcc_unreachable ();
}
}
/* Replace code like
a = matmul(b,c) + d
with
@ -336,15 +175,6 @@ optimize_assignment (gfc_code * c)
if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0)
optimize_binop_array_assignment (c, &rhs, false);
/* If we insert a statement after the current one, the surrounding loop in
optimize_code will call optimize_assignment on the inserted statement
anyway, so there is no need to call optimize_assignment again. */
/* All direct optimizations have been done. Now it's time
to optimize the rhs. */
optimize_expr_0 (rhs);
}
@ -375,58 +205,12 @@ strip_function_call (gfc_expr *e)
}
/* Top-level optimization of expressions. Calls gfc_simplify_expr if
optimize_expr succeeds in doing something.
TODO: Optimization of multiple function occurrence to come here. */
static void
optimize_expr_0 (gfc_expr * e)
{
if (optimize_expr (e))
gfc_simplify_expr (e, 0);
return;
}
/* Recursive optimization of expressions.
TODO: Make this handle many more things. */
static bool
optimize_expr (gfc_expr *e)
{
bool ret;
if (e == NULL)
return false;
ret = false;
switch (e->expr_type)
{
case EXPR_OP:
return optimize_op (e);
break;
case EXPR_FUNCTION:
optimize_actual_arglist (e->value.function.actual);
break;
default:
break;
}
return ret;
}
/* Recursive optimization of operators. */
static bool
optimize_op (gfc_expr *e)
{
gfc_intrinsic_op op;
op = e->value.op.op;
gfc_intrinsic_op op = e->value.op.op;
switch (op)
{
@ -437,7 +221,6 @@ optimize_op (gfc_expr *e)
case INTRINSIC_LE:
case INTRINSIC_LE_OS:
return optimize_equality (e, true);
break;
case INTRINSIC_NE:
case INTRINSIC_NE_OS:
@ -446,7 +229,6 @@ optimize_op (gfc_expr *e)
case INTRINSIC_LT:
case INTRINSIC_LT_OS:
return optimize_equality (e, false);
break;
default:
break;
@ -460,7 +242,6 @@ optimize_op (gfc_expr *e)
static bool
optimize_equality (gfc_expr *e, bool equal)
{
gfc_expr *op1, *op2;
bool change;
@ -519,18 +300,252 @@ optimize_equality (gfc_expr *e, bool equal)
return false;
}
/* Optimize a call list. Right now, this just goes through the actual
arg list and optimizes each expression in turn. */
#define WALK_SUBEXPR(NODE) \
do \
{ \
result = gfc_expr_walker (&(NODE), exprfn, data); \
if (result) \
return result; \
} \
while (0)
#define WALK_SUBEXPR_TAIL(NODE) e = &(NODE); continue
static void
optimize_actual_arglist (gfc_actual_arglist *a)
/* Walk expression *E, calling EXPRFN on each expression in it. */
int
gfc_expr_walker (gfc_expr **e, walk_expr_fn_t exprfn, void *data)
{
for (; a; a = a->next)
while (*e)
{
if (a->expr != NULL)
optimize_expr_0 (a->expr);
int walk_subtrees = 1;
gfc_actual_arglist *a;
int result = exprfn (e, &walk_subtrees, data);
if (result)
return result;
if (walk_subtrees)
switch ((*e)->expr_type)
{
case EXPR_OP:
WALK_SUBEXPR ((*e)->value.op.op1);
WALK_SUBEXPR_TAIL ((*e)->value.op.op2);
break;
case EXPR_FUNCTION:
for (a = (*e)->value.function.actual; a; a = a->next)
WALK_SUBEXPR (a->expr);
break;
case EXPR_COMPCALL:
case EXPR_PPC:
WALK_SUBEXPR ((*e)->value.compcall.base_object);
for (a = (*e)->value.compcall.actual; a; a = a->next)
WALK_SUBEXPR (a->expr);
break;
default:
break;
}
return 0;
}
return;
return 0;
}
#define WALK_SUBCODE(NODE) \
do \
{ \
result = gfc_code_walker (&(NODE), codefn, exprfn, data); \
if (result) \
return result; \
} \
while (0)
/* Walk code *C, calling CODEFN on each gfc_code node in it and calling EXPRFN
on each expression in it. If any of the hooks returns non-zero, that
value is immediately returned. If the hook sets *WALK_SUBTREES to 0,
no subcodes or subexpressions are traversed. */
int
gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
void *data)
{
for (; *c; c = &(*c)->next)
{
int walk_subtrees = 1;
int result = codefn (c, &walk_subtrees, data);
if (result)
return result;
if (walk_subtrees)
{
gfc_code *b;
switch ((*c)->op)
{
case EXEC_DO:
WALK_SUBEXPR ((*c)->ext.iterator->var);
WALK_SUBEXPR ((*c)->ext.iterator->start);
WALK_SUBEXPR ((*c)->ext.iterator->end);
WALK_SUBEXPR ((*c)->ext.iterator->step);
break;
case EXEC_SELECT:
WALK_SUBEXPR ((*c)->expr1);
for (b = (*c)->block; b; b = b->block)
{
gfc_case *cp;
for (cp = b->ext.case_list; cp; cp = cp->next)
{
WALK_SUBEXPR (cp->low);
WALK_SUBEXPR (cp->high);
}
WALK_SUBCODE (b->next);
}
continue;
case EXEC_ALLOCATE:
case EXEC_DEALLOCATE:
{
gfc_alloc *a;
for (a = (*c)->ext.alloc.list; a; a = a->next)
WALK_SUBEXPR (a->expr);
break;
}
case EXEC_FORALL:
{
gfc_forall_iterator *fa;
for (fa = (*c)->ext.forall_iterator; fa; fa = fa->next)
{
WALK_SUBEXPR (fa->var);
WALK_SUBEXPR (fa->start);
WALK_SUBEXPR (fa->end);
WALK_SUBEXPR (fa->stride);
}
break;
}
case EXEC_OPEN:
WALK_SUBEXPR ((*c)->ext.open->unit);
WALK_SUBEXPR ((*c)->ext.open->file);
WALK_SUBEXPR ((*c)->ext.open->status);
WALK_SUBEXPR ((*c)->ext.open->access);
WALK_SUBEXPR ((*c)->ext.open->form);
WALK_SUBEXPR ((*c)->ext.open->recl);
WALK_SUBEXPR ((*c)->ext.open->blank);
WALK_SUBEXPR ((*c)->ext.open->position);
WALK_SUBEXPR ((*c)->ext.open->action);
WALK_SUBEXPR ((*c)->ext.open->delim);
WALK_SUBEXPR ((*c)->ext.open->pad);
WALK_SUBEXPR ((*c)->ext.open->iostat);
WALK_SUBEXPR ((*c)->ext.open->iomsg);
WALK_SUBEXPR ((*c)->ext.open->convert);
WALK_SUBEXPR ((*c)->ext.open->decimal);
WALK_SUBEXPR ((*c)->ext.open->encoding);
WALK_SUBEXPR ((*c)->ext.open->round);
WALK_SUBEXPR ((*c)->ext.open->sign);
WALK_SUBEXPR ((*c)->ext.open->asynchronous);
WALK_SUBEXPR ((*c)->ext.open->id);
WALK_SUBEXPR ((*c)->ext.open->newunit);
break;
case EXEC_CLOSE:
WALK_SUBEXPR ((*c)->ext.close->unit);
WALK_SUBEXPR ((*c)->ext.close->status);
WALK_SUBEXPR ((*c)->ext.close->iostat);
WALK_SUBEXPR ((*c)->ext.close->iomsg);
break;
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
case EXEC_FLUSH:
WALK_SUBEXPR ((*c)->ext.filepos->unit);
WALK_SUBEXPR ((*c)->ext.filepos->iostat);
WALK_SUBEXPR ((*c)->ext.filepos->iomsg);
break;
case EXEC_INQUIRE:
WALK_SUBEXPR ((*c)->ext.inquire->unit);
WALK_SUBEXPR ((*c)->ext.inquire->file);
WALK_SUBEXPR ((*c)->ext.inquire->iomsg);
WALK_SUBEXPR ((*c)->ext.inquire->iostat);
WALK_SUBEXPR ((*c)->ext.inquire->exist);
WALK_SUBEXPR ((*c)->ext.inquire->opened);
WALK_SUBEXPR ((*c)->ext.inquire->number);
WALK_SUBEXPR ((*c)->ext.inquire->named);
WALK_SUBEXPR ((*c)->ext.inquire->name);
WALK_SUBEXPR ((*c)->ext.inquire->access);
WALK_SUBEXPR ((*c)->ext.inquire->sequential);
WALK_SUBEXPR ((*c)->ext.inquire->direct);
WALK_SUBEXPR ((*c)->ext.inquire->form);
WALK_SUBEXPR ((*c)->ext.inquire->formatted);
WALK_SUBEXPR ((*c)->ext.inquire->unformatted);
WALK_SUBEXPR ((*c)->ext.inquire->recl);
WALK_SUBEXPR ((*c)->ext.inquire->nextrec);
WALK_SUBEXPR ((*c)->ext.inquire->blank);
WALK_SUBEXPR ((*c)->ext.inquire->position);
WALK_SUBEXPR ((*c)->ext.inquire->action);
WALK_SUBEXPR ((*c)->ext.inquire->read);
WALK_SUBEXPR ((*c)->ext.inquire->write);
WALK_SUBEXPR ((*c)->ext.inquire->readwrite);
WALK_SUBEXPR ((*c)->ext.inquire->delim);
WALK_SUBEXPR ((*c)->ext.inquire->encoding);
WALK_SUBEXPR ((*c)->ext.inquire->pad);
WALK_SUBEXPR ((*c)->ext.inquire->iolength);
WALK_SUBEXPR ((*c)->ext.inquire->convert);
WALK_SUBEXPR ((*c)->ext.inquire->strm_pos);
WALK_SUBEXPR ((*c)->ext.inquire->asynchronous);
WALK_SUBEXPR ((*c)->ext.inquire->decimal);
WALK_SUBEXPR ((*c)->ext.inquire->pending);
WALK_SUBEXPR ((*c)->ext.inquire->id);
WALK_SUBEXPR ((*c)->ext.inquire->sign);
WALK_SUBEXPR ((*c)->ext.inquire->size);
WALK_SUBEXPR ((*c)->ext.inquire->round);
break;
case EXEC_WAIT:
WALK_SUBEXPR ((*c)->ext.wait->unit);
WALK_SUBEXPR ((*c)->ext.wait->iostat);
WALK_SUBEXPR ((*c)->ext.wait->iomsg);
WALK_SUBEXPR ((*c)->ext.wait->id);
break;
case EXEC_READ:
case EXEC_WRITE:
WALK_SUBEXPR ((*c)->ext.dt->io_unit);
WALK_SUBEXPR ((*c)->ext.dt->format_expr);
WALK_SUBEXPR ((*c)->ext.dt->rec);
WALK_SUBEXPR ((*c)->ext.dt->advance);
WALK_SUBEXPR ((*c)->ext.dt->iostat);
WALK_SUBEXPR ((*c)->ext.dt->size);
WALK_SUBEXPR ((*c)->ext.dt->iomsg);
WALK_SUBEXPR ((*c)->ext.dt->id);
WALK_SUBEXPR ((*c)->ext.dt->pos);
WALK_SUBEXPR ((*c)->ext.dt->asynchronous);
WALK_SUBEXPR ((*c)->ext.dt->blank);
WALK_SUBEXPR ((*c)->ext.dt->decimal);
WALK_SUBEXPR ((*c)->ext.dt->delim);
WALK_SUBEXPR ((*c)->ext.dt->pad);
WALK_SUBEXPR ((*c)->ext.dt->round);
WALK_SUBEXPR ((*c)->ext.dt->sign);
WALK_SUBEXPR ((*c)->ext.dt->extra_comma);
break;
case EXEC_OMP_DO:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_SECTIONS:
case EXEC_OMP_PARALLEL_WORKSHARE:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_TASK:
if ((*c)->ext.omp_clauses)
{
WALK_SUBEXPR ((*c)->ext.omp_clauses->if_expr);
WALK_SUBEXPR ((*c)->ext.omp_clauses->num_threads);
WALK_SUBEXPR ((*c)->ext.omp_clauses->chunk_size);
}
break;
default:
break;
}
WALK_SUBEXPR ((*c)->expr1);
WALK_SUBEXPR ((*c)->expr2);
WALK_SUBEXPR ((*c)->expr3);
for (b = (*c)->block; b; b = b->block)
{
WALK_SUBEXPR (b->expr1);
WALK_SUBEXPR (b->expr2);
WALK_SUBCODE (b->next);
}
}
}
return 0;
}

6
gcc/fortran/gfortran.h
View File

@ -2886,4 +2886,10 @@ gfc_symtree* gfc_get_tbp_symtree (gfc_symtree**, const char*);
void gfc_run_passes (gfc_namespace *);
typedef int (*walk_code_fn_t) (gfc_code **, int *, void *);
typedef int (*walk_expr_fn_t) (gfc_expr **, int *, void *);
int gfc_expr_walker (gfc_expr **, walk_expr_fn_t, void *);
int gfc_code_walker (gfc_code **, walk_code_fn_t, walk_expr_fn_t, void *);
#endif /* GCC_GFORTRAN_H */