diff options
author | jakub <jakub@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-09-16 16:53:35 +0000 |
---|---|---|
committer | jakub <jakub@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-09-16 16:53:35 +0000 |
commit | 5f99b52653bb9725daa7961550050a3687f368a9 (patch) | |
tree | ff17985e2f0017ae579952341a586002328cafb1 /gcc/fortran | |
parent | a448002d1711638e592464c549782903a7bb6ec4 (diff) | |
download | gcc-5f99b52653bb9725daa7961550050a3687f368a9.tar.gz |
* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164342 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 12 | ||||
-rw-r--r-- | gcc/fortran/frontend-passes.c | 517 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 6 |
3 files changed, 284 insertions, 251 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e8fe091e4d7..3f97c4c332d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index cad38795c22..b6a74fd2cce 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -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,195 +43,39 @@ gfc_run_passes (gfc_namespace *ns) optimize_namespace (ns); } -/* Optimize a namespace, including all contained namespaces. */ +/* Callback for each gfc_code node invoked through gfc_code_walker + from optimize_namespace. */ -static void -optimize_namespace (gfc_namespace *ns) +static int +optimize_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) { - optimize_code (ns->code); - - for (ns = ns->contained; ns; ns = ns->sibling) - optimize_namespace (ns); + if ((*c)->op == EXEC_ASSIGN) + optimize_assignment (*c); + return 0; } -static void -optimize_code (gfc_code *c) +/* 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) { - for (; c; c = c->next) - optimize_code_node (c); + if ((*e)->expr_type == EXPR_OP && optimize_op (*e)) + gfc_simplify_expr (*e, 0); + return 0; } - -/* Do the optimizations for a code node. */ +/* Optimize a namespace, including all contained namespaces. */ static void -optimize_code_node (gfc_code *c) +optimize_namespace (gfc_namespace *ns) { + gfc_code_walker (&ns->code, optimize_code, optimize_expr, NULL); - 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 (); - - } + for (ns = ns->contained; ns; ns = ns->sibling) + optimize_namespace (ns); } /* Replace code like @@ -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) { + while (*e) + { + 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 0; +} - for (; a; a = a->next) +#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) { - if (a->expr != NULL) - optimize_expr_0 (a->expr); + 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; + return 0; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 056009aabb0..947f1ff766e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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 */ |