| /* Dependency analysis |
| Copyright (C) 2000, 2001, 2002, 2005 Free Software Foundation, Inc. |
| Contributed by Paul Brook <paul@nowt.org> |
| |
| This file is part of GCC. |
| |
| GCC is free software; you can redistribute it and/or modify it under |
| the terms of the GNU General Public License as published by the Free |
| Software Foundation; either version 2, or (at your option) any later |
| version. |
| |
| GCC is distributed in the hope that it will be useful, but WITHOUT ANY |
| WARRANTY; without even the implied warranty of MERCHANTABILITY or |
| FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
| for more details. |
| |
| You should have received a copy of the GNU General Public License |
| along with GCC; see the file COPYING. If not, write to the Free |
| Software Foundation, 59 Temple Place - Suite 330, Boston, MA |
| 02111-1307, USA. */ |
| |
| /* dependency.c -- Expression dependency analysis code. */ |
| /* There's probably quite a bit of duplication in this file. We currently |
| have different dependency checking functions for different types |
| if dependencies. Ideally these would probably be merged. */ |
| |
| |
| #include "config.h" |
| #include "gfortran.h" |
| #include "dependency.h" |
| |
| /* static declarations */ |
| /* Enums */ |
| enum range {LHS, RHS, MID}; |
| |
| /* Dependency types. These must be in reverse order of priority. */ |
| typedef enum |
| { |
| GFC_DEP_ERROR, |
| GFC_DEP_EQUAL, /* Identical Ranges. */ |
| GFC_DEP_FORWARD, /* eg. a(1:3), a(2:4). */ |
| GFC_DEP_OVERLAP, /* May overlap in some other way. */ |
| GFC_DEP_NODEP /* Distinct ranges. */ |
| } |
| gfc_dependency; |
| |
| /* Macros */ |
| #define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0)) |
| |
| |
| /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or |
| def if the value could not be determined. */ |
| |
| int |
| gfc_expr_is_one (gfc_expr * expr, int def) |
| { |
| gcc_assert (expr != NULL); |
| |
| if (expr->expr_type != EXPR_CONSTANT) |
| return def; |
| |
| if (expr->ts.type != BT_INTEGER) |
| return def; |
| |
| return mpz_cmp_si (expr->value.integer, 1) == 0; |
| } |
| |
| |
| /* Compare two values. Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2, |
| and -2 if the relationship could not be determined. */ |
| |
| int |
| gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2) |
| { |
| int i; |
| |
| if (e1->expr_type != e2->expr_type) |
| return -2; |
| |
| switch (e1->expr_type) |
| { |
| case EXPR_CONSTANT: |
| if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER) |
| return -2; |
| |
| i = mpz_cmp (e1->value.integer, e2->value.integer); |
| if (i == 0) |
| return 0; |
| else if (i < 0) |
| return -1; |
| return 1; |
| |
| case EXPR_VARIABLE: |
| if (e1->ref || e2->ref) |
| return -2; |
| if (e1->symtree->n.sym == e2->symtree->n.sym) |
| return 0; |
| return -2; |
| |
| default: |
| return -2; |
| } |
| } |
| |
| |
| /* Returns 1 if the two ranges are the same, 0 if they are not, and def |
| if the results are indeterminate. N is the dimension to compare. */ |
| |
| int |
| gfc_is_same_range (gfc_array_ref * ar1, gfc_array_ref * ar2, int n, int def) |
| { |
| gfc_expr *e1; |
| gfc_expr *e2; |
| int i; |
| |
| /* TODO: More sophisticated range comparison. */ |
| gcc_assert (ar1 && ar2); |
| |
| gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]); |
| |
| e1 = ar1->stride[n]; |
| e2 = ar2->stride[n]; |
| /* Check for mismatching strides. A NULL stride means a stride of 1. */ |
| if (e1 && !e2) |
| { |
| i = gfc_expr_is_one (e1, -1); |
| if (i == -1) |
| return def; |
| else if (i == 0) |
| return 0; |
| } |
| else if (e2 && !e1) |
| { |
| i = gfc_expr_is_one (e2, -1); |
| if (i == -1) |
| return def; |
| else if (i == 0) |
| return 0; |
| } |
| else if (e1 && e2) |
| { |
| i = gfc_dep_compare_expr (e1, e2); |
| if (i == -2) |
| return def; |
| else if (i != 0) |
| return 0; |
| } |
| /* The strides match. */ |
| |
| /* Check the range start. */ |
| e1 = ar1->start[n]; |
| e2 = ar2->start[n]; |
| |
| if (!(e1 || e2)) |
| return 1; |
| |
| /* Use the bound of the array if no bound is specified. */ |
| if (ar1->as && !e1) |
| e1 = ar1->as->lower[n]; |
| |
| if (ar2->as && !e2) |
| e2 = ar2->as->upper[n]; |
| |
| /* Check we have values for both. */ |
| if (!(e1 && e2)) |
| return def; |
| |
| i = gfc_dep_compare_expr (e1, e2); |
| |
| if (i == -2) |
| return def; |
| else if (i == 0) |
| return 1; |
| return 0; |
| } |
| |
| |
| /* Dependency checking for direct function return by reference. |
| Returns true if the arguments of the function depend on the |
| destination. This is considerably less conservative than other |
| dependencies because many function arguments will already be |
| copied into a temporary. */ |
| |
| int |
| gfc_check_fncall_dependency (gfc_expr * dest, gfc_expr * fncall) |
| { |
| gfc_actual_arglist *actual; |
| gfc_ref *ref; |
| gfc_expr *expr; |
| int n; |
| |
| gcc_assert (dest->expr_type == EXPR_VARIABLE |
| && fncall->expr_type == EXPR_FUNCTION); |
| gcc_assert (fncall->rank > 0); |
| |
| for (actual = fncall->value.function.actual; actual; actual = actual->next) |
| { |
| expr = actual->expr; |
| |
| /* Skip args which are not present. */ |
| if (!expr) |
| continue; |
| |
| /* Non-variable expressions will be allocated temporaries anyway. */ |
| switch (expr->expr_type) |
| { |
| case EXPR_VARIABLE: |
| if (expr->rank > 1) |
| { |
| /* This is an array section. */ |
| for (ref = expr->ref; ref; ref = ref->next) |
| { |
| if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) |
| break; |
| } |
| gcc_assert (ref); |
| /* AR_FULL can't contain vector subscripts. */ |
| if (ref->u.ar.type == AR_SECTION) |
| { |
| for (n = 0; n < ref->u.ar.dimen; n++) |
| { |
| if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR) |
| break; |
| } |
| /* Vector subscript array sections will be copied to a |
| temporary. */ |
| if (n != ref->u.ar.dimen) |
| continue; |
| } |
| } |
| |
| if (gfc_check_dependency (dest, actual->expr, NULL, 0)) |
| return 1; |
| break; |
| |
| case EXPR_ARRAY: |
| if (gfc_check_dependency (dest, expr, NULL, 0)) |
| return 1; |
| break; |
| |
| default: |
| break; |
| } |
| } |
| |
| return 0; |
| } |
| |
| |
| /* Return true if the statement body redefines the condition. Returns |
| true if expr2 depends on expr1. expr1 should be a single term |
| suitable for the lhs of an assignment. The symbols listed in VARS |
| must be considered to have all possible values. All other scalar |
| variables may be considered constant. Used for forall and where |
| statements. Also used with functions returning arrays without a |
| temporary. */ |
| |
| int |
| gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars, |
| int nvars) |
| { |
| gfc_ref *ref; |
| int n; |
| gfc_actual_arglist *actual; |
| |
| gcc_assert (expr1->expr_type == EXPR_VARIABLE); |
| |
| /* TODO: -fassume-no-pointer-aliasing */ |
| if (expr1->symtree->n.sym->attr.pointer) |
| return 1; |
| for (ref = expr1->ref; ref; ref = ref->next) |
| { |
| if (ref->type == REF_COMPONENT && ref->u.c.component->pointer) |
| return 1; |
| } |
| |
| switch (expr2->expr_type) |
| { |
| case EXPR_OP: |
| n = gfc_check_dependency (expr1, expr2->value.op.op1, vars, nvars); |
| if (n) |
| return n; |
| if (expr2->value.op.op2) |
| return gfc_check_dependency (expr1, expr2->value.op.op2, vars, nvars); |
| return 0; |
| |
| case EXPR_VARIABLE: |
| if (expr2->symtree->n.sym->attr.pointer) |
| return 1; |
| |
| for (ref = expr2->ref; ref; ref = ref->next) |
| { |
| if (ref->type == REF_COMPONENT && ref->u.c.component->pointer) |
| return 1; |
| } |
| |
| if (expr1->symtree->n.sym != expr2->symtree->n.sym) |
| return 0; |
| |
| for (ref = expr2->ref; ref; ref = ref->next) |
| { |
| /* Identical ranges return 0, overlapping ranges return 1. */ |
| if (ref->type == REF_ARRAY) |
| return 1; |
| } |
| return 1; |
| |
| case EXPR_FUNCTION: |
| /* Remember possible differences between elemental and |
| transformational functions. All functions inside a FORALL |
| will be pure. */ |
| for (actual = expr2->value.function.actual; |
| actual; actual = actual->next) |
| { |
| if (!actual->expr) |
| continue; |
| n = gfc_check_dependency (expr1, actual->expr, vars, nvars); |
| if (n) |
| return n; |
| } |
| return 0; |
| |
| case EXPR_CONSTANT: |
| return 0; |
| |
| case EXPR_ARRAY: |
| /* Probably ok in the majority of (constant) cases. */ |
| return 1; |
| |
| default: |
| return 1; |
| } |
| } |
| |
| |
| /* Calculates size of the array reference using lower bound, upper bound |
| and stride. */ |
| |
| static void |
| get_no_of_elements(mpz_t ele, gfc_expr * u1, gfc_expr * l1, gfc_expr * s1) |
| { |
| /* nNoOfEle = (u1-l1)/s1 */ |
| |
| mpz_sub (ele, u1->value.integer, l1->value.integer); |
| |
| if (s1 != NULL) |
| mpz_tdiv_q (ele, ele, s1->value.integer); |
| } |
| |
| |
| /* Returns if the ranges ((0..Y), (X1..X2)) overlap. */ |
| |
| static gfc_dependency |
| get_deps (mpz_t x1, mpz_t x2, mpz_t y) |
| { |
| int start; |
| int end; |
| |
| start = mpz_cmp_ui (x1, 0); |
| end = mpz_cmp (x2, y); |
| |
| /* Both ranges the same. */ |
| if (start == 0 && end == 0) |
| return GFC_DEP_EQUAL; |
| |
| /* Distinct ranges. */ |
| if ((start < 0 && mpz_cmp_ui (x2, 0) < 0) |
| || (mpz_cmp (x1, y) > 0 && end > 0)) |
| return GFC_DEP_NODEP; |
| |
| /* Overlapping, but with corresponding elements of the second range |
| greater than the first. */ |
| if (start > 0 && end > 0) |
| return GFC_DEP_FORWARD; |
| |
| /* Overlapping in some other way. */ |
| return GFC_DEP_OVERLAP; |
| } |
| |
| |
| /* Transforms a sections l and r such that |
| (l_start:l_end:l_stride) -> (0:no_of_elements) |
| (r_start:r_end:r_stride) -> (X1:X2) |
| Where r_end is implicit as both sections must have the same number of |
| elements. |
| Returns 0 on success, 1 of the transformation failed. */ |
| /* TODO: Should this be (0:no_of_elements-1) */ |
| |
| static int |
| transform_sections (mpz_t X1, mpz_t X2, mpz_t no_of_elements, |
| gfc_expr * l_start, gfc_expr * l_end, gfc_expr * l_stride, |
| gfc_expr * r_start, gfc_expr * r_stride) |
| { |
| if (NULL == l_start || NULL == l_end || NULL == r_start) |
| return 1; |
| |
| /* TODO : Currently we check the dependency only when start, end and stride |
| are constant. We could also check for equal (variable) values, and |
| common subexpressions, eg. x vs. x+1. */ |
| |
| if (l_end->expr_type != EXPR_CONSTANT |
| || l_start->expr_type != EXPR_CONSTANT |
| || r_start->expr_type != EXPR_CONSTANT |
| || ((NULL != l_stride) && (l_stride->expr_type != EXPR_CONSTANT)) |
| || ((NULL != r_stride) && (r_stride->expr_type != EXPR_CONSTANT))) |
| { |
| return 1; |
| } |
| |
| |
| get_no_of_elements (no_of_elements, l_end, l_start, l_stride); |
| |
| mpz_sub (X1, r_start->value.integer, l_start->value.integer); |
| if (l_stride != NULL) |
| mpz_cdiv_q (X1, X1, l_stride->value.integer); |
| |
| if (r_stride == NULL) |
| mpz_set (X2, no_of_elements); |
| else |
| mpz_mul (X2, no_of_elements, r_stride->value.integer); |
| |
| if (l_stride != NULL) |
| mpz_cdiv_q (X2, X2, r_stride->value.integer); |
| mpz_add (X2, X2, X1); |
| |
| return 0; |
| } |
| |
| |
| /* Determines overlapping for two array sections. */ |
| |
| static gfc_dependency |
| gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n) |
| { |
| gfc_expr *l_start; |
| gfc_expr *l_end; |
| gfc_expr *l_stride; |
| |
| gfc_expr *r_start; |
| gfc_expr *r_stride; |
| |
| gfc_array_ref l_ar; |
| gfc_array_ref r_ar; |
| |
| mpz_t no_of_elements; |
| mpz_t X1, X2; |
| gfc_dependency dep; |
| |
| l_ar = lref->u.ar; |
| r_ar = rref->u.ar; |
| |
| l_start = l_ar.start[n]; |
| l_end = l_ar.end[n]; |
| l_stride = l_ar.stride[n]; |
| r_start = r_ar.start[n]; |
| r_stride = r_ar.stride[n]; |
| |
| /* if l_start is NULL take it from array specifier */ |
| if (NULL == l_start && IS_ARRAY_EXPLICIT(l_ar.as)) |
| l_start = l_ar.as->lower[n]; |
| |
| /* if l_end is NULL take it from array specifier */ |
| if (NULL == l_end && IS_ARRAY_EXPLICIT(l_ar.as)) |
| l_end = l_ar.as->upper[n]; |
| |
| /* if r_start is NULL take it from array specifier */ |
| if (NULL == r_start && IS_ARRAY_EXPLICIT(r_ar.as)) |
| r_start = r_ar.as->lower[n]; |
| |
| mpz_init (X1); |
| mpz_init (X2); |
| mpz_init (no_of_elements); |
| |
| if (transform_sections (X1, X2, no_of_elements, |
| l_start, l_end, l_stride, |
| r_start, r_stride)) |
| dep = GFC_DEP_OVERLAP; |
| else |
| dep = get_deps (X1, X2, no_of_elements); |
| |
| mpz_clear (no_of_elements); |
| mpz_clear (X1); |
| mpz_clear (X2); |
| return dep; |
| } |
| |
| |
| /* Checks if the expr chk is inside the range left-right. |
| Returns GFC_DEP_NODEP if chk is outside the range, |
| GFC_DEP_OVERLAP otherwise. |
| Assumes left<=right. */ |
| |
| static gfc_dependency |
| gfc_is_inside_range (gfc_expr * chk, gfc_expr * left, gfc_expr * right) |
| { |
| int l; |
| int r; |
| int s; |
| |
| s = gfc_dep_compare_expr (left, right); |
| if (s == -2) |
| return GFC_DEP_OVERLAP; |
| |
| l = gfc_dep_compare_expr (chk, left); |
| r = gfc_dep_compare_expr (chk, right); |
| |
| /* Check for indeterminate relationships. */ |
| if (l == -2 || r == -2 || s == -2) |
| return GFC_DEP_OVERLAP; |
| |
| if (s == 1) |
| { |
| /* When left>right we want to check for right <= chk <= left. */ |
| if (l <= 0 || r >= 0) |
| return GFC_DEP_OVERLAP; |
| } |
| else |
| { |
| /* Otherwise check for left <= chk <= right. */ |
| if (l >= 0 || r <= 0) |
| return GFC_DEP_OVERLAP; |
| } |
| |
| return GFC_DEP_NODEP; |
| } |
| |
| |
| /* Determines overlapping for a single element and a section. */ |
| |
| static gfc_dependency |
| gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n) |
| { |
| gfc_array_ref l_ar; |
| gfc_array_ref r_ar; |
| gfc_expr *l_start; |
| gfc_expr *r_start; |
| gfc_expr *r_end; |
| |
| l_ar = lref->u.ar; |
| r_ar = rref->u.ar; |
| l_start = l_ar.start[n] ; |
| r_start = r_ar.start[n] ; |
| r_end = r_ar.end[n] ; |
| if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as)) |
| r_start = r_ar.as->lower[n]; |
| if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as)) |
| r_end = r_ar.as->upper[n]; |
| if (NULL == r_start || NULL == r_end || l_start == NULL) |
| return GFC_DEP_OVERLAP; |
| |
| return gfc_is_inside_range (l_start, r_end, r_start); |
| } |
| |
| |
| /* Determines overlapping for two single element array references. */ |
| |
| static gfc_dependency |
| gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n) |
| { |
| gfc_array_ref l_ar; |
| gfc_array_ref r_ar; |
| gfc_expr *l_start; |
| gfc_expr *r_start; |
| gfc_dependency nIsDep; |
| |
| if (lref->type == REF_ARRAY && rref->type == REF_ARRAY) |
| { |
| l_ar = lref->u.ar; |
| r_ar = rref->u.ar; |
| l_start = l_ar.start[n] ; |
| r_start = r_ar.start[n] ; |
| if (gfc_dep_compare_expr (r_start, l_start) == 0) |
| nIsDep = GFC_DEP_EQUAL; |
| else |
| nIsDep = GFC_DEP_NODEP; |
| } |
| else |
| nIsDep = GFC_DEP_NODEP; |
| |
| return nIsDep; |
| } |
| |
| |
| /* Finds if two array references are overlapping or not. |
| Return value |
| 1 : array references are overlapping. |
| 0 : array references are not overlapping. */ |
| |
| int |
| gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref) |
| { |
| int n; |
| gfc_dependency fin_dep; |
| gfc_dependency this_dep; |
| |
| |
| fin_dep = GFC_DEP_ERROR; |
| /* Dependencies due to pointers should already have been identified. |
| We only need to check for overlapping array references. */ |
| |
| while (lref && rref) |
| { |
| /* We're resolving from the same base symbol, so both refs should be |
| the same type. We traverse the reference chain intil we find ranges |
| that are not equal. */ |
| gcc_assert (lref->type == rref->type); |
| switch (lref->type) |
| { |
| case REF_COMPONENT: |
| /* The two ranges can't overlap if they are from different |
| components. */ |
| if (lref->u.c.component != rref->u.c.component) |
| return 0; |
| break; |
| |
| case REF_SUBSTRING: |
| /* Substring overlaps are handled by the string assignment code. */ |
| return 0; |
| |
| case REF_ARRAY: |
| |
| for (n=0; n < lref->u.ar.dimen; n++) |
| { |
| /* Assume dependency when either of array reference is vector |
| subscript. */ |
| if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR |
| || rref->u.ar.dimen_type[n] == DIMEN_VECTOR) |
| return 1; |
| if (lref->u.ar.dimen_type[n] == DIMEN_RANGE |
| && rref->u.ar.dimen_type[n] == DIMEN_RANGE) |
| this_dep = gfc_check_section_vs_section (lref, rref, n); |
| else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT |
| && rref->u.ar.dimen_type[n] == DIMEN_RANGE) |
| this_dep = gfc_check_element_vs_section (lref, rref, n); |
| else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT |
| && lref->u.ar.dimen_type[n] == DIMEN_RANGE) |
| this_dep = gfc_check_element_vs_section (rref, lref, n); |
| else |
| { |
| gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT |
| && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT); |
| this_dep = gfc_check_element_vs_element (rref, lref, n); |
| } |
| |
| /* If any dimension doesn't overlap, we have no dependency. */ |
| if (this_dep == GFC_DEP_NODEP) |
| return 0; |
| |
| /* Overlap codes are in order of priority. We only need to |
| know the worst one.*/ |
| if (this_dep > fin_dep) |
| fin_dep = this_dep; |
| } |
| /* Exactly matching and forward overlapping ranges don't cause a |
| dependency. */ |
| if (fin_dep < GFC_DEP_OVERLAP) |
| return 0; |
| |
| /* Keep checking. We only have a dependency if |
| subsequent references also overlap. */ |
| break; |
| |
| default: |
| gcc_unreachable (); |
| } |
| lref = lref->next; |
| rref = rref->next; |
| } |
| |
| /* If we haven't seen any array refs then something went wrong. */ |
| gcc_assert (fin_dep != GFC_DEP_ERROR); |
| |
| if (fin_dep < GFC_DEP_OVERLAP) |
| return 0; |
| else |
| return 1; |
| } |
| |