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 /* Return true if the result of reference REF can only be constructed
179 using a temporary array. */
182 gfc_ref_needs_temporary_p (gfc_ref
*ref
)
188 for (; ref
; ref
= ref
->next
)
192 /* Vector dimensions are generally not monotonic and must be
193 handled using a temporary. */
194 if (ref
->u
.ar
.type
== AR_SECTION
)
195 for (n
= 0; n
< ref
->u
.ar
.dimen
; n
++)
196 if (ref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
203 /* Within an array reference, character substrings generally
204 need a temporary. Character array strides are expressed as
205 multiples of the element size (consistent with other array
206 types), not in characters. */
217 /* Dependency checking for direct function return by reference.
218 Returns true if the arguments of the function depend on the
219 destination. This is considerably less conservative than other
220 dependencies because many function arguments will already be
221 copied into a temporary. */
224 gfc_check_fncall_dependency (gfc_expr
* dest
, gfc_expr
* fncall
)
226 gfc_actual_arglist
*actual
;
229 gcc_assert (dest
->expr_type
== EXPR_VARIABLE
230 && fncall
->expr_type
== EXPR_FUNCTION
);
231 gcc_assert (fncall
->rank
> 0);
233 for (actual
= fncall
->value
.function
.actual
; actual
; actual
= actual
->next
)
237 /* Skip args which are not present. */
241 /* Non-variable expressions will be allocated temporaries anyway. */
242 switch (expr
->expr_type
)
245 if (!gfc_ref_needs_temporary_p (expr
->ref
)
246 && gfc_check_dependency (dest
, expr
, NULL
, 0))
251 if (gfc_check_dependency (dest
, expr
, NULL
, 0))
264 /* Return true if the statement body redefines the condition. Returns
265 true if expr2 depends on expr1. expr1 should be a single term
266 suitable for the lhs of an assignment. The symbols listed in VARS
267 must be considered to have all possible values. All other scalar
268 variables may be considered constant. Used for forall and where
269 statements. Also used with functions returning arrays without a
273 gfc_check_dependency (gfc_expr
* expr1
, gfc_expr
* expr2
, gfc_expr
** vars
,
278 gfc_actual_arglist
*actual
;
280 gcc_assert (expr1
->expr_type
== EXPR_VARIABLE
);
282 /* TODO: -fassume-no-pointer-aliasing */
283 if (expr1
->symtree
->n
.sym
->attr
.pointer
)
285 for (ref
= expr1
->ref
; ref
; ref
= ref
->next
)
287 if (ref
->type
== REF_COMPONENT
&& ref
->u
.c
.component
->pointer
)
291 switch (expr2
->expr_type
)
294 n
= gfc_check_dependency (expr1
, expr2
->value
.op
.op1
, vars
, nvars
);
297 if (expr2
->value
.op
.op2
)
298 return gfc_check_dependency (expr1
, expr2
->value
.op
.op2
, vars
, nvars
);
302 if (expr2
->symtree
->n
.sym
->attr
.pointer
)
305 for (ref
= expr2
->ref
; ref
; ref
= ref
->next
)
307 if (ref
->type
== REF_COMPONENT
&& ref
->u
.c
.component
->pointer
)
311 if (expr1
->symtree
->n
.sym
!= expr2
->symtree
->n
.sym
)
314 for (ref
= expr2
->ref
; ref
; ref
= ref
->next
)
316 /* Identical ranges return 0, overlapping ranges return 1. */
317 if (ref
->type
== REF_ARRAY
)
323 /* Remember possible differences between elemental and
324 transformational functions. All functions inside a FORALL
326 for (actual
= expr2
->value
.function
.actual
;
327 actual
; actual
= actual
->next
)
331 n
= gfc_check_dependency (expr1
, actual
->expr
, vars
, nvars
);
341 /* Probably ok in the majority of (constant) cases. */
350 /* Calculates size of the array reference using lower bound, upper bound
354 get_no_of_elements(mpz_t ele
, gfc_expr
* u1
, gfc_expr
* l1
, gfc_expr
* s1
)
356 /* nNoOfEle = (u1-l1)/s1 */
358 mpz_sub (ele
, u1
->value
.integer
, l1
->value
.integer
);
361 mpz_tdiv_q (ele
, ele
, s1
->value
.integer
);
365 /* Returns if the ranges ((0..Y), (X1..X2)) overlap. */
367 static gfc_dependency
368 get_deps (mpz_t x1
, mpz_t x2
, mpz_t y
)
373 start
= mpz_cmp_ui (x1
, 0);
374 end
= mpz_cmp (x2
, y
);
376 /* Both ranges the same. */
377 if (start
== 0 && end
== 0)
378 return GFC_DEP_EQUAL
;
380 /* Distinct ranges. */
381 if ((start
< 0 && mpz_cmp_ui (x2
, 0) < 0)
382 || (mpz_cmp (x1
, y
) > 0 && end
> 0))
383 return GFC_DEP_NODEP
;
385 /* Overlapping, but with corresponding elements of the second range
386 greater than the first. */
387 if (start
> 0 && end
> 0)
388 return GFC_DEP_FORWARD
;
390 /* Overlapping in some other way. */
391 return GFC_DEP_OVERLAP
;
395 /* Perform the same linear transformation on sections l and r such that
396 (l_start:l_end:l_stride) -> (0:no_of_elements)
397 (r_start:r_end:r_stride) -> (X1:X2)
398 Where r_end is implicit as both sections must have the same number of
400 Returns 0 on success, 1 of the transformation failed. */
401 /* TODO: Should this be (0:no_of_elements-1) */
404 transform_sections (mpz_t X1
, mpz_t X2
, mpz_t no_of_elements
,
405 gfc_expr
* l_start
, gfc_expr
* l_end
, gfc_expr
* l_stride
,
406 gfc_expr
* r_start
, gfc_expr
* r_stride
)
408 if (NULL
== l_start
|| NULL
== l_end
|| NULL
== r_start
)
411 /* TODO : Currently we check the dependency only when start, end and stride
412 are constant. We could also check for equal (variable) values, and
413 common subexpressions, eg. x vs. x+1. */
415 if (l_end
->expr_type
!= EXPR_CONSTANT
416 || l_start
->expr_type
!= EXPR_CONSTANT
417 || r_start
->expr_type
!= EXPR_CONSTANT
418 || ((NULL
!= l_stride
) && (l_stride
->expr_type
!= EXPR_CONSTANT
))
419 || ((NULL
!= r_stride
) && (r_stride
->expr_type
!= EXPR_CONSTANT
)))
425 get_no_of_elements (no_of_elements
, l_end
, l_start
, l_stride
);
427 mpz_sub (X1
, r_start
->value
.integer
, l_start
->value
.integer
);
428 if (l_stride
!= NULL
)
429 mpz_cdiv_q (X1
, X1
, l_stride
->value
.integer
);
431 if (r_stride
== NULL
)
432 mpz_set (X2
, no_of_elements
);
434 mpz_mul (X2
, no_of_elements
, r_stride
->value
.integer
);
436 if (l_stride
!= NULL
)
437 mpz_cdiv_q (X2
, X2
, l_stride
->value
.integer
);
438 mpz_add (X2
, X2
, X1
);
444 /* Determines overlapping for two array sections. */
446 static gfc_dependency
447 gfc_check_section_vs_section (gfc_ref
* lref
, gfc_ref
* rref
, int n
)
459 mpz_t no_of_elements
;
466 l_start
= l_ar
.start
[n
];
468 l_stride
= l_ar
.stride
[n
];
469 r_start
= r_ar
.start
[n
];
470 r_stride
= r_ar
.stride
[n
];
472 /* if l_start is NULL take it from array specifier */
473 if (NULL
== l_start
&& IS_ARRAY_EXPLICIT(l_ar
.as
))
474 l_start
= l_ar
.as
->lower
[n
];
476 /* if l_end is NULL take it from array specifier */
477 if (NULL
== l_end
&& IS_ARRAY_EXPLICIT(l_ar
.as
))
478 l_end
= l_ar
.as
->upper
[n
];
480 /* if r_start is NULL take it from array specifier */
481 if (NULL
== r_start
&& IS_ARRAY_EXPLICIT(r_ar
.as
))
482 r_start
= r_ar
.as
->lower
[n
];
486 mpz_init (no_of_elements
);
488 if (transform_sections (X1
, X2
, no_of_elements
,
489 l_start
, l_end
, l_stride
,
491 dep
= GFC_DEP_OVERLAP
;
493 dep
= get_deps (X1
, X2
, no_of_elements
);
495 mpz_clear (no_of_elements
);
502 /* Checks if the expr chk is inside the range left-right.
503 Returns GFC_DEP_NODEP if chk is outside the range,
504 GFC_DEP_OVERLAP otherwise.
505 Assumes left<=right. */
507 static gfc_dependency
508 gfc_is_inside_range (gfc_expr
* chk
, gfc_expr
* left
, gfc_expr
* right
)
514 s
= gfc_dep_compare_expr (left
, right
);
516 return GFC_DEP_OVERLAP
;
518 l
= gfc_dep_compare_expr (chk
, left
);
519 r
= gfc_dep_compare_expr (chk
, right
);
521 /* Check for indeterminate relationships. */
522 if (l
== -2 || r
== -2 || s
== -2)
523 return GFC_DEP_OVERLAP
;
527 /* When left>right we want to check for right <= chk <= left. */
528 if (l
<= 0 || r
>= 0)
529 return GFC_DEP_OVERLAP
;
533 /* Otherwise check for left <= chk <= right. */
534 if (l
>= 0 || r
<= 0)
535 return GFC_DEP_OVERLAP
;
538 return GFC_DEP_NODEP
;
542 /* Determines overlapping for a single element and a section. */
544 static gfc_dependency
545 gfc_check_element_vs_section( gfc_ref
* lref
, gfc_ref
* rref
, int n
)
555 l_start
= l_ar
.start
[n
] ;
556 r_start
= r_ar
.start
[n
] ;
557 r_end
= r_ar
.end
[n
] ;
558 if (NULL
== r_start
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
559 r_start
= r_ar
.as
->lower
[n
];
560 if (NULL
== r_end
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
561 r_end
= r_ar
.as
->upper
[n
];
562 if (NULL
== r_start
|| NULL
== r_end
|| l_start
== NULL
)
563 return GFC_DEP_OVERLAP
;
565 return gfc_is_inside_range (l_start
, r_end
, r_start
);
569 /* Determines overlapping for two single element array references. */
571 static gfc_dependency
572 gfc_check_element_vs_element (gfc_ref
* lref
, gfc_ref
* rref
, int n
)
578 gfc_dependency nIsDep
;
580 if (lref
->type
== REF_ARRAY
&& rref
->type
== REF_ARRAY
)
584 l_start
= l_ar
.start
[n
] ;
585 r_start
= r_ar
.start
[n
] ;
586 if (gfc_dep_compare_expr (r_start
, l_start
) == 0)
587 nIsDep
= GFC_DEP_EQUAL
;
589 nIsDep
= GFC_DEP_NODEP
;
592 nIsDep
= GFC_DEP_NODEP
;
598 /* Finds if two array references are overlapping or not.
600 1 : array references are overlapping.
601 0 : array references are not overlapping. */
604 gfc_dep_resolver (gfc_ref
* lref
, gfc_ref
* rref
)
607 gfc_dependency fin_dep
;
608 gfc_dependency this_dep
;
611 fin_dep
= GFC_DEP_ERROR
;
612 /* Dependencies due to pointers should already have been identified.
613 We only need to check for overlapping array references. */
617 /* We're resolving from the same base symbol, so both refs should be
618 the same type. We traverse the reference chain intil we find ranges
619 that are not equal. */
620 gcc_assert (lref
->type
== rref
->type
);
624 /* The two ranges can't overlap if they are from different
626 if (lref
->u
.c
.component
!= rref
->u
.c
.component
)
631 /* Substring overlaps are handled by the string assignment code. */
636 for (n
=0; n
< lref
->u
.ar
.dimen
; n
++)
638 /* Assume dependency when either of array reference is vector
640 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
641 || rref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
643 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
644 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
645 this_dep
= gfc_check_section_vs_section (lref
, rref
, n
);
646 else if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
647 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
648 this_dep
= gfc_check_element_vs_section (lref
, rref
, n
);
649 else if (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
650 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
651 this_dep
= gfc_check_element_vs_section (rref
, lref
, n
);
654 gcc_assert (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
655 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
);
656 this_dep
= gfc_check_element_vs_element (rref
, lref
, n
);
659 /* If any dimension doesn't overlap, we have no dependency. */
660 if (this_dep
== GFC_DEP_NODEP
)
663 /* Overlap codes are in order of priority. We only need to
664 know the worst one.*/
665 if (this_dep
> fin_dep
)
668 /* Exactly matching and forward overlapping ranges don't cause a
670 if (fin_dep
< GFC_DEP_OVERLAP
)
673 /* Keep checking. We only have a dependency if
674 subsequent references also overlap. */
684 /* If we haven't seen any array refs then something went wrong. */
685 gcc_assert (fin_dep
!= GFC_DEP_ERROR
);
687 if (fin_dep
< GFC_DEP_OVERLAP
)