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 gfc_are_identical_variables (gfc_expr *e1, gfc_expr *e2)
126 if (e1->symtree->n.sym != e2->symtree->n.sym)
129 /* Volatile variables should never compare equal to themselves. */
131 if (e1->symtree->n.sym->attr.volatile_)
137 while (r1 != NULL || r2 != NULL)
140 /* Assume the variables are not equal if one has a reference and the
142 TODO: Handle full references like comparing a(:) to a.
145 if (r1 == NULL || r2 == NULL)
148 if (r1->type != r2->type)
155 if (!identical_array_ref (&r1->u.ar, &r2->u.ar))
161 if (r1->u.c.component != r2->u.c.component)
166 if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start) != 0
167 || gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0)
172 gfc_internal_error ("gfc_are_identical_variables: Bad type");
180 /* Compare two functions for equality. Returns 0 if e1==e2, -2 otherwise. If
181 impure_ok is false, only return 0 for pure functions. */
184 gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
187 gfc_actual_arglist *args1;
188 gfc_actual_arglist *args2;
190 if (e1->expr_type != EXPR_FUNCTION || e2->expr_type != EXPR_FUNCTION)
193 if ((e1->value.function.esym && e2->value.function.esym
194 && e1->value.function.esym == e2->value.function.esym
195 && (e1->value.function.esym->result->attr.pure || impure_ok))
196 || (e1->value.function.isym && e2->value.function.isym
197 && e1->value.function.isym == e2->value.function.isym
198 && (e1->value.function.isym->pure || impure_ok)))
200 args1 = e1->value.function.actual;
201 args2 = e2->value.function.actual;
203 /* Compare the argument lists for equality. */
204 while (args1 && args2)
206 /* Bitwise xor, since C has no non-bitwise xor operator. */
207 if ((args1->expr == NULL) ^ (args2->expr == NULL))
210 if (args1->expr != NULL && args2->expr != NULL
211 && gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
217 return (args1 || args2) ? -2 : 0;
223 /* Compare two values. Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
224 and -2 if the relationship could not be determined. */
227 gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
229 gfc_actual_arglist *args1;
230 gfc_actual_arglist *args2;
237 /* Remove any integer conversion functions to larger types. */
238 if (e1->expr_type == EXPR_FUNCTION && e1->value.function.isym
239 && e1->value.function.isym->id == GFC_ISYM_CONVERSION
240 && e1->ts.type == BT_INTEGER)
242 args1 = e1->value.function.actual;
243 if (args1->expr->ts.type == BT_INTEGER
244 && e1->ts.kind > args1->expr->ts.kind)
248 if (e2->expr_type == EXPR_FUNCTION && e2->value.function.isym
249 && e2->value.function.isym->id == GFC_ISYM_CONVERSION
250 && e2->ts.type == BT_INTEGER)
252 args2 = e2->value.function.actual;
253 if (args2->expr->ts.type == BT_INTEGER
254 && e2->ts.kind > args2->expr->ts.kind)
261 return gfc_dep_compare_expr (n1, n2);
263 return gfc_dep_compare_expr (n1, e2);
268 return gfc_dep_compare_expr (e1, n2);
271 if (e1->expr_type == EXPR_OP
272 && (e1->value.op.op == INTRINSIC_UPLUS
273 || e1->value.op.op == INTRINSIC_PARENTHESES))
274 return gfc_dep_compare_expr (e1->value.op.op1, e2);
275 if (e2->expr_type == EXPR_OP
276 && (e2->value.op.op == INTRINSIC_UPLUS
277 || e2->value.op.op == INTRINSIC_PARENTHESES))
278 return gfc_dep_compare_expr (e1, e2->value.op.op1);
280 if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
282 /* Compare X+C vs. X. */
283 if (e1->value.op.op2->expr_type == EXPR_CONSTANT
284 && e1->value.op.op2->ts.type == BT_INTEGER
285 && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
286 return mpz_sgn (e1->value.op.op2->value.integer);
288 /* Compare P+Q vs. R+S. */
289 if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
293 l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
294 r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
295 if (l == 0 && r == 0)
297 if (l == 0 && r != -2)
299 if (l != -2 && r == 0)
301 if (l == 1 && r == 1)
303 if (l == -1 && r == -1)
306 l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
307 r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
308 if (l == 0 && r == 0)
310 if (l == 0 && r != -2)
312 if (l != -2 && r == 0)
314 if (l == 1 && r == 1)
316 if (l == -1 && r == -1)
321 /* Compare X vs. X+C. */
322 if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
324 if (e2->value.op.op2->expr_type == EXPR_CONSTANT
325 && e2->value.op.op2->ts.type == BT_INTEGER
326 && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
327 return -mpz_sgn (e2->value.op.op2->value.integer);
330 /* Compare X-C vs. X. */
331 if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
333 if (e1->value.op.op2->expr_type == EXPR_CONSTANT
334 && e1->value.op.op2->ts.type == BT_INTEGER
335 && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
336 return -mpz_sgn (e1->value.op.op2->value.integer);
338 /* Compare P-Q vs. R-S. */
339 if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
343 l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
344 r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
345 if (l == 0 && r == 0)
347 if (l != -2 && r == 0)
349 if (l == 0 && r != -2)
351 if (l == 1 && r == -1)
353 if (l == -1 && r == 1)
358 /* Compare A // B vs. C // D. */
360 if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_CONCAT
361 && e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_CONCAT)
365 l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
366 r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
373 /* Watch out for 'A ' // x vs. 'A' // x. */
374 gfc_expr *e1_left = e1->value.op.op1;
375 gfc_expr *e2_left = e2->value.op.op1;
377 if (e1_left->expr_type == EXPR_CONSTANT
378 && e2_left->expr_type == EXPR_CONSTANT
379 && e1_left->value.character.length
380 != e2_left->value.character.length)
394 /* Compare X vs. X-C. */
395 if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
397 if (e2->value.op.op2->expr_type == EXPR_CONSTANT
398 && e2->value.op.op2->ts.type == BT_INTEGER
399 && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
400 return mpz_sgn (e2->value.op.op2->value.integer);
403 if (e1->expr_type != e2->expr_type)
406 switch (e1->expr_type)
409 /* Compare strings for equality. */
410 if (e1->ts.type == BT_CHARACTER && e2->ts.type == BT_CHARACTER)
411 return gfc_compare_string (e1, e2);
413 if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
416 i = mpz_cmp (e1->value.integer, e2->value.integer);
424 if (gfc_are_identical_variables (e1, e2))
430 /* Intrinsic operators are the same if their operands are the same. */
431 if (e1->value.op.op != e2->value.op.op)
433 if (e1->value.op.op2 == 0)
435 i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
436 return i == 0 ? 0 : -2;
438 if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
439 && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
441 /* TODO Handle commutative binary operators here? */
445 return gfc_dep_compare_functions (e1, e2, false);
454 /* Returns 1 if the two ranges are the same, 0 if they are not, and def
455 if the results are indeterminate. N is the dimension to compare. */
458 gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def)
464 /* TODO: More sophisticated range comparison. */
465 gcc_assert (ar1 && ar2);
467 gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
471 /* Check for mismatching strides. A NULL stride means a stride of 1. */
474 i = gfc_expr_is_one (e1, -1);
482 i = gfc_expr_is_one (e2, -1);
490 i = gfc_dep_compare_expr (e1, e2);
496 /* The strides match. */
498 /* Check the range start. */
503 /* Use the bound of the array if no bound is specified. */
505 e1 = ar1->as->lower[n];
508 e2 = ar2->as->lower[n];
510 /* Check we have values for both. */
514 i = gfc_dep_compare_expr (e1, e2);
521 /* Check the range end. */
526 /* Use the bound of the array if no bound is specified. */
528 e1 = ar1->as->upper[n];
531 e2 = ar2->as->upper[n];
533 /* Check we have values for both. */
537 i = gfc_dep_compare_expr (e1, e2);
548 /* Some array-returning intrinsics can be implemented by reusing the
549 data from one of the array arguments. For example, TRANSPOSE does
550 not necessarily need to allocate new data: it can be implemented
551 by copying the original array's descriptor and simply swapping the
552 two dimension specifications.
554 If EXPR is a call to such an intrinsic, return the argument
555 whose data can be reused, otherwise return NULL. */
558 gfc_get_noncopying_intrinsic_argument (gfc_expr *expr)
560 if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
563 switch (expr->value.function.isym->id)
565 case GFC_ISYM_TRANSPOSE:
566 return expr->value.function.actual->expr;
574 /* Return true if the result of reference REF can only be constructed
575 using a temporary array. */
578 gfc_ref_needs_temporary_p (gfc_ref *ref)
584 for (; ref; ref = ref->next)
588 /* Vector dimensions are generally not monotonic and must be
589 handled using a temporary. */
590 if (ref->u.ar.type == AR_SECTION)
591 for (n = 0; n < ref->u.ar.dimen; n++)
592 if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
599 /* Within an array reference, character substrings generally
600 need a temporary. Character array strides are expressed as
601 multiples of the element size (consistent with other array
602 types), not in characters. */
614 gfc_is_data_pointer (gfc_expr *e)
618 if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_FUNCTION)
621 /* No subreference if it is a function */
622 gcc_assert (e->expr_type == EXPR_VARIABLE || !e->ref);
624 if (e->symtree->n.sym->attr.pointer)
627 for (ref = e->ref; ref; ref = ref->next)
628 if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
635 /* Return true if array variable VAR could be passed to the same function
636 as argument EXPR without interfering with EXPR. INTENT is the intent
639 This is considerably less conservative than other dependencies
640 because many function arguments will already be copied into a
644 gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
645 gfc_expr *expr, gfc_dep_check elemental)
649 gcc_assert (var->expr_type == EXPR_VARIABLE);
650 gcc_assert (var->rank > 0);
652 switch (expr->expr_type)
655 /* In case of elemental subroutines, there is no dependency
656 between two same-range array references. */
657 if (gfc_ref_needs_temporary_p (expr->ref)
658 || gfc_check_dependency (var, expr, elemental == NOT_ELEMENTAL))
660 if (elemental == ELEM_DONT_CHECK_VARIABLE)
662 /* Too many false positive with pointers. */
663 if (!gfc_is_data_pointer (var) && !gfc_is_data_pointer (expr))
665 /* Elemental procedures forbid unspecified intents,
666 and we don't check dependencies for INTENT_IN args. */
667 gcc_assert (intent == INTENT_OUT || intent == INTENT_INOUT);
669 /* We are told not to check dependencies.
670 We do it, however, and issue a warning in case we find one.
671 If a dependency is found in the case
672 elemental == ELEM_CHECK_VARIABLE, we will generate
673 a temporary, so we don't need to bother the user. */
674 gfc_warning ("INTENT(%s) actual argument at %L might "
675 "interfere with actual argument at %L.",
676 intent == INTENT_OUT ? "OUT" : "INOUT",
677 &var->where, &expr->where);
687 return gfc_check_dependency (var, expr, 1);
690 if (intent != INTENT_IN)
692 arg = gfc_get_noncopying_intrinsic_argument (expr);
694 return gfc_check_argument_var_dependency (var, intent, arg,
698 if (elemental != NOT_ELEMENTAL)
700 if ((expr->value.function.esym
701 && expr->value.function.esym->attr.elemental)
702 || (expr->value.function.isym
703 && expr->value.function.isym->elemental))
704 return gfc_check_fncall_dependency (var, intent, NULL,
705 expr->value.function.actual,
706 ELEM_CHECK_VARIABLE);
711 /* In case of non-elemental procedures, there is no need to catch
712 dependencies, as we will make a temporary anyway. */
715 /* If the actual arg EXPR is an expression, we need to catch
716 a dependency between variables in EXPR and VAR,
717 an intent((IN)OUT) variable. */
718 if (expr->value.op.op1
719 && gfc_check_argument_var_dependency (var, intent,
721 ELEM_CHECK_VARIABLE))
723 else if (expr->value.op.op2
724 && gfc_check_argument_var_dependency (var, intent,
726 ELEM_CHECK_VARIABLE))
737 /* Like gfc_check_argument_var_dependency, but extended to any
738 array expression OTHER, not just variables. */
741 gfc_check_argument_dependency (gfc_expr *other, sym_intent intent,
742 gfc_expr *expr, gfc_dep_check elemental)
744 switch (other->expr_type)
747 return gfc_check_argument_var_dependency (other, intent, expr, elemental);
750 other = gfc_get_noncopying_intrinsic_argument (other);
752 return gfc_check_argument_dependency (other, INTENT_IN, expr,
763 /* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
764 FNSYM is the function being called, or NULL if not known. */
767 gfc_check_fncall_dependency (gfc_expr *other, sym_intent intent,
768 gfc_symbol *fnsym, gfc_actual_arglist *actual,
769 gfc_dep_check elemental)
771 gfc_formal_arglist *formal;
774 formal = fnsym ? fnsym->formal : NULL;
775 for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
779 /* Skip args which are not present. */
783 /* Skip other itself. */
787 /* Skip intent(in) arguments if OTHER itself is intent(in). */
788 if (formal && intent == INTENT_IN
789 && formal->sym->attr.intent == INTENT_IN)
792 if (gfc_check_argument_dependency (other, intent, expr, elemental))
800 /* Return 1 if e1 and e2 are equivalenced arrays, either
801 directly or indirectly; i.e., equivalence (a,b) for a and b
802 or equivalence (a,c),(b,c). This function uses the equiv_
803 lists, generated in trans-common(add_equivalences), that are
804 guaranteed to pick up indirect equivalences. We explicitly
805 check for overlap using the offset and length of the equivalence.
806 This function is symmetric.
807 TODO: This function only checks whether the full top-level
808 symbols overlap. An improved implementation could inspect
809 e1->ref and e2->ref to determine whether the actually accessed
810 portions of these variables/arrays potentially overlap. */
813 gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
816 gfc_equiv_info *s, *fl1, *fl2;
818 gcc_assert (e1->expr_type == EXPR_VARIABLE
819 && e2->expr_type == EXPR_VARIABLE);
821 if (!e1->symtree->n.sym->attr.in_equivalence
822 || !e2->symtree->n.sym->attr.in_equivalence|| !e1->rank || !e2->rank)
825 if (e1->symtree->n.sym->ns
826 && e1->symtree->n.sym->ns != gfc_current_ns)
827 l = e1->symtree->n.sym->ns->equiv_lists;
829 l = gfc_current_ns->equiv_lists;
831 /* Go through the equiv_lists and return 1 if the variables
832 e1 and e2 are members of the same group and satisfy the
833 requirement on their relative offsets. */
834 for (; l; l = l->next)
838 for (s = l->equiv; s; s = s->next)
840 if (s->sym == e1->symtree->n.sym)
846 if (s->sym == e2->symtree->n.sym)
856 /* Can these lengths be zero? */
857 if (fl1->length <= 0 || fl2->length <= 0)
859 /* These can't overlap if [f11,fl1+length] is before
860 [fl2,fl2+length], or [fl2,fl2+length] is before
861 [fl1,fl1+length], otherwise they do overlap. */
862 if (fl1->offset + fl1->length > fl2->offset
863 && fl2->offset + fl2->length > fl1->offset)
871 /* Return true if there is no possibility of aliasing because of a type
872 mismatch between all the possible pointer references and the
873 potential target. Note that this function is asymmetric in the
874 arguments and so must be called twice with the arguments exchanged. */
877 check_data_pointer_types (gfc_expr *expr1, gfc_expr *expr2)
883 bool seen_component_ref;
885 if (expr1->expr_type != EXPR_VARIABLE
886 || expr1->expr_type != EXPR_VARIABLE)
889 sym1 = expr1->symtree->n.sym;
890 sym2 = expr2->symtree->n.sym;
892 /* Keep it simple for now. */
893 if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
896 if (sym1->attr.pointer)
898 if (gfc_compare_types (&sym1->ts, &sym2->ts))
902 /* This is a conservative check on the components of the derived type
903 if no component references have been seen. Since we will not dig
904 into the components of derived type components, we play it safe by
905 returning false. First we check the reference chain and then, if
906 no component references have been seen, the components. */
907 seen_component_ref = false;
908 if (sym1->ts.type == BT_DERIVED)
910 for (ref1 = expr1->ref; ref1; ref1 = ref1->next)
912 if (ref1->type != REF_COMPONENT)
915 if (ref1->u.c.component->ts.type == BT_DERIVED)
918 if ((sym2->attr.pointer || ref1->u.c.component->attr.pointer)
919 && gfc_compare_types (&ref1->u.c.component->ts, &sym2->ts))
922 seen_component_ref = true;
926 if (sym1->ts.type == BT_DERIVED && !seen_component_ref)
928 for (cm1 = sym1->ts.u.derived->components; cm1; cm1 = cm1->next)
930 if (cm1->ts.type == BT_DERIVED)
933 if ((sym2->attr.pointer || cm1->attr.pointer)
934 && gfc_compare_types (&cm1->ts, &sym2->ts))
943 /* Return true if the statement body redefines the condition. Returns
944 true if expr2 depends on expr1. expr1 should be a single term
945 suitable for the lhs of an assignment. The IDENTICAL flag indicates
946 whether array references to the same symbol with identical range
947 references count as a dependency or not. Used for forall and where
948 statements. Also used with functions returning arrays without a
952 gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
954 gfc_actual_arglist *actual;
958 gcc_assert (expr1->expr_type == EXPR_VARIABLE);
960 switch (expr2->expr_type)
963 n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
966 if (expr2->value.op.op2)
967 return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
971 /* The interesting cases are when the symbols don't match. */
972 if (expr1->symtree->n.sym != expr2->symtree->n.sym)
974 gfc_typespec *ts1 = &expr1->symtree->n.sym->ts;
975 gfc_typespec *ts2 = &expr2->symtree->n.sym->ts;
977 /* Return 1 if expr1 and expr2 are equivalenced arrays. */
978 if (gfc_are_equivalenced_arrays (expr1, expr2))
981 /* Symbols can only alias if they have the same type. */
982 if (ts1->type != BT_UNKNOWN && ts2->type != BT_UNKNOWN
983 && ts1->type != BT_DERIVED && ts2->type != BT_DERIVED)
985 if (ts1->type != ts2->type || ts1->kind != ts2->kind)
989 /* If either variable is a pointer, assume the worst. */
990 /* TODO: -fassume-no-pointer-aliasing */
991 if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2))
993 if (check_data_pointer_types (expr1, expr2)
994 && check_data_pointer_types (expr2, expr1))
1001 gfc_symbol *sym1 = expr1->symtree->n.sym;
1002 gfc_symbol *sym2 = expr2->symtree->n.sym;
1003 if (sym1->attr.target && sym2->attr.target
1004 && ((sym1->attr.dummy && !sym1->attr.contiguous
1005 && (!sym1->attr.dimension
1006 || sym2->as->type == AS_ASSUMED_SHAPE))
1007 || (sym2->attr.dummy && !sym2->attr.contiguous
1008 && (!sym2->attr.dimension
1009 || sym2->as->type == AS_ASSUMED_SHAPE))))
1013 /* Otherwise distinct symbols have no dependencies. */
1020 /* Identical and disjoint ranges return 0,
1021 overlapping ranges return 1. */
1022 if (expr1->ref && expr2->ref)
1023 return gfc_dep_resolver (expr1->ref, expr2->ref, NULL);
1028 if (gfc_get_noncopying_intrinsic_argument (expr2) != NULL)
1031 /* Remember possible differences between elemental and
1032 transformational functions. All functions inside a FORALL
1034 for (actual = expr2->value.function.actual;
1035 actual; actual = actual->next)
1039 n = gfc_check_dependency (expr1, actual->expr, identical);
1050 /* Loop through the array constructor's elements. */
1051 for (c = gfc_constructor_first (expr2->value.constructor);
1052 c; c = gfc_constructor_next (c))
1054 /* If this is an iterator, assume the worst. */
1057 /* Avoid recursion in the common case. */
1058 if (c->expr->expr_type == EXPR_CONSTANT)
1060 if (gfc_check_dependency (expr1, c->expr, 1))
1071 /* Determines overlapping for two array sections. */
1073 static gfc_dependency
1074 check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
1090 int stride_comparison;
1091 int start_comparison;
1093 /* If they are the same range, return without more ado. */
1094 if (gfc_is_same_range (l_ar, r_ar, n, 0))
1095 return GFC_DEP_EQUAL;
1097 l_start = l_ar->start[n];
1098 l_end = l_ar->end[n];
1099 l_stride = l_ar->stride[n];
1101 r_start = r_ar->start[n];
1102 r_end = r_ar->end[n];
1103 r_stride = r_ar->stride[n];
1105 /* If l_start is NULL take it from array specifier. */
1106 if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar->as))
1107 l_start = l_ar->as->lower[n];
1108 /* If l_end is NULL take it from array specifier. */
1109 if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar->as))
1110 l_end = l_ar->as->upper[n];
1112 /* If r_start is NULL take it from array specifier. */
1113 if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar->as))
1114 r_start = r_ar->as->lower[n];
1115 /* If r_end is NULL take it from array specifier. */
1116 if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar->as))
1117 r_end = r_ar->as->upper[n];
1119 /* Determine whether the l_stride is positive or negative. */
1122 else if (l_stride->expr_type == EXPR_CONSTANT
1123 && l_stride->ts.type == BT_INTEGER)
1124 l_dir = mpz_sgn (l_stride->value.integer);
1125 else if (l_start && l_end)
1126 l_dir = gfc_dep_compare_expr (l_end, l_start);
1130 /* Determine whether the r_stride is positive or negative. */
1133 else if (r_stride->expr_type == EXPR_CONSTANT
1134 && r_stride->ts.type == BT_INTEGER)
1135 r_dir = mpz_sgn (r_stride->value.integer);
1136 else if (r_start && r_end)
1137 r_dir = gfc_dep_compare_expr (r_end, r_start);
1141 /* The strides should never be zero. */
1142 if (l_dir == 0 || r_dir == 0)
1143 return GFC_DEP_OVERLAP;
1145 /* Determine the relationship between the strides. Set stride_comparison to
1146 -2 if the dependency cannot be determined
1147 -1 if l_stride < r_stride
1148 0 if l_stride == r_stride
1149 1 if l_stride > r_stride
1150 as determined by gfc_dep_compare_expr. */
1152 one_expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
1154 stride_comparison = gfc_dep_compare_expr (l_stride ? l_stride : one_expr,
1155 r_stride ? r_stride : one_expr);
1157 if (l_start && r_start)
1158 start_comparison = gfc_dep_compare_expr (l_start, r_start);
1160 start_comparison = -2;
1164 /* Determine LHS upper and lower bounds. */
1170 else if (l_dir == -1)
1181 /* Determine RHS upper and lower bounds. */
1187 else if (r_dir == -1)
1198 /* Check whether the ranges are disjoint. */
1199 if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
1200 return GFC_DEP_NODEP;
1201 if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
1202 return GFC_DEP_NODEP;
1204 /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL. */
1205 if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
1207 if (l_dir == 1 && r_dir == -1)
1208 return GFC_DEP_EQUAL;
1209 if (l_dir == -1 && r_dir == 1)
1210 return GFC_DEP_EQUAL;
1213 /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL. */
1214 if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 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:2 vs. x+1:z:4 as GFC_DEP_NODEP.
1223 There is no dependency if the remainder of
1224 (l_start - r_start) / gcd(l_stride, r_stride) is
1227 - Handle cases where x is an expression.
1228 - Cases like a(1:4:2) = a(2:3) are still not handled.
1231 #define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
1232 && (a)->ts.type == BT_INTEGER)
1234 if (IS_CONSTANT_INTEGER(l_start) && IS_CONSTANT_INTEGER(r_start)
1235 && IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride))
1243 mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer);
1244 mpz_sub (tmp, l_start->value.integer, r_start->value.integer);
1246 mpz_fdiv_r (tmp, tmp, gcd);
1247 result = mpz_cmp_si (tmp, 0L);
1253 return GFC_DEP_NODEP;
1256 #undef IS_CONSTANT_INTEGER
1258 /* Check for forward dependencies x:y vs. x+1:z and x:y:z vs. x:y:z+1. */
1260 if (l_dir == 1 && r_dir == 1 &&
1261 (start_comparison == 0 || start_comparison == -1)
1262 && (stride_comparison == 0 || stride_comparison == -1))
1263 return GFC_DEP_FORWARD;
1265 /* Check for forward dependencies x:y:-1 vs. x-1:z:-1 and
1266 x:y:-1 vs. x:y:-2. */
1267 if (l_dir == -1 && r_dir == -1 &&
1268 (start_comparison == 0 || start_comparison == 1)
1269 && (stride_comparison == 0 || stride_comparison == 1))
1270 return GFC_DEP_FORWARD;
1272 if (stride_comparison == 0 || stride_comparison == -1)
1274 if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
1277 /* Check for a(low:y:s) vs. a(z:x:s) or
1278 a(low:y:s) vs. a(z:x:s+1) where a has a lower bound
1279 of low, which is always at least a forward dependence. */
1282 && gfc_dep_compare_expr (l_start, l_ar->as->lower[n]) == 0)
1283 return GFC_DEP_FORWARD;
1287 if (stride_comparison == 0 || stride_comparison == 1)
1289 if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
1292 /* Check for a(high:y:-s) vs. a(z:x:-s) or
1293 a(high:y:-s vs. a(z:x:-s-1) where a has a higher bound
1294 of high, which is always at least a forward dependence. */
1297 && gfc_dep_compare_expr (l_start, l_ar->as->upper[n]) == 0)
1298 return GFC_DEP_FORWARD;
1303 if (stride_comparison == 0)
1305 /* From here, check for backwards dependencies. */
1306 /* x+1:y vs. x:z. */
1307 if (l_dir == 1 && r_dir == 1 && start_comparison == 1)
1308 return GFC_DEP_BACKWARD;
1310 /* x-1:y:-1 vs. x:z:-1. */
1311 if (l_dir == -1 && r_dir == -1 && start_comparison == -1)
1312 return GFC_DEP_BACKWARD;
1315 return GFC_DEP_OVERLAP;
1319 /* Determines overlapping for a single element and a section. */
1321 static gfc_dependency
1322 gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
1331 elem = lref->u.ar.start[n];
1333 return GFC_DEP_OVERLAP;
1336 start = ref->start[n] ;
1338 stride = ref->stride[n];
1340 if (!start && IS_ARRAY_EXPLICIT (ref->as))
1341 start = ref->as->lower[n];
1342 if (!end && IS_ARRAY_EXPLICIT (ref->as))
1343 end = ref->as->upper[n];
1345 /* Determine whether the stride is positive or negative. */
1348 else if (stride->expr_type == EXPR_CONSTANT
1349 && stride->ts.type == BT_INTEGER)
1350 s = mpz_sgn (stride->value.integer);
1354 /* Stride should never be zero. */
1356 return GFC_DEP_OVERLAP;
1358 /* Positive strides. */
1361 /* Check for elem < lower. */
1362 if (start && gfc_dep_compare_expr (elem, start) == -1)
1363 return GFC_DEP_NODEP;
1364 /* Check for elem > upper. */
1365 if (end && gfc_dep_compare_expr (elem, end) == 1)
1366 return GFC_DEP_NODEP;
1370 s = gfc_dep_compare_expr (start, end);
1371 /* Check for an empty range. */
1373 return GFC_DEP_NODEP;
1374 if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
1375 return GFC_DEP_EQUAL;
1378 /* Negative strides. */
1381 /* Check for elem > upper. */
1382 if (end && gfc_dep_compare_expr (elem, start) == 1)
1383 return GFC_DEP_NODEP;
1384 /* Check for elem < lower. */
1385 if (start && gfc_dep_compare_expr (elem, end) == -1)
1386 return GFC_DEP_NODEP;
1390 s = gfc_dep_compare_expr (start, end);
1391 /* Check for an empty range. */
1393 return GFC_DEP_NODEP;
1394 if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
1395 return GFC_DEP_EQUAL;
1398 /* Unknown strides. */
1402 return GFC_DEP_OVERLAP;
1403 s = gfc_dep_compare_expr (start, end);
1405 return GFC_DEP_OVERLAP;
1406 /* Assume positive stride. */
1409 /* Check for elem < lower. */
1410 if (gfc_dep_compare_expr (elem, start) == -1)
1411 return GFC_DEP_NODEP;
1412 /* Check for elem > upper. */
1413 if (gfc_dep_compare_expr (elem, end) == 1)
1414 return GFC_DEP_NODEP;
1416 /* Assume negative stride. */
1419 /* Check for elem > upper. */
1420 if (gfc_dep_compare_expr (elem, start) == 1)
1421 return GFC_DEP_NODEP;
1422 /* Check for elem < lower. */
1423 if (gfc_dep_compare_expr (elem, end) == -1)
1424 return GFC_DEP_NODEP;
1429 s = gfc_dep_compare_expr (elem, start);
1431 return GFC_DEP_EQUAL;
1432 if (s == 1 || s == -1)
1433 return GFC_DEP_NODEP;
1437 return GFC_DEP_OVERLAP;
1441 /* Traverse expr, checking all EXPR_VARIABLE symbols for their
1442 forall_index attribute. Return true if any variable may be
1443 being used as a FORALL index. Its safe to pessimistically
1444 return true, and assume a dependency. */
1447 contains_forall_index_p (gfc_expr *expr)
1449 gfc_actual_arglist *arg;
1457 switch (expr->expr_type)
1460 if (expr->symtree->n.sym->forall_index)
1465 if (contains_forall_index_p (expr->value.op.op1)
1466 || contains_forall_index_p (expr->value.op.op2))
1471 for (arg = expr->value.function.actual; arg; arg = arg->next)
1472 if (contains_forall_index_p (arg->expr))
1478 case EXPR_SUBSTRING:
1481 case EXPR_STRUCTURE:
1483 for (c = gfc_constructor_first (expr->value.constructor);
1484 c; gfc_constructor_next (c))
1485 if (contains_forall_index_p (c->expr))
1493 for (ref = expr->ref; ref; ref = ref->next)
1497 for (i = 0; i < ref->u.ar.dimen; i++)
1498 if (contains_forall_index_p (ref->u.ar.start[i])
1499 || contains_forall_index_p (ref->u.ar.end[i])
1500 || contains_forall_index_p (ref->u.ar.stride[i]))
1508 if (contains_forall_index_p (ref->u.ss.start)
1509 || contains_forall_index_p (ref->u.ss.end))
1520 /* Determines overlapping for two single element array references. */
1522 static gfc_dependency
1523 gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
1533 l_start = l_ar.start[n] ;
1534 r_start = r_ar.start[n] ;
1535 i = gfc_dep_compare_expr (r_start, l_start);
1537 return GFC_DEP_EQUAL;
1539 /* Treat two scalar variables as potentially equal. This allows
1540 us to prove that a(i,:) and a(j,:) have no dependency. See
1541 Gerald Roth, "Evaluation of Array Syntax Dependence Analysis",
1542 Proceedings of the International Conference on Parallel and
1543 Distributed Processing Techniques and Applications (PDPTA2001),
1544 Las Vegas, Nevada, June 2001. */
1545 /* However, we need to be careful when either scalar expression
1546 contains a FORALL index, as these can potentially change value
1547 during the scalarization/traversal of this array reference. */
1548 if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
1549 return GFC_DEP_OVERLAP;
1552 return GFC_DEP_NODEP;
1553 return GFC_DEP_EQUAL;
1557 /* Determine if an array ref, usually an array section specifies the
1558 entire array. In addition, if the second, pointer argument is
1559 provided, the function will return true if the reference is
1560 contiguous; eg. (:, 1) gives true but (1,:) gives false. */
1563 gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
1567 bool lbound_OK = true;
1568 bool ubound_OK = true;
1571 *contiguous = false;
1573 if (ref->type != REF_ARRAY)
1576 if (ref->u.ar.type == AR_FULL)
1583 if (ref->u.ar.type != AR_SECTION)
1588 for (i = 0; i < ref->u.ar.dimen; i++)
1590 /* If we have a single element in the reference, for the reference
1591 to be full, we need to ascertain that the array has a single
1592 element in this dimension and that we actually reference the
1594 if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
1596 /* This is unconditionally a contiguous reference if all the
1597 remaining dimensions are elements. */
1601 for (n = i + 1; n < ref->u.ar.dimen; n++)
1602 if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
1603 *contiguous = false;
1607 || !ref->u.ar.as->lower[i]
1608 || !ref->u.ar.as->upper[i]
1609 || gfc_dep_compare_expr (ref->u.ar.as->lower[i],
1610 ref->u.ar.as->upper[i])
1611 || !ref->u.ar.start[i]
1612 || gfc_dep_compare_expr (ref->u.ar.start[i],
1613 ref->u.ar.as->lower[i]))
1619 /* Check the lower bound. */
1620 if (ref->u.ar.start[i]
1622 || !ref->u.ar.as->lower[i]
1623 || gfc_dep_compare_expr (ref->u.ar.start[i],
1624 ref->u.ar.as->lower[i])))
1626 /* Check the upper bound. */
1627 if (ref->u.ar.end[i]
1629 || !ref->u.ar.as->upper[i]
1630 || gfc_dep_compare_expr (ref->u.ar.end[i],
1631 ref->u.ar.as->upper[i])))
1633 /* Check the stride. */
1634 if (ref->u.ar.stride[i]
1635 && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
1638 /* This is unconditionally a contiguous reference as long as all
1639 the subsequent dimensions are elements. */
1643 for (n = i + 1; n < ref->u.ar.dimen; n++)
1644 if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
1645 *contiguous = false;
1648 if (!lbound_OK || !ubound_OK)
1655 /* Determine if a full array is the same as an array section with one
1656 variable limit. For this to be so, the strides must both be unity
1657 and one of either start == lower or end == upper must be true. */
1660 ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
1663 bool upper_or_lower;
1665 if (full_ref->type != REF_ARRAY)
1667 if (full_ref->u.ar.type != AR_FULL)
1669 if (ref->type != REF_ARRAY)
1671 if (ref->u.ar.type != AR_SECTION)
1674 for (i = 0; i < ref->u.ar.dimen; i++)
1676 /* If we have a single element in the reference, we need to check
1677 that the array has a single element and that we actually reference
1678 the correct element. */
1679 if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
1681 if (!full_ref->u.ar.as
1682 || !full_ref->u.ar.as->lower[i]
1683 || !full_ref->u.ar.as->upper[i]
1684 || gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
1685 full_ref->u.ar.as->upper[i])
1686 || !ref->u.ar.start[i]
1687 || gfc_dep_compare_expr (ref->u.ar.start[i],
1688 full_ref->u.ar.as->lower[i]))
1692 /* Check the strides. */
1693 if (full_ref->u.ar.stride[i] && !gfc_expr_is_one (full_ref->u.ar.stride[i], 0))
1695 if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
1698 upper_or_lower = false;
1699 /* Check the lower bound. */
1700 if (ref->u.ar.start[i]
1702 && full_ref->u.ar.as->lower[i]
1703 && gfc_dep_compare_expr (ref->u.ar.start[i],
1704 full_ref->u.ar.as->lower[i]) == 0))
1705 upper_or_lower = true;
1706 /* Check the upper bound. */
1707 if (ref->u.ar.end[i]
1709 && full_ref->u.ar.as->upper[i]
1710 && gfc_dep_compare_expr (ref->u.ar.end[i],
1711 full_ref->u.ar.as->upper[i]) == 0))
1712 upper_or_lower = true;
1713 if (!upper_or_lower)
1720 /* Finds if two array references are overlapping or not.
1722 2 : array references are overlapping but reversal of one or
1723 more dimensions will clear the dependency.
1724 1 : array references are overlapping.
1725 0 : array references are identical or not overlapping. */
1728 gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
1731 gfc_dependency fin_dep;
1732 gfc_dependency this_dep;
1734 this_dep = GFC_DEP_ERROR;
1735 fin_dep = GFC_DEP_ERROR;
1736 /* Dependencies due to pointers should already have been identified.
1737 We only need to check for overlapping array references. */
1739 while (lref && rref)
1741 /* We're resolving from the same base symbol, so both refs should be
1742 the same type. We traverse the reference chain until we find ranges
1743 that are not equal. */
1744 gcc_assert (lref->type == rref->type);
1748 /* The two ranges can't overlap if they are from different
1750 if (lref->u.c.component != rref->u.c.component)
1755 /* Substring overlaps are handled by the string assignment code
1756 if there is not an underlying dependency. */
1757 return (fin_dep == GFC_DEP_OVERLAP) ? 1 : 0;
1761 if (ref_same_as_full_array (lref, rref))
1764 if (ref_same_as_full_array (rref, lref))
1767 if (lref->u.ar.dimen != rref->u.ar.dimen)
1769 if (lref->u.ar.type == AR_FULL)
1770 fin_dep = gfc_full_array_ref_p (rref, NULL) ? GFC_DEP_EQUAL
1772 else if (rref->u.ar.type == AR_FULL)
1773 fin_dep = gfc_full_array_ref_p (lref, NULL) ? GFC_DEP_EQUAL
1780 for (n=0; n < lref->u.ar.dimen; n++)
1782 /* Assume dependency when either of array reference is vector
1784 if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
1785 || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
1788 if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
1789 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
1790 this_dep = check_section_vs_section (&lref->u.ar, &rref->u.ar, n);
1791 else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
1792 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
1793 this_dep = gfc_check_element_vs_section (lref, rref, n);
1794 else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
1795 && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
1796 this_dep = gfc_check_element_vs_section (rref, lref, n);
1799 gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
1800 && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
1801 this_dep = gfc_check_element_vs_element (rref, lref, n);
1804 /* If any dimension doesn't overlap, we have no dependency. */
1805 if (this_dep == GFC_DEP_NODEP)
1808 /* Now deal with the loop reversal logic: This only works on
1809 ranges and is activated by setting
1810 reverse[n] == GFC_ENABLE_REVERSE
1811 The ability to reverse or not is set by previous conditions
1812 in this dimension. If reversal is not activated, the
1813 value GFC_DEP_BACKWARD is reset to GFC_DEP_OVERLAP. */
1814 if (rref->u.ar.dimen_type[n] == DIMEN_RANGE
1815 && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
1817 /* Set reverse if backward dependence and not inhibited. */
1818 if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
1819 reverse[n] = (this_dep == GFC_DEP_BACKWARD) ?
1820 GFC_REVERSE_SET : reverse[n];
1822 /* Set forward if forward dependence and not inhibited. */
1823 if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
1824 reverse[n] = (this_dep == GFC_DEP_FORWARD) ?
1825 GFC_FORWARD_SET : reverse[n];
1827 /* Flag up overlap if dependence not compatible with
1828 the overall state of the expression. */
1829 if (reverse && reverse[n] == GFC_REVERSE_SET
1830 && this_dep == GFC_DEP_FORWARD)
1832 reverse[n] = GFC_INHIBIT_REVERSE;
1833 this_dep = GFC_DEP_OVERLAP;
1835 else if (reverse && reverse[n] == GFC_FORWARD_SET
1836 && this_dep == GFC_DEP_BACKWARD)
1838 reverse[n] = GFC_INHIBIT_REVERSE;
1839 this_dep = GFC_DEP_OVERLAP;
1842 /* If no intention of reversing or reversing is explicitly
1843 inhibited, convert backward dependence to overlap. */
1844 if ((reverse == NULL && this_dep == GFC_DEP_BACKWARD)
1845 || (reverse != NULL && reverse[n] == GFC_INHIBIT_REVERSE))
1846 this_dep = GFC_DEP_OVERLAP;
1849 /* Overlap codes are in order of priority. We only need to
1850 know the worst one.*/
1851 if (this_dep > fin_dep)
1855 /* If this is an equal element, we have to keep going until we find
1856 the "real" array reference. */
1857 if (lref->u.ar.type == AR_ELEMENT
1858 && rref->u.ar.type == AR_ELEMENT
1859 && fin_dep == GFC_DEP_EQUAL)
1862 /* Exactly matching and forward overlapping ranges don't cause a
1864 if (fin_dep < GFC_DEP_BACKWARD)
1867 /* Keep checking. We only have a dependency if
1868 subsequent references also overlap. */
1878 /* If we haven't seen any array refs then something went wrong. */
1879 gcc_assert (fin_dep != GFC_DEP_ERROR);
1881 /* Assume the worst if we nest to different depths. */
1885 return fin_dep == GFC_DEP_OVERLAP;