/* Pass manager for Fortran front end.
- Copyright (C) 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2010-2014 Free Software Foundation, Inc.
Contributed by Thomas König.
This file is part of GCC.
static void optimize_minmaxloc (gfc_expr **);
static bool is_empty_string (gfc_expr *e);
static void doloop_warn (gfc_namespace *);
+static void optimize_reduction (gfc_namespace *);
+static int callback_reduction (gfc_expr **, int *, void *);
/* How deep we are inside an argument list. */
static int count_arglist;
-/* Pointer to an array of gfc_expr ** we operate on, plus its size
- and counter. */
+/* Vector of gfc_expr ** we operate on. */
-static gfc_expr ***expr_array;
-static int expr_size, expr_count;
+static vec<gfc_expr **> expr_array;
/* Pointer to the gfc_code we currently work on - to be able to insert
a block before the statement. */
/* Keep track of DO loop levels. */
-static gfc_code **doloop_list;
-static int doloop_size, doloop_level;
+static vec<gfc_code *> doloop_list;
+
+static int doloop_level;
/* Vector of gfc_expr * to keep track of DO loops. */
struct my_struct *evec;
-/* Entry point - run all passes for a namespace. */
+/* Keep track of association lists. */
+
+static bool in_assoc_list;
+
+/* Entry point - run all passes for a namespace. */
void
gfc_run_passes (gfc_namespace *ns)
/* Warn about dubious DO loops where the index might
change. */
- doloop_size = 20;
doloop_level = 0;
- doloop_list = XNEWVEC(gfc_code *, doloop_size);
doloop_warn (ns);
- XDELETEVEC (doloop_list);
+ doloop_list.release ();
if (gfc_option.flag_frontend_optimize)
{
- expr_size = 20;
- expr_array = XNEWVEC(gfc_expr **, expr_size);
-
optimize_namespace (ns);
+ optimize_reduction (ns);
if (gfc_option.dump_fortran_optimized)
gfc_dump_parse_tree (ns, stdout);
- XDELETEVEC (expr_array);
+ expr_array.release ();
}
}
else
count_arglist = 0;
+ current_code = c;
+ inserted_block = NULL;
+ changed_statement = NULL;
+
if (op == EXEC_ASSIGN)
optimize_assignment (*c);
return 0;
return 0;
}
+/* Auxiliary function to handle the arguments to reduction intrnisics. If the
+ function is a scalar, just copy it; otherwise returns the new element, the
+ old one can be freed. */
+
+static gfc_expr *
+copy_walk_reduction_arg (gfc_constructor *c, gfc_expr *fn)
+{
+ gfc_expr *fcn, *e = c->expr;
+
+ fcn = gfc_copy_expr (e);
+ if (c->iterator)
+ {
+ gfc_constructor_base newbase;
+ gfc_expr *new_expr;
+ gfc_constructor *new_c;
+
+ newbase = NULL;
+ new_expr = gfc_get_expr ();
+ new_expr->expr_type = EXPR_ARRAY;
+ new_expr->ts = e->ts;
+ new_expr->where = e->where;
+ new_expr->rank = 1;
+ new_c = gfc_constructor_append_expr (&newbase, fcn, &(e->where));
+ new_c->iterator = c->iterator;
+ new_expr->value.constructor = newbase;
+ c->iterator = NULL;
+
+ fcn = new_expr;
+ }
+
+ if (fcn->rank != 0)
+ {
+ gfc_isym_id id = fn->value.function.isym->id;
+
+ if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT)
+ fcn = gfc_build_intrinsic_call (current_ns, id,
+ fn->value.function.isym->name,
+ fn->where, 3, fcn, NULL, NULL);
+ else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL)
+ fcn = gfc_build_intrinsic_call (current_ns, id,
+ fn->value.function.isym->name,
+ fn->where, 2, fcn, NULL);
+ else
+ gfc_internal_error ("Illegal id in copy_walk_reduction_arg");
+
+ fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE;
+ }
+
+ return fcn;
+}
+
+/* Callback function for optimzation of reductions to scalars. Transform ANY
+ ([f1,f2,f3, ...]) to f1 .or. f2 .or. f3 .or. ..., with ANY, SUM and PRODUCT
+ correspondingly. Handly only the simple cases without MASK and DIM. */
+
+static int
+callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ gfc_expr *fn, *arg;
+ gfc_intrinsic_op op;
+ gfc_isym_id id;
+ gfc_actual_arglist *a;
+ gfc_actual_arglist *dim;
+ gfc_constructor *c;
+ gfc_expr *res, *new_expr;
+ gfc_actual_arglist *mask;
+
+ fn = *e;
+
+ if (fn->rank != 0 || fn->expr_type != EXPR_FUNCTION
+ || fn->value.function.isym == NULL)
+ return 0;
+
+ id = fn->value.function.isym->id;
+
+ if (id != GFC_ISYM_SUM && id != GFC_ISYM_PRODUCT
+ && id != GFC_ISYM_ANY && id != GFC_ISYM_ALL)
+ return 0;
+
+ a = fn->value.function.actual;
+
+ /* Don't handle MASK or DIM. */
+
+ dim = a->next;
+
+ if (dim->expr != NULL)
+ return 0;
+
+ if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT)
+ {
+ mask = dim->next;
+ if ( mask->expr != NULL)
+ return 0;
+ }
+
+ arg = a->expr;
+
+ if (arg->expr_type != EXPR_ARRAY)
+ return 0;
+
+ switch (id)
+ {
+ case GFC_ISYM_SUM:
+ op = INTRINSIC_PLUS;
+ break;
+
+ case GFC_ISYM_PRODUCT:
+ op = INTRINSIC_TIMES;
+ break;
+
+ case GFC_ISYM_ANY:
+ op = INTRINSIC_OR;
+ break;
+
+ case GFC_ISYM_ALL:
+ op = INTRINSIC_AND;
+ break;
+
+ default:
+ return 0;
+ }
+
+ c = gfc_constructor_first (arg->value.constructor);
+
+ /* Don't do any simplififcation if we have
+ - no element in the constructor or
+ - only have a single element in the array which contains an
+ iterator. */
+
+ if (c == NULL)
+ return 0;
+
+ res = copy_walk_reduction_arg (c, fn);
+
+ c = gfc_constructor_next (c);
+ while (c)
+ {
+ new_expr = gfc_get_expr ();
+ new_expr->ts = fn->ts;
+ new_expr->expr_type = EXPR_OP;
+ new_expr->rank = fn->rank;
+ new_expr->where = fn->where;
+ new_expr->value.op.op = op;
+ new_expr->value.op.op1 = res;
+ new_expr->value.op.op2 = copy_walk_reduction_arg (c, fn);
+ res = new_expr;
+ c = gfc_constructor_next (c);
+ }
+
+ gfc_simplify_expr (res, 0);
+ *e = res;
+ gfc_free_expr (fn);
+
+ return 0;
+}
/* Callback function for common function elimination, called from cfe_expr_0.
Put all eligible function expressions into expr_array. */
return 0;
}
- if (expr_count >= expr_size)
- {
- expr_size += expr_size;
- expr_array = XRESIZEVEC(gfc_expr **, expr_array, expr_size);
- }
- expr_array[expr_count] = e;
- expr_count ++;
+ expr_array.safe_push (e);
return 0;
}
+/* Auxiliary function to check if an expression is a temporary created by
+ create var. */
+
+static bool
+is_fe_temp (gfc_expr *e)
+{
+ if (e->expr_type != EXPR_VARIABLE)
+ return false;
+
+ return e->symtree->n.sym->attr.fe_temp;
+}
+
+
/* Returns a new expression (a variable) to be used in place of the old one,
with an assignment statement before the current statement to set
the value of the variable. Creates a new BLOCK for the statement if
that hasn't already been done and puts the statement, plus the
- newly created variables, in that block. */
+ newly created variables, in that block. Special cases: If the
+ expression is constant or a temporary which has already
+ been created, just copy it. */
static gfc_expr*
create_var (gfc_expr * e)
gfc_namespace *ns;
int i;
+ if (e->expr_type == EXPR_CONSTANT || is_fe_temp (e))
+ return gfc_copy_expr (e);
+
/* If the block hasn't already been created, do so. */
if (inserted_block == NULL)
{
if (e->shape == NULL)
{
/* We don't know the shape at compile time, so we use an
- allocatable. */
+ allocatable. */
symbol->as->type = AS_DEFERRED;
symbol->attr.allocatable = 1;
}
symbol->attr.flavor = FL_VARIABLE;
symbol->attr.referenced = 1;
symbol->attr.dimension = e->rank > 0;
+ symbol->attr.fe_temp = 1;
gfc_commit_symbol (symbol);
result = gfc_get_expr ();
result->ref->u.ar.where = e->where;
result->ref->u.ar.as = symbol->ts.type == BT_CLASS
? CLASS_DATA (symbol)->as : symbol->as;
- if (gfc_option.warn_array_temp)
+ if (warn_array_temporaries)
gfc_warning ("Creating array temporary at %L", &(e->where));
}
/* Warn about function elimination. */
static void
-warn_function_elimination (gfc_expr *e)
+do_warn_function_elimination (gfc_expr *e)
{
if (e->expr_type != EXPR_FUNCTION)
return;
{
int i,j;
gfc_expr *newvar;
+ gfc_expr **ei, **ej;
- /* Don't do this optimization within OMP workshare. */
+ /* Don't do this optimization within OMP workshare. */
if (in_omp_workshare)
{
return 0;
}
- expr_count = 0;
+ expr_array.release ();
gfc_expr_walker (e, cfe_register_funcs, NULL);
/* Walk through all the functions. */
- for (i=1; i<expr_count; i++)
+ FOR_EACH_VEC_ELT_FROM (expr_array, i, ei, 1)
{
/* Skip if the function has been replaced by a variable already. */
- if ((*(expr_array[i]))->expr_type == EXPR_VARIABLE)
+ if ((*ei)->expr_type == EXPR_VARIABLE)
continue;
newvar = NULL;
for (j=0; j<i; j++)
{
- if (gfc_dep_compare_functions(*(expr_array[i]),
- *(expr_array[j]), true) == 0)
+ ej = expr_array[j];
+ if (gfc_dep_compare_functions (*ei, *ej, true) == 0)
{
if (newvar == NULL)
- newvar = create_var (*(expr_array[i]));
+ newvar = create_var (*ei);
- if (gfc_option.warn_function_elimination)
- warn_function_elimination (*(expr_array[j]));
+ if (warn_function_elimination)
+ do_warn_function_elimination (*ej);
- free (*(expr_array[j]));
- *(expr_array[j]) = gfc_copy_expr (newvar);
+ free (*ej);
+ *ej = gfc_copy_expr (newvar);
}
}
if (newvar)
- *(expr_array[i]) = newvar;
+ *ei = newvar;
}
/* We did all the necessary walking in this function. */
to insert statements as needed. */
static int
-cfe_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
- void *data ATTRIBUTE_UNUSED)
+cfe_code (gfc_code **c, int *walk_subtrees, void *data ATTRIBUTE_UNUSED)
{
current_code = c;
inserted_block = NULL;
changed_statement = NULL;
+
+ /* Do not do anything inside a WHERE statement; scalar assignments, BLOCKs
+ and allocation on assigment are prohibited inside WHERE, and finally
+ masking an expression would lead to wrong-code when replacing
+
+ WHERE (a>0)
+ b = sum(foo(a) + foo(a))
+ END WHERE
+
+ with
+
+ WHERE (a > 0)
+ tmp = foo(a)
+ b = sum(tmp + tmp)
+ END WHERE
+*/
+
+ if ((*c)->op == EXEC_WHERE)
+ {
+ *walk_subtrees = 0;
+ return 0;
+ }
+
+
return 0;
}
return 0;
}
+/* Dummy function for code callback, for use when we really
+ don't want to do anything. */
+int
+gfc_dummy_code_callback (gfc_code **e ATTRIBUTE_UNUSED,
+ int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data ATTRIBUTE_UNUSED)
+{
+ return 0;
+}
+
/* Code callback function for converting
do while(a)
end do
current_ns = ns;
forall_level = 0;
iterator_level = 0;
+ in_assoc_list = false;
in_omp_workshare = false;
gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
}
}
+static void
+optimize_reduction (gfc_namespace *ns)
+{
+ current_ns = ns;
+ gfc_code_walker (&ns->code, gfc_dummy_code_callback,
+ callback_reduction, NULL);
+
+/* BLOCKs are handled in the expression walker below. */
+ for (ns = ns->contained; ns; ns = ns->sibling)
+ {
+ if (ns->code == NULL || ns->code->op != EXEC_BLOCK)
+ optimize_reduction (ns);
+ }
+}
+
/* Replace code like
a = matmul(b,c) + d
with
return true;
break;
+ case INTRINSIC_CONCAT:
+ /* Do not do string concatenations. */
+ break;
+
default:
/* Binary operators. */
if (optimize_binop_array_assignment (c, &e->value.op.op1, true))
remove_trim (rhs);
/* Replace a = ' ' by a = '' to optimize away a memcpy. */
- if (is_empty_string(rhs))
+ if (is_empty_string (rhs))
rhs->value.character.length = 0;
}
return false;
}
+/* Combine stuff like [a]>b into [a>b], for easier optimization later. Do not
+ do CHARACTER because of possible pessimization involving character
+ lengths. */
+
+static bool
+combine_array_constructor (gfc_expr *e)
+{
+
+ gfc_expr *op1, *op2;
+ gfc_expr *scalar;
+ gfc_expr *new_expr;
+ gfc_constructor *c, *new_c;
+ gfc_constructor_base oldbase, newbase;
+ bool scalar_first;
+
+ /* Array constructors have rank one. */
+ if (e->rank != 1)
+ return false;
+
+ /* Don't try to combine association lists, this makes no sense
+ and leads to an ICE. */
+ if (in_assoc_list)
+ return false;
+
+ op1 = e->value.op.op1;
+ op2 = e->value.op.op2;
+
+ if (op1->expr_type == EXPR_ARRAY && op2->rank == 0)
+ scalar_first = false;
+ else if (op2->expr_type == EXPR_ARRAY && op1->rank == 0)
+ {
+ scalar_first = true;
+ op1 = e->value.op.op2;
+ op2 = e->value.op.op1;
+ }
+ else
+ return false;
+
+ if (op2->ts.type == BT_CHARACTER)
+ return false;
+
+ scalar = create_var (gfc_copy_expr (op2));
+
+ oldbase = op1->value.constructor;
+ newbase = NULL;
+ e->expr_type = EXPR_ARRAY;
+
+ for (c = gfc_constructor_first (oldbase); c;
+ c = gfc_constructor_next (c))
+ {
+ new_expr = gfc_get_expr ();
+ new_expr->ts = e->ts;
+ new_expr->expr_type = EXPR_OP;
+ new_expr->rank = c->expr->rank;
+ new_expr->where = c->where;
+ new_expr->value.op.op = e->value.op.op;
+
+ if (scalar_first)
+ {
+ new_expr->value.op.op1 = gfc_copy_expr (scalar);
+ new_expr->value.op.op2 = gfc_copy_expr (c->expr);
+ }
+ else
+ {
+ new_expr->value.op.op1 = gfc_copy_expr (c->expr);
+ new_expr->value.op.op2 = gfc_copy_expr (scalar);
+ }
+
+ new_c = gfc_constructor_append_expr (&newbase, new_expr, &(e->where));
+ new_c->iterator = c->iterator;
+ c->iterator = NULL;
+ }
+
+ gfc_free_expr (op1);
+ gfc_free_expr (op2);
+ gfc_free_expr (scalar);
+
+ e->value.constructor = newbase;
+ return true;
+}
+
+/* Change (-1)**k into 1-ishift(iand(k,1),1) and
+ 2**k into ishift(1,k) */
+
+static bool
+optimize_power (gfc_expr *e)
+{
+ gfc_expr *op1, *op2;
+ gfc_expr *iand, *ishft;
+
+ if (e->ts.type != BT_INTEGER)
+ return false;
+
+ op1 = e->value.op.op1;
+
+ if (op1 == NULL || op1->expr_type != EXPR_CONSTANT)
+ return false;
+
+ if (mpz_cmp_si (op1->value.integer, -1L) == 0)
+ {
+ gfc_free_expr (op1);
+
+ op2 = e->value.op.op2;
+
+ if (op2 == NULL)
+ return false;
+
+ iand = gfc_build_intrinsic_call (current_ns, GFC_ISYM_IAND,
+ "_internal_iand", e->where, 2, op2,
+ gfc_get_int_expr (e->ts.kind,
+ &e->where, 1));
+
+ ishft = gfc_build_intrinsic_call (current_ns, GFC_ISYM_ISHFT,
+ "_internal_ishft", e->where, 2, iand,
+ gfc_get_int_expr (e->ts.kind,
+ &e->where, 1));
+
+ e->value.op.op = INTRINSIC_MINUS;
+ e->value.op.op1 = gfc_get_int_expr (e->ts.kind, &e->where, 1);
+ e->value.op.op2 = ishft;
+ return true;
+ }
+ else if (mpz_cmp_si (op1->value.integer, 2L) == 0)
+ {
+ gfc_free_expr (op1);
+
+ op2 = e->value.op.op2;
+ if (op2 == NULL)
+ return false;
+
+ ishft = gfc_build_intrinsic_call (current_ns, GFC_ISYM_ISHFT,
+ "_internal_ishft", e->where, 2,
+ gfc_get_int_expr (e->ts.kind,
+ &e->where, 1),
+ op2);
+ *e = *ishft;
+ return true;
+ }
+
+ else if (mpz_cmp_si (op1->value.integer, 1L) == 0)
+ {
+ op2 = e->value.op.op2;
+ if (op2 == NULL)
+ return false;
+
+ gfc_free_expr (op1);
+ gfc_free_expr (op2);
+
+ e->expr_type = EXPR_CONSTANT;
+ e->value.op.op1 = NULL;
+ e->value.op.op2 = NULL;
+ mpz_init_set_si (e->value.integer, 1);
+ /* Typespec and location are still OK. */
+ return true;
+ }
+
+ return false;
+}
+
/* Recursive optimization of operators. */
static bool
optimize_op (gfc_expr *e)
{
+ bool changed;
+
gfc_intrinsic_op op = e->value.op.op;
+ changed = false;
+
/* Only use new-style comparisons. */
switch(op)
{
case INTRINSIC_NE:
case INTRINSIC_GT:
case INTRINSIC_LT:
- return optimize_comparison (e, op);
+ changed = optimize_comparison (e, op);
+
+ /* Fall through */
+ /* Look at array constructors. */
+ case INTRINSIC_PLUS:
+ case INTRINSIC_MINUS:
+ case INTRINSIC_TIMES:
+ case INTRINSIC_DIVIDE:
+ return combine_array_constructor (e) || changed;
+
+ case INTRINSIC_POWER:
+ return optimize_power (e);
+ break;
default:
break;
/* 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->expr_type == EXPR_OP
&& op1->value.op.op == INTRINSIC_CONCAT
+ && op2->expr_type == EXPR_OP
&& op2->value.op.op == INTRINSIC_CONCAT)
{
gfc_expr *op1_left = op1->value.op.op1;
int i;
gfc_formal_arglist *f;
gfc_actual_arglist *a;
+ gfc_code *cl;
co = *c;
+ /* If the doloop_list grew, we have to truncate it here. */
+
+ if ((unsigned) doloop_level < doloop_list.length())
+ doloop_list.truncate (doloop_level);
+
switch (co->op)
{
case EXEC_DO:
- /* Grow the temporary storage if necessary. */
- if (doloop_level >= doloop_size)
- {
- doloop_size = 2 * doloop_size;
- doloop_list = XRESIZEVEC (gfc_code *, doloop_list, doloop_size);
- }
-
- /* Mark the DO loop variable if there is one. */
if (co->ext.iterator && co->ext.iterator->var)
- doloop_list[doloop_level] = co;
+ doloop_list.safe_push (co);
else
- doloop_list[doloop_level] = NULL;
+ doloop_list.safe_push ((gfc_code *) NULL);
break;
case EXEC_CALL:
if (co->resolved_sym == NULL)
break;
- f = co->resolved_sym->formal;
+ f = gfc_sym_get_dummy_args (co->resolved_sym);
/* Withot a formal arglist, there is only unknown INTENT,
which we don't check for. */
while (a && f)
{
- for (i=0; i<doloop_level; i++)
+ FOR_EACH_VEC_ELT (doloop_list, i, cl)
{
gfc_symbol *do_sym;
- if (doloop_list[i] == NULL)
+ if (cl == NULL)
break;
- do_sym = doloop_list[i]->ext.iterator->var->symtree->n.sym;
+ do_sym = cl->ext.iterator->var->symtree->n.sym;
if (a->expr && a->expr->symtree
&& a->expr->symtree->n.sym == do_sym)
{
if (f->sym->attr.intent == INTENT_OUT)
- gfc_error_now("Variable '%s' at %L set to undefined value "
- "inside loop beginning at %L as INTENT(OUT) "
- "argument to subroutine '%s'", do_sym->name,
- &a->expr->where, &doloop_list[i]->loc,
- co->symtree->n.sym->name);
+ gfc_error_now_1 ("Variable '%s' at %L set to undefined "
+ "value inside loop beginning at %L as "
+ "INTENT(OUT) argument to subroutine '%s'",
+ do_sym->name, &a->expr->where,
+ &doloop_list[i]->loc,
+ co->symtree->n.sym->name);
else if (f->sym->attr.intent == INTENT_INOUT)
- gfc_error_now("Variable '%s' at %L not definable inside loop "
- "beginning at %L as INTENT(INOUT) argument to "
- "subroutine '%s'", do_sym->name,
- &a->expr->where, &doloop_list[i]->loc,
- co->symtree->n.sym->name);
+ gfc_error_now_1 ("Variable '%s' at %L not definable inside "
+ "loop beginning at %L as INTENT(INOUT) "
+ "argument to subroutine '%s'",
+ do_sym->name, &a->expr->where,
+ &doloop_list[i]->loc,
+ co->symtree->n.sym->name);
}
}
a = a->next;
gfc_formal_arglist *f;
gfc_actual_arglist *a;
gfc_expr *expr;
+ gfc_code *dl;
int i;
expr = *e;
if (expr->value.function.isym)
return 0;
- f = expr->symtree->n.sym->formal;
+ f = gfc_sym_get_dummy_args (expr->symtree->n.sym);
/* Without a formal arglist, there is only unknown INTENT,
which we don't check for. */
while (a && f)
{
- for (i=0; i<doloop_level; i++)
+ FOR_EACH_VEC_ELT (doloop_list, i, dl)
{
gfc_symbol *do_sym;
-
-
- if (doloop_list[i] == NULL)
+
+ if (dl == NULL)
break;
- do_sym = doloop_list[i]->ext.iterator->var->symtree->n.sym;
+ do_sym = dl->ext.iterator->var->symtree->n.sym;
if (a->expr && a->expr->symtree
&& a->expr->symtree->n.sym == do_sym)
{
if (f->sym->attr.intent == INTENT_OUT)
- gfc_error_now("Variable '%s' at %L set to undefined value "
- "inside loop beginning at %L as INTENT(OUT) "
- "argument to function '%s'", do_sym->name,
- &a->expr->where, &doloop_list[i]->loc,
- expr->symtree->n.sym->name);
+ gfc_error_now_1 ("Variable '%s' at %L set to undefined value "
+ "inside loop beginning at %L as INTENT(OUT) "
+ "argument to function '%s'", do_sym->name,
+ &a->expr->where, &doloop_list[i]->loc,
+ expr->symtree->n.sym->name);
else if (f->sym->attr.intent == INTENT_INOUT)
- gfc_error_now("Variable '%s' at %L not definable inside loop "
- "beginning at %L as INTENT(INOUT) argument to "
- "function '%s'", do_sym->name,
- &a->expr->where, &doloop_list[i]->loc,
- expr->symtree->n.sym->name);
+ gfc_error_now_1 ("Variable '%s' at %L not definable inside loop"
+ " beginning at %L as INTENT(INOUT) argument to"
+ " function '%s'", do_sym->name,
+ &a->expr->where, &doloop_list[i]->loc,
+ expr->symtree->n.sym->name);
}
}
a = a->next;
case EXEC_BLOCK:
WALK_SUBCODE (co->ext.block.ns->code);
- for (alist = co->ext.block.assoc; alist; alist = alist->next)
- WALK_SUBEXPR (alist->target);
+ if (co->ext.block.assoc)
+ {
+ bool saved_in_assoc_list = in_assoc_list;
+
+ in_assoc_list = true;
+ for (alist = co->ext.block.assoc; alist; alist = alist->next)
+ WALK_SUBEXPR (alist->target);
+
+ in_assoc_list = saved_in_assoc_list;
+ }
+
break;
case EXEC_DO:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
+ case EXEC_OMP_PARALLEL_DO_SIMD:
case EXEC_OMP_PARALLEL_SECTIONS:
in_omp_workshare = false;
in_omp_workshare = true;
/* Fall through */
-
+
+ case EXEC_OMP_DISTRIBUTE:
+ case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
+ case EXEC_OMP_DO_SIMD:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
case EXEC_OMP_END_SINGLE:
+ case EXEC_OMP_SIMD:
+ case EXEC_OMP_TARGET:
+ case EXEC_OMP_TARGET_DATA:
+ case EXEC_OMP_TARGET_TEAMS:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TARGET_UPDATE:
case EXEC_OMP_TASK:
+ case EXEC_OMP_TEAMS:
+ case EXEC_OMP_TEAMS_DISTRIBUTE:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
/* Come to this label only from the
EXEC_OMP_PARALLEL_* cases above. */
if (co->ext.omp_clauses)
{
+ gfc_omp_namelist *n;
+ static int list_types[]
+ = { OMP_LIST_ALIGNED, OMP_LIST_LINEAR, OMP_LIST_DEPEND,
+ OMP_LIST_MAP, OMP_LIST_TO, OMP_LIST_FROM };
+ size_t idx;
WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
WALK_SUBEXPR (co->ext.omp_clauses->final_expr);
WALK_SUBEXPR (co->ext.omp_clauses->num_threads);
WALK_SUBEXPR (co->ext.omp_clauses->chunk_size);
+ WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr);
+ WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr);
+ WALK_SUBEXPR (co->ext.omp_clauses->num_teams);
+ WALK_SUBEXPR (co->ext.omp_clauses->device);
+ WALK_SUBEXPR (co->ext.omp_clauses->thread_limit);
+ WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size);
+ for (idx = 0;
+ idx < sizeof (list_types) / sizeof (list_types[0]);
+ idx++)
+ for (n = co->ext.omp_clauses->lists[list_types[idx]];
+ n; n = n->next)
+ WALK_SUBEXPR (n->expr);
}
break;
default:
projects / gcc.git / blobdiff