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 /* Some array-returning intrinsics can be implemented by reusing the
179 data from one of the array arguments. For example, TRANSPOSE does
180 not necessarily need to allocate new data: it can be implemented
181 by copying the original array's descriptor and simply swapping the
182 two dimension specifications.
184 If EXPR is a call to such an intrinsic, return the argument
185 whose data can be reused, otherwise return NULL. */
188 gfc_get_noncopying_intrinsic_argument (gfc_expr
* expr
)
190 if (expr
->expr_type
!= EXPR_FUNCTION
|| !expr
->value
.function
.isym
)
193 switch (expr
->value
.function
.isym
->generic_id
)
195 case GFC_ISYM_TRANSPOSE
:
196 return expr
->value
.function
.actual
->expr
;
204 /* Return true if the result of reference REF can only be constructed
205 using a temporary array. */
208 gfc_ref_needs_temporary_p (gfc_ref
*ref
)
214 for (; ref
; ref
= ref
->next
)
218 /* Vector dimensions are generally not monotonic and must be
219 handled using a temporary. */
220 if (ref
->u
.ar
.type
== AR_SECTION
)
221 for (n
= 0; n
< ref
->u
.ar
.dimen
; n
++)
222 if (ref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
229 /* Within an array reference, character substrings generally
230 need a temporary. Character array strides are expressed as
231 multiples of the element size (consistent with other array
232 types), not in characters. */
243 /* Return true if array variable VAR could be passed to the same function
244 as argument EXPR without interfering with EXPR. INTENT is the intent
247 This is considerably less conservative than other dependencies
248 because many function arguments will already be copied into a
252 gfc_check_argument_var_dependency (gfc_expr
* var
, sym_intent intent
,
255 gcc_assert (var
->expr_type
== EXPR_VARIABLE
);
256 gcc_assert (var
->rank
> 0);
258 switch (expr
->expr_type
)
261 return (gfc_ref_needs_temporary_p (expr
->ref
)
262 || gfc_check_dependency (var
, expr
, NULL
, 0));
265 return gfc_check_dependency (var
, expr
, NULL
, 0);
268 if (intent
!= INTENT_IN
&& expr
->inline_noncopying_intrinsic
)
270 expr
= gfc_get_noncopying_intrinsic_argument (expr
);
271 return gfc_check_argument_var_dependency (var
, intent
, expr
);
281 /* Like gfc_check_argument_var_dependency, but extended to any
282 array expression OTHER, not just variables. */
285 gfc_check_argument_dependency (gfc_expr
* other
, sym_intent intent
,
288 switch (other
->expr_type
)
291 return gfc_check_argument_var_dependency (other
, intent
, expr
);
294 if (other
->inline_noncopying_intrinsic
)
296 other
= gfc_get_noncopying_intrinsic_argument (other
);
297 return gfc_check_argument_dependency (other
, INTENT_IN
, expr
);
307 /* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
308 FNSYM is the function being called, or NULL if not known. */
311 gfc_check_fncall_dependency (gfc_expr
* other
, sym_intent intent
,
312 gfc_symbol
* fnsym
, gfc_actual_arglist
* actual
)
314 gfc_formal_arglist
*formal
;
317 formal
= fnsym
? fnsym
->formal
: NULL
;
318 for (; actual
; actual
= actual
->next
, formal
= formal
? formal
->next
: NULL
)
322 /* Skip args which are not present. */
326 /* Skip intent(in) arguments if OTHER itself is intent(in). */
328 && intent
== INTENT_IN
329 && formal
->sym
->attr
.intent
== INTENT_IN
)
332 if (gfc_check_argument_dependency (other
, intent
, expr
))
340 /* Return true if the statement body redefines the condition. Returns
341 true if expr2 depends on expr1. expr1 should be a single term
342 suitable for the lhs of an assignment. The symbols listed in VARS
343 must be considered to have all possible values. All other scalar
344 variables may be considered constant. Used for forall and where
345 statements. Also used with functions returning arrays without a
349 gfc_check_dependency (gfc_expr
* expr1
, gfc_expr
* expr2
, gfc_expr
** vars
,
354 gfc_actual_arglist
*actual
;
356 gcc_assert (expr1
->expr_type
== EXPR_VARIABLE
);
358 /* TODO: -fassume-no-pointer-aliasing */
359 if (expr1
->symtree
->n
.sym
->attr
.pointer
)
361 for (ref
= expr1
->ref
; ref
; ref
= ref
->next
)
363 if (ref
->type
== REF_COMPONENT
&& ref
->u
.c
.component
->pointer
)
367 switch (expr2
->expr_type
)
370 n
= gfc_check_dependency (expr1
, expr2
->value
.op
.op1
, vars
, nvars
);
373 if (expr2
->value
.op
.op2
)
374 return gfc_check_dependency (expr1
, expr2
->value
.op
.op2
, vars
, nvars
);
378 if (expr2
->symtree
->n
.sym
->attr
.pointer
)
381 for (ref
= expr2
->ref
; ref
; ref
= ref
->next
)
383 if (ref
->type
== REF_COMPONENT
&& ref
->u
.c
.component
->pointer
)
387 if (expr1
->symtree
->n
.sym
!= expr2
->symtree
->n
.sym
)
390 for (ref
= expr2
->ref
; ref
; ref
= ref
->next
)
392 /* Identical ranges return 0, overlapping ranges return 1. */
393 if (ref
->type
== REF_ARRAY
)
399 /* Remember possible differences between elemental and
400 transformational functions. All functions inside a FORALL
402 for (actual
= expr2
->value
.function
.actual
;
403 actual
; actual
= actual
->next
)
407 n
= gfc_check_dependency (expr1
, actual
->expr
, vars
, nvars
);
417 /* Probably ok in the majority of (constant) cases. */
426 /* Calculates size of the array reference using lower bound, upper bound
430 get_no_of_elements(mpz_t ele
, gfc_expr
* u1
, gfc_expr
* l1
, gfc_expr
* s1
)
432 /* nNoOfEle = (u1-l1)/s1 */
434 mpz_sub (ele
, u1
->value
.integer
, l1
->value
.integer
);
437 mpz_tdiv_q (ele
, ele
, s1
->value
.integer
);
441 /* Returns if the ranges ((0..Y), (X1..X2)) overlap. */
443 static gfc_dependency
444 get_deps (mpz_t x1
, mpz_t x2
, mpz_t y
)
449 start
= mpz_cmp_ui (x1
, 0);
450 end
= mpz_cmp (x2
, y
);
452 /* Both ranges the same. */
453 if (start
== 0 && end
== 0)
454 return GFC_DEP_EQUAL
;
456 /* Distinct ranges. */
457 if ((start
< 0 && mpz_cmp_ui (x2
, 0) < 0)
458 || (mpz_cmp (x1
, y
) > 0 && end
> 0))
459 return GFC_DEP_NODEP
;
461 /* Overlapping, but with corresponding elements of the second range
462 greater than the first. */
463 if (start
> 0 && end
> 0)
464 return GFC_DEP_FORWARD
;
466 /* Overlapping in some other way. */
467 return GFC_DEP_OVERLAP
;
471 /* Perform the same linear transformation on sections l and r such that
472 (l_start:l_end:l_stride) -> (0:no_of_elements)
473 (r_start:r_end:r_stride) -> (X1:X2)
474 Where r_end is implicit as both sections must have the same number of
476 Returns 0 on success, 1 of the transformation failed. */
477 /* TODO: Should this be (0:no_of_elements-1) */
480 transform_sections (mpz_t X1
, mpz_t X2
, mpz_t no_of_elements
,
481 gfc_expr
* l_start
, gfc_expr
* l_end
, gfc_expr
* l_stride
,
482 gfc_expr
* r_start
, gfc_expr
* r_stride
)
484 if (NULL
== l_start
|| NULL
== l_end
|| NULL
== r_start
)
487 /* TODO : Currently we check the dependency only when start, end and stride
488 are constant. We could also check for equal (variable) values, and
489 common subexpressions, eg. x vs. x+1. */
491 if (l_end
->expr_type
!= EXPR_CONSTANT
492 || l_start
->expr_type
!= EXPR_CONSTANT
493 || r_start
->expr_type
!= EXPR_CONSTANT
494 || ((NULL
!= l_stride
) && (l_stride
->expr_type
!= EXPR_CONSTANT
))
495 || ((NULL
!= r_stride
) && (r_stride
->expr_type
!= EXPR_CONSTANT
)))
501 get_no_of_elements (no_of_elements
, l_end
, l_start
, l_stride
);
503 mpz_sub (X1
, r_start
->value
.integer
, l_start
->value
.integer
);
504 if (l_stride
!= NULL
)
505 mpz_cdiv_q (X1
, X1
, l_stride
->value
.integer
);
507 if (r_stride
== NULL
)
508 mpz_set (X2
, no_of_elements
);
510 mpz_mul (X2
, no_of_elements
, r_stride
->value
.integer
);
512 if (l_stride
!= NULL
)
513 mpz_cdiv_q (X2
, X2
, l_stride
->value
.integer
);
514 mpz_add (X2
, X2
, X1
);
520 /* Determines overlapping for two array sections. */
522 static gfc_dependency
523 gfc_check_section_vs_section (gfc_ref
* lref
, gfc_ref
* rref
, int n
)
535 mpz_t no_of_elements
;
542 l_start
= l_ar
.start
[n
];
544 l_stride
= l_ar
.stride
[n
];
545 r_start
= r_ar
.start
[n
];
546 r_stride
= r_ar
.stride
[n
];
548 /* if l_start is NULL take it from array specifier */
549 if (NULL
== l_start
&& IS_ARRAY_EXPLICIT(l_ar
.as
))
550 l_start
= l_ar
.as
->lower
[n
];
552 /* if l_end is NULL take it from array specifier */
553 if (NULL
== l_end
&& IS_ARRAY_EXPLICIT(l_ar
.as
))
554 l_end
= l_ar
.as
->upper
[n
];
556 /* if r_start is NULL take it from array specifier */
557 if (NULL
== r_start
&& IS_ARRAY_EXPLICIT(r_ar
.as
))
558 r_start
= r_ar
.as
->lower
[n
];
562 mpz_init (no_of_elements
);
564 if (transform_sections (X1
, X2
, no_of_elements
,
565 l_start
, l_end
, l_stride
,
567 dep
= GFC_DEP_OVERLAP
;
569 dep
= get_deps (X1
, X2
, no_of_elements
);
571 mpz_clear (no_of_elements
);
578 /* Checks if the expr chk is inside the range left-right.
579 Returns GFC_DEP_NODEP if chk is outside the range,
580 GFC_DEP_OVERLAP otherwise.
581 Assumes left<=right. */
583 static gfc_dependency
584 gfc_is_inside_range (gfc_expr
* chk
, gfc_expr
* left
, gfc_expr
* right
)
590 s
= gfc_dep_compare_expr (left
, right
);
592 return GFC_DEP_OVERLAP
;
594 l
= gfc_dep_compare_expr (chk
, left
);
595 r
= gfc_dep_compare_expr (chk
, right
);
597 /* Check for indeterminate relationships. */
598 if (l
== -2 || r
== -2 || s
== -2)
599 return GFC_DEP_OVERLAP
;
603 /* When left>right we want to check for right <= chk <= left. */
604 if (l
<= 0 || r
>= 0)
605 return GFC_DEP_OVERLAP
;
609 /* Otherwise check for left <= chk <= right. */
610 if (l
>= 0 || r
<= 0)
611 return GFC_DEP_OVERLAP
;
614 return GFC_DEP_NODEP
;
618 /* Determines overlapping for a single element and a section. */
620 static gfc_dependency
621 gfc_check_element_vs_section( gfc_ref
* lref
, gfc_ref
* rref
, int n
)
631 l_start
= l_ar
.start
[n
] ;
632 r_start
= r_ar
.start
[n
] ;
633 r_end
= r_ar
.end
[n
] ;
634 if (NULL
== r_start
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
635 r_start
= r_ar
.as
->lower
[n
];
636 if (NULL
== r_end
&& IS_ARRAY_EXPLICIT (r_ar
.as
))
637 r_end
= r_ar
.as
->upper
[n
];
638 if (NULL
== r_start
|| NULL
== r_end
|| l_start
== NULL
)
639 return GFC_DEP_OVERLAP
;
641 return gfc_is_inside_range (l_start
, r_end
, r_start
);
645 /* Determines overlapping for two single element array references. */
647 static gfc_dependency
648 gfc_check_element_vs_element (gfc_ref
* lref
, gfc_ref
* rref
, int n
)
654 gfc_dependency nIsDep
;
656 if (lref
->type
== REF_ARRAY
&& rref
->type
== REF_ARRAY
)
660 l_start
= l_ar
.start
[n
] ;
661 r_start
= r_ar
.start
[n
] ;
662 if (gfc_dep_compare_expr (r_start
, l_start
) == 0)
663 nIsDep
= GFC_DEP_EQUAL
;
665 nIsDep
= GFC_DEP_NODEP
;
668 nIsDep
= GFC_DEP_NODEP
;
674 /* Finds if two array references are overlapping or not.
676 1 : array references are overlapping.
677 0 : array references are not overlapping. */
680 gfc_dep_resolver (gfc_ref
* lref
, gfc_ref
* rref
)
683 gfc_dependency fin_dep
;
684 gfc_dependency this_dep
;
687 fin_dep
= GFC_DEP_ERROR
;
688 /* Dependencies due to pointers should already have been identified.
689 We only need to check for overlapping array references. */
693 /* We're resolving from the same base symbol, so both refs should be
694 the same type. We traverse the reference chain intil we find ranges
695 that are not equal. */
696 gcc_assert (lref
->type
== rref
->type
);
700 /* The two ranges can't overlap if they are from different
702 if (lref
->u
.c
.component
!= rref
->u
.c
.component
)
707 /* Substring overlaps are handled by the string assignment code. */
712 for (n
=0; n
< lref
->u
.ar
.dimen
; n
++)
714 /* Assume dependency when either of array reference is vector
716 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
717 || rref
->u
.ar
.dimen_type
[n
] == DIMEN_VECTOR
)
719 if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
720 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
721 this_dep
= gfc_check_section_vs_section (lref
, rref
, n
);
722 else if (lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
723 && rref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
724 this_dep
= gfc_check_element_vs_section (lref
, rref
, n
);
725 else if (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
726 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_RANGE
)
727 this_dep
= gfc_check_element_vs_section (rref
, lref
, n
);
730 gcc_assert (rref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
731 && lref
->u
.ar
.dimen_type
[n
] == DIMEN_ELEMENT
);
732 this_dep
= gfc_check_element_vs_element (rref
, lref
, n
);
735 /* If any dimension doesn't overlap, we have no dependency. */
736 if (this_dep
== GFC_DEP_NODEP
)
739 /* Overlap codes are in order of priority. We only need to
740 know the worst one.*/
741 if (this_dep
> fin_dep
)
744 /* Exactly matching and forward overlapping ranges don't cause a
746 if (fin_dep
< GFC_DEP_OVERLAP
)
749 /* Keep checking. We only have a dependency if
750 subsequent references also overlap. */
760 /* If we haven't seen any array refs then something went wrong. */
761 gcc_assert (fin_dep
!= GFC_DEP_ERROR
);
763 if (fin_dep
< GFC_DEP_OVERLAP
)