static gfc_dependency gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n) { gfc_array_ref l_ar; gfc_expr *l_start; gfc_expr *l_end; gfc_expr *l_stride; gfc_expr *l_lower; gfc_expr *l_upper; int l_dir; gfc_array_ref r_ar; gfc_expr *r_start; gfc_expr *r_end; gfc_expr *r_stride; gfc_expr *r_lower; gfc_expr *r_upper; int r_dir; l_ar = lref->u.ar; r_ar = rref->u.ar; /* If they are the same range, return without more ado. */ if (gfc_is_same_range (&l_ar, &r_ar, n, 0)) return GFC_DEP_EQUAL; 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_end = r_ar.end[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]; /* If r_end is NULL take it from array specifier. */ if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as)) r_end = r_ar.as->upper[n]; /* Determine whether the l_stride is positive or negative. */ if (!l_stride) l_dir = 1; else if (l_stride->expr_type == EXPR_CONSTANT && l_stride->ts.type == BT_INTEGER) l_dir = mpz_sgn (l_stride->value.integer); else if (l_start && l_end) l_dir = gfc_dep_compare_expr (l_end, l_start); else l_dir = -2; /* Determine whether the r_stride is positive or negative. */ if (!r_stride) r_dir = 1; else if (r_stride->expr_type == EXPR_CONSTANT && r_stride->ts.type == BT_INTEGER) r_dir = mpz_sgn (r_stride->value.integer); else if (r_start && r_end) r_dir = gfc_dep_compare_expr (r_end, r_start); else r_dir = -2; /* The strides should never be zero. */ if (l_dir == 0 || r_dir == 0) return GFC_DEP_OVERLAP; /* Determine LHS upper and lower bounds. */ if (l_dir == 1) { l_lower = l_start; l_upper = l_end; } else if (l_dir == -1) { l_lower = l_end; l_upper = l_start; } else { l_lower = NULL; l_upper = NULL; } /* Determine RHS upper and lower bounds. */ if (r_dir == 1) { r_lower = r_start; r_upper = r_end; } else if (r_dir == -1) { r_lower = r_end; r_upper = r_start; } else { r_lower = NULL; r_upper = NULL; } /* Check whether the ranges are disjoint. */ if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1) return GFC_DEP_NODEP; if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1) return GFC_DEP_NODEP; /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL. */ if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0) { if (l_dir == 1 && r_dir == -1) return GFC_DEP_EQUAL; if (l_dir == -1 && r_dir == 1) return GFC_DEP_EQUAL; } /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL. */ if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0) { if (l_dir == 1 && r_dir == -1) return GFC_DEP_EQUAL; if (l_dir == -1 && r_dir == 1) return GFC_DEP_EQUAL; } /* Handle cases like x:y:2 vs. x+1:z:4 as GFC_DEP_NODEP. There is no dependency if the remainder of (l_start - r_start) / gcd(l_stride, r_stride) is nonzero. TODO: - Handle cases where x is an expression. - Cases like a(1:4:2) = a(2:3) are still not handled. */ #define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \ && (a)->ts.type == BT_INTEGER) if (IS_CONSTANT_INTEGER(l_start) && IS_CONSTANT_INTEGER(r_start) && IS_CONSTANT_INTEGER(l_stride) && IS_CONSTANT_INTEGER(r_stride)) { mpz_t gcd, tmp; int result; mpz_init (gcd); mpz_init (tmp); mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer); mpz_sub (tmp, l_start->value.integer, r_start->value.integer); mpz_fdiv_r (tmp, tmp, gcd); result = mpz_cmp_si (tmp, 0L); mpz_clear (gcd); mpz_clear (tmp); if (result != 0) return GFC_DEP_NODEP; } #undef IS_CONSTANT_INTEGER /* Check for forward dependencies x:y vs. x+1:z. */ if (l_dir == 1 && r_dir == 1 && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == -1 && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == -1) { /* Check that the strides are the same. */ if (!l_stride && !r_stride) return GFC_DEP_FORWARD; if (l_stride && r_stride && gfc_dep_compare_expr (l_stride, r_stride) == 0) return GFC_DEP_FORWARD; } /* Check for forward dependencies x:y:-1 vs. x-1:z:-1. */ if (l_dir == -1 && r_dir == -1 && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 1 && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 1) { /* Check that the strides are the same. */ if (!l_stride && !r_stride) return GFC_DEP_FORWARD; if (l_stride && r_stride && gfc_dep_compare_expr (l_stride, r_stride) == 0) return GFC_DEP_FORWARD; } /* Check for backward dependencies: Are the strides the same?. */ if ((!l_stride && !r_stride) || (l_stride && r_stride && gfc_dep_compare_expr (l_stride, r_stride) == 0)) { /* x:y vs. x+1:z. */ if (l_dir == 1 && r_dir == 1 && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 1 && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 1) return GFC_DEP_BACKWARD; /* x:y:-1 vs. x-1:z:-1. */ if (l_dir == -1 && r_dir == -1 && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == -1 && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == -1) return GFC_DEP_BACKWARD; } return GFC_DEP_OVERLAP; }
static gfc_dependency gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n) { gfc_array_ref l_ar; gfc_expr *l_start; gfc_expr *l_end; gfc_expr *l_stride; gfc_expr *l_lower; gfc_expr *l_upper; int l_dir; gfc_array_ref r_ar; gfc_expr *r_start; gfc_expr *r_end; gfc_expr *r_stride; gfc_expr *r_lower; gfc_expr *r_upper; int r_dir; l_ar = lref->u.ar; r_ar = rref->u.ar; /* If they are the same range, return without more ado. */ if (gfc_is_same_range (&l_ar, &r_ar, n, 0)) return GFC_DEP_EQUAL; 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_end = r_ar.end[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]; /* If r_end is NULL take it from array specifier. */ if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as)) r_end = r_ar.as->upper[n]; /* Determine whether the l_stride is positive or negative. */ if (!l_stride) l_dir = 1; else if (l_stride->expr_type == EXPR_CONSTANT && l_stride->ts.type == BT_INTEGER) l_dir = mpz_sgn (l_stride->value.integer); else if (l_start && l_end) l_dir = gfc_dep_compare_expr (l_end, l_start); else l_dir = -2; /* Determine whether the r_stride is positive or negative. */ if (!r_stride) r_dir = 1; else if (r_stride->expr_type == EXPR_CONSTANT && r_stride->ts.type == BT_INTEGER) r_dir = mpz_sgn (r_stride->value.integer); else if (r_start && r_end) r_dir = gfc_dep_compare_expr (r_end, r_start); else r_dir = -2; /* The strides should never be zero. */ if (l_dir == 0 || r_dir == 0) return GFC_DEP_OVERLAP; /* Determine LHS upper and lower bounds. */ if (l_dir == 1) { l_lower = l_start; l_upper = l_end; } else if (l_dir == -1) { l_lower = l_end; l_upper = l_start; } else { l_lower = NULL; l_upper = NULL; } /* Determine RHS upper and lower bounds. */ if (r_dir == 1) { r_lower = r_start; r_upper = r_end; } else if (r_dir == -1) { r_lower = r_end; r_upper = r_start; } else { r_lower = NULL; r_upper = NULL; } /* Check whether the ranges are disjoint. */ if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1) return GFC_DEP_NODEP; if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1) return GFC_DEP_NODEP; /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL. */ if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0) { if (l_dir == 1 && r_dir == -1) return GFC_DEP_EQUAL; if (l_dir == -1 && r_dir == 1) return GFC_DEP_EQUAL; } /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL. */ if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0) { if (l_dir == 1 && r_dir == -1) return GFC_DEP_EQUAL; if (l_dir == -1 && r_dir == 1) return GFC_DEP_EQUAL; } /* Check for forward dependencies x:y vs. x+1:z. */ if (l_dir == 1 && r_dir == 1 && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == -1 && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == -1) { /* Check that the strides are the same. */ if (!l_stride && !r_stride) return GFC_DEP_FORWARD; if (l_stride && r_stride && gfc_dep_compare_expr (l_stride, r_stride) == 0) return GFC_DEP_FORWARD; } /* Check for forward dependencies x:y:-1 vs. x-1:z:-1. */ if (l_dir == -1 && r_dir == -1 && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 1 && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 1) { /* Check that the strides are the same. */ if (!l_stride && !r_stride) return GFC_DEP_FORWARD; if (l_stride && r_stride && gfc_dep_compare_expr (l_stride, r_stride) == 0) return GFC_DEP_FORWARD; } return GFC_DEP_OVERLAP; }