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);
717 if (gfc_inline_intrinsic_function_p (expr))
719 /* The TRANSPOSE case should have been caught in the
720 noncopying intrinsic case above. */
721 gcc_assert (expr->value.function.isym->id != GFC_ISYM_TRANSPOSE);
723 return gfc_check_fncall_dependency (var, intent, NULL,
724 expr->value.function.actual,
725 ELEM_CHECK_VARIABLE);
731 /* In case of non-elemental procedures, there is no need to catch
732 dependencies, as we will make a temporary anyway. */
735 /* If the actual arg EXPR is an expression, we need to catch
736 a dependency between variables in EXPR and VAR,
737 an intent((IN)OUT) variable. */
738 if (expr->value.op.op1
739 && gfc_check_argument_var_dependency (var, intent,
741 ELEM_CHECK_VARIABLE))
743 else if (expr->value.op.op2
744 && gfc_check_argument_var_dependency (var, intent,
746 ELEM_CHECK_VARIABLE))
757 /* Like gfc_check_argument_var_dependency, but extended to any
758 array expression OTHER, not just variables. */
761 gfc_check_argument_dependency (gfc_expr *other, sym_intent intent,
762 gfc_expr *expr, gfc_dep_check elemental)
764 switch (other->expr_type)
767 return gfc_check_argument_var_dependency (other, intent, expr, elemental);
770 other = gfc_get_noncopying_intrinsic_argument (other);
772 return gfc_check_argument_dependency (other, INTENT_IN, expr,
783 /* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
784 FNSYM is the function being called, or NULL if not known. */
787 gfc_check_fncall_dependency (gfc_expr *other, sym_intent intent,
788 gfc_symbol *fnsym, gfc_actual_arglist *actual,
789 gfc_dep_check elemental)
791 gfc_formal_arglist *formal;
794 formal = fnsym ? fnsym->formal : NULL;
795 for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
799 /* Skip args which are not present. */
803 /* Skip other itself. */
807 /* Skip intent(in) arguments if OTHER itself is intent(in). */
808 if (formal && intent == INTENT_IN
809 && formal->sym->attr.intent == INTENT_IN)
812 if (gfc_check_argument_dependency (other, intent, expr, elemental))
820 /* Return 1 if e1 and e2 are equivalenced arrays, either
821 directly or indirectly; i.e., equivalence (a,b) for a and b
822 or equivalence (a,c),(b,c). This function uses the equiv_
823 lists, generated in trans-common(add_equivalences), that are
824 guaranteed to pick up indirect equivalences. We explicitly
825 check for overlap using the offset and length of the equivalence.
826 This function is symmetric.
827 TODO: This function only checks whether the full top-level
828 symbols overlap. An improved implementation could inspect
829 e1->ref and e2->ref to determine whether the actually accessed
830 portions of these variables/arrays potentially overlap. */
833 gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
836 gfc_equiv_info *s, *fl1, *fl2;
838 gcc_assert (e1->expr_type == EXPR_VARIABLE
839 && e2->expr_type == EXPR_VARIABLE);
841 if (!e1->symtree->n.sym->attr.in_equivalence
842 || !e2->symtree->n.sym->attr.in_equivalence|| !e1->rank || !e2->rank)
845 if (e1->symtree->n.sym->ns
846 && e1->symtree->n.sym->ns != gfc_current_ns)
847 l = e1->symtree->n.sym->ns->equiv_lists;
849 l = gfc_current_ns->equiv_lists;
851 /* Go through the equiv_lists and return 1 if the variables
852 e1 and e2 are members of the same group and satisfy the
853 requirement on their relative offsets. */
854 for (; l; l = l->next)
858 for (s = l->equiv; s; s = s->next)
860 if (s->sym == e1->symtree->n.sym)
866 if (s->sym == e2->symtree->n.sym)
876 /* Can these lengths be zero? */
877 if (fl1->length <= 0 || fl2->length <= 0)
879 /* These can't overlap if [f11,fl1+length] is before
880 [fl2,fl2+length], or [fl2,fl2+length] is before
881 [fl1,fl1+length], otherwise they do overlap. */
882 if (fl1->offset + fl1->length > fl2->offset
883 && fl2->offset + fl2->length > fl1->offset)
891 /* Return true if there is no possibility of aliasing because of a type
892 mismatch between all the possible pointer references and the
893 potential target. Note that this function is asymmetric in the
894 arguments and so must be called twice with the arguments exchanged. */
897 check_data_pointer_types (gfc_expr *expr1, gfc_expr *expr2)
903 bool seen_component_ref;
905 if (expr1->expr_type != EXPR_VARIABLE
906 || expr1->expr_type != EXPR_VARIABLE)
909 sym1 = expr1->symtree->n.sym;
910 sym2 = expr2->symtree->n.sym;
912 /* Keep it simple for now. */
913 if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
916 if (sym1->attr.pointer)
918 if (gfc_compare_types (&sym1->ts, &sym2->ts))
922 /* This is a conservative check on the components of the derived type
923 if no component references have been seen. Since we will not dig
924 into the components of derived type components, we play it safe by
925 returning false. First we check the reference chain and then, if
926 no component references have been seen, the components. */
927 seen_component_ref = false;
928 if (sym1->ts.type == BT_DERIVED)
930 for (ref1 = expr1->ref; ref1; ref1 = ref1->next)
932 if (ref1->type != REF_COMPONENT)
935 if (ref1->u.c.component->ts.type == BT_DERIVED)
938 if ((sym2->attr.pointer || ref1->u.c.component->attr.pointer)
939 && gfc_compare_types (&ref1->u.c.component->ts, &sym2->ts))
942 seen_component_ref = true;
946 if (sym1->ts.type == BT_DERIVED && !seen_component_ref)
948 for (cm1 = sym1->ts.u.derived->components; cm1; cm1 = cm1->next)
950 if (cm1->ts.type == BT_DERIVED)
953 if ((sym2->attr.pointer || cm1->attr.pointer)
954 && gfc_compare_types (&cm1->ts, &sym2->ts))
963 /* Return true if the statement body redefines the condition. Returns
964 true if expr2 depends on expr1. expr1 should be a single term
965 suitable for the lhs of an assignment. The IDENTICAL flag indicates
966 whether array references to the same symbol with identical range
967 references count as a dependency or not. Used for forall and where
968 statements. Also used with functions returning arrays without a
972 gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
974 gfc_actual_arglist *actual;
978 gcc_assert (expr1->expr_type == EXPR_VARIABLE);
980 switch (expr2->expr_type)
983 n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
986 if (expr2->value.op.op2)
987 return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
991 /* The interesting cases are when the symbols don't match. */
992 if (expr1->symtree->n.sym != expr2->symtree->n.sym)
994 gfc_typespec *ts1 = &expr1->symtree->n.sym->ts;
995 gfc_typespec *ts2 = &expr2->symtree->n.sym->ts;
997 /* Return 1 if expr1 and expr2 are equivalenced arrays. */
998 if (gfc_are_equivalenced_arrays (expr1, expr2))
1001 /* Symbols can only alias if they have the same type. */
1002 if (ts1->type != BT_UNKNOWN && ts2->type != BT_UNKNOWN
1003 && ts1->type != BT_DERIVED && ts2->type != BT_DERIVED)
1005 if (ts1->type != ts2->type || ts1->kind != ts2->kind)
1009 /* If either variable is a pointer, assume the worst. */
1010 /* TODO: -fassume-no-pointer-aliasing */
1011 if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2))
1013 if (check_data_pointer_types (expr1, expr2)
1014 && check_data_pointer_types (expr2, expr1))
1021 gfc_symbol *sym1 = expr1->symtree->n.sym;
1022 gfc_symbol *sym2 = expr2->symtree->n.sym;
1023 if (sym1->attr.target && sym2->attr.target
1024 && ((sym1->attr.dummy && !sym1->attr.contiguous
1025 && (!sym1->attr.dimension
1026 || sym2->as->type == AS_ASSUMED_SHAPE))
1027 || (sym2->attr.dummy && !sym2->attr.contiguous
1028 && (!sym2->attr.dimension
1029 || sym2->as->type == AS_ASSUMED_SHAPE))))
1033 /* Otherwise distinct symbols have no dependencies. */
1040 /* Identical and disjoint ranges return 0,
1041 overlapping ranges return 1. */
1042 if (expr1->ref && expr2->ref)
1043 return gfc_dep_resolver (expr1->ref, expr2->ref, NULL);
1048 if (gfc_get_noncopying_intrinsic_argument (expr2) != NULL)
1051 /* Remember possible differences between elemental and
1052 transformational functions. All functions inside a FORALL
1054 for (actual = expr2->value.function.actual;
1055 actual; actual = actual->next)
1059 n = gfc_check_dependency (expr1, actual->expr, identical);
1070 /* Loop through the array constructor's elements. */
1071 for (c = gfc_constructor_first (expr2->value.constructor);
1072 c; c = gfc_constructor_next (c))
1074 /* If this is an iterator, assume the worst. */
1077 /* Avoid recursion in the common case. */
1078 if (c->expr->expr_type == EXPR_CONSTANT)
1080 if (gfc_check_dependency (expr1, c->expr, 1))
1091 /* Determines overlapping for two array sections. */
1093 static gfc_dependency
1094 check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
1110 int stride_comparison;
1111 int start_comparison;
1113 /* If they are the same range, return without more ado. */
1114 if (is_same_range (l_ar, r_ar, n))
1115 return GFC_DEP_EQUAL;
1117 l_start = l_ar->start[n];
1118 l_end = l_ar->end[n];
1119 l_stride = l_ar->stride[n];
1121 r_start = r_ar->start[n];
1122 r_end = r_ar->end[n];
1123 r_stride = r_ar->stride[n];
1125 /* If l_start is NULL take it from array specifier. */
1126 if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar->as))
1127 l_start = l_ar->as->lower[n];
1128 /* If l_end is NULL take it from array specifier. */
1129 if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar->as))
1130 l_end = l_ar->as->upper[n];
1132 /* If r_start is NULL take it from array specifier. */
1133 if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar->as))
1134 r_start = r_ar->as->lower[n];
1135 /* If r_end is NULL take it from array specifier. */
1136 if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar->as))
1137 r_end = r_ar->as->upper[n];
1139 /* Determine whether the l_stride is positive or negative. */
1142 else if (l_stride->expr_type == EXPR_CONSTANT
1143 && l_stride->ts.type == BT_INTEGER)
1144 l_dir = mpz_sgn (l_stride->value.integer);
1145 else if (l_start && l_end)
1146 l_dir = gfc_dep_compare_expr (l_end, l_start);
1150 /* Determine whether the r_stride is positive or negative. */
1153 else if (r_stride->expr_type == EXPR_CONSTANT
1154 && r_stride->ts.type == BT_INTEGER)
1155 r_dir = mpz_sgn (r_stride->value.integer);
1156 else if (r_start && r_end)
1157 r_dir = gfc_dep_compare_expr (r_end, r_start);
1161 /* The strides should never be zero. */
1162 if (l_dir == 0 || r_dir == 0)
1163 return GFC_DEP_OVERLAP;
1165 /* Determine the relationship between the strides. Set stride_comparison to
1166 -2 if the dependency cannot be determined
1167 -1 if l_stride < r_stride
1168 0 if l_stride == r_stride
1169 1 if l_stride > r_stride
1170 as determined by gfc_dep_compare_expr. */
1172 one_expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
1174 stride_comparison = gfc_dep_compare_expr (l_stride ? l_stride : one_expr,
1175 r_stride ? r_stride : one_expr);
1177 if (l_start && r_start)
1178 start_comparison = gfc_dep_compare_expr (l_start, r_start);
1180 start_comparison = -2;
1184 /* Determine LHS upper and lower bounds. */
1190 else if (l_dir == -1)
1201 /* Determine RHS upper and lower bounds. */
1207 else if (r_dir == -1)
1218 /* Check whether the ranges are disjoint. */
1219 if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
1220 return GFC_DEP_NODEP;
1221 if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
1222 return GFC_DEP_NODEP;
1224 /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL. */
1225 if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
1227 if (l_dir == 1 && r_dir == -1)
1228 return GFC_DEP_EQUAL;
1229 if (l_dir == -1 && r_dir == 1)
1230 return GFC_DEP_EQUAL;
1233 /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL. */
1234 if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
1236 if (l_dir == 1 && r_dir == -1)
1237 return GFC_DEP_EQUAL;
1238 if (l_dir == -1 && r_dir == 1)
1239 return GFC_DEP_EQUAL;
1242 /* Handle cases like x:y:2 vs. x+1:z:4 as GFC_DEP_NODEP.
1243 There is no dependency if the remainder of
1244 (l_start - r_start) / gcd(l_stride, r_stride) is
1247 - Handle cases where x is an expression.
1248 - Cases like a(1:4:2) = a(2:3) are still not handled.
1251 #define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
1252 && (a)->ts.type == BT_INTEGER)
1254 if (IS_CONSTANT_INTEGER(l_start) && IS_CONSTANT_INTEGER(r_start)
1255 && IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride))
1263 mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer);
1264 mpz_sub (tmp, l_start->value.integer, r_start->value.integer);
1266 mpz_fdiv_r (tmp, tmp, gcd);
1267 result = mpz_cmp_si (tmp, 0L);
1273 return GFC_DEP_NODEP;
1276 #undef IS_CONSTANT_INTEGER
1278 /* Check for forward dependencies x:y vs. x+1:z and x:y:z vs. x:y:z+1. */
1280 if (l_dir == 1 && r_dir == 1 &&
1281 (start_comparison == 0 || start_comparison == -1)
1282 && (stride_comparison == 0 || stride_comparison == -1))
1283 return GFC_DEP_FORWARD;
1285 /* Check for forward dependencies x:y:-1 vs. x-1:z:-1 and
1286 x:y:-1 vs. x:y:-2. */
1287 if (l_dir == -1 && r_dir == -1 &&
1288 (start_comparison == 0 || start_comparison == 1)
1289 && (stride_comparison == 0 || stride_comparison == 1))
1290 return GFC_DEP_FORWARD;
1292 if (stride_comparison == 0 || stride_comparison == -1)
1294 if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
1297 /* Check for a(low:y:s) vs. a(z:x:s) or
1298 a(low:y:s) vs. a(z:x:s+1) where a has a lower bound
1299 of low, which is always at least a forward dependence. */
1302 && gfc_dep_compare_expr (l_start, l_ar->as->lower[n]) == 0)
1303 return GFC_DEP_FORWARD;
1307 if (stride_comparison == 0 || stride_comparison == 1)
1309 if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
1312 /* Check for a(high:y:-s) vs. a(z:x:-s) or
1313 a(high:y:-s vs. a(z:x:-s-1) where a has a higher bound
1314 of high, which is always at least a forward dependence. */
1317 && gfc_dep_compare_expr (l_start, l_ar->as->upper[n]) == 0)
1318 return GFC_DEP_FORWARD;
1323 if (stride_comparison == 0)
1325 /* From here, check for backwards dependencies. */
1326 /* x+1:y vs. x:z. */
1327 if (l_dir == 1 && r_dir == 1 && start_comparison == 1)
1328 return GFC_DEP_BACKWARD;
1330 /* x-1:y:-1 vs. x:z:-1. */
1331 if (l_dir == -1 && r_dir == -1 && start_comparison == -1)
1332 return GFC_DEP_BACKWARD;
1335 return GFC_DEP_OVERLAP;
1339 /* Determines overlapping for a single element and a section. */
1341 static gfc_dependency
1342 gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
1351 elem = lref->u.ar.start[n];
1353 return GFC_DEP_OVERLAP;
1356 start = ref->start[n] ;
1358 stride = ref->stride[n];
1360 if (!start && IS_ARRAY_EXPLICIT (ref->as))
1361 start = ref->as->lower[n];
1362 if (!end && IS_ARRAY_EXPLICIT (ref->as))
1363 end = ref->as->upper[n];
1365 /* Determine whether the stride is positive or negative. */
1368 else if (stride->expr_type == EXPR_CONSTANT
1369 && stride->ts.type == BT_INTEGER)
1370 s = mpz_sgn (stride->value.integer);
1374 /* Stride should never be zero. */
1376 return GFC_DEP_OVERLAP;
1378 /* Positive strides. */
1381 /* Check for elem < lower. */
1382 if (start && gfc_dep_compare_expr (elem, start) == -1)
1383 return GFC_DEP_NODEP;
1384 /* Check for elem > upper. */
1385 if (end && 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 /* Negative strides. */
1401 /* Check for elem > upper. */
1402 if (end && gfc_dep_compare_expr (elem, start) == 1)
1403 return GFC_DEP_NODEP;
1404 /* Check for elem < lower. */
1405 if (start && gfc_dep_compare_expr (elem, end) == -1)
1406 return GFC_DEP_NODEP;
1410 s = gfc_dep_compare_expr (start, end);
1411 /* Check for an empty range. */
1413 return GFC_DEP_NODEP;
1414 if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
1415 return GFC_DEP_EQUAL;
1418 /* Unknown strides. */
1422 return GFC_DEP_OVERLAP;
1423 s = gfc_dep_compare_expr (start, end);
1425 return GFC_DEP_OVERLAP;
1426 /* Assume positive stride. */
1429 /* Check for elem < lower. */
1430 if (gfc_dep_compare_expr (elem, start) == -1)
1431 return GFC_DEP_NODEP;
1432 /* Check for elem > upper. */
1433 if (gfc_dep_compare_expr (elem, end) == 1)
1434 return GFC_DEP_NODEP;
1436 /* Assume negative stride. */
1439 /* Check for elem > upper. */
1440 if (gfc_dep_compare_expr (elem, start) == 1)
1441 return GFC_DEP_NODEP;
1442 /* Check for elem < lower. */
1443 if (gfc_dep_compare_expr (elem, end) == -1)
1444 return GFC_DEP_NODEP;
1449 s = gfc_dep_compare_expr (elem, start);
1451 return GFC_DEP_EQUAL;
1452 if (s == 1 || s == -1)
1453 return GFC_DEP_NODEP;
1457 return GFC_DEP_OVERLAP;
1461 /* Traverse expr, checking all EXPR_VARIABLE symbols for their
1462 forall_index attribute. Return true if any variable may be
1463 being used as a FORALL index. Its safe to pessimistically
1464 return true, and assume a dependency. */
1467 contains_forall_index_p (gfc_expr *expr)
1469 gfc_actual_arglist *arg;
1477 switch (expr->expr_type)
1480 if (expr->symtree->n.sym->forall_index)
1485 if (contains_forall_index_p (expr->value.op.op1)
1486 || contains_forall_index_p (expr->value.op.op2))
1491 for (arg = expr->value.function.actual; arg; arg = arg->next)
1492 if (contains_forall_index_p (arg->expr))
1498 case EXPR_SUBSTRING:
1501 case EXPR_STRUCTURE:
1503 for (c = gfc_constructor_first (expr->value.constructor);
1504 c; gfc_constructor_next (c))
1505 if (contains_forall_index_p (c->expr))
1513 for (ref = expr->ref; ref; ref = ref->next)
1517 for (i = 0; i < ref->u.ar.dimen; i++)
1518 if (contains_forall_index_p (ref->u.ar.start[i])
1519 || contains_forall_index_p (ref->u.ar.end[i])
1520 || contains_forall_index_p (ref->u.ar.stride[i]))
1528 if (contains_forall_index_p (ref->u.ss.start)
1529 || contains_forall_index_p (ref->u.ss.end))
1540 /* Determines overlapping for two single element array references. */
1542 static gfc_dependency
1543 gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
1553 l_start = l_ar.start[n] ;
1554 r_start = r_ar.start[n] ;
1555 i = gfc_dep_compare_expr (r_start, l_start);
1557 return GFC_DEP_EQUAL;
1559 /* Treat two scalar variables as potentially equal. This allows
1560 us to prove that a(i,:) and a(j,:) have no dependency. See
1561 Gerald Roth, "Evaluation of Array Syntax Dependence Analysis",
1562 Proceedings of the International Conference on Parallel and
1563 Distributed Processing Techniques and Applications (PDPTA2001),
1564 Las Vegas, Nevada, June 2001. */
1565 /* However, we need to be careful when either scalar expression
1566 contains a FORALL index, as these can potentially change value
1567 during the scalarization/traversal of this array reference. */
1568 if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
1569 return GFC_DEP_OVERLAP;
1572 return GFC_DEP_NODEP;
1573 return GFC_DEP_EQUAL;
1577 /* Determine if an array ref, usually an array section specifies the
1578 entire array. In addition, if the second, pointer argument is
1579 provided, the function will return true if the reference is
1580 contiguous; eg. (:, 1) gives true but (1,:) gives false. */
1583 gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
1587 bool lbound_OK = true;
1588 bool ubound_OK = true;
1591 *contiguous = false;
1593 if (ref->type != REF_ARRAY)
1596 if (ref->u.ar.type == AR_FULL)
1603 if (ref->u.ar.type != AR_SECTION)
1608 for (i = 0; i < ref->u.ar.dimen; i++)
1610 /* If we have a single element in the reference, for the reference
1611 to be full, we need to ascertain that the array has a single
1612 element in this dimension and that we actually reference the
1614 if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
1616 /* This is unconditionally a contiguous reference if all the
1617 remaining dimensions are elements. */
1621 for (n = i + 1; n < ref->u.ar.dimen; n++)
1622 if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
1623 *contiguous = false;
1627 || !ref->u.ar.as->lower[i]
1628 || !ref->u.ar.as->upper[i]
1629 || gfc_dep_compare_expr (ref->u.ar.as->lower[i],
1630 ref->u.ar.as->upper[i])
1631 || !ref->u.ar.start[i]
1632 || gfc_dep_compare_expr (ref->u.ar.start[i],
1633 ref->u.ar.as->lower[i]))
1639 /* Check the lower bound. */
1640 if (ref->u.ar.start[i]
1642 || !ref->u.ar.as->lower[i]
1643 || gfc_dep_compare_expr (ref->u.ar.start[i],
1644 ref->u.ar.as->lower[i])))
1646 /* Check the upper bound. */
1647 if (ref->u.ar.end[i]
1649 || !ref->u.ar.as->upper[i]
1650 || gfc_dep_compare_expr (ref->u.ar.end[i],
1651 ref->u.ar.as->upper[i])))
1653 /* Check the stride. */
1654 if (ref->u.ar.stride[i]
1655 && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
1658 /* This is unconditionally a contiguous reference as long as all
1659 the subsequent dimensions are elements. */
1663 for (n = i + 1; n < ref->u.ar.dimen; n++)
1664 if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
1665 *contiguous = false;
1668 if (!lbound_OK || !ubound_OK)
1675 /* Determine if a full array is the same as an array section with one
1676 variable limit. For this to be so, the strides must both be unity
1677 and one of either start == lower or end == upper must be true. */
1680 ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
1683 bool upper_or_lower;
1685 if (full_ref->type != REF_ARRAY)
1687 if (full_ref->u.ar.type != AR_FULL)
1689 if (ref->type != REF_ARRAY)
1691 if (ref->u.ar.type != AR_SECTION)
1694 for (i = 0; i < ref->u.ar.dimen; i++)
1696 /* If we have a single element in the reference, we need to check
1697 that the array has a single element and that we actually reference
1698 the correct element. */
1699 if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
1701 if (!full_ref->u.ar.as
1702 || !full_ref->u.ar.as->lower[i]
1703 || !full_ref->u.ar.as->upper[i]
1704 || gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
1705 full_ref->u.ar.as->upper[i])
1706 || !ref->u.ar.start[i]
1707 || gfc_dep_compare_expr (ref->u.ar.start[i],
1708 full_ref->u.ar.as->lower[i]))
1712 /* Check the strides. */
1713 if (full_ref->u.ar.stride[i] && !gfc_expr_is_one (full_ref->u.ar.stride[i], 0))
1715 if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
1718 upper_or_lower = false;
1719 /* Check the lower bound. */
1720 if (ref->u.ar.start[i]
1722 && full_ref->u.ar.as->lower[i]
1723 && gfc_dep_compare_expr (ref->u.ar.start[i],
1724 full_ref->u.ar.as->lower[i]) == 0))
1725 upper_or_lower = true;
1726 /* Check the upper bound. */
1727 if (ref->u.ar.end[i]
1729 && full_ref->u.ar.as->upper[i]
1730 && gfc_dep_compare_expr (ref->u.ar.end[i],
1731 full_ref->u.ar.as->upper[i]) == 0))
1732 upper_or_lower = true;
1733 if (!upper_or_lower)
1740 /* Finds if two array references are overlapping or not.
1742 2 : array references are overlapping but reversal of one or
1743 more dimensions will clear the dependency.
1744 1 : array references are overlapping.
1745 0 : array references are identical or not overlapping. */
1748 gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
1751 gfc_dependency fin_dep;
1752 gfc_dependency this_dep;
1754 this_dep = GFC_DEP_ERROR;
1755 fin_dep = GFC_DEP_ERROR;
1756 /* Dependencies due to pointers should already have been identified.
1757 We only need to check for overlapping array references. */
1759 while (lref && rref)
1761 /* We're resolving from the same base symbol, so both refs should be
1762 the same type. We traverse the reference chain until we find ranges
1763 that are not equal. */
1764 gcc_assert (lref->type == rref->type);
1768 /* The two ranges can't overlap if they are from different
1770 if (lref->u.c.component != rref->u.c.component)
1775 /* Substring overlaps are handled by the string assignment code
1776 if there is not an underlying dependency. */
1777 return (fin_dep == GFC_DEP_OVERLAP) ? 1 : 0;
1781 if (ref_same_as_full_array (lref, rref))
1784 if (ref_same_as_full_array (rref, lref))
1787 if (lref->u.ar.dimen != rref->u.ar.dimen)
1789 if (lref->u.ar.type == AR_FULL)
1790 fin_dep = gfc_full_array_ref_p (rref, NULL) ? GFC_DEP_EQUAL
1792 else if (rref->u.ar.type == AR_FULL)
1793 fin_dep = gfc_full_array_ref_p (lref, NULL) ? GFC_DEP_EQUAL
1800 for (n=0; n < lref->u.ar.dimen; n++)
1802 /* Assume dependency when either of array reference is vector
1804 if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
1805 || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
1808 if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
1809 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
1810 this_dep = check_section_vs_section (&lref->u.ar, &rref->u.ar, n);
1811 else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
1812 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
1813 this_dep = gfc_check_element_vs_section (lref, rref, n);
1814 else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
1815 && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
1816 this_dep = gfc_check_element_vs_section (rref, lref, n);
1819 gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
1820 && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
1821 this_dep = gfc_check_element_vs_element (rref, lref, n);
1824 /* If any dimension doesn't overlap, we have no dependency. */
1825 if (this_dep == GFC_DEP_NODEP)
1828 /* Now deal with the loop reversal logic: This only works on
1829 ranges and is activated by setting
1830 reverse[n] == GFC_ENABLE_REVERSE
1831 The ability to reverse or not is set by previous conditions
1832 in this dimension. If reversal is not activated, the
1833 value GFC_DEP_BACKWARD is reset to GFC_DEP_OVERLAP. */
1834 if (rref->u.ar.dimen_type[n] == DIMEN_RANGE
1835 && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
1837 /* Set reverse if backward dependence and not inhibited. */
1838 if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
1839 reverse[n] = (this_dep == GFC_DEP_BACKWARD) ?
1840 GFC_REVERSE_SET : reverse[n];
1842 /* Set forward if forward dependence and not inhibited. */
1843 if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
1844 reverse[n] = (this_dep == GFC_DEP_FORWARD) ?
1845 GFC_FORWARD_SET : reverse[n];
1847 /* Flag up overlap if dependence not compatible with
1848 the overall state of the expression. */
1849 if (reverse && reverse[n] == GFC_REVERSE_SET
1850 && this_dep == GFC_DEP_FORWARD)
1852 reverse[n] = GFC_INHIBIT_REVERSE;
1853 this_dep = GFC_DEP_OVERLAP;
1855 else if (reverse && reverse[n] == GFC_FORWARD_SET
1856 && this_dep == GFC_DEP_BACKWARD)
1858 reverse[n] = GFC_INHIBIT_REVERSE;
1859 this_dep = GFC_DEP_OVERLAP;
1862 /* If no intention of reversing or reversing is explicitly
1863 inhibited, convert backward dependence to overlap. */
1864 if ((reverse == NULL && this_dep == GFC_DEP_BACKWARD)
1865 || (reverse != NULL && reverse[n] == GFC_INHIBIT_REVERSE))
1866 this_dep = GFC_DEP_OVERLAP;
1869 /* Overlap codes are in order of priority. We only need to
1870 know the worst one.*/
1871 if (this_dep > fin_dep)
1875 /* If this is an equal element, we have to keep going until we find
1876 the "real" array reference. */
1877 if (lref->u.ar.type == AR_ELEMENT
1878 && rref->u.ar.type == AR_ELEMENT
1879 && fin_dep == GFC_DEP_EQUAL)
1882 /* Exactly matching and forward overlapping ranges don't cause a
1884 if (fin_dep < GFC_DEP_BACKWARD)
1887 /* Keep checking. We only have a dependency if
1888 subsequent references also overlap. */
1898 /* If we haven't seen any array refs then something went wrong. */
1899 gcc_assert (fin_dep != GFC_DEP_ERROR);
1901 /* Assume the worst if we nest to different depths. */
1905 return fin_dep == GFC_DEP_OVERLAP;