2 Copyright (C) 2000, 2001, 2002, 2005 Free Software Foundation, Inc.
3 Contributed by Paul Brook <paul@nowt.org>
5 This file is part of GCC.
7 GCC is free software; you can redistribute it and/or modify it under
8 the terms of the GNU General Public License as published by the Free
9 Software Foundation; either version 2, or (at your option) any later
12 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 You should have received a copy of the GNU General Public License
18 along with GCC; see the file COPYING. If not, write to the Free
19 Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
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"
32 /* static declarations */
34 enum range {LHS, RHS, MID};
36 /* Dependency types. These must be in reverse order of priority. */
40 GFC_DEP_EQUAL, /* Identical Ranges. */
41 GFC_DEP_FORWARD, /* eg. a(1:3), a(2:4). */
42 GFC_DEP_OVERLAP, /* May overlap in some other way. */
43 GFC_DEP_NODEP /* Distinct ranges. */
48 #define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
51 /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
52 def if the value could not be determined. */
55 gfc_expr_is_one (gfc_expr * expr, int def)
57 gcc_assert (expr != NULL);
59 if (expr->expr_type != EXPR_CONSTANT)
62 if (expr->ts.type != BT_INTEGER)
65 return mpz_cmp_si (expr->value.integer, 1) == 0;
69 /* Compare two values. Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
70 and -2 if the relationship could not be determined. */
73 gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
77 if (e1->expr_type != e2->expr_type)
80 switch (e1->expr_type)
83 if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
86 i = mpz_cmp (e1->value.integer, e2->value.integer);
94 if (e1->ref || e2->ref)
96 if (e1->symtree->n.sym == e2->symtree->n.sym)
106 /* Returns 1 if the two ranges are the same, 0 if they are not, and def
107 if the results are indeterminate. N is the dimension to compare. */
110 gfc_is_same_range (gfc_array_ref * ar1, gfc_array_ref * ar2, int n, int def)
116 /* TODO: More sophisticated range comparison. */
117 gcc_assert (ar1 && ar2);
119 gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
123 /* Check for mismatching strides. A NULL stride means a stride of 1. */
126 i = gfc_expr_is_one (e1, -1);
134 i = gfc_expr_is_one (e2, -1);
142 i = gfc_dep_compare_expr (e1, e2);
148 /* The strides match. */
150 /* Check the range start. */
157 /* Use the bound of the array if no bound is specified. */
159 e1 = ar1->as->lower[n];
162 e2 = ar2->as->upper[n];
164 /* Check we have values for both. */
168 i = gfc_dep_compare_expr (e1, e2);
178 /* Some array-returning intrinsics can be implemented by reusing the
179 data from one of the array arguments. For example, TRANSPOSE does
180 not necessarily need to allocate new data: it can be implemented
181 by copying the original array's descriptor and simply swapping the
182 two dimension specifications.
184 If EXPR is a call to such an intrinsic, return the argument
185 whose data can be reused, otherwise return NULL. */
188 gfc_get_noncopying_intrinsic_argument (gfc_expr * expr)
190 if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
193 switch (expr->value.function.isym->generic_id)
195 case GFC_ISYM_TRANSPOSE:
196 return expr->value.function.actual->expr;
204 /* Return true if the result of reference REF can only be constructed
205 using a temporary array. */
208 gfc_ref_needs_temporary_p (gfc_ref *ref)
214 for (; ref; ref = ref->next)
218 /* Vector dimensions are generally not monotonic and must be
219 handled using a temporary. */
220 if (ref->u.ar.type == AR_SECTION)
221 for (n = 0; n < ref->u.ar.dimen; n++)
222 if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
229 /* Within an array reference, character substrings generally
230 need a temporary. Character array strides are expressed as
231 multiples of the element size (consistent with other array
232 types), not in characters. */
243 /* Return true if array variable VAR could be passed to the same function
244 as argument EXPR without interfering with EXPR. INTENT is the intent
247 This is considerably less conservative than other dependencies
248 because many function arguments will already be copied into a
252 gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
255 gcc_assert (var->expr_type == EXPR_VARIABLE);
256 gcc_assert (var->rank > 0);
258 switch (expr->expr_type)
261 return (gfc_ref_needs_temporary_p (expr->ref)
262 || gfc_check_dependency (var, expr, 1));
265 return gfc_check_dependency (var, expr, 1);
268 if (intent != INTENT_IN && expr->inline_noncopying_intrinsic)
270 expr = gfc_get_noncopying_intrinsic_argument (expr);
271 return gfc_check_argument_var_dependency (var, intent, expr);
281 /* Like gfc_check_argument_var_dependency, but extended to any
282 array expression OTHER, not just variables. */
285 gfc_check_argument_dependency (gfc_expr * other, sym_intent intent,
288 switch (other->expr_type)
291 return gfc_check_argument_var_dependency (other, intent, expr);
294 if (other->inline_noncopying_intrinsic)
296 other = gfc_get_noncopying_intrinsic_argument (other);
297 return gfc_check_argument_dependency (other, INTENT_IN, expr);
307 /* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
308 FNSYM is the function being called, or NULL if not known. */
311 gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
312 gfc_symbol * fnsym, gfc_actual_arglist * actual)
314 gfc_formal_arglist *formal;
317 formal = fnsym ? fnsym->formal : NULL;
318 for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
322 /* Skip args which are not present. */
326 /* Skip intent(in) arguments if OTHER itself is intent(in). */
328 && intent == INTENT_IN
329 && formal->sym->attr.intent == INTENT_IN)
332 if (gfc_check_argument_dependency (other, intent, expr))
340 /* Return true if the statement body redefines the condition. Returns
341 true if expr2 depends on expr1. expr1 should be a single term
342 suitable for the lhs of an assignment. The IDENTICAL flag indicates
343 whether array references to the same symbol with identical range
344 references count as a dependency or not. Used for forall and where
345 statements. Also used with functions returning arrays without a
349 gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
353 gfc_actual_arglist *actual;
355 gcc_assert (expr1->expr_type == EXPR_VARIABLE);
357 /* TODO: -fassume-no-pointer-aliasing */
358 if (expr1->symtree->n.sym->attr.pointer)
360 for (ref = expr1->ref; ref; ref = ref->next)
362 if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
366 switch (expr2->expr_type)
369 n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
372 if (expr2->value.op.op2)
373 return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
377 if (expr2->symtree->n.sym->attr.pointer)
380 for (ref = expr2->ref; ref; ref = ref->next)
382 if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
386 if (expr1->symtree->n.sym != expr2->symtree->n.sym)
392 /* Identical ranges return 0, overlapping ranges return 1. */
394 /* Return zero if we refer to the same full arrays. */
395 if (expr1->ref->type == REF_ARRAY
396 && expr2->ref->type == REF_ARRAY
397 && expr1->ref->u.ar.type == AR_FULL
398 && expr2->ref->u.ar.type == AR_FULL
400 && !expr2->ref->next)
406 if (expr2->inline_noncopying_intrinsic)
408 /* Remember possible differences between elemental and
409 transformational functions. All functions inside a FORALL
411 for (actual = expr2->value.function.actual;
412 actual; actual = actual->next)
416 n = gfc_check_dependency (expr1, actual->expr, identical);
426 /* Probably ok in the majority of (constant) cases. */
435 /* Calculates size of the array reference using lower bound, upper bound
439 get_no_of_elements(mpz_t ele, gfc_expr * u1, gfc_expr * l1, gfc_expr * s1)
441 /* nNoOfEle = (u1-l1)/s1 */
443 mpz_sub (ele, u1->value.integer, l1->value.integer);
446 mpz_tdiv_q (ele, ele, s1->value.integer);
450 /* Returns if the ranges ((0..Y), (X1..X2)) overlap. */
452 static gfc_dependency
453 get_deps (mpz_t x1, mpz_t x2, mpz_t y)
458 start = mpz_cmp_ui (x1, 0);
459 end = mpz_cmp (x2, y);
461 /* Both ranges the same. */
462 if (start == 0 && end == 0)
463 return GFC_DEP_EQUAL;
465 /* Distinct ranges. */
466 if ((start < 0 && mpz_cmp_ui (x2, 0) < 0)
467 || (mpz_cmp (x1, y) > 0 && end > 0))
468 return GFC_DEP_NODEP;
470 /* Overlapping, but with corresponding elements of the second range
471 greater than the first. */
472 if (start > 0 && end > 0)
473 return GFC_DEP_FORWARD;
475 /* Overlapping in some other way. */
476 return GFC_DEP_OVERLAP;
480 /* Perform the same linear transformation on sections l and r such that
481 (l_start:l_end:l_stride) -> (0:no_of_elements)
482 (r_start:r_end:r_stride) -> (X1:X2)
483 Where r_end is implicit as both sections must have the same number of
485 Returns 0 on success, 1 of the transformation failed. */
486 /* TODO: Should this be (0:no_of_elements-1) */
489 transform_sections (mpz_t X1, mpz_t X2, mpz_t no_of_elements,
490 gfc_expr * l_start, gfc_expr * l_end, gfc_expr * l_stride,
491 gfc_expr * r_start, gfc_expr * r_stride)
493 if (NULL == l_start || NULL == l_end || NULL == r_start)
496 /* TODO : Currently we check the dependency only when start, end and stride
497 are constant. We could also check for equal (variable) values, and
498 common subexpressions, eg. x vs. x+1. */
500 if (l_end->expr_type != EXPR_CONSTANT
501 || l_start->expr_type != EXPR_CONSTANT
502 || r_start->expr_type != EXPR_CONSTANT
503 || ((NULL != l_stride) && (l_stride->expr_type != EXPR_CONSTANT))
504 || ((NULL != r_stride) && (r_stride->expr_type != EXPR_CONSTANT)))
510 get_no_of_elements (no_of_elements, l_end, l_start, l_stride);
512 mpz_sub (X1, r_start->value.integer, l_start->value.integer);
513 if (l_stride != NULL)
514 mpz_cdiv_q (X1, X1, l_stride->value.integer);
516 if (r_stride == NULL)
517 mpz_set (X2, no_of_elements);
519 mpz_mul (X2, no_of_elements, r_stride->value.integer);
521 if (l_stride != NULL)
522 mpz_cdiv_q (X2, X2, l_stride->value.integer);
523 mpz_add (X2, X2, X1);
529 /* Determines overlapping for two array sections. */
531 static gfc_dependency
532 gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
544 mpz_t no_of_elements;
551 l_start = l_ar.start[n];
553 l_stride = l_ar.stride[n];
554 r_start = r_ar.start[n];
555 r_stride = r_ar.stride[n];
557 /* if l_start is NULL take it from array specifier */
558 if (NULL == l_start && IS_ARRAY_EXPLICIT(l_ar.as))
559 l_start = l_ar.as->lower[n];
561 /* if l_end is NULL take it from array specifier */
562 if (NULL == l_end && IS_ARRAY_EXPLICIT(l_ar.as))
563 l_end = l_ar.as->upper[n];
565 /* if r_start is NULL take it from array specifier */
566 if (NULL == r_start && IS_ARRAY_EXPLICIT(r_ar.as))
567 r_start = r_ar.as->lower[n];
571 mpz_init (no_of_elements);
573 if (transform_sections (X1, X2, no_of_elements,
574 l_start, l_end, l_stride,
576 dep = GFC_DEP_OVERLAP;
578 dep = get_deps (X1, X2, no_of_elements);
580 mpz_clear (no_of_elements);
587 /* Checks if the expr chk is inside the range left-right.
588 Returns GFC_DEP_NODEP if chk is outside the range,
589 GFC_DEP_OVERLAP otherwise.
590 Assumes left<=right. */
592 static gfc_dependency
593 gfc_is_inside_range (gfc_expr * chk, gfc_expr * left, gfc_expr * right)
599 s = gfc_dep_compare_expr (left, right);
601 return GFC_DEP_OVERLAP;
603 l = gfc_dep_compare_expr (chk, left);
604 r = gfc_dep_compare_expr (chk, right);
606 /* Check for indeterminate relationships. */
607 if (l == -2 || r == -2 || s == -2)
608 return GFC_DEP_OVERLAP;
612 /* When left>right we want to check for right <= chk <= left. */
613 if (l <= 0 || r >= 0)
614 return GFC_DEP_OVERLAP;
618 /* Otherwise check for left <= chk <= right. */
619 if (l >= 0 || r <= 0)
620 return GFC_DEP_OVERLAP;
623 return GFC_DEP_NODEP;
627 /* Determines overlapping for a single element and a section. */
629 static gfc_dependency
630 gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
640 l_start = l_ar.start[n] ;
641 r_start = r_ar.start[n] ;
642 r_end = r_ar.end[n] ;
643 if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as))
644 r_start = r_ar.as->lower[n];
645 if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as))
646 r_end = r_ar.as->upper[n];
647 if (NULL == r_start || NULL == r_end || l_start == NULL)
648 return GFC_DEP_OVERLAP;
650 return gfc_is_inside_range (l_start, r_end, r_start);
654 /* Determines overlapping for two single element array references. */
656 static gfc_dependency
657 gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
663 gfc_dependency nIsDep;
665 if (lref->type == REF_ARRAY && rref->type == REF_ARRAY)
669 l_start = l_ar.start[n] ;
670 r_start = r_ar.start[n] ;
671 if (gfc_dep_compare_expr (r_start, l_start) == 0)
672 nIsDep = GFC_DEP_EQUAL;
674 nIsDep = GFC_DEP_NODEP;
677 nIsDep = GFC_DEP_NODEP;
683 /* Finds if two array references are overlapping or not.
685 1 : array references are overlapping.
686 0 : array references are not overlapping. */
689 gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
692 gfc_dependency fin_dep;
693 gfc_dependency this_dep;
696 fin_dep = GFC_DEP_ERROR;
697 /* Dependencies due to pointers should already have been identified.
698 We only need to check for overlapping array references. */
702 /* We're resolving from the same base symbol, so both refs should be
703 the same type. We traverse the reference chain intil we find ranges
704 that are not equal. */
705 gcc_assert (lref->type == rref->type);
709 /* The two ranges can't overlap if they are from different
711 if (lref->u.c.component != rref->u.c.component)
716 /* Substring overlaps are handled by the string assignment code. */
721 for (n=0; n < lref->u.ar.dimen; n++)
723 /* Assume dependency when either of array reference is vector
725 if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
726 || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
728 if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
729 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
730 this_dep = gfc_check_section_vs_section (lref, rref, n);
731 else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
732 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
733 this_dep = gfc_check_element_vs_section (lref, rref, n);
734 else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
735 && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
736 this_dep = gfc_check_element_vs_section (rref, lref, n);
739 gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
740 && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
741 this_dep = gfc_check_element_vs_element (rref, lref, n);
744 /* If any dimension doesn't overlap, we have no dependency. */
745 if (this_dep == GFC_DEP_NODEP)
748 /* Overlap codes are in order of priority. We only need to
749 know the worst one.*/
750 if (this_dep > fin_dep)
753 /* Exactly matching and forward overlapping ranges don't cause a
755 if (fin_dep < GFC_DEP_OVERLAP)
758 /* Keep checking. We only have a dependency if
759 subsequent references also overlap. */
769 /* If we haven't seen any array refs then something went wrong. */
770 gcc_assert (fin_dep != GFC_DEP_ERROR);
772 if (fin_dep < GFC_DEP_OVERLAP)