예제 #1
0
bool
gfc_full_array_ref_p (gfc_ref *ref)
{
  int i;

  if (ref->type != REF_ARRAY)
    return false;
  if (ref->u.ar.type == AR_FULL)
    return true;
  if (ref->u.ar.type != AR_SECTION)
    return false;
  if (ref->next)
    return false;

  for (i = 0; i < ref->u.ar.dimen; i++)
    {
      /* Check the lower bound.  */
      if (ref->u.ar.start[i]
	  && (!ref->u.ar.as
	      || !ref->u.ar.as->lower[i]
	      || gfc_dep_compare_expr (ref->u.ar.start[i],
				       ref->u.ar.as->lower[i])))
	return false;
      /* Check the upper bound.  */
      if (ref->u.ar.end[i]
	  && (!ref->u.ar.as
	      || !ref->u.ar.as->upper[i]
	      || gfc_dep_compare_expr (ref->u.ar.end[i],
				       ref->u.ar.as->upper[i])))
	return false;
      /* Check the stride.  */
      if (ref->u.ar.stride[i]
	  && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
	return false;
    }
  return true;
}
예제 #2
0
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;
}
예제 #3
0
int
gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
{
  gfc_actual_arglist *args1;
  gfc_actual_arglist *args2;
  int i;

  if (e1->expr_type == EXPR_OP
      && (e1->value.op.op == INTRINSIC_UPLUS
	  || e1->value.op.op == INTRINSIC_PARENTHESES))
    return gfc_dep_compare_expr (e1->value.op.op1, e2);
  if (e2->expr_type == EXPR_OP
      && (e2->value.op.op == INTRINSIC_UPLUS
	  || e2->value.op.op == INTRINSIC_PARENTHESES))
    return gfc_dep_compare_expr (e1, e2->value.op.op1);

  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
    {
      /* Compare X+C vs. X.  */
      if (e1->value.op.op2->expr_type == EXPR_CONSTANT
	  && e1->value.op.op2->ts.type == BT_INTEGER
	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
	return mpz_sgn (e1->value.op.op2->value.integer);

      /* Compare P+Q vs. R+S.  */
      if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
	{
	  int l, r;

	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
	  if (l == 0 && r == 0)
	    return 0;
	  if (l == 0 && r != -2)
	    return r;
	  if (l != -2 && r == 0)
	    return l;
	  if (l == 1 && r == 1)
	    return 1;
	  if (l == -1 && r == -1)
	    return -1;

	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
	  if (l == 0 && r == 0)
	    return 0;
	  if (l == 0 && r != -2)
	    return r;
	  if (l != -2 && r == 0)
	    return l;
	  if (l == 1 && r == 1)
	    return 1;
	  if (l == -1 && r == -1)
	    return -1;
	}
    }

  /* Compare X vs. X+C.  */
  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
    {
      if (e2->value.op.op2->expr_type == EXPR_CONSTANT
	  && e2->value.op.op2->ts.type == BT_INTEGER
	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
	return -mpz_sgn (e2->value.op.op2->value.integer);
    }

  /* Compare X-C vs. X.  */
  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
    {
      if (e1->value.op.op2->expr_type == EXPR_CONSTANT
	  && e1->value.op.op2->ts.type == BT_INTEGER
	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
	return -mpz_sgn (e1->value.op.op2->value.integer);

      /* Compare P-Q vs. R-S.  */
      if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
	{
	  int l, r;

	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
	  if (l == 0 && r == 0)
	    return 0;
	  if (l != -2 && r == 0)
	    return l;
	  if (l == 0 && r != -2)
	    return -r;
	  if (l == 1 && r == -1)
	    return 1;
	  if (l == -1 && r == 1)
	    return -1;
	}
    }

  /* Compare X vs. X-C.  */
  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
    {
      if (e2->value.op.op2->expr_type == EXPR_CONSTANT
	  && e2->value.op.op2->ts.type == BT_INTEGER
	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
	return mpz_sgn (e2->value.op.op2->value.integer);
    }

  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;

    case EXPR_OP:
      /* Intrinsic operators are the same if their operands are the same.  */
      if (e1->value.op.op != e2->value.op.op)
	return -2;
      if (e1->value.op.op2 == 0)
	{
	  i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
	  return i == 0 ? 0 : -2;
	}
      if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
	  && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
	return 0;
      /* TODO Handle commutative binary operators here?  */
      return -2;

    case EXPR_FUNCTION:
      /* We can only compare calls to the same intrinsic function.  */
      if (e1->value.function.isym == 0 || e2->value.function.isym == 0
	  || e1->value.function.isym != e2->value.function.isym)
	return -2;

      args1 = e1->value.function.actual;
      args2 = e2->value.function.actual;

      /* We should list the "constant" intrinsic functions.  Those
	 without side-effects that provide equal results given equal
	 argument lists.  */
      switch (e1->value.function.isym->id)
	{
	case GFC_ISYM_CONVERSION:
	  /* Handle integer extensions specially, as __convert_i4_i8
	     is not only "constant" but also "unary" and "increasing".  */
	  if (args1 && !args1->next
	      && args2 && !args2->next
	      && e1->ts.type == BT_INTEGER
	      && args1->expr->ts.type == BT_INTEGER
	      && e1->ts.kind > args1->expr->ts.kind
	      && e2->ts.type == e1->ts.type
	      && e2->ts.kind == e1->ts.kind
	      && args2->expr->ts.type == args1->expr->ts.type
	      && args2->expr->ts.kind == args2->expr->ts.kind)
	    return gfc_dep_compare_expr (args1->expr, args2->expr);
	  break;

	case GFC_ISYM_REAL:
	case GFC_ISYM_LOGICAL:
	case GFC_ISYM_DBLE:
	  break;

	default:
	  return -2;
	}

      /* Compare the argument lists for equality.  */
      while (args1 && args2)
	{
	  if (gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
	    return -2;
	  args1 = args1->next;
	  args2 = args2->next;
	}
      return (args1 || args2) ? -2 : 0;
      
    default:
      return -2;
    }
}
예제 #4
0
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)
    {
      /* 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->lower[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 0;
    }

  /* Check the range end.  */
  e1 = ar1->end[n];
  e2 = ar2->end[n];
  if (e1 || e2)
    {
      /* Use the bound of the array if no bound is specified.  */
      if (ar1->as && !e1)
	e1 = ar1->as->upper[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 0;
    }

  return 1;
}
예제 #5
0
bool
gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
{
  int i;
  int n;
  bool lbound_OK = true;
  bool ubound_OK = true;

  if (contiguous)
    *contiguous = false;

  if (ref->type != REF_ARRAY)
    return false;

  if (ref->u.ar.type == AR_FULL)
    {
      if (contiguous)
	*contiguous = true;
      return true;
    }

  if (ref->u.ar.type != AR_SECTION)
    return false;
  if (ref->next)
    return false;

  for (i = 0; i < ref->u.ar.dimen; i++)
    {
      /* If we have a single element in the reference, for the reference
	 to be full, we need to ascertain that the array has a single
	 element in this dimension and that we actually reference the
	 correct element.  */
      if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
	{
	  /* This is unconditionally a contiguous reference if all the
	     remaining dimensions are elements.  */
	  if (contiguous)
	    {
	      *contiguous = true;
	      for (n = i + 1; n < ref->u.ar.dimen; n++)
		if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
		  *contiguous = false;
	    }

	  if (!ref->u.ar.as
	      || !ref->u.ar.as->lower[i]
	      || !ref->u.ar.as->upper[i]
	      || gfc_dep_compare_expr (ref->u.ar.as->lower[i],
				       ref->u.ar.as->upper[i])
	      || !ref->u.ar.start[i]
	      || gfc_dep_compare_expr (ref->u.ar.start[i],
				       ref->u.ar.as->lower[i]))
	    return false;
	  else
	    continue;
	}

      /* Check the lower bound.  */
      if (ref->u.ar.start[i]
	  && (!ref->u.ar.as
	      || !ref->u.ar.as->lower[i]
	      || gfc_dep_compare_expr (ref->u.ar.start[i],
				       ref->u.ar.as->lower[i])))
	lbound_OK = false;
      /* Check the upper bound.  */
      if (ref->u.ar.end[i]
	  && (!ref->u.ar.as
	      || !ref->u.ar.as->upper[i]
	      || gfc_dep_compare_expr (ref->u.ar.end[i],
				       ref->u.ar.as->upper[i])))
	ubound_OK = false;
      /* Check the stride.  */
      if (ref->u.ar.stride[i]
	    && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
	return false;

      /* This is unconditionally a contiguous reference as long as all
	 the subsequent dimensions are elements.  */
      if (contiguous)
	{
	  *contiguous = true;
	  for (n = i + 1; n < ref->u.ar.dimen; n++)
	    if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
	      *contiguous = false;
	}

      if (!lbound_OK || !ubound_OK)
	return false;
    }
  return true;
}
예제 #6
0
static gfc_dependency
gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
{
  gfc_array_ref *ref;
  gfc_expr *elem;
  gfc_expr *start;
  gfc_expr *end;
  gfc_expr *stride;
  int s;

  elem = lref->u.ar.start[n];
  if (!elem)
    return GFC_DEP_OVERLAP;

  ref = &rref->u.ar;
  start = ref->start[n] ;
  end = ref->end[n] ;
  stride = ref->stride[n];

  if (!start && IS_ARRAY_EXPLICIT (ref->as))
    start = ref->as->lower[n];
  if (!end && IS_ARRAY_EXPLICIT (ref->as))
    end = ref->as->upper[n];

  /* Determine whether the stride is positive or negative.  */
  if (!stride)
    s = 1;
  else if (stride->expr_type == EXPR_CONSTANT
	   && stride->ts.type == BT_INTEGER)
    s = mpz_sgn (stride->value.integer);
  else
    s = -2;

  /* Stride should never be zero.  */
  if (s == 0)
    return GFC_DEP_OVERLAP;

  /* Positive strides.  */
  if (s == 1)
    {
      /* Check for elem < lower.  */
      if (start && gfc_dep_compare_expr (elem, start) == -1)
	return GFC_DEP_NODEP;
      /* Check for elem > upper.  */
      if (end && gfc_dep_compare_expr (elem, end) == 1)
	return GFC_DEP_NODEP;

      if (start && end)
	{
	  s = gfc_dep_compare_expr (start, end);
	  /* Check for an empty range.  */
	  if (s == 1)
	    return GFC_DEP_NODEP;
	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
	    return GFC_DEP_EQUAL;
	}
    }
  /* Negative strides.  */
  else if (s == -1)
    {
      /* Check for elem > upper.  */
      if (end && gfc_dep_compare_expr (elem, start) == 1)
	return GFC_DEP_NODEP;
      /* Check for elem < lower.  */
      if (start && gfc_dep_compare_expr (elem, end) == -1)
	return GFC_DEP_NODEP;

      if (start && end)
	{
	  s = gfc_dep_compare_expr (start, end);
	  /* Check for an empty range.  */
	  if (s == -1)
	    return GFC_DEP_NODEP;
	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
	    return GFC_DEP_EQUAL;
	}
    }
  /* Unknown strides.  */
  else
    {
      if (!start || !end)
	return GFC_DEP_OVERLAP;
      s = gfc_dep_compare_expr (start, end);
      if (s == -2)
	return GFC_DEP_OVERLAP;
      /* Assume positive stride.  */
      if (s == -1)
	{
	  /* Check for elem < lower.  */
	  if (gfc_dep_compare_expr (elem, start) == -1)
	    return GFC_DEP_NODEP;
	  /* Check for elem > upper.  */
	  if (gfc_dep_compare_expr (elem, end) == 1)
	    return GFC_DEP_NODEP;
	}
      /* Assume negative stride.  */
      else if (s == 1)
	{
	  /* Check for elem > upper.  */
	  if (gfc_dep_compare_expr (elem, start) == 1)
	    return GFC_DEP_NODEP;
	  /* Check for elem < lower.  */
	  if (gfc_dep_compare_expr (elem, end) == -1)
	    return GFC_DEP_NODEP;
	}
      /* Equal bounds.  */
      else if (s == 0)
	{
	  s = gfc_dep_compare_expr (elem, start);
	  if (s == 0)
	    return GFC_DEP_EQUAL;
	  if (s == 1 || s == -1)
	    return GFC_DEP_NODEP;
	}
    }

  return GFC_DEP_OVERLAP;
}
예제 #7
0
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;
}