]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/fortran/dependency.c
2006-03-04 Krister Walfridsson <cato@df.lth.se>
[thirdparty/gcc.git] / gcc / fortran / dependency.c
CommitLineData
4ee9c684 1/* Dependency analysis
7b3423b9 2 Copyright (C) 2000, 2001, 2002, 2005 Free Software Foundation, Inc.
4ee9c684 3 Contributed by Paul Brook <paul@nowt.org>
4
c84b470d 5This file is part of GCC.
4ee9c684 6
c84b470d 7GCC is free software; you can redistribute it and/or modify it under
8the terms of the GNU General Public License as published by the Free
9Software Foundation; either version 2, or (at your option) any later
10version.
4ee9c684 11
c84b470d 12GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13WARRANTY; without even the implied warranty of MERCHANTABILITY or
14FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15for more details.
4ee9c684 16
17You should have received a copy of the GNU General Public License
c84b470d 18along with GCC; see the file COPYING. If not, write to the Free
30d4ffea 19Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
2002110-1301, USA. */
4ee9c684 21
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. */
26
27
28#include "config.h"
29#include "gfortran.h"
30#include "dependency.h"
4ee9c684 31
32/* static declarations */
33/* Enums */
34enum range {LHS, RHS, MID};
35
36/* Dependency types. These must be in reverse order of priority. */
37typedef enum
38{
39 GFC_DEP_ERROR,
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. */
44}
45gfc_dependency;
46
47/* Macros */
48#define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
49
50
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. */
53
54int
55gfc_expr_is_one (gfc_expr * expr, int def)
56{
22d678e8 57 gcc_assert (expr != NULL);
4ee9c684 58
59 if (expr->expr_type != EXPR_CONSTANT)
60 return def;
61
62 if (expr->ts.type != BT_INTEGER)
63 return def;
64
65 return mpz_cmp_si (expr->value.integer, 1) == 0;
66}
67
68
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. */
71
72int
73gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
74{
75 int i;
76
77 if (e1->expr_type != e2->expr_type)
78 return -2;
79
80 switch (e1->expr_type)
81 {
82 case EXPR_CONSTANT:
83 if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
84 return -2;
85
86 i = mpz_cmp (e1->value.integer, e2->value.integer);
87 if (i == 0)
88 return 0;
89 else if (i < 0)
90 return -1;
91 return 1;
92
93 case EXPR_VARIABLE:
94 if (e1->ref || e2->ref)
95 return -2;
96 if (e1->symtree->n.sym == e2->symtree->n.sym)
97 return 0;
98 return -2;
99
100 default:
101 return -2;
102 }
103}
104
105
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. */
108
109int
110gfc_is_same_range (gfc_array_ref * ar1, gfc_array_ref * ar2, int n, int def)
111{
112 gfc_expr *e1;
113 gfc_expr *e2;
114 int i;
115
116 /* TODO: More sophisticated range comparison. */
22d678e8 117 gcc_assert (ar1 && ar2);
4ee9c684 118
22d678e8 119 gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
4ee9c684 120
121 e1 = ar1->stride[n];
122 e2 = ar2->stride[n];
123 /* Check for mismatching strides. A NULL stride means a stride of 1. */
124 if (e1 && !e2)
125 {
126 i = gfc_expr_is_one (e1, -1);
127 if (i == -1)
128 return def;
129 else if (i == 0)
130 return 0;
131 }
132 else if (e2 && !e1)
133 {
134 i = gfc_expr_is_one (e2, -1);
135 if (i == -1)
136 return def;
137 else if (i == 0)
138 return 0;
139 }
140 else if (e1 && e2)
141 {
142 i = gfc_dep_compare_expr (e1, e2);
143 if (i == -2)
144 return def;
145 else if (i != 0)
146 return 0;
147 }
148 /* The strides match. */
149
150 /* Check the range start. */
151 e1 = ar1->start[n];
152 e2 = ar2->start[n];
a7455f80 153 if (e1 || e2)
154 {
155 /* Use the bound of the array if no bound is specified. */
156 if (ar1->as && !e1)
157 e1 = ar1->as->lower[n];
4ee9c684 158
a7455f80 159 if (ar2->as && !e2)
160 e2 = ar2->as->lower[n];
4ee9c684 161
a7455f80 162 /* Check we have values for both. */
163 if (!(e1 && e2))
164 return def;
4ee9c684 165
a7455f80 166 i = gfc_dep_compare_expr (e1, e2);
167 if (i == -2)
168 return def;
169 else if (i != 0)
170 return 0;
171 }
4ee9c684 172
a7455f80 173 /* Check the range end. */
174 e1 = ar1->end[n];
175 e2 = ar2->end[n];
176 if (e1 || e2)
177 {
178 /* Use the bound of the array if no bound is specified. */
179 if (ar1->as && !e1)
180 e1 = ar1->as->upper[n];
4ee9c684 181
a7455f80 182 if (ar2->as && !e2)
183 e2 = ar2->as->upper[n];
4ee9c684 184
a7455f80 185 /* Check we have values for both. */
186 if (!(e1 && e2))
187 return def;
188
189 i = gfc_dep_compare_expr (e1, e2);
190 if (i == -2)
191 return def;
192 else if (i != 0)
193 return 0;
194 }
195
196 return 1;
4ee9c684 197}
198
199
018ef8b8 200/* Some array-returning intrinsics can be implemented by reusing the
22046c26 201 data from one of the array arguments. For example, TRANSPOSE does
018ef8b8 202 not necessarily need to allocate new data: it can be implemented
203 by copying the original array's descriptor and simply swapping the
204 two dimension specifications.
205
206 If EXPR is a call to such an intrinsic, return the argument
207 whose data can be reused, otherwise return NULL. */
208
209gfc_expr *
210gfc_get_noncopying_intrinsic_argument (gfc_expr * expr)
211{
212 if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
213 return NULL;
214
215 switch (expr->value.function.isym->generic_id)
216 {
217 case GFC_ISYM_TRANSPOSE:
218 return expr->value.function.actual->expr;
219
220 default:
221 return NULL;
222 }
223}
224
225
c99d633f 226/* Return true if the result of reference REF can only be constructed
227 using a temporary array. */
228
229bool
230gfc_ref_needs_temporary_p (gfc_ref *ref)
231{
232 int n;
233 bool subarray_p;
234
235 subarray_p = false;
236 for (; ref; ref = ref->next)
237 switch (ref->type)
238 {
239 case REF_ARRAY:
240 /* Vector dimensions are generally not monotonic and must be
241 handled using a temporary. */
242 if (ref->u.ar.type == AR_SECTION)
243 for (n = 0; n < ref->u.ar.dimen; n++)
244 if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
245 return true;
246
247 subarray_p = true;
248 break;
249
250 case REF_SUBSTRING:
251 /* Within an array reference, character substrings generally
252 need a temporary. Character array strides are expressed as
253 multiples of the element size (consistent with other array
254 types), not in characters. */
255 return subarray_p;
256
257 case REF_COMPONENT:
258 break;
259 }
260
261 return false;
262}
263
264
018ef8b8 265/* Return true if array variable VAR could be passed to the same function
266 as argument EXPR without interfering with EXPR. INTENT is the intent
267 of VAR.
268
269 This is considerably less conservative than other dependencies
270 because many function arguments will already be copied into a
271 temporary. */
272
273static int
274gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
275 gfc_expr * expr)
276{
277 gcc_assert (var->expr_type == EXPR_VARIABLE);
278 gcc_assert (var->rank > 0);
279
280 switch (expr->expr_type)
281 {
282 case EXPR_VARIABLE:
283 return (gfc_ref_needs_temporary_p (expr->ref)
dded0b23 284 || gfc_check_dependency (var, expr, 1));
018ef8b8 285
286 case EXPR_ARRAY:
dded0b23 287 return gfc_check_dependency (var, expr, 1);
018ef8b8 288
289 case EXPR_FUNCTION:
290 if (intent != INTENT_IN && expr->inline_noncopying_intrinsic)
291 {
292 expr = gfc_get_noncopying_intrinsic_argument (expr);
293 return gfc_check_argument_var_dependency (var, intent, expr);
294 }
295 return 0;
296
297 default:
298 return 0;
299 }
300}
301
302
303/* Like gfc_check_argument_var_dependency, but extended to any
304 array expression OTHER, not just variables. */
305
306static int
307gfc_check_argument_dependency (gfc_expr * other, sym_intent intent,
308 gfc_expr * expr)
309{
310 switch (other->expr_type)
311 {
312 case EXPR_VARIABLE:
313 return gfc_check_argument_var_dependency (other, intent, expr);
314
315 case EXPR_FUNCTION:
316 if (other->inline_noncopying_intrinsic)
317 {
318 other = gfc_get_noncopying_intrinsic_argument (other);
319 return gfc_check_argument_dependency (other, INTENT_IN, expr);
320 }
321 return 0;
322
323 default:
324 return 0;
325 }
326}
327
328
329/* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
330 FNSYM is the function being called, or NULL if not known. */
4ee9c684 331
332int
018ef8b8 333gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
334 gfc_symbol * fnsym, gfc_actual_arglist * actual)
4ee9c684 335{
018ef8b8 336 gfc_formal_arglist *formal;
4ee9c684 337 gfc_expr *expr;
4ee9c684 338
018ef8b8 339 formal = fnsym ? fnsym->formal : NULL;
340 for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
4ee9c684 341 {
342 expr = actual->expr;
343
344 /* Skip args which are not present. */
345 if (!expr)
346 continue;
347
018ef8b8 348 /* Skip intent(in) arguments if OTHER itself is intent(in). */
349 if (formal
350 && intent == INTENT_IN
351 && formal->sym->attr.intent == INTENT_IN)
352 continue;
353
354 if (gfc_check_argument_dependency (other, intent, expr))
355 return 1;
4ee9c684 356 }
357
358 return 0;
359}
360
361
0b5dc8b5 362/* Return 1 if e1 and e2 are equivalenced arrays, either
363 directly or indirectly; ie. equivalence (a,b) for a and b
364 or equivalence (a,c),(b,c). This function uses the equiv_
365 lists, generated in trans-common(add_equivalences), that are
366 guaranteed to pick up indirect equivalences. A rudimentary
367 use is made of the offset to ensure that cases where the
368 source elements are moved down to the destination are not
369 identified as dependencies. */
370
371int
372gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
373{
374 gfc_equiv_list *l;
375 gfc_equiv_info *s, *fl1, *fl2;
376
377 gcc_assert (e1->expr_type == EXPR_VARIABLE
378 && e2->expr_type == EXPR_VARIABLE);
379
380 if (!e1->symtree->n.sym->attr.in_equivalence
381 || !e2->symtree->n.sym->attr.in_equivalence
382 || !e1->rank
383 || !e2->rank)
384 return 0;
385
386 /* Go through the equiv_lists and return 1 if the variables
387 e1 and e2 are members of the same group and satisfy the
388 requirement on their relative offsets. */
389 for (l = gfc_current_ns->equiv_lists; l; l = l->next)
390 {
391 fl1 = NULL;
392 fl2 = NULL;
393 for (s = l->equiv; s; s = s->next)
394 {
395 if (s->sym == e1->symtree->n.sym)
396 fl1 = s;
397 if (s->sym == e2->symtree->n.sym)
398 fl2 = s;
399 if (fl1 && fl2 && (fl1->offset > fl2->offset))
400 return 1;
401 }
402 }
403return 0;
404}
405
406
4ee9c684 407/* Return true if the statement body redefines the condition. Returns
408 true if expr2 depends on expr1. expr1 should be a single term
dded0b23 409 suitable for the lhs of an assignment. The IDENTICAL flag indicates
410 whether array references to the same symbol with identical range
411 references count as a dependency or not. Used for forall and where
4ee9c684 412 statements. Also used with functions returning arrays without a
413 temporary. */
414
415int
dded0b23 416gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
4ee9c684 417{
418 gfc_ref *ref;
419 int n;
420 gfc_actual_arglist *actual;
421
22d678e8 422 gcc_assert (expr1->expr_type == EXPR_VARIABLE);
4ee9c684 423
424 /* TODO: -fassume-no-pointer-aliasing */
425 if (expr1->symtree->n.sym->attr.pointer)
426 return 1;
427 for (ref = expr1->ref; ref; ref = ref->next)
428 {
429 if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
430 return 1;
431 }
432
433 switch (expr2->expr_type)
434 {
435 case EXPR_OP:
dded0b23 436 n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
4ee9c684 437 if (n)
438 return n;
9b773341 439 if (expr2->value.op.op2)
dded0b23 440 return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
4ee9c684 441 return 0;
442
443 case EXPR_VARIABLE:
444 if (expr2->symtree->n.sym->attr.pointer)
445 return 1;
446
447 for (ref = expr2->ref; ref; ref = ref->next)
448 {
449 if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
450 return 1;
451 }
452
0b5dc8b5 453 /* Return 1 if expr1 and expr2 are equivalenced arrays. */
454 if (gfc_are_equivalenced_arrays (expr1, expr2))
455 return 1;
456
4ee9c684 457 if (expr1->symtree->n.sym != expr2->symtree->n.sym)
458 return 0;
459
dded0b23 460 if (identical)
461 return 1;
462
80425127 463 /* Identical and disjoint ranges return 0,
464 overlapping ranges return 1. */
dded0b23 465 /* Return zero if we refer to the same full arrays. */
80425127 466 if (expr1->ref->type == REF_ARRAY && expr2->ref->type == REF_ARRAY)
467 return gfc_dep_resolver (expr1->ref, expr2->ref);
dded0b23 468
4ee9c684 469 return 1;
470
471 case EXPR_FUNCTION:
dded0b23 472 if (expr2->inline_noncopying_intrinsic)
473 identical = 1;
231e961a 474 /* Remember possible differences between elemental and
a7455f80 475 transformational functions. All functions inside a FORALL
476 will be pure. */
4ee9c684 477 for (actual = expr2->value.function.actual;
478 actual; actual = actual->next)
479 {
480 if (!actual->expr)
481 continue;
dded0b23 482 n = gfc_check_dependency (expr1, actual->expr, identical);
4ee9c684 483 if (n)
484 return n;
485 }
486 return 0;
487
488 case EXPR_CONSTANT:
489 return 0;
490
491 case EXPR_ARRAY:
492 /* Probably ok in the majority of (constant) cases. */
493 return 1;
494
495 default:
496 return 1;
497 }
498}
499
500
501/* Calculates size of the array reference using lower bound, upper bound
502 and stride. */
503
504static void
505get_no_of_elements(mpz_t ele, gfc_expr * u1, gfc_expr * l1, gfc_expr * s1)
506{
507 /* nNoOfEle = (u1-l1)/s1 */
508
509 mpz_sub (ele, u1->value.integer, l1->value.integer);
510
511 if (s1 != NULL)
512 mpz_tdiv_q (ele, ele, s1->value.integer);
513}
514
515
516/* Returns if the ranges ((0..Y), (X1..X2)) overlap. */
517
518static gfc_dependency
519get_deps (mpz_t x1, mpz_t x2, mpz_t y)
520{
521 int start;
522 int end;
523
524 start = mpz_cmp_ui (x1, 0);
525 end = mpz_cmp (x2, y);
526
527 /* Both ranges the same. */
528 if (start == 0 && end == 0)
529 return GFC_DEP_EQUAL;
530
531 /* Distinct ranges. */
532 if ((start < 0 && mpz_cmp_ui (x2, 0) < 0)
533 || (mpz_cmp (x1, y) > 0 && end > 0))
534 return GFC_DEP_NODEP;
535
536 /* Overlapping, but with corresponding elements of the second range
537 greater than the first. */
538 if (start > 0 && end > 0)
539 return GFC_DEP_FORWARD;
540
541 /* Overlapping in some other way. */
542 return GFC_DEP_OVERLAP;
543}
544
545
ef833b98 546/* Perform the same linear transformation on sections l and r such that
4ee9c684 547 (l_start:l_end:l_stride) -> (0:no_of_elements)
548 (r_start:r_end:r_stride) -> (X1:X2)
549 Where r_end is implicit as both sections must have the same number of
7b3423b9 550 elements.
4ee9c684 551 Returns 0 on success, 1 of the transformation failed. */
552/* TODO: Should this be (0:no_of_elements-1) */
553
554static int
555transform_sections (mpz_t X1, mpz_t X2, mpz_t no_of_elements,
556 gfc_expr * l_start, gfc_expr * l_end, gfc_expr * l_stride,
557 gfc_expr * r_start, gfc_expr * r_stride)
558{
559 if (NULL == l_start || NULL == l_end || NULL == r_start)
560 return 1;
561
562 /* TODO : Currently we check the dependency only when start, end and stride
563 are constant. We could also check for equal (variable) values, and
564 common subexpressions, eg. x vs. x+1. */
565
566 if (l_end->expr_type != EXPR_CONSTANT
567 || l_start->expr_type != EXPR_CONSTANT
568 || r_start->expr_type != EXPR_CONSTANT
569 || ((NULL != l_stride) && (l_stride->expr_type != EXPR_CONSTANT))
570 || ((NULL != r_stride) && (r_stride->expr_type != EXPR_CONSTANT)))
571 {
572 return 1;
573 }
574
575
576 get_no_of_elements (no_of_elements, l_end, l_start, l_stride);
577
578 mpz_sub (X1, r_start->value.integer, l_start->value.integer);
579 if (l_stride != NULL)
580 mpz_cdiv_q (X1, X1, l_stride->value.integer);
581
582 if (r_stride == NULL)
583 mpz_set (X2, no_of_elements);
584 else
585 mpz_mul (X2, no_of_elements, r_stride->value.integer);
586
587 if (l_stride != NULL)
ef833b98 588 mpz_cdiv_q (X2, X2, l_stride->value.integer);
4ee9c684 589 mpz_add (X2, X2, X1);
590
591 return 0;
592}
593
594
595/* Determines overlapping for two array sections. */
596
597static gfc_dependency
598gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
599{
600 gfc_expr *l_start;
601 gfc_expr *l_end;
602 gfc_expr *l_stride;
603
604 gfc_expr *r_start;
605 gfc_expr *r_stride;
606
477c2f87 607 gfc_array_ref l_ar;
608 gfc_array_ref r_ar;
4ee9c684 609
610 mpz_t no_of_elements;
477c2f87 611 mpz_t X1, X2;
4ee9c684 612 gfc_dependency dep;
613
614 l_ar = lref->u.ar;
615 r_ar = rref->u.ar;
477c2f87 616
617 /* If they are the same range, return without more ado. */
618 if (gfc_is_same_range (&l_ar, &r_ar, n, 0))
619 return GFC_DEP_EQUAL;
4ee9c684 620
621 l_start = l_ar.start[n];
622 l_end = l_ar.end[n];
623 l_stride = l_ar.stride[n];
624 r_start = r_ar.start[n];
625 r_stride = r_ar.stride[n];
626
627 /* if l_start is NULL take it from array specifier */
628 if (NULL == l_start && IS_ARRAY_EXPLICIT(l_ar.as))
629 l_start = l_ar.as->lower[n];
630
631 /* if l_end is NULL take it from array specifier */
632 if (NULL == l_end && IS_ARRAY_EXPLICIT(l_ar.as))
633 l_end = l_ar.as->upper[n];
634
635 /* if r_start is NULL take it from array specifier */
636 if (NULL == r_start && IS_ARRAY_EXPLICIT(r_ar.as))
637 r_start = r_ar.as->lower[n];
638
639 mpz_init (X1);
640 mpz_init (X2);
641 mpz_init (no_of_elements);
642
643 if (transform_sections (X1, X2, no_of_elements,
644 l_start, l_end, l_stride,
645 r_start, r_stride))
646 dep = GFC_DEP_OVERLAP;
647 else
648 dep = get_deps (X1, X2, no_of_elements);
649
650 mpz_clear (no_of_elements);
651 mpz_clear (X1);
652 mpz_clear (X2);
653 return dep;
654}
655
656
657/* Checks if the expr chk is inside the range left-right.
658 Returns GFC_DEP_NODEP if chk is outside the range,
659 GFC_DEP_OVERLAP otherwise.
660 Assumes left<=right. */
661
662static gfc_dependency
663gfc_is_inside_range (gfc_expr * chk, gfc_expr * left, gfc_expr * right)
664{
665 int l;
666 int r;
667 int s;
668
669 s = gfc_dep_compare_expr (left, right);
670 if (s == -2)
671 return GFC_DEP_OVERLAP;
672
673 l = gfc_dep_compare_expr (chk, left);
674 r = gfc_dep_compare_expr (chk, right);
675
676 /* Check for indeterminate relationships. */
677 if (l == -2 || r == -2 || s == -2)
678 return GFC_DEP_OVERLAP;
679
680 if (s == 1)
681 {
682 /* When left>right we want to check for right <= chk <= left. */
683 if (l <= 0 || r >= 0)
684 return GFC_DEP_OVERLAP;
685 }
686 else
687 {
688 /* Otherwise check for left <= chk <= right. */
689 if (l >= 0 || r <= 0)
690 return GFC_DEP_OVERLAP;
691 }
692
693 return GFC_DEP_NODEP;
694}
695
696
697/* Determines overlapping for a single element and a section. */
698
699static gfc_dependency
700gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
701{
702 gfc_array_ref l_ar;
703 gfc_array_ref r_ar;
704 gfc_expr *l_start;
705 gfc_expr *r_start;
706 gfc_expr *r_end;
707
708 l_ar = lref->u.ar;
709 r_ar = rref->u.ar;
710 l_start = l_ar.start[n] ;
711 r_start = r_ar.start[n] ;
712 r_end = r_ar.end[n] ;
713 if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as))
714 r_start = r_ar.as->lower[n];
715 if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as))
716 r_end = r_ar.as->upper[n];
717 if (NULL == r_start || NULL == r_end || l_start == NULL)
718 return GFC_DEP_OVERLAP;
719
720 return gfc_is_inside_range (l_start, r_end, r_start);
721}
722
723
724/* Determines overlapping for two single element array references. */
725
726static gfc_dependency
727gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
728{
729 gfc_array_ref l_ar;
730 gfc_array_ref r_ar;
731 gfc_expr *l_start;
732 gfc_expr *r_start;
80425127 733 int i;
4ee9c684 734
80425127 735 l_ar = lref->u.ar;
736 r_ar = rref->u.ar;
737 l_start = l_ar.start[n] ;
738 r_start = r_ar.start[n] ;
739 i = gfc_dep_compare_expr (r_start, l_start);
740 if (i == 0)
741 return GFC_DEP_EQUAL;
b1888307 742 /* Treat two scalar variables as potentially equal. This allows
743 us to prove that a(i,:) and a(j,:) have no dependency. See
744 Gerald Roth, "Evaluation of Array Syntax Dependence Analysis",
745 Proceedings of the International Conference on Parallel and
746 Distributed Processing Techniques and Applications (PDPTA2001),
747 Las Vegas, Nevada, June 2001. This used to be GFC_DEP_OVERLAP. */
80425127 748 if (i == -2)
b1888307 749 return GFC_DEP_EQUAL;
80425127 750 return GFC_DEP_NODEP;
4ee9c684 751}
752
753
754/* Finds if two array references are overlapping or not.
755 Return value
756 1 : array references are overlapping.
80425127 757 0 : array references are identical or not overlapping. */
4ee9c684 758
759int
760gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
761{
762 int n;
763 gfc_dependency fin_dep;
764 gfc_dependency this_dep;
765
766
767 fin_dep = GFC_DEP_ERROR;
768 /* Dependencies due to pointers should already have been identified.
769 We only need to check for overlapping array references. */
770
771 while (lref && rref)
772 {
773 /* We're resolving from the same base symbol, so both refs should be
a7455f80 774 the same type. We traverse the reference chain intil we find ranges
4ee9c684 775 that are not equal. */
22d678e8 776 gcc_assert (lref->type == rref->type);
4ee9c684 777 switch (lref->type)
778 {
779 case REF_COMPONENT:
780 /* The two ranges can't overlap if they are from different
781 components. */
782 if (lref->u.c.component != rref->u.c.component)
783 return 0;
784 break;
785
786 case REF_SUBSTRING:
787 /* Substring overlaps are handled by the string assignment code. */
788 return 0;
789
790 case REF_ARRAY:
4ee9c684 791 for (n=0; n < lref->u.ar.dimen; n++)
792 {
793 /* Assume dependency when either of array reference is vector
a7455f80 794 subscript. */
4ee9c684 795 if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
796 || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
797 return 1;
798 if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
799 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
800 this_dep = gfc_check_section_vs_section (lref, rref, n);
801 else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
802 && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
803 this_dep = gfc_check_element_vs_section (lref, rref, n);
804 else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
805 && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
806 this_dep = gfc_check_element_vs_section (rref, lref, n);
807 else
808 {
22d678e8 809 gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
a7455f80 810 && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
4ee9c684 811 this_dep = gfc_check_element_vs_element (rref, lref, n);
812 }
813
814 /* If any dimension doesn't overlap, we have no dependency. */
815 if (this_dep == GFC_DEP_NODEP)
816 return 0;
817
818 /* Overlap codes are in order of priority. We only need to
a7455f80 819 know the worst one.*/
4ee9c684 820 if (this_dep > fin_dep)
821 fin_dep = this_dep;
822 }
823 /* Exactly matching and forward overlapping ranges don't cause a
824 dependency. */
825 if (fin_dep < GFC_DEP_OVERLAP)
826 return 0;
827
828 /* Keep checking. We only have a dependency if
829 subsequent references also overlap. */
830 break;
831
832 default:
22d678e8 833 gcc_unreachable ();
4ee9c684 834 }
835 lref = lref->next;
836 rref = rref->next;
837 }
838
839 /* If we haven't seen any array refs then something went wrong. */
22d678e8 840 gcc_assert (fin_dep != GFC_DEP_ERROR);
4ee9c684 841
80425127 842 /* Assume the worst if we nest to different depths. */
843 if (lref || rref)
4ee9c684 844 return 1;
80425127 845
846 return fin_dep == GFC_DEP_OVERLAP;
4ee9c684 847}
848