diff options
Diffstat (limited to 'gcc/fortran/frontend-passes.c')
| -rw-r--r-- | gcc/fortran/frontend-passes.c | 833 |
1 files changed, 833 insertions, 0 deletions
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c new file mode 100644 index 000000000..7c5576798 --- /dev/null +++ b/gcc/fortran/frontend-passes.c @@ -0,0 +1,833 @@ +/* Pass manager for Fortran front end. + Copyright (C) 2010 Free Software Foundation, Inc. + Contributed by Thomas König. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 3, or (at your option) any later +version. + +GCC is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +<http://www.gnu.org/licenses/>. */ + +#include "config.h" +#include "system.h" +#include "gfortran.h" +#include "arith.h" +#include "flags.h" +#include "dependency.h" +#include "constructor.h" +#include "opts.h" + +/* Forward declarations. */ + +static void strip_function_call (gfc_expr *); +static void optimize_namespace (gfc_namespace *); +static void optimize_assignment (gfc_code *); +static bool optimize_op (gfc_expr *); +static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op); +static bool optimize_trim (gfc_expr *); + +/* How deep we are inside an argument list. */ + +static int count_arglist; + +/* Entry point - run all passes for a namespace. So far, only an + optimization pass is run. */ + +void +gfc_run_passes (gfc_namespace *ns) +{ + if (optimize) + { + optimize_namespace (ns); + if (gfc_option.dump_fortran_optimized) + gfc_dump_parse_tree (ns, stdout); + } +} + +/* 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) +{ + + gfc_exec_op op; + + op = (*c)->op; + + if (op == EXEC_CALL || op == EXEC_COMPCALL || op == EXEC_ASSIGN_CALL + || op == EXEC_CALL_PPC) + count_arglist = 1; + else + count_arglist = 0; + + if (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) +{ + bool function_expr; + + if ((*e)->expr_type == EXPR_FUNCTION) + { + count_arglist ++; + function_expr = true; + } + else + function_expr = false; + + if (optimize_trim (*e)) + gfc_simplify_expr (*e, 0); + + if ((*e)->expr_type == EXPR_OP && optimize_op (*e)) + gfc_simplify_expr (*e, 0); + + if (function_expr) + count_arglist --; + + return 0; +} + +/* Optimize a namespace, including all contained namespaces. */ + +static void +optimize_namespace (gfc_namespace *ns) +{ + gfc_code_walker (&ns->code, optimize_code, optimize_expr, NULL); + + for (ns = ns->contained; ns; ns = ns->sibling) + optimize_namespace (ns); +} + +/* Replace code like + a = matmul(b,c) + d + with + a = matmul(b,c) ; a = a + d + where the array function is not elemental and not allocatable + and does not depend on the left-hand side. +*/ + +static bool +optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op) +{ + gfc_expr *e; + + e = *rhs; + if (e->expr_type == EXPR_OP) + { + switch (e->value.op.op) + { + /* Unary operators and exponentiation: Only look at a single + operand. */ + case INTRINSIC_NOT: + case INTRINSIC_UPLUS: + case INTRINSIC_UMINUS: + case INTRINSIC_PARENTHESES: + case INTRINSIC_POWER: + if (optimize_binop_array_assignment (c, &e->value.op.op1, seen_op)) + return true; + break; + + default: + /* Binary operators. */ + if (optimize_binop_array_assignment (c, &e->value.op.op1, true)) + return true; + + if (optimize_binop_array_assignment (c, &e->value.op.op2, true)) + return true; + + break; + } + } + else if (seen_op && e->expr_type == EXPR_FUNCTION && e->rank > 0 + && ! (e->value.function.esym + && (e->value.function.esym->attr.elemental + || e->value.function.esym->attr.allocatable + || e->value.function.esym->ts.type != c->expr1->ts.type + || e->value.function.esym->ts.kind != c->expr1->ts.kind)) + && ! (e->value.function.isym + && (e->value.function.isym->elemental + || e->ts.type != c->expr1->ts.type + || e->ts.kind != c->expr1->ts.kind))) + { + + gfc_code *n; + gfc_expr *new_expr; + + /* Insert a new assignment statement after the current one. */ + n = XCNEW (gfc_code); + n->op = EXEC_ASSIGN; + n->loc = c->loc; + n->next = c->next; + c->next = n; + + n->expr1 = gfc_copy_expr (c->expr1); + n->expr2 = c->expr2; + new_expr = gfc_copy_expr (c->expr1); + c->expr2 = e; + *rhs = new_expr; + + return true; + + } + + /* Nothing to optimize. */ + return false; +} + +/* Optimizations for an assignment. */ + +static void +optimize_assignment (gfc_code * c) +{ + gfc_expr *lhs, *rhs; + + lhs = c->expr1; + rhs = c->expr2; + + /* Optimize away a = trim(b), where a is a character variable. */ + + if (lhs->ts.type == BT_CHARACTER) + { + if (rhs->expr_type == EXPR_FUNCTION && + rhs->value.function.isym && + rhs->value.function.isym->id == GFC_ISYM_TRIM) + { + strip_function_call (rhs); + optimize_assignment (c); + return; + } + } + + if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0) + optimize_binop_array_assignment (c, &rhs, false); +} + + +/* Remove an unneeded function call, modifying the expression. + This replaces the function call with the value of its + first argument. The rest of the argument list is freed. */ + +static void +strip_function_call (gfc_expr *e) +{ + gfc_expr *e1; + gfc_actual_arglist *a; + + a = e->value.function.actual; + + /* We should have at least one argument. */ + gcc_assert (a->expr != NULL); + + e1 = a->expr; + + /* Free the remaining arglist, if any. */ + if (a->next) + gfc_free_actual_arglist (a->next); + + /* Graft the argument expression onto the original function. */ + *e = *e1; + gfc_free (e1); + +} + +/* Recursive optimization of operators. */ + +static bool +optimize_op (gfc_expr *e) +{ + gfc_intrinsic_op op = e->value.op.op; + + switch (op) + { + case INTRINSIC_EQ: + case INTRINSIC_EQ_OS: + case INTRINSIC_GE: + case INTRINSIC_GE_OS: + case INTRINSIC_LE: + case INTRINSIC_LE_OS: + case INTRINSIC_NE: + case INTRINSIC_NE_OS: + case INTRINSIC_GT: + case INTRINSIC_GT_OS: + case INTRINSIC_LT: + case INTRINSIC_LT_OS: + return optimize_comparison (e, op); + + default: + break; + } + + return false; +} + +/* Optimize expressions for equality. */ + +static bool +optimize_comparison (gfc_expr *e, gfc_intrinsic_op op) +{ + gfc_expr *op1, *op2; + bool change; + int eq; + bool result; + + op1 = e->value.op.op1; + op2 = e->value.op.op2; + + /* Strip off unneeded TRIM calls from string comparisons. */ + + change = false; + + if (op1->expr_type == EXPR_FUNCTION + && op1->value.function.isym + && op1->value.function.isym->id == GFC_ISYM_TRIM) + { + strip_function_call (op1); + change = true; + } + + if (op2->expr_type == EXPR_FUNCTION + && op2->value.function.isym + && op2->value.function.isym->id == GFC_ISYM_TRIM) + { + strip_function_call (op2); + change = true; + } + + if (change) + { + optimize_comparison (e, op); + return true; + } + + /* An expression of type EXPR_CONSTANT is only valid for scalars. */ + /* TODO: A scalar constant may be acceptable in some cases (the scalarizer + handles them well). However, there are also cases that need a non-scalar + argument. For example the any intrinsic. See PR 45380. */ + if (e->rank > 0) + return false; + + /* Don't compare REAL or COMPLEX expressions when honoring NaNs. */ + + if (flag_finite_math_only + || (op1->ts.type != BT_REAL && op2->ts.type != BT_REAL + && op1->ts.type != BT_COMPLEX && op2->ts.type != BT_COMPLEX)) + { + eq = gfc_dep_compare_expr (op1, op2); + if (eq == -2) + { + /* Replace A // B < A // C with B < C, and A // B < C // B + with A < C. */ + if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER + && op1->value.op.op == INTRINSIC_CONCAT + && op2->value.op.op == INTRINSIC_CONCAT) + { + gfc_expr *op1_left = op1->value.op.op1; + gfc_expr *op2_left = op2->value.op.op1; + gfc_expr *op1_right = op1->value.op.op2; + gfc_expr *op2_right = op2->value.op.op2; + + if (gfc_dep_compare_expr (op1_left, op2_left) == 0) + { + /* Watch out for 'A ' // x vs. 'A' // x. */ + + if (op1_left->expr_type == EXPR_CONSTANT + && op2_left->expr_type == EXPR_CONSTANT + && op1_left->value.character.length + != op2_left->value.character.length) + return -2; + else + { + gfc_free (op1_left); + gfc_free (op2_left); + e->value.op.op1 = op1_right; + e->value.op.op2 = op2_right; + optimize_comparison (e, op); + return true; + } + } + if (gfc_dep_compare_expr (op1_right, op2_right) == 0) + { + gfc_free (op1_right); + gfc_free (op2_right); + e->value.op.op1 = op1_left; + e->value.op.op2 = op2_left; + optimize_comparison (e, op); + return true; + } + } + } + else + { + /* eq can only be -1, 0 or 1 at this point. */ + switch (op) + { + case INTRINSIC_EQ: + case INTRINSIC_EQ_OS: + result = eq == 0; + break; + + case INTRINSIC_GE: + case INTRINSIC_GE_OS: + result = eq >= 0; + break; + + case INTRINSIC_LE: + case INTRINSIC_LE_OS: + result = eq <= 0; + break; + + case INTRINSIC_NE: + case INTRINSIC_NE_OS: + result = eq != 0; + break; + + case INTRINSIC_GT: + case INTRINSIC_GT_OS: + result = eq > 0; + break; + + case INTRINSIC_LT: + case INTRINSIC_LT_OS: + result = eq < 0; + break; + + default: + gfc_internal_error ("illegal OP in optimize_comparison"); + break; + } + + /* Replace the expression by a constant expression. The typespec + and where remains the way it is. */ + gfc_free (op1); + gfc_free (op2); + e->expr_type = EXPR_CONSTANT; + e->value.logical = result; + return true; + } + } + + return false; +} + +/* Optimize a trim function by replacing it with an equivalent substring + involving a call to len_trim. This only works for expressions where + variables are trimmed. Return true if anything was modified. */ + +static bool +optimize_trim (gfc_expr *e) +{ + gfc_expr *a; + gfc_ref *ref; + gfc_expr *fcn; + gfc_actual_arglist *actual_arglist, *next; + + /* Don't do this optimization within an argument list, because + otherwise aliasing issues may occur. */ + + if (count_arglist != 1) + return false; + + if (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_FUNCTION + || e->value.function.isym == NULL + || e->value.function.isym->id != GFC_ISYM_TRIM) + return false; + + a = e->value.function.actual->expr; + + if (a->expr_type != EXPR_VARIABLE) + return false; + + if (a->ref) + { + /* FIXME - also handle substring references, by modifying the + reference itself. Make sure not to evaluate functions in + the references twice. */ + return false; + } + else + { + strip_function_call (e); + + /* Create the reference. */ + + ref = gfc_get_ref (); + ref->type = REF_SUBSTRING; + + /* Set the start of the reference. */ + + ref->u.ss.start = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1); + + /* Build the function call to len_trim(x, gfc_defaul_integer_kind). */ + + fcn = gfc_get_expr (); + fcn->expr_type = EXPR_FUNCTION; + fcn->value.function.isym = + gfc_intrinsic_function_by_id (GFC_ISYM_LEN_TRIM); + actual_arglist = gfc_get_actual_arglist (); + actual_arglist->expr = gfc_copy_expr (e); + next = gfc_get_actual_arglist (); + next->expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, + gfc_default_integer_kind); + actual_arglist->next = next; + fcn->value.function.actual = actual_arglist; + + /* Set the end of the reference to the call to len_trim. */ + + ref->u.ss.end = fcn; + e->ref = ref; + return true; + } +} + +#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 + +/* 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; + gfc_ref *r; + gfc_constructor *c; + + 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; + + case EXPR_STRUCTURE: + case EXPR_ARRAY: + for (c = gfc_constructor_first ((*e)->value.constructor); c; + c = gfc_constructor_next (c)) + { + WALK_SUBEXPR (c->expr); + if (c->iterator != NULL) + { + WALK_SUBEXPR (c->iterator->var); + WALK_SUBEXPR (c->iterator->start); + WALK_SUBEXPR (c->iterator->end); + WALK_SUBEXPR (c->iterator->step); + } + } + + if ((*e)->expr_type != EXPR_ARRAY) + break; + + /* Fall through to the variable case in order to walk the + the reference. */ + + case EXPR_SUBSTRING: + case EXPR_VARIABLE: + for (r = (*e)->ref; r; r = r->next) + { + gfc_array_ref *ar; + int i; + + switch (r->type) + { + case REF_ARRAY: + ar = &r->u.ar; + if (ar->type == AR_SECTION || ar->type == AR_ELEMENT) + { + for (i=0; i< ar->dimen; i++) + { + WALK_SUBEXPR (ar->start[i]); + WALK_SUBEXPR (ar->end[i]); + WALK_SUBEXPR (ar->stride[i]); + } + } + + break; + + case REF_SUBSTRING: + WALK_SUBEXPR (r->u.ss.start); + WALK_SUBEXPR (r->u.ss.end); + break; + + case REF_COMPONENT: + break; + } + } + + default: + break; + } + return 0; + } + 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; + gfc_actual_arglist *a; + + 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_CALL: + case EXEC_ASSIGN_CALL: + for (a = (*c)->ext.actual; a; a = a->next) + WALK_SUBEXPR (a->expr); + break; + + case EXEC_CALL_PPC: + WALK_SUBEXPR ((*c)->expr1); + for (a = (*c)->ext.actual; a; a = a->next) + WALK_SUBEXPR (a->expr); + break; + + case EXEC_SELECT: + WALK_SUBEXPR ((*c)->expr1); + for (b = (*c)->block; b; b = b->block) + { + gfc_case *cp; + for (cp = b->ext.block.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; +} |