2 Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007, 2008, 2009, 2010
3 Free Software Foundation, Inc.
4 Contributed by Paul Brook <paul@nowt.org>
6 This file is part of GCC.
8 GCC is free software; you can redistribute it and/or modify it under
9 the terms of the GNU General Public License as published by the Free
10 Software Foundation; either version 3, or (at your option) any later
13 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
14 WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with GCC; see the file COPYING3. If not see
20 <http://www.gnu.org/licenses/>. */
22 /* dependency.c -- Expression dependency analysis code. */
23 /* There's probably quite a bit of duplication in this file. We currently
24 have different dependency checking functions for different types
25 if dependencies. Ideally these would probably be merged. */
30 #include "dependency.h"
31 #include "constructor.h"
34 /* static declarations */
36 enum range {LHS, RHS, MID};
38 /* Dependency types. These must be in reverse order of priority. */
42 GFC_DEP_EQUAL, /* Identical Ranges. */
43 GFC_DEP_FORWARD, /* e.g., a(1:3) = a(2:4). */
44 GFC_DEP_BACKWARD, /* e.g. a(2:4) = a(1:3). */
45 GFC_DEP_OVERLAP, /* May overlap in some other way. */
46 GFC_DEP_NODEP /* Distinct ranges. */
51 #define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
53 /* Forward declarations */
55 static gfc_dependency check_section_vs_section (gfc_array_ref *,
56 gfc_array_ref *, int);
58 /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
59 def if the value could not be determined. */
62 gfc_expr_is_one (gfc_expr *expr, int def)
64 gcc_assert (expr != NULL);
66 if (expr->expr_type != EXPR_CONSTANT)
69 if (expr->ts.type != BT_INTEGER)
72 return mpz_cmp_si (expr->value.integer, 1) == 0;
75 /* Check if two array references are known to be identical. Calls
76 gfc_dep_compare_expr if necessary for comparing array indices. */
79 identical_array_ref (gfc_array_ref *a1, gfc_array_ref *a2)
83 if (a1->type == AR_FULL && a2->type == AR_FULL)
86 if (a1->type == AR_SECTION && a2->type == AR_SECTION)
88 gcc_assert (a1->dimen == a2->dimen);
90 for ( i = 0; i < a1->dimen; i++)
92 /* TODO: Currently, we punt on an integer array as an index. */
93 if (a1->dimen_type[i] != DIMEN_RANGE
94 || a2->dimen_type[i] != DIMEN_RANGE)
97 if (check_section_vs_section (a1, a2, i) != GFC_DEP_EQUAL)
103 if (a1->type == AR_ELEMENT && a2->type == AR_ELEMENT)
105 gcc_assert (a1->dimen == a2->dimen);
106 for (i = 0; i < a1->dimen; i++)
108 if (gfc_dep_compare_expr (a1->start[i], a2->start[i]) != 0)
118 /* Return true for identical variables, checking for references if
119 necessary. Calls identical_array_ref for checking array sections. */
122 are_identical_variables (gfc_expr *e1, gfc_expr *e2)
126 if (e1->symtree->n.sym->attr.dummy && e2->symtree->n.sym->attr.dummy)
128 /* Dummy arguments: Only check for equal names. */
129 if (e1->symtree->n.sym->name != e2->symtree->n.sym->name)
134 /* Check for equal symbols. */
135 if (e1->symtree->n.sym != e2->symtree->n.sym)
139 /* Volatile variables should never compare equal to themselves. */
141 if (e1->symtree->n.sym->attr.volatile_)
147 while (r1 != NULL || r2 != NULL)
150 /* Assume the variables are not equal if one has a reference and the
152 TODO: Handle full references like comparing a(:) to a.
155 if (r1 == NULL || r2 == NULL)
158 if (r1->type != r2->type)
165 if (!identical_array_ref (&r1->u.ar, &r2->u.ar))
171 if (r1->u.c.component != r2->u.c.component)
176 if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start) != 0
177 || gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0)
182 gfc_internal_error ("are_identical_variables: Bad type");
190 /* Compare two functions for equality. Returns 0 if e1==e2, -2 otherwise. If
191 impure_ok is false, only return 0 for pure functions. */
194 gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
197 gfc_actual_arglist *args1;
198 gfc_actual_arglist *args2;
200 if (e1->expr_type != EXPR_FUNCTION || e2->expr_type != EXPR_FUNCTION)
203 if ((e1->value.function.esym && e2->value.function.esym
204 && e1->value.function.esym == e2->value.function.esym
205 && (e1->value.function.esym->result->attr.pure || impure_ok))
206 || (e1->value.function.isym && e2->value.function.isym
207 && e1->value.function.isym == e2->value.function.isym
208 && (e1->value.function.isym->pure || impure_ok)))
210 args1 = e1->value.function.actual;
211 args2 = e2->value.function.actual;
213 /* Compare the argument lists for equality. */
214 while (args1 && args2)
216 /* Bitwise xor, since C has no non-bitwise xor operator. */
217 if ((args1->expr == NULL) ^ (args2->expr == NULL))
220 if (args1->expr != NULL && args2->expr != NULL
221 && gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
227 return (args1 || args2) ? -2 : 0;
233 /* Compare two expressions. Return values:
237 * -2 if the relationship could not be determined
238 * -3 if e1 /= e2, but we cannot tell which one is larger. */
241 gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
243 gfc_actual_arglist *args1;
244 gfc_actual_arglist *args2;
251 /* Remove any integer conversion functions to larger types. */
252 if (e1->expr_type == EXPR_FUNCTION && e1->value.function.isym
253 && e1->value.function.isym->id == GFC_ISYM_CONVERSION
254 && e1->ts.type == BT_INTEGER)
256 args1 = e1->value.function.actual;
257 if (args1->expr->ts.type == BT_INTEGER
258 && e1->ts.kind > args1->expr->ts.kind)
262 if (e2->expr_type == EXPR_FUNCTION && e2->value.function.isym
263 && e2->value.function.isym->id == GFC_ISYM_CONVERSION
264 && e2->ts.type == BT_INTEGER)
266 args2 = e2->value.function.actual;
267 if (args2->expr->ts.type == BT_INTEGER
268 && e2->ts.kind > args2->expr->ts.kind)
275 return gfc_dep_compare_expr (n1, n2);
277 return gfc_dep_compare_expr (n1, e2);
282 return gfc_dep_compare_expr (e1, n2);
285 if (e1->expr_type == EXPR_OP
286 && (e1->value.op.op == INTRINSIC_UPLUS
287 || e1->value.op.op == INTRINSIC_PARENTHESES))
288 return gfc_dep_compare_expr (e1->value.op.op1, e2);
289 if (e2->expr_type == EXPR_OP
290 && (e2->value.op.op == INTRINSIC_UPLUS
291 || e2->value.op.op == INTRINSIC_PARENTHESES))
292 return gfc_dep_compare_expr (e1, e2->value.op.op1);
294 if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
296 /* Compare X+C vs. X. */
297 if (e1->value.op.op2->expr_type == EXPR_CONSTANT
298 && e1->value.op.op2->ts.type == BT_INTEGER
299 && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
300 return mpz_sgn (e1->value.op.op2->value.integer);
302 /* Compare P+Q vs. R+S. */
303 if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
307 l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
308 r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
309 if (l == 0 && r == 0)
311 if (l == 0 && r > -2)
313 if (l > -2 && r == 0)
315 if (l == 1 && r == 1)
317 if (l == -1 && r == -1)
320 l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
321 r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
322 if (l == 0 && r == 0)
324 if (l == 0 && r > -2)
326 if (l > -2 && r == 0)
328 if (l == 1 && r == 1)
330 if (l == -1 && r == -1)
335 /* Compare X vs. X+C. */
336 if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
338 if (e2->value.op.op2->expr_type == EXPR_CONSTANT
339 && e2->value.op.op2->ts.type == BT_INTEGER
340 && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
341 return -mpz_sgn (e2->value.op.op2->value.integer);
344 /* Compare X-C vs. X. */
345 if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
347 if (e1->value.op.op2->expr_type == EXPR_CONSTANT
348 && e1->value.op.op2->ts.type == BT_INTEGER
349 && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
350 return -mpz_sgn (e1->value.op.op2->value.integer);
352 /* Compare P-Q vs. R-S. */
353 if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
357 l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
358 r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
359 if (l == 0 && r == 0)
361 if (l > -2 && r == 0)
363 if (l == 0 && r > -2)
365 if (l == 1 && r == -1)
367 if (l == -1 && r == 1)
372 /* Compare A // B vs. C // D. */
374 if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_CONCAT
375 && e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_CONCAT)
379 l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
380 r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
387 /* Watch out for 'A ' // x vs. 'A' // x. */
388 gfc_expr *e1_left = e1->value.op.op1;
389 gfc_expr *e2_left = e2->value.op.op1;
391 if (e1_left->expr_type == EXPR_CONSTANT
392 && e2_left->expr_type == EXPR_CONSTANT
393 && e1_left->value.character.length
394 != e2_left->value.character.length)
408 /* Compare X vs. X-C. */
409 if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
411 if (e2->value.op.op2->expr_type == EXPR_CONSTANT
412 && e2->value.op.op2->ts.type == BT_INTEGER
413 && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
414 return mpz_sgn (e2->value.op.op2->value.integer);
417 if (e1->expr_type != e2->expr_type)
420 switch (e1->expr_type)
423 /* Compare strings for equality. */
424 if (e1->ts.type == BT_CHARACTER && e2->ts.type == BT_CHARACTER)
425 return gfc_compare_string (e1, e2);
427 if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
430 i = mpz_cmp (e1->value.integer, e2->value.integer);
438 if (are_identical_variables (e1, e2))
444 /* Intrinsic operators are the same if their operands are the same. */
445 if (e1->value.op.op != e2->value.op.op)
447 if (e1->value.op.op2 == 0)
449 i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
450 return i == 0 ? 0 : -2;
452 if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
453 && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
455 else if (e1->value.op.op == INTRINSIC_TIMES
456 && gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2) == 0
457 && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1) == 0)
458 /* Commutativity of multiplication. */
464 return gfc_dep_compare_functions (e1, e2, false);
473 /* Returns 1 if the two ranges are the same and 0 if they are not (or if the
474 results are indeterminate). 'n' is the dimension to compare. */
477 is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n)
483 /* TODO: More sophisticated range comparison. */
484 gcc_assert (ar1 && ar2);
486 gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
490 /* Check for mismatching strides. A NULL stride means a stride of 1. */
493 i = gfc_expr_is_one (e1, -1);
494 if (i == -1 || i == 0)
499 i = gfc_expr_is_one (e2, -1);
500 if (i == -1 || i == 0)
505 i = gfc_dep_compare_expr (e1, e2);
509 /* The strides match. */
511 /* Check the range start. */
516 /* Use the bound of the array if no bound is specified. */
518 e1 = ar1->as->lower[n];
521 e2 = ar2->as->lower[n];
523 /* Check we have values for both. */
527 i = gfc_dep_compare_expr (e1, e2);
532 /* Check the range end. */
537 /* Use the bound of the array if no bound is specified. */
539 e1 = ar1->as->upper[n];
542 e2 = ar2->as->upper[n];
544 /* Check we have values for both. */
548 i = gfc_dep_compare_expr (e1, e2);
557 /* Some array-returning intrinsics can be implemented by reusing the
558 data from one of the array arguments. For example, TRANSPOSE does
559 not necessarily need to allocate new data: it can be implemented
560 by copying the original array's descriptor and simply swapping the
561 two dimension specifications.
563 If EXPR is a call to such an intrinsic, return the argument
564 whose data can be reused, otherwise return NULL. */
567 gfc_get_noncopying_intrinsic_argument (gfc_expr *expr)
569 if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
572 switch (expr->value.function.isym->id)
574 case GFC_ISYM_TRANSPOSE:
575 return expr->value.function.actual->expr;
583 /* Return true if the result of reference REF can only be constructed
584 using a temporary array. */
587 gfc_ref_needs_temporary_p (gfc_ref *ref)
593 for (; ref; ref = ref->next)
597 /* Vector dimensions are generally not monotonic and must be
598 handled using a temporary. */
599 if (ref->u.ar.type == AR_SECTION)
600 for (n = 0; n < ref->u.ar.dimen; n++)
601 if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
608 /* Within an array reference, character substrings generally
609 need a temporary. Character array strides are expressed as
610 multiples of the element size (consistent with other array
611 types), not in characters. */
623 gfc_is_data_pointer (gfc_expr *e)
627 if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_FUNCTION)
630 /* No subreference if it is a function */
631 gcc_assert (e->expr_type == EXPR_VARIABLE || !e->ref);
633 if (e->symtree->n.sym->attr.pointer)
636 for (ref = e->ref; ref; ref = ref->next)
637 if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
644 /* Return true if array variable VAR could be passed to the same function
645 as argument EXPR without interfering with EXPR. INTENT is the intent
648 This is considerably less conservative than other dependencies
649 because many function arguments will already be copied into a
653 gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
654 gfc_expr *expr, gfc_dep_check elemental)
658 gcc_assert (var->expr_type == EXPR_VARIABLE);
659 gcc_assert (var->rank > 0);
661 switch (expr->expr_type)
664 /* In case of elemental subroutines, there is no dependency
665 between two same-range array references. */
666 if (gfc_ref_needs_temporary_p (expr->ref)
667 || gfc_check_dependency (var, expr, elemental == NOT_ELEMENTAL))
669 if (elemental == ELEM_DONT_CHECK_VARIABLE)
671 /* Too many false positive with pointers. */
672 if (!gfc_is_data_pointer (var) && !gfc_is_data_pointer (expr))
674 /* Elemental procedures forbid unspecified intents,
675 and we don't check dependencies for INTENT_IN args. */
676 gcc_assert (intent == INTENT_OUT || intent == INTENT_INOUT);
678 /* We are told not to check dependencies.
679 We do it, however, and issue a warning in case we find one.
680 If a dependency is found in the case
681 elemental == ELEM_CHECK_VARIABLE, we will generate
682 a temporary, so we don't need to bother the user. */
683 gfc_warning ("INTENT(%s) actual argument at %L might "
684 "interfere with actual argument at %L.",
685 intent == INTENT_OUT ? "OUT" : "INOUT",
686 &var->where, &expr->where);
696 return gfc_check_dependency (var, expr, 1);
699 if (intent != INTENT_IN)
701 arg = gfc_get_noncopying_intrinsic_argument (expr);
703 return gfc_check_argument_var_dependency (var, intent, arg,
707 if (elemental != NOT_ELEMENTAL)
709 if ((expr->value.function.esym
710 && expr->value.function.esym->attr.elemental)
711 || (expr->value.function.isym
712 && expr->value.function.isym->elemental))
713 return gfc_check_fncall_dependency (var, intent, NULL,
714 expr->value.function.actual,
715 ELEM_CHECK_VARIABLE);
720 /* In case of non-elemental procedures, there is no need to catch
721 dependencies, as we will make a temporary anyway. */
724 /* If the actual arg EXPR is an expression, we need to catch
725 a dependency between variables in EXPR and VAR,
726 an intent((IN)OUT) variable. */
727 if (expr->value.op.op1
728 && gfc_check_argument_var_dependency (var, intent,
730 ELEM_CHECK_VARIABLE))
732 else if (expr->value.op.op2
733 && gfc_check_argument_var_dependency (var, intent,
735 ELEM_CHECK_VARIABLE))
746 /* Like gfc_check_argument_var_dependency, but extended to any
747 array expression OTHER, not just variables. */
750 gfc_check_argument_dependency (gfc_expr *other, sym_intent intent,
751 gfc_expr *expr, gfc_dep_check elemental)
753 switch (other->expr_type)
756 return gfc_check_argument_var_dependency (other, intent, expr, elemental);
759 other = gfc_get_noncopying_intrinsic_argument (other);
761 return gfc_check_argument_dependency (other, INTENT_IN, expr,
772 /* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
773 FNSYM is the function being called, or NULL if not known. */
776 gfc_check_fncall_dependency (gfc_expr *other, sym_intent intent,
777 gfc_symbol *fnsym, gfc_actual_arglist *actual,
778 gfc_dep_check elemental)
780 gfc_formal_arglist *formal;
783 formal = fnsym ? fnsym->formal : NULL;
784 for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
788 /* Skip args which are not present. */
792 /* Skip other itself. */
796 /* Skip intent(in) arguments if OTHER itself is intent(in). */
797 if (formal && intent == INTENT_IN
798 && formal->sym->attr.intent == INTENT_IN)
801 if (gfc_check_argument_dependency (other, intent, expr, elemental))
809 /* Return 1 if e1 and e2 are equivalenced arrays, either
810 directly or indirectly; i.e., equivalence (a,b) for a and b
811 or equivalence (a,c),(b,c). This function uses the equiv_
812 lists, generated in trans-common(add_equivalences), that are
813 guaranteed to pick up indirect equivalences. We explicitly
814 check for overlap using the offset and length of the equivalence.
815 This function is symmetric.
816 TODO: This function only checks whether the full top-level
817 symbols overlap. An improved implementation could inspect
818 e1->ref and e2->ref to determine whether the actually accessed
819 portions of these variables/arrays potentially overlap. */
822 gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
825 gfc_equiv_info *s, *fl1, *fl2;
827 gcc_assert (e1->expr_type == EXPR_VARIABLE
828 && e2->expr_type == EXPR_VARIABLE);
830 if (!e1->symtree->n.sym->attr.in_equivalence
831 || !e2->symtree->n.sym->attr.in_equivalence|| !e1->rank || !e2->rank)
834 if (e1->symtree->n.sym->ns
835 && e1->symtree->n.sym->ns != gfc_current_ns)
836 l = e1->symtree->n.sym->ns->equiv_lists;
838 l = gfc_current_ns->equiv_lists;
840 /* Go through the equiv_lists and return 1 if the variables
841 e1 and e2 are members of the same group and satisfy the
842 requirement on their relative offsets. */
843 for (; l; l = l->next)
847 for (s = l->equiv; s; s = s->next)
849 if (s->sym == e1->symtree->n.sym)
855 if (s->sym == e2->symtree->n.sym)
865 /* Can these lengths be zero? */
866 if (fl1->length <= 0 || fl2->length <= 0)
868 /* These can't overlap if [f11,fl1+length] is before
869 [fl2,fl2+length], or [fl2,fl2+length] is before
870 [fl1,fl1+length], otherwise they do overlap. */
871 if (fl1->offset + fl1->length > fl2->offset
872 && fl2->offset + fl2->length > fl1->offset)
880 /* Return true if there is no possibility of aliasing because of a type
881 mismatch between all the possible pointer references and the
882 potential target. Note that this function is asymmetric in the
883 arguments and so must be called twice with the arguments exchanged. */
886 check_data_pointer_types (gfc_expr *expr1, gfc_expr *expr2)
892 bool seen_component_ref;
894 if (expr1->expr_type != EXPR_VARIABLE
895 || expr1->expr_type != EXPR_VARIABLE)
898 sym1 = expr1->symtree->n.sym;
899 sym2 = expr2->symtree->n.sym;
901 /* Keep it simple for now. */
902 if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
905 if (sym1->attr.pointer)
907 if (gfc_compare_types (&sym1->ts, &sym2->ts))
911 /* This is a conservative check on the components of the derived type
912 if no component references have been seen. Since we will not dig
913 into the components of derived type components, we play it safe by
914 returning false. First we check the reference chain and then, if
915 no component references have been seen, the components. */
916 seen_component_ref = false;
917 if (sym1->ts.type == BT_DERIVED)
919 for (ref1 = expr1->ref; ref1; ref1 = ref1->next)
921 if (ref1->type != REF_COMPONENT)
924 if (ref1->u.c.component->ts.type == BT_DERIVED)
927 if ((sym2->attr.pointer || ref1->u.c.component->attr.pointer)
928 && gfc_compare_types (&ref1->u.c.component->ts, &sym2->ts))
931 seen_component_ref = true;
935 if (sym1->ts.type == BT_DERIVED && !seen_component_ref)
937 for (cm1 = sym1->ts.u.derived->components; cm1; cm1 = cm1->next)
939 if (cm1->ts.type == BT_DERIVED)
942 if ((sym2->attr.pointer || cm1->attr.pointer)
943 && gfc_compare_types (&cm1->ts, &sym2->ts))
952 /* Return true if the statement body redefines the condition. Returns
953 true if expr2 depends on expr1. expr1 should be a single term
954 suitable for the lhs of an assignment. The IDENTICAL flag indicates
955 whether array references to the same symbol with identical range
956 references count as a dependency or not. Used for forall and where
957 statements. Also used with functions returning arrays without a
961 gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
963 gfc_actual_arglist *actual;
967 gcc_assert (expr1->expr_type == EXPR_VARIABLE);
969 switch (expr2->expr_type)
972 n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
975 if (expr2->value.op.op2)
976 return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
980 /* The interesting cases are when the symbols don't match. */
981 if (expr1->symtree->n.sym != expr2->symtree->n.sym)
983 gfc_typespec *ts1 = &expr1->symtree->n.sym->ts;
984 gfc_typespec *ts2 = &expr2->symtree->n.sym->ts;
986 /* Return 1 if expr1 and expr2 are equivalenced arrays. */
987 if (gfc_are_equivalenced_arrays (expr1, expr2))
990 /* Symbols can only alias if they have the same type. */
991 if (ts1->type != BT_UNKNOWN && ts2->type != BT_UNKNOWN
992 && ts1->type != BT_DERIVED && ts2->type != BT_DERIVED)
994 if (ts1->type != ts2->type || ts1->kind != ts2->kind)
998 /* If either variable is a pointer, assume the worst. */
999 /* TODO: -fassume-no-pointer-aliasing */
1000 if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2))
1002 if (check_data_pointer_types (expr1, expr2)
1003 && check_data_pointer_types (expr2, expr1))
1010 gfc_symbol *sym1 = expr1->symtree->n.sym;
1011 gfc_symbol *sym2 = expr2->symtree->n.sym;
1012 if (sym1->attr.target && sym2->attr.target
1013 && ((sym1->attr.dummy && !sym1->attr.contiguous
1014 && (!sym1->attr.dimension
1015 || sym2->as->type == AS_ASSUMED_SHAPE))
1016 || (sym2->attr.dummy && !sym2->attr.contiguous
1017 && (!sym2->attr.dimension
1018 || sym2->as->type == AS_ASSUMED_SHAPE))))
1022 /* Otherwise distinct symbols have no dependencies. */
1029 /* Identical and disjoint ranges return 0,
1030 overlapping ranges return 1. */
1031 if (expr1->ref && expr2->ref)
1032 return gfc_dep_resolver (expr1->ref, expr2->ref, NULL);
1037 if (gfc_get_noncopying_intrinsic_argument (expr2) != NULL)
1040 /* Remember possible differences between elemental and
1041 transformational functions. All functions inside a FORALL
1043 for (actual = expr2->value.function.actual;
1044 actual; actual = actual->next)
1048 n = gfc_check_dependency (expr1, actual->expr, identical);
1059 /* Loop through the array constructor's elements. */
1060 for (c = gfc_constructor_first (expr2->value.constructor);
1061 c; c = gfc_constructor_next (c))
1063 /* If this is an iterator, assume the worst. */
1066 /* Avoid recursion in the common case. */
1067 if (c->expr->expr_type == EXPR_CONSTANT)
1069 if (gfc_check_dependency (expr1, c->expr, 1))
1080 /* Determines overlapping for two array sections. */
1082 static gfc_dependency
1083 check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
1099 int stride_comparison;
1100 int start_comparison;
1102 /* If they are the same range, return without more ado. */
1103 if (is_same_range (l_ar, r_ar, n))
1104 return GFC_DEP_EQUAL;
1106 l_start = l_ar->start[n];
1107 l_end = l_ar->end[n];
1108 l_stride = l_ar->stride[n];
1110 r_start = r_ar->start[n];
1111 r_end = r_ar->end[n];
1112 r_stride = r_ar->stride[n];
1114 /* If l_start is NULL take it from array specifier. */
1115 if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar->as))
1116 l_start = l_ar->as->lower[n];
1117 /* If l_end is NULL take it from array specifier. */
1118 if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar->as))
1119 l_end = l_ar->as->upper[n];
1121 /* If r_start is NULL take it from array specifier. */
1122 if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar->as))
1123 r_start = r_ar->as->lower[n];
1124 /* If r_end is NULL take it from array specifier. */
1125 if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar->as))
1126 r_end = r_ar->as->upper[n];
1128 /* Determine whether the l_stride is positive or negative. */
1131 else if (l_stride->expr_type == EXPR_CONSTANT
1132 && l_stride->ts.type == BT_INTEGER)
1133 l_dir = mpz_sgn (l_stride->value.integer);
1134 else if (l_start && l_end)
1135 l_dir = gfc_dep_compare_expr (l_end, l_start);
1139 /* Determine whether the r_stride is positive or negative. */
1142 else if (r_stride->expr_type == EXPR_CONSTANT
1143 && r_stride->ts.type == BT_INTEGER)
1144 r_dir = mpz_sgn (r_stride->value.integer);
1145 else if (r_start && r_end)
1146 r_dir = gfc_dep_compare_expr (r_end, r_start);
1150 /* The strides should never be zero. */
1151 if (l_dir == 0 || r_dir == 0)
1152 return GFC_DEP_OVERLAP;
1154 /* Determine the relationship between the strides. Set stride_comparison to
1155 -2 if the dependency cannot be determined
1156 -1 if l_stride < r_stride
1157 0 if l_stride == r_stride
1158 1 if l_stride > r_stride
1159 as determined by gfc_dep_compare_expr. */
1161 one_expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
1163 stride_comparison = gfc_dep_compare_expr (l_stride ? l_stride : one_expr,
1164 r_stride ? r_stride : one_expr);
1166 if (l_start && r_start)
1167 start_comparison = gfc_dep_compare_expr (l_start, r_start);
1169 start_comparison = -2;
1173 /* Determine LHS upper and lower bounds. */
1179 else if (l_dir == -1)
1190 /* Determine RHS upper and lower bounds. */
1196 else if (r_dir == -1)
1207 /* Check whether the ranges are disjoint. */
1208 if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
1209 return GFC_DEP_NODEP;
1210 if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
1211 return GFC_DEP_NODEP;
1213 /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL. */
1214 if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
1216 if (l_dir == 1 && r_dir == -1)
1217 return GFC_DEP_EQUAL;
1218 if (l_dir == -1 && r_dir == 1)
1219 return GFC_DEP_EQUAL;
1222 /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL. */
1223 if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
1225 if (l_dir == 1 && r_dir == -1)
1226 return GFC_DEP_EQUAL;
1227 if (l_dir == -1 && r_dir == 1)
1228 return GFC_DEP_EQUAL;
1231 /* Handle cases like x:y:2 vs. x+1:z:4 as GFC_DEP_NODEP.
1232 There is no dependency if the remainder of
1233 (l_start - r_start) / gcd(l_stride, r_stride) is
1236 - Handle cases where x is an expression.
1237 - Cases like a(1:4:2) = a(2:3) are still not handled.
1240 #define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
1241 && (a)->ts.type == BT_INTEGER)
1243 if (IS_CONSTANT_INTEGER(l_start) && IS_CONSTANT_INTEGER(r_start)
1244 && IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride))
1252 mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer);
1253 mpz_sub (tmp, l_start->value.integer, r_start->value.integer);
1255 mpz_fdiv_r (tmp, tmp, gcd);
1256 result = mpz_cmp_si (tmp, 0L);
1262 return GFC_DEP_NODEP;
1265 #undef IS_CONSTANT_INTEGER
1267 /* Check for forward dependencies x:y vs. x+1:z and x:y:z vs. x:y:z+1. */
1269 if (l_dir == 1 && r_dir == 1 &&
1270 (start_comparison == 0 || start_comparison == -1)
1271 && (stride_comparison == 0 || stride_comparison == -1))
1272 return GFC_DEP_FORWARD;
1274 /* Check for forward dependencies x:y:-1 vs. x-1:z:-1 and
1275 x:y:-1 vs. x:y:-2. */
1276 if (l_dir == -1 && r_dir == -1 &&
1277 (start_comparison == 0 || start_comparison == 1)
1278 && (stride_comparison == 0 || stride_comparison == 1))
1279 return GFC_DEP_FORWARD;
1281 if (stride_comparison == 0 || stride_comparison == -1)
1283 if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
1286 /* Check for a(low:y:s) vs. a(z:x:s) or
1287 a(low:y:s) vs. a(z:x:s+1) where a has a lower bound
1288 of low, which is always at least a forward dependence. */
1291 && gfc_dep_compare_expr (l_start, l_ar->as->lower[n]) == 0)
1292 return GFC_DEP_FORWARD;
1296 if (stride_comparison == 0 || stride_comparison == 1)
1298 if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
1301 /* Check for a(high:y:-s) vs. a(z:x:-s) or
1302 a(high:y:-s vs. a(z:x:-s-1) where a has a higher bound
1303 of high, which is always at least a forward dependence. */
1306 && gfc_dep_compare_expr (l_start, l_ar->as->upper[n]) == 0)
1307 return GFC_DEP_FORWARD;
1312 if (stride_comparison == 0)
1314 /* From here, check for backwards dependencies. */
1315 /* x+1:y vs. x:z. */
1316 if (l_dir == 1 && r_dir == 1 && start_comparison == 1)
1317 return GFC_DEP_BACKWARD;
1319 /* x-1:y:-1 vs. x:z:-1. */
1320 if (l_dir == -1 && r_dir == -1 && start_comparison == -1)
1321 return GFC_DEP_BACKWARD;
1324 return GFC_DEP_OVERLAP;
1328 /* Determines overlapping for a single element and a section. */
1330 static gfc_dependency
1331 gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
1340 elem = lref->u.ar.start[n];
1342 return GFC_DEP_OVERLAP;
1345 start = ref->start[n] ;
1347 stride = ref->stride[n];
1349 if (!start && IS_ARRAY_EXPLICIT (ref->as))
1350 start = ref->as->lower[n];
1351 if (!end && IS_ARRAY_EXPLICIT (ref->as))
1352 end = ref->as->upper[n];
1354 /* Determine whether the stride is positive or negative. */
1357 else if (stride->expr_type == EXPR_CONSTANT
1358 && stride->ts.type == BT_INTEGER)
1359 s = mpz_sgn (stride->value.integer);
1363 /* Stride should never be zero. */
1365 return GFC_DEP_OVERLAP;
1367 /* Positive strides. */
1370 /* Check for elem < lower. */
1371 if (start && gfc_dep_compare_expr (elem, start) == -1)
1372 return GFC_DEP_NODEP;
1373 /* Check for elem > upper. */
1374 if (end && gfc_dep_compare_expr (elem, end) == 1)
1375 return GFC_DEP_NODEP;
1379 s = gfc_dep_compare_expr (start, end);
1380 /* Check for an empty range. */
1382 return GFC_DEP_NODEP;
1383 if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
1384 return GFC_DEP_EQUAL;
1387 /* Negative strides. */
1390 /* Check for elem > upper. */
1391 if (end && gfc_dep_compare_expr (elem, start) == 1)
1392 return GFC_DEP_NODEP;
1393 /* Check for elem < lower. */
1394 if (start && gfc_dep_compare_expr (elem, end) == -1)
1395 return GFC_DEP_NODEP;
1399 s = gfc_dep_compare_expr (start, end);
1400 /* Check for an empty range. */
1402 return GFC_DEP_NODEP;
1403 if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
1404 return GFC_DEP_EQUAL;
1407 /* Unknown strides. */
1411 return GFC_DEP_OVERLAP;
1412 s = gfc_dep_compare_expr (start, end);
1414 return GFC_DEP_OVERLAP;
1415 /* Assume positive stride. */
1418 /* Check for elem < lower. */
1419 if (gfc_dep_compare_expr (elem, start) == -1)
1420 return GFC_DEP_NODEP;
1421 /* Check for elem > upper. */
1422 if (gfc_dep_compare_expr (elem, end) == 1)
1423 return GFC_DEP_NODEP;
1425 /* Assume negative stride. */
1428 /* Check for elem > upper. */
1429 if (gfc_dep_compare_expr (elem, start) == 1)
1430 return GFC_DEP_NODEP;
1431 /* Check for elem < lower. */
1432 if (gfc_dep_compare_expr (elem, end) == -1)
1433 return GFC_DEP_NODEP;
1438 s = gfc_dep_compare_expr (elem, start);
1440 return GFC_DEP_EQUAL;
1441 if (s == 1 || s == -1)
1442 return GFC_DEP_NODEP;
1446 return GFC_DEP_OVERLAP;
1450 /* Traverse expr, checking all EXPR_VARIABLE symbols for their
1451 forall_index attribute. Return true if any variable may be
1452 being used as a FORALL index. Its safe to pessimistically
1453 return true, and assume a dependency. */
1456 contains_forall_index_p (gfc_expr *expr)
1458 gfc_actual_arglist *arg;
1466 switch (expr->expr_type)
1469 if (expr->symtree->n.sym->forall_index)
1474 if (contains_forall_index_p (expr->value.op.op1)
1475 || contains_forall_index_p (expr->value.op.op2))
1480 for (arg = expr->value.function.actual; arg; arg = arg->next)
1481 if (contains_forall_index_p (arg->expr))
1487 case EXPR_SUBSTRING:
1490 case EXPR_STRUCTURE:
1492 for (c = gfc_constructor_first (expr->value.constructor);
1493 c; gfc_constructor_next (c))
1494 if (contains_forall_index_p (c->expr))
1502 for (ref = expr->ref; ref; ref = ref->next)
1506 for (i = 0; i < ref->u.ar.dimen; i++)
1507 if (contains_forall_index_p (ref->u.ar.start[i])
1508 || contains_forall_index_p (ref->u.ar.end[i])
1509 || contains_forall_index_p (ref->u.ar.stride[i]))
1517 if (contains_forall_index_p (ref->u.ss.start)
1518 || contains_forall_index_p (ref->u.ss.end))
1529 /* Determines overlapping for two single element array references. */
1531 static gfc_dependency
1532 gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
1542 l_start = l_ar.start[n] ;
1543 r_start = r_ar.start[n] ;
1544 i = gfc_dep_compare_expr (r_start, l_start);
1546 return GFC_DEP_EQUAL;
1548 /* Treat two scalar variables as potentially equal. This allows
1549 us to prove that a(i,:) and a(j,:) have no dependency. See
1550 Gerald Roth, "Evaluation of Array Syntax Dependence Analysis",
1551 Proceedings of the International Conference on Parallel and
1552 Distributed Processing Techniques and Applications (PDPTA2001),
1553 Las Vegas, Nevada, June 2001. */
1554 /* However, we need to be careful when either scalar expression
1555 contains a FORALL index, as these can potentially change value
1556 during the scalarization/traversal of this array reference. */
1557 if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
1558 return GFC_DEP_OVERLAP;
1561 return GFC_DEP_NODEP;
1562 return GFC_DEP_EQUAL;
1566 /* Determine if an array ref, usually an array section specifies the
1567 entire array. In addition, if the second, pointer argument is
1568 provided, the function will return true if the reference is
1569 contiguous; eg. (:, 1) gives true but (1,:) gives false. */
1572 gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
1576 bool lbound_OK = true;
1577 bool ubound_OK = true;
1580 *contiguous = false;
1582 if (ref->type != REF_ARRAY)
1585 if (ref->u.ar.type == AR_FULL)
1592 if (ref->u.ar.type != AR_SECTION)
1597 for (i = 0; i < ref->u.ar.dimen; i++)
1599 /* If we have a single element in the reference, for the reference
1600 to be full, we need to ascertain that the array has a single
1601 element in this dimension and that we actually reference the
1603 if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
1605 /* This is unconditionally a contiguous reference if all the
1606 remaining dimensions are elements. */
1610 for (n = i + 1; n < ref->u.ar.dimen; n++)
1611 if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
1612 *contiguous = false;
1616 || !ref->u.ar.as->lower[i]
1617 || !ref->u.ar.as->upper[i]
1618 || gfc_dep_compare_expr (ref->u.ar.as->lower[i],
1619 ref->u.ar.as->upper[i])
1620 || !ref->u.ar.start[i]
1621 || gfc_dep_compare_expr (ref->u.ar.start[i],
1622 ref->u.ar.as->lower[i]))
1628 /* Check the lower bound. */
1629 if (ref->u.ar.start[i]
1631 || !ref->u.ar.as->lower[i]
1632 || gfc_dep_compare_expr (ref->u.ar.start[i],
1633 ref->u.ar.as->lower[i])))
1635 /* Check the upper bound. */
1636 if (ref->u.ar.end[i]
1638 || !ref->u.ar.as->upper[i]
1639 || gfc_dep_compare_expr (ref->u.ar.end[i],
1640 ref->u.ar.as->upper[i])))
1642 /* Check the stride. */
1643 if (ref->u.ar.stride[i]
1644 && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
1647 /* This is unconditionally a contiguous reference as long as all
1648 the subsequent dimensions are elements. */
1652 for (n = i + 1; n < ref->u.ar.dimen; n++)
1653 if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
1654 *contiguous = false;
1657 if (!lbound_OK || !ubound_OK)
1664 /* Determine if a full array is the same as an array section with one
1665 variable limit. For this to be so, the strides must both be unity
1666 and one of either start == lower or end == upper must be true. */
1669 ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
1672 bool upper_or_lower;
1674 if (full_ref->type != REF_ARRAY)
1676 if (full_ref->u.ar.type != AR_FULL)
1678 if (ref->type != REF_ARRAY)
1680 if (ref->u.ar.type != AR_SECTION)
1683 for (i = 0; i < ref->u.ar.dimen; i++)
1685 /* If we have a single element in the reference, we need to check
1686 that the array has a single element and that we actually reference
1687 the correct element. */
1688 if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
1690 if (!full_ref->u.ar.as
1691 || !full_ref->u.ar.as->lower[i]
1692 || !full_ref->u.ar.as->upper[i]
1693 || gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
1694 full_ref->u.ar.as->upper[i])
1695 || !ref->u.ar.start[i]
1696 || gfc_dep_compare_expr (ref->u.ar.start[i],
1697 full_ref->u.ar.as->lower[i]))
1701 /* Check the strides. */
1702 if (full_ref->u.ar.stride[i] && !gfc_expr_is_one (full_ref->u.ar.stride[i], 0))
1704 if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
1707 upper_or_lower = false;
1708 /* Check the lower bound. */
1709 if (ref->u.ar.start[i]
1711 && full_ref->u.ar.as->lower[i]
1712 && gfc_dep_compare_expr (ref->u.ar.start[i],
1713 full_ref->u.ar.as->lower[i]) == 0))
1714 upper_or_lower = true;
1715 /* Check the upper bound. */
1716 if (ref->u.ar.end[i]
1718 && full_ref->u.ar.as->upper[i]
1719 && gfc_dep_compare_expr (ref->u.ar.end[i],
1720 full_ref->u.ar.as->upper[i]) == 0))
1721 upper_or_lower = true;
1722 if (!upper_or_lower)
1729 /* Finds if two array references are overlapping or not.
1731 2 : array references are overlapping but reversal of one or
1732 more dimensions will clear the dependency.
1733 1 : array references are overlapping.
1734 0 : array references are identical or not overlapping. */
1737 gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
1740 gfc_dependency fin_dep;
1741 gfc_dependency this_dep;
1743 this_dep = GFC_DEP_ERROR;
1744 fin_dep = GFC_DEP_ERROR;
1745 /* Dependencies due to pointers should already have been identified.
1746 We only need to check for overlapping array references. */
1748 while (lref && rref)
1750 /* We're resolving from the same base symbol, so both refs should be
1751 the same type. We traverse the reference chain until we find ranges
1752 that are not equal. */
1753 gcc_assert (lref->type == rref->type);
1757 /* The two ranges can't overlap if they are from different
1759 if (lref->u.c.component != rref->u.c.component)
1764 /* Substring overlaps are handled by the string assignment code
1765 if there is not an underlying dependency. */
1766 return (fin_dep == GFC_DEP_OVERLAP) ? 1 : 0;
1770 if (ref_same_as_full_array (lref, rref))
1773 if (ref_same_as_full_array (rref, lref))
1776 if (lref->u.ar.dimen != rref->u.ar.dimen)
1778 if (lref->u.ar.type == AR_FULL)
1779 fin_dep = gfc_full_array_ref_p (rref, NULL) ? GFC_DEP_EQUAL
1781 else if (rref->u.ar.type == AR_FULL)
1782 fin_dep = gfc_full_array_ref_p (lref, NULL) ? GFC_DEP_EQUAL
1789 for (n=0; n < lref->u.ar.dimen; n++)
1791 /* Assume dependency when either of array reference is vector
1793 if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
1794 || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
1797 if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
1798 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
1799 this_dep = check_section_vs_section (&lref->u.ar, &rref->u.ar, n);
1800 else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
1801 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
1802 this_dep = gfc_check_element_vs_section (lref, rref, n);
1803 else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
1804 && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
1805 this_dep = gfc_check_element_vs_section (rref, lref, n);
1808 gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
1809 && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
1810 this_dep = gfc_check_element_vs_element (rref, lref, n);
1813 /* If any dimension doesn't overlap, we have no dependency. */
1814 if (this_dep == GFC_DEP_NODEP)
1817 /* Now deal with the loop reversal logic: This only works on
1818 ranges and is activated by setting
1819 reverse[n] == GFC_ENABLE_REVERSE
1820 The ability to reverse or not is set by previous conditions
1821 in this dimension. If reversal is not activated, the
1822 value GFC_DEP_BACKWARD is reset to GFC_DEP_OVERLAP. */
1823 if (rref->u.ar.dimen_type[n] == DIMEN_RANGE
1824 && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
1826 /* Set reverse if backward dependence and not inhibited. */
1827 if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
1828 reverse[n] = (this_dep == GFC_DEP_BACKWARD) ?
1829 GFC_REVERSE_SET : reverse[n];
1831 /* Set forward if forward dependence and not inhibited. */
1832 if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
1833 reverse[n] = (this_dep == GFC_DEP_FORWARD) ?
1834 GFC_FORWARD_SET : reverse[n];
1836 /* Flag up overlap if dependence not compatible with
1837 the overall state of the expression. */
1838 if (reverse && reverse[n] == GFC_REVERSE_SET
1839 && this_dep == GFC_DEP_FORWARD)
1841 reverse[n] = GFC_INHIBIT_REVERSE;
1842 this_dep = GFC_DEP_OVERLAP;
1844 else if (reverse && reverse[n] == GFC_FORWARD_SET
1845 && this_dep == GFC_DEP_BACKWARD)
1847 reverse[n] = GFC_INHIBIT_REVERSE;
1848 this_dep = GFC_DEP_OVERLAP;
1851 /* If no intention of reversing or reversing is explicitly
1852 inhibited, convert backward dependence to overlap. */
1853 if ((reverse == NULL && this_dep == GFC_DEP_BACKWARD)
1854 || (reverse != NULL && reverse[n] == GFC_INHIBIT_REVERSE))
1855 this_dep = GFC_DEP_OVERLAP;
1858 /* Overlap codes are in order of priority. We only need to
1859 know the worst one.*/
1860 if (this_dep > fin_dep)
1864 /* If this is an equal element, we have to keep going until we find
1865 the "real" array reference. */
1866 if (lref->u.ar.type == AR_ELEMENT
1867 && rref->u.ar.type == AR_ELEMENT
1868 && fin_dep == GFC_DEP_EQUAL)
1871 /* Exactly matching and forward overlapping ranges don't cause a
1873 if (fin_dep < GFC_DEP_BACKWARD)
1876 /* Keep checking. We only have a dependency if
1877 subsequent references also overlap. */
1887 /* If we haven't seen any array refs then something went wrong. */
1888 gcc_assert (fin_dep != GFC_DEP_ERROR);
1890 /* Assume the worst if we nest to different depths. */
1894 return fin_dep == GFC_DEP_OVERLAP;