2 Copyright (C) 2000, 2001, 2002 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"
33 /* static declarations */
35 enum range
{LHS
, RHS
, MID
};
37 /* Dependency types. These must be in reverse order of priority. */
41 GFC_DEP_EQUAL
, /* Identical Ranges. */
42 GFC_DEP_FORWARD
, /* eg. a(1:3), a(2:4). */
43 GFC_DEP_OVERLAP
, /* May overlap in some other way. */
44 GFC_DEP_NODEP
/* Distinct ranges. */
49 #define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
52 /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
53 def if the value could not be determined. */
56 gfc_expr_is_one (gfc_expr
* expr
, int def
)
58 assert (expr
!= NULL
);
60 if (expr
->expr_type
!= EXPR_CONSTANT
)
63 if (expr
->ts
.type
!= BT_INTEGER
)
66 return mpz_cmp_si (expr
->value
.integer
, 1) == 0;
70 /* Compare two values. Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2,
71 and -2 if the relationship could not be determined. */
74 gfc_dep_compare_expr (gfc_expr
* e1
, gfc_expr
* e2
)
78 if (e1
->expr_type
!= e2
->expr_type
)
81 switch (e1
->expr_type
)
84 if (e1
->ts
.type
!= BT_INTEGER
|| e2
->ts
.type
!= BT_INTEGER
)
87 i
= mpz_cmp (e1
->value
.integer
, e2
->value
.integer
);
95 if (e1
->ref
|| e2
->ref
)
97 if (e1
->symtree
->n
.sym
== e2
->symtree
->n
.sym
)
107 /* Returns 1 if the two ranges are the same, 0 if they are not, and def
108 if the results are indeterminate. N is the dimension to compare. */
111 gfc_is_same_range (gfc_array_ref
* ar1
, gfc_array_ref
* ar2
, int n
, int def
)
117 /* TODO: More sophisticated range comparison. */
120 assert (ar1
->dimen_type
[n
] == ar2
->dimen_type
[n
]);
124 /* Check for mismatching strides. A NULL stride means a stride of 1. */
127 i
= gfc_expr_is_one (e1
, -1);
135 i
= gfc_expr_is_one (e2
, -1);
143 i
= gfc_dep_compare_expr (e1
, e2
);
149 /* The strides match. */
151 /* Check the range start. */
158 /* Use the bound of the array if no bound is specified. */
160 e1
= ar1
->as
->lower
[n
];
163 e2
= ar2
->as
->upper
[n
];
165 /* Check we have values for both. */
169 i
= gfc_dep_compare_expr (e1
, e2
);
179 /* Dependency checking for direct function return by reference.
180 Returns true if the arguments of the function depend on the
181 destination. This is considerably less conservative than other
182 dependencies because many function arguments will already be
183 copied into a temporary. */
186 gfc_check_fncall_dependency (gfc_expr
* dest
, gfc_expr
* fncall
)
188 gfc_actual_arglist
*actual
;
193 assert (dest
->expr_type
== EXPR_VARIABLE
194 && fncall
->expr_type
== EXPR_FUNCTION
);
195 assert (fncall
->rank
> 0);
197 for (actual
= fncall
->value
.function
.actual
; actual
; actual
= actual
->next
)
201 /* Skip args which are not present. */
205 /* Non-variable expressions will be allocated temporaries anyway. */
206 switch (expr
->expr_type
)
211 /* This is an array section. */
212 for (ref
= expr
->ref
; ref
; ref
= ref
->next
)
214 if (ref
->type
== REF_ARRAY
&& ref
->u
.ar
.type
!= AR_ELEMENT
)
218 /* AR_FULL can't contain vector subscripts. */
219 if (ref
->u
.ar
.type
== AR_SECTION
)
221 for (n
= 0; n
< ref
->u
.ar
.dimen
; n
++)
223 if (ref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
226 /* Vector subscript array sections will be copied to a
228 if (n
!= ref
->u
.ar
.dimen
)
233 if (gfc_check_dependency (dest
, actual
->expr
, NULL
, 0))
238 if (gfc_check_dependency (dest
, expr
, NULL
, 0))
251 /* Return true if the statement body redefines the condition. Returns
252 true if expr2 depends on expr1. expr1 should be a single term
253 suitable for the lhs of an assignment. The symbols listed in VARS
254 must be considered to have all possible values. All other scalar
255 variables may be considered constant. Used for forall and where
256 statements. Also used with functions returning arrays without a
260 gfc_check_dependency (gfc_expr
* expr1
, gfc_expr
* expr2
, gfc_expr
** vars
,
265 gfc_actual_arglist
*actual
;
267 assert (expr1
->expr_type
== EXPR_VARIABLE
);
269 /* TODO: -fassume-no-pointer-aliasing */
270 if (expr1
->symtree
->n
.sym
->attr
.pointer
)
272 for (ref
= expr1
->ref
; ref
; ref
= ref
->next
)
274 if (ref
->type
== REF_COMPONENT
&& ref
->u
.c
.component
->pointer
)
278 switch (expr2
->expr_type
)
281 n
= gfc_check_dependency (expr1
, expr2
->op1
, vars
, nvars
);
285 return gfc_check_dependency (expr1
, expr2
->op2
, vars
, nvars
);
289 if (expr2
->symtree
->n
.sym
->attr
.pointer
)
292 for (ref
= expr2
->ref
; ref
; ref
= ref
->next
)
294 if (ref
->type
== REF_COMPONENT
&& ref
->u
.c
.component
->pointer
)
298 if (expr1
->symtree
->n
.sym
!= expr2
->symtree
->n
.sym
)
301 for (ref
= expr2
->ref
; ref
; ref
= ref
->next
)
303 /* Identical ranges return 0, overlapping ranges return 1. */
304 if (ref
->type
== REF_ARRAY
)
310 /* Remember possible differences betweeen elemental and
311 transformational functions. All functions inside a FORALL
313 for (actual
= expr2
->value
.function
.actual
;
314 actual
; actual
= actual
->next
)
318 n
= gfc_check_dependency (expr1
, actual
->expr
, vars
, nvars
);
328 /* Probably ok in the majority of (constant) cases. */
337 /* Calculates size of the array reference using lower bound, upper bound
341 get_no_of_elements(mpz_t ele
, gfc_expr
* u1
, gfc_expr
* l1
, gfc_expr
* s1
)
343 /* nNoOfEle = (u1-l1)/s1 */
345 mpz_sub (ele
, u1
->value
.integer
, l1
->value
.integer
);
348 mpz_tdiv_q (ele
, ele
, s1
->value
.integer
);
352 /* Returns if the ranges ((0..Y), (X1..X2)) overlap. */
354 static gfc_dependency
355 get_deps (mpz_t x1
, mpz_t x2
, mpz_t y
)
360 start
= mpz_cmp_ui (x1
, 0);
361 end
= mpz_cmp (x2
, y
);
363 /* Both ranges the same. */
364 if (start
== 0 && end
== 0)
365 return GFC_DEP_EQUAL
;
367 /* Distinct ranges. */
368 if ((start
< 0 && mpz_cmp_ui (x2
, 0) < 0)
369 || (mpz_cmp (x1
, y
) > 0 && end
> 0))
370 return GFC_DEP_NODEP
;
372 /* Overlapping, but with corresponding elements of the second range
373 greater than the first. */
374 if (start
> 0 && end
> 0)
375 return GFC_DEP_FORWARD
;
377 /* Overlapping in some other way. */
378 return GFC_DEP_OVERLAP
;
382 /* Transforms a sections l and r such that
383 (l_start:l_end:l_stride) -> (0:no_of_elements)
384 (r_start:r_end:r_stride) -> (X1:X2)
385 Where r_end is implicit as both sections must have the same number of
387 Returns 0 on success, 1 of the transformation failed. */
388 /* TODO: Should this be (0:no_of_elements-1) */
391 transform_sections (mpz_t X1
, mpz_t X2
, mpz_t no_of_elements
,
392 gfc_expr
* l_start
, gfc_expr
* l_end
, gfc_expr
* l_stride
,
393 gfc_expr
* r_start
, gfc_expr
* r_stride
)
395 if (NULL
== l_start
|| NULL
== l_end
|| NULL
== r_start
)
398 /* TODO : Currently we check the dependency only when start, end and stride
399 are constant. We could also check for equal (variable) values, and
400 common subexpressions, eg. x vs. x+1. */
402 if (l_end
->expr_type
!= EXPR_CONSTANT
403 || l_start
->expr_type
!= EXPR_CONSTANT
404 || r_start
->expr_type
!= EXPR_CONSTANT
405 || ((NULL
!= l_stride
) && (l_stride
->expr_type
!= EXPR_CONSTANT
))
406 || ((NULL
!= r_stride
) && (r_stride
->expr_type
!= EXPR_CONSTANT
)))
412 get_no_of_elements (no_of_elements
, l_end
, l_start
, l_stride
);
414 mpz_sub (X1
, r_start
->value
.integer
, l_start
->value
.integer
);
415 if (l_stride
!= NULL
)
416 mpz_cdiv_q (X1
, X1
, l_stride
->value
.integer
);
418 if (r_stride
== NULL
)
419 mpz_set (X2
, no_of_elements
);
421 mpz_mul (X2
, no_of_elements
, r_stride
->value
.integer
);
423 if (l_stride
!= NULL
)
424 mpz_cdiv_q (X2
, X2
, r_stride
->value
.integer
);
425 mpz_add (X2
, X2
, X1
);
431 /* Determines overlapping for two array sections. */
433 static gfc_dependency
434 gfc_check_section_vs_section (gfc_ref
* lref
, gfc_ref
* rref
, int n
)
446 mpz_t no_of_elements
;
453 l_start
= l_ar
.start
[n
];
455 l_stride
= l_ar
.stride
[n
];
456 r_start
= r_ar
.start
[n
];
457 r_stride
= r_ar
.stride
[n
];
459 /* if l_start is NULL take it from array specifier */
460 if (NULL
== l_start
&& IS_ARRAY_EXPLICIT(l_ar
.as
))
461 l_start
= l_ar
.as
->lower
[n
];
463 /* if l_end is NULL take it from array specifier */
464 if (NULL
== l_end
&& IS_ARRAY_EXPLICIT(l_ar
.as
))
465 l_end
= l_ar
.as
->upper
[n
];
467 /* if r_start is NULL take it from array specifier */
468 if (NULL
== r_start
&& IS_ARRAY_EXPLICIT(r_ar
.as
))
469 r_start
= r_ar
.as
->lower
[n
];
473 mpz_init (no_of_elements
);
475 if (transform_sections (X1
, X2
, no_of_elements
,
476 l_start
, l_end
, l_stride
,
478 dep
= GFC_DEP_OVERLAP
;
480 dep
= get_deps (X1
, X2
, no_of_elements
);
482 mpz_clear (no_of_elements
);
489 /* Checks if the expr chk is inside the range left-right.
490 Returns GFC_DEP_NODEP if chk is outside the range,
491 GFC_DEP_OVERLAP otherwise.
492 Assumes left<=right. */
494 static gfc_dependency
495 gfc_is_inside_range (gfc_expr
* chk
, gfc_expr
* left
, gfc_expr
* right
)
501 s
= gfc_dep_compare_expr (left
, right
);
503 return GFC_DEP_OVERLAP
;
505 l
= gfc_dep_compare_expr (chk
, left
);
506 r
= gfc_dep_compare_expr (chk
, right
);
508 /* Check for indeterminate relationships. */
509 if (l
== -2 || r
== -2 || s
== -2)
510 return GFC_DEP_OVERLAP
;
514 /* When left>right we want to check for right <= chk <= left. */
515 if (l
<= 0 || r
>= 0)
516 return GFC_DEP_OVERLAP
;
520 /* Otherwise check for left <= chk <= right. */
521 if (l
>= 0 || r
<= 0)
522 return GFC_DEP_OVERLAP
;
525 return GFC_DEP_NODEP
;
529 /* Determines overlapping for a single element and a section. */
531 static gfc_dependency
532 gfc_check_element_vs_section( gfc_ref
* lref
, gfc_ref
* rref
, int n
)
542 l_start
= l_ar
.start
[n
] ;
543 r_start
= r_ar
.start
[n
] ;
544 r_end
= r_ar
.end
[n
] ;
545 if (NULL
== r_start
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
546 r_start
= r_ar
.as
->lower
[n
];
547 if (NULL
== r_end
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
548 r_end
= r_ar
.as
->upper
[n
];
549 if (NULL
== r_start
|| NULL
== r_end
|| l_start
== NULL
)
550 return GFC_DEP_OVERLAP
;
552 return gfc_is_inside_range (l_start
, r_end
, r_start
);
556 /* Determines overlapping for two single element array references. */
558 static gfc_dependency
559 gfc_check_element_vs_element (gfc_ref
* lref
, gfc_ref
* rref
, int n
)
565 gfc_dependency nIsDep
;
567 if (lref
->type
== REF_ARRAY
&& rref
->type
== REF_ARRAY
)
571 l_start
= l_ar
.start
[n
] ;
572 r_start
= r_ar
.start
[n
] ;
573 if (gfc_dep_compare_expr (r_start
, l_start
) == 0)
574 nIsDep
= GFC_DEP_EQUAL
;
576 nIsDep
= GFC_DEP_NODEP
;
579 nIsDep
= GFC_DEP_NODEP
;
585 /* Finds if two array references are overlapping or not.
587 1 : array references are overlapping.
588 0 : array references are not overlapping. */
591 gfc_dep_resolver (gfc_ref
* lref
, gfc_ref
* rref
)
594 gfc_dependency fin_dep
;
595 gfc_dependency this_dep
;
598 fin_dep
= GFC_DEP_ERROR
;
599 /* Dependencies due to pointers should already have been identified.
600 We only need to check for overlapping array references. */
604 /* We're resolving from the same base symbol, so both refs should be
605 the same type. We traverse the reference chain intil we find ranges
606 that are not equal. */
607 assert (lref
->type
== rref
->type
);
611 /* The two ranges can't overlap if they are from different
613 if (lref
->u
.c
.component
!= rref
->u
.c
.component
)
618 /* Substring overlaps are handled by the string assignment code. */
623 for (n
=0; n
< lref
->u
.ar
.dimen
; n
++)
625 /* Assume dependency when either of array reference is vector
627 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
628 || rref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
630 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
631 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
632 this_dep
= gfc_check_section_vs_section (lref
, rref
, n
);
633 else if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
634 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
635 this_dep
= gfc_check_element_vs_section (lref
, rref
, n
);
636 else if (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
637 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
638 this_dep
= gfc_check_element_vs_section (rref
, lref
, n
);
641 assert (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
642 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
);
643 this_dep
= gfc_check_element_vs_element (rref
, lref
, n
);
646 /* If any dimension doesn't overlap, we have no dependency. */
647 if (this_dep
== GFC_DEP_NODEP
)
650 /* Overlap codes are in order of priority. We only need to
651 know the worst one.*/
652 if (this_dep
> fin_dep
)
655 /* Exactly matching and forward overlapping ranges don't cause a
657 if (fin_dep
< GFC_DEP_OVERLAP
)
660 /* Keep checking. We only have a dependency if
661 subsequent references also overlap. */
671 /* If we haven't seen any array refs then something went wrong. */
672 assert (fin_dep
!= GFC_DEP_ERROR
);
674 if (fin_dep
< GFC_DEP_OVERLAP
)