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, 59 Temple Place - Suite 330, 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 /* Dependency checking for direct function return by reference.
179 Returns true if the arguments of the function depend on the
180 destination. This is considerably less conservative than other
181 dependencies because many function arguments will already be
182 copied into a temporary. */
185 gfc_check_fncall_dependency (gfc_expr
* dest
, gfc_expr
* fncall
)
187 gfc_actual_arglist
*actual
;
192 gcc_assert (dest
->expr_type
== EXPR_VARIABLE
193 && fncall
->expr_type
== EXPR_FUNCTION
);
194 gcc_assert (fncall
->rank
> 0);
196 for (actual
= fncall
->value
.function
.actual
; actual
; actual
= actual
->next
)
200 /* Skip args which are not present. */
204 /* Non-variable expressions will be allocated temporaries anyway. */
205 switch (expr
->expr_type
)
210 /* This is an array section. */
211 for (ref
= expr
->ref
; ref
; ref
= ref
->next
)
213 if (ref
->type
== REF_ARRAY
&& ref
->u
.ar
.type
!= AR_ELEMENT
)
217 /* AR_FULL can't contain vector subscripts. */
218 if (ref
->u
.ar
.type
== AR_SECTION
)
220 for (n
= 0; n
< ref
->u
.ar
.dimen
; n
++)
222 if (ref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
225 /* Vector subscript array sections will be copied to a
227 if (n
!= ref
->u
.ar
.dimen
)
232 if (gfc_check_dependency (dest
, actual
->expr
, NULL
, 0))
237 if (gfc_check_dependency (dest
, expr
, NULL
, 0))
250 /* Return true if the statement body redefines the condition. Returns
251 true if expr2 depends on expr1. expr1 should be a single term
252 suitable for the lhs of an assignment. The symbols listed in VARS
253 must be considered to have all possible values. All other scalar
254 variables may be considered constant. Used for forall and where
255 statements. Also used with functions returning arrays without a
259 gfc_check_dependency (gfc_expr
* expr1
, gfc_expr
* expr2
, gfc_expr
** vars
,
264 gfc_actual_arglist
*actual
;
266 gcc_assert (expr1
->expr_type
== EXPR_VARIABLE
);
268 /* TODO: -fassume-no-pointer-aliasing */
269 if (expr1
->symtree
->n
.sym
->attr
.pointer
)
271 for (ref
= expr1
->ref
; ref
; ref
= ref
->next
)
273 if (ref
->type
== REF_COMPONENT
&& ref
->u
.c
.component
->pointer
)
277 switch (expr2
->expr_type
)
280 n
= gfc_check_dependency (expr1
, expr2
->op1
, vars
, nvars
);
284 return gfc_check_dependency (expr1
, expr2
->op2
, vars
, nvars
);
288 if (expr2
->symtree
->n
.sym
->attr
.pointer
)
291 for (ref
= expr2
->ref
; ref
; ref
= ref
->next
)
293 if (ref
->type
== REF_COMPONENT
&& ref
->u
.c
.component
->pointer
)
297 if (expr1
->symtree
->n
.sym
!= expr2
->symtree
->n
.sym
)
300 for (ref
= expr2
->ref
; ref
; ref
= ref
->next
)
302 /* Identical ranges return 0, overlapping ranges return 1. */
303 if (ref
->type
== REF_ARRAY
)
309 /* Remember possible differences between elemental and
310 transformational functions. All functions inside a FORALL
312 for (actual
= expr2
->value
.function
.actual
;
313 actual
; actual
= actual
->next
)
317 n
= gfc_check_dependency (expr1
, actual
->expr
, vars
, nvars
);
327 /* Probably ok in the majority of (constant) cases. */
336 /* Calculates size of the array reference using lower bound, upper bound
340 get_no_of_elements(mpz_t ele
, gfc_expr
* u1
, gfc_expr
* l1
, gfc_expr
* s1
)
342 /* nNoOfEle = (u1-l1)/s1 */
344 mpz_sub (ele
, u1
->value
.integer
, l1
->value
.integer
);
347 mpz_tdiv_q (ele
, ele
, s1
->value
.integer
);
351 /* Returns if the ranges ((0..Y), (X1..X2)) overlap. */
353 static gfc_dependency
354 get_deps (mpz_t x1
, mpz_t x2
, mpz_t y
)
359 start
= mpz_cmp_ui (x1
, 0);
360 end
= mpz_cmp (x2
, y
);
362 /* Both ranges the same. */
363 if (start
== 0 && end
== 0)
364 return GFC_DEP_EQUAL
;
366 /* Distinct ranges. */
367 if ((start
< 0 && mpz_cmp_ui (x2
, 0) < 0)
368 || (mpz_cmp (x1
, y
) > 0 && end
> 0))
369 return GFC_DEP_NODEP
;
371 /* Overlapping, but with corresponding elements of the second range
372 greater than the first. */
373 if (start
> 0 && end
> 0)
374 return GFC_DEP_FORWARD
;
376 /* Overlapping in some other way. */
377 return GFC_DEP_OVERLAP
;
381 /* Transforms a sections l and r such that
382 (l_start:l_end:l_stride) -> (0:no_of_elements)
383 (r_start:r_end:r_stride) -> (X1:X2)
384 Where r_end is implicit as both sections must have the same number of
386 Returns 0 on success, 1 of the transformation failed. */
387 /* TODO: Should this be (0:no_of_elements-1) */
390 transform_sections (mpz_t X1
, mpz_t X2
, mpz_t no_of_elements
,
391 gfc_expr
* l_start
, gfc_expr
* l_end
, gfc_expr
* l_stride
,
392 gfc_expr
* r_start
, gfc_expr
* r_stride
)
394 if (NULL
== l_start
|| NULL
== l_end
|| NULL
== r_start
)
397 /* TODO : Currently we check the dependency only when start, end and stride
398 are constant. We could also check for equal (variable) values, and
399 common subexpressions, eg. x vs. x+1. */
401 if (l_end
->expr_type
!= EXPR_CONSTANT
402 || l_start
->expr_type
!= EXPR_CONSTANT
403 || r_start
->expr_type
!= EXPR_CONSTANT
404 || ((NULL
!= l_stride
) && (l_stride
->expr_type
!= EXPR_CONSTANT
))
405 || ((NULL
!= r_stride
) && (r_stride
->expr_type
!= EXPR_CONSTANT
)))
411 get_no_of_elements (no_of_elements
, l_end
, l_start
, l_stride
);
413 mpz_sub (X1
, r_start
->value
.integer
, l_start
->value
.integer
);
414 if (l_stride
!= NULL
)
415 mpz_cdiv_q (X1
, X1
, l_stride
->value
.integer
);
417 if (r_stride
== NULL
)
418 mpz_set (X2
, no_of_elements
);
420 mpz_mul (X2
, no_of_elements
, r_stride
->value
.integer
);
422 if (l_stride
!= NULL
)
423 mpz_cdiv_q (X2
, X2
, r_stride
->value
.integer
);
424 mpz_add (X2
, X2
, X1
);
430 /* Determines overlapping for two array sections. */
432 static gfc_dependency
433 gfc_check_section_vs_section (gfc_ref
* lref
, gfc_ref
* rref
, int n
)
445 mpz_t no_of_elements
;
452 l_start
= l_ar
.start
[n
];
454 l_stride
= l_ar
.stride
[n
];
455 r_start
= r_ar
.start
[n
];
456 r_stride
= r_ar
.stride
[n
];
458 /* if l_start is NULL take it from array specifier */
459 if (NULL
== l_start
&& IS_ARRAY_EXPLICIT(l_ar
.as
))
460 l_start
= l_ar
.as
->lower
[n
];
462 /* if l_end is NULL take it from array specifier */
463 if (NULL
== l_end
&& IS_ARRAY_EXPLICIT(l_ar
.as
))
464 l_end
= l_ar
.as
->upper
[n
];
466 /* if r_start is NULL take it from array specifier */
467 if (NULL
== r_start
&& IS_ARRAY_EXPLICIT(r_ar
.as
))
468 r_start
= r_ar
.as
->lower
[n
];
472 mpz_init (no_of_elements
);
474 if (transform_sections (X1
, X2
, no_of_elements
,
475 l_start
, l_end
, l_stride
,
477 dep
= GFC_DEP_OVERLAP
;
479 dep
= get_deps (X1
, X2
, no_of_elements
);
481 mpz_clear (no_of_elements
);
488 /* Checks if the expr chk is inside the range left-right.
489 Returns GFC_DEP_NODEP if chk is outside the range,
490 GFC_DEP_OVERLAP otherwise.
491 Assumes left<=right. */
493 static gfc_dependency
494 gfc_is_inside_range (gfc_expr
* chk
, gfc_expr
* left
, gfc_expr
* right
)
500 s
= gfc_dep_compare_expr (left
, right
);
502 return GFC_DEP_OVERLAP
;
504 l
= gfc_dep_compare_expr (chk
, left
);
505 r
= gfc_dep_compare_expr (chk
, right
);
507 /* Check for indeterminate relationships. */
508 if (l
== -2 || r
== -2 || s
== -2)
509 return GFC_DEP_OVERLAP
;
513 /* When left>right we want to check for right <= chk <= left. */
514 if (l
<= 0 || r
>= 0)
515 return GFC_DEP_OVERLAP
;
519 /* Otherwise check for left <= chk <= right. */
520 if (l
>= 0 || r
<= 0)
521 return GFC_DEP_OVERLAP
;
524 return GFC_DEP_NODEP
;
528 /* Determines overlapping for a single element and a section. */
530 static gfc_dependency
531 gfc_check_element_vs_section( gfc_ref
* lref
, gfc_ref
* rref
, int n
)
541 l_start
= l_ar
.start
[n
] ;
542 r_start
= r_ar
.start
[n
] ;
543 r_end
= r_ar
.end
[n
] ;
544 if (NULL
== r_start
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
545 r_start
= r_ar
.as
->lower
[n
];
546 if (NULL
== r_end
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
547 r_end
= r_ar
.as
->upper
[n
];
548 if (NULL
== r_start
|| NULL
== r_end
|| l_start
== NULL
)
549 return GFC_DEP_OVERLAP
;
551 return gfc_is_inside_range (l_start
, r_end
, r_start
);
555 /* Determines overlapping for two single element array references. */
557 static gfc_dependency
558 gfc_check_element_vs_element (gfc_ref
* lref
, gfc_ref
* rref
, int n
)
564 gfc_dependency nIsDep
;
566 if (lref
->type
== REF_ARRAY
&& rref
->type
== REF_ARRAY
)
570 l_start
= l_ar
.start
[n
] ;
571 r_start
= r_ar
.start
[n
] ;
572 if (gfc_dep_compare_expr (r_start
, l_start
) == 0)
573 nIsDep
= GFC_DEP_EQUAL
;
575 nIsDep
= GFC_DEP_NODEP
;
578 nIsDep
= GFC_DEP_NODEP
;
584 /* Finds if two array references are overlapping or not.
586 1 : array references are overlapping.
587 0 : array references are not overlapping. */
590 gfc_dep_resolver (gfc_ref
* lref
, gfc_ref
* rref
)
593 gfc_dependency fin_dep
;
594 gfc_dependency this_dep
;
597 fin_dep
= GFC_DEP_ERROR
;
598 /* Dependencies due to pointers should already have been identified.
599 We only need to check for overlapping array references. */
603 /* We're resolving from the same base symbol, so both refs should be
604 the same type. We traverse the reference chain intil we find ranges
605 that are not equal. */
606 gcc_assert (lref
->type
== rref
->type
);
610 /* The two ranges can't overlap if they are from different
612 if (lref
->u
.c
.component
!= rref
->u
.c
.component
)
617 /* Substring overlaps are handled by the string assignment code. */
622 for (n
=0; n
< lref
->u
.ar
.dimen
; n
++)
624 /* Assume dependency when either of array reference is vector
626 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
627 || rref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
629 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
630 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
631 this_dep
= gfc_check_section_vs_section (lref
, rref
, n
);
632 else if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
633 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
634 this_dep
= gfc_check_element_vs_section (lref
, rref
, n
);
635 else if (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
636 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
637 this_dep
= gfc_check_element_vs_section (rref
, lref
, n
);
640 gcc_assert (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
641 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
);
642 this_dep
= gfc_check_element_vs_element (rref
, lref
, n
);
645 /* If any dimension doesn't overlap, we have no dependency. */
646 if (this_dep
== GFC_DEP_NODEP
)
649 /* Overlap codes are in order of priority. We only need to
650 know the worst one.*/
651 if (this_dep
> fin_dep
)
654 /* Exactly matching and forward overlapping ranges don't cause a
656 if (fin_dep
< GFC_DEP_OVERLAP
)
659 /* Keep checking. We only have a dependency if
660 subsequent references also overlap. */
670 /* If we haven't seen any array refs then something went wrong. */
671 gcc_assert (fin_dep
!= GFC_DEP_ERROR
);
673 if (fin_dep
< GFC_DEP_OVERLAP
)