]>
Commit | Line | Data |
---|---|---|
4ee9c684 | 1 | /* Dependency analysis |
1a9745d2 | 2 | Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007 |
3 | Free Software Foundation, Inc. | |
4ee9c684 | 4 | Contributed by Paul Brook <paul@nowt.org> |
5 | ||
c84b470d | 6 | This file is part of GCC. |
4ee9c684 | 7 | |
c84b470d | 8 | GCC is free software; you can redistribute it and/or modify it under |
9 | the terms of the GNU General Public License as published by the Free | |
10 | Software Foundation; either version 2, or (at your option) any later | |
11 | version. | |
4ee9c684 | 12 | |
c84b470d | 13 | GCC is distributed in the hope that it will be useful, but WITHOUT ANY |
14 | WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 | FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 | for more details. | |
4ee9c684 | 17 | |
18 | You should have received a copy of the GNU General Public License | |
c84b470d | 19 | along with GCC; see the file COPYING. If not, write to the Free |
30d4ffea | 20 | Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA |
21 | 02110-1301, USA. */ | |
4ee9c684 | 22 | |
23 | /* dependency.c -- Expression dependency analysis code. */ | |
24 | /* There's probably quite a bit of duplication in this file. We currently | |
25 | have different dependency checking functions for different types | |
26 | if dependencies. Ideally these would probably be merged. */ | |
27 | ||
4ee9c684 | 28 | #include "config.h" |
29 | #include "gfortran.h" | |
30 | #include "dependency.h" | |
4ee9c684 | 31 | |
32 | /* static declarations */ | |
33 | /* Enums */ | |
34 | enum range {LHS, RHS, MID}; | |
35 | ||
36 | /* Dependency types. These must be in reverse order of priority. */ | |
37 | typedef 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 | } | |
45 | gfc_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 | ||
54 | int | |
1a9745d2 | 55 | gfc_expr_is_one (gfc_expr *expr, int def) |
4ee9c684 | 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 | ||
72 | int | |
1a9745d2 | 73 | gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) |
4ee9c684 | 74 | { |
4d4677fd | 75 | gfc_actual_arglist *args1; |
76 | gfc_actual_arglist *args2; | |
4ee9c684 | 77 | int i; |
78 | ||
4d4677fd | 79 | if (e1->expr_type == EXPR_OP |
80 | && (e1->value.op.operator == INTRINSIC_UPLUS | |
1a9745d2 | 81 | || e1->value.op.operator == INTRINSIC_PARENTHESES)) |
4d4677fd | 82 | return gfc_dep_compare_expr (e1->value.op.op1, e2); |
83 | if (e2->expr_type == EXPR_OP | |
84 | && (e2->value.op.operator == INTRINSIC_UPLUS | |
1a9745d2 | 85 | || e2->value.op.operator == INTRINSIC_PARENTHESES)) |
4d4677fd | 86 | return gfc_dep_compare_expr (e1, e2->value.op.op1); |
87 | ||
1a9745d2 | 88 | if (e1->expr_type == EXPR_OP && e1->value.op.operator == INTRINSIC_PLUS) |
4d4677fd | 89 | { |
90 | /* Compare X+C vs. X. */ | |
91 | if (e1->value.op.op2->expr_type == EXPR_CONSTANT | |
92 | && e1->value.op.op2->ts.type == BT_INTEGER | |
93 | && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0) | |
94 | return mpz_sgn (e1->value.op.op2->value.integer); | |
95 | ||
96 | /* Compare P+Q vs. R+S. */ | |
1a9745d2 | 97 | if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_PLUS) |
4d4677fd | 98 | { |
99 | int l, r; | |
100 | ||
101 | l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1); | |
102 | r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2); | |
103 | if (l == 0 && r == 0) | |
104 | return 0; | |
105 | if (l == 0 && r != -2) | |
106 | return r; | |
107 | if (l != -2 && r == 0) | |
108 | return l; | |
109 | if (l == 1 && r == 1) | |
110 | return 1; | |
111 | if (l == -1 && r == -1) | |
112 | return -1; | |
113 | ||
114 | l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2); | |
115 | r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1); | |
116 | if (l == 0 && r == 0) | |
117 | return 0; | |
118 | if (l == 0 && r != -2) | |
119 | return r; | |
120 | if (l != -2 && r == 0) | |
121 | return l; | |
122 | if (l == 1 && r == 1) | |
123 | return 1; | |
124 | if (l == -1 && r == -1) | |
125 | return -1; | |
126 | } | |
127 | } | |
128 | ||
129 | /* Compare X vs. X+C. */ | |
1a9745d2 | 130 | if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_PLUS) |
4d4677fd | 131 | { |
132 | if (e2->value.op.op2->expr_type == EXPR_CONSTANT | |
133 | && e2->value.op.op2->ts.type == BT_INTEGER | |
134 | && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0) | |
135 | return -mpz_sgn (e2->value.op.op2->value.integer); | |
136 | } | |
137 | ||
138 | /* Compare X-C vs. X. */ | |
1a9745d2 | 139 | if (e1->expr_type == EXPR_OP && e1->value.op.operator == INTRINSIC_MINUS) |
4d4677fd | 140 | { |
141 | if (e1->value.op.op2->expr_type == EXPR_CONSTANT | |
142 | && e1->value.op.op2->ts.type == BT_INTEGER | |
143 | && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0) | |
144 | return -mpz_sgn (e1->value.op.op2->value.integer); | |
145 | ||
146 | /* Compare P-Q vs. R-S. */ | |
1a9745d2 | 147 | if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_MINUS) |
4d4677fd | 148 | { |
149 | int l, r; | |
150 | ||
151 | l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1); | |
152 | r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2); | |
153 | if (l == 0 && r == 0) | |
154 | return 0; | |
155 | if (l != -2 && r == 0) | |
156 | return l; | |
157 | if (l == 0 && r != -2) | |
158 | return -r; | |
159 | if (l == 1 && r == -1) | |
160 | return 1; | |
161 | if (l == -1 && r == 1) | |
162 | return -1; | |
163 | } | |
164 | } | |
165 | ||
166 | /* Compare X vs. X-C. */ | |
1a9745d2 | 167 | if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_MINUS) |
4d4677fd | 168 | { |
169 | if (e2->value.op.op2->expr_type == EXPR_CONSTANT | |
170 | && e2->value.op.op2->ts.type == BT_INTEGER | |
171 | && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0) | |
172 | return mpz_sgn (e2->value.op.op2->value.integer); | |
173 | } | |
174 | ||
4ee9c684 | 175 | if (e1->expr_type != e2->expr_type) |
176 | return -2; | |
177 | ||
178 | switch (e1->expr_type) | |
179 | { | |
180 | case EXPR_CONSTANT: | |
181 | if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER) | |
182 | return -2; | |
183 | ||
184 | i = mpz_cmp (e1->value.integer, e2->value.integer); | |
185 | if (i == 0) | |
186 | return 0; | |
187 | else if (i < 0) | |
188 | return -1; | |
189 | return 1; | |
190 | ||
191 | case EXPR_VARIABLE: | |
192 | if (e1->ref || e2->ref) | |
193 | return -2; | |
194 | if (e1->symtree->n.sym == e2->symtree->n.sym) | |
195 | return 0; | |
196 | return -2; | |
197 | ||
bee621f2 | 198 | case EXPR_OP: |
199 | /* Intrinsic operators are the same if their operands are the same. */ | |
200 | if (e1->value.op.operator != e2->value.op.operator) | |
201 | return -2; | |
202 | if (e1->value.op.op2 == 0) | |
203 | { | |
204 | i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1); | |
205 | return i == 0 ? 0 : -2; | |
206 | } | |
207 | if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0 | |
208 | && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0) | |
209 | return 0; | |
210 | /* TODO Handle commutative binary operators here? */ | |
211 | return -2; | |
212 | ||
213 | case EXPR_FUNCTION: | |
214 | /* We can only compare calls to the same intrinsic function. */ | |
1a9745d2 | 215 | if (e1->value.function.isym == 0 || e2->value.function.isym == 0 |
bee621f2 | 216 | || e1->value.function.isym != e2->value.function.isym) |
217 | return -2; | |
218 | ||
4d4677fd | 219 | args1 = e1->value.function.actual; |
220 | args2 = e2->value.function.actual; | |
221 | ||
bee621f2 | 222 | /* We should list the "constant" intrinsic functions. Those |
223 | without side-effects that provide equal results given equal | |
224 | argument lists. */ | |
225 | switch (e1->value.function.isym->generic_id) | |
226 | { | |
227 | case GFC_ISYM_CONVERSION: | |
4d4677fd | 228 | /* Handle integer extensions specially, as __convert_i4_i8 |
229 | is not only "constant" but also "unary" and "increasing". */ | |
230 | if (args1 && !args1->next | |
231 | && args2 && !args2->next | |
232 | && e1->ts.type == BT_INTEGER | |
233 | && args1->expr->ts.type == BT_INTEGER | |
234 | && e1->ts.kind > args1->expr->ts.kind | |
235 | && e2->ts.type == e1->ts.type | |
236 | && e2->ts.kind == e1->ts.kind | |
237 | && args2->expr->ts.type == args1->expr->ts.type | |
238 | && args2->expr->ts.kind == args2->expr->ts.kind) | |
239 | return gfc_dep_compare_expr (args1->expr, args2->expr); | |
240 | break; | |
241 | ||
bee621f2 | 242 | case GFC_ISYM_REAL: |
243 | case GFC_ISYM_LOGICAL: | |
244 | case GFC_ISYM_DBLE: | |
245 | break; | |
246 | ||
247 | default: | |
248 | return -2; | |
249 | } | |
250 | ||
251 | /* Compare the argument lists for equality. */ | |
4d4677fd | 252 | while (args1 && args2) |
253 | { | |
254 | if (gfc_dep_compare_expr (args1->expr, args2->expr) != 0) | |
255 | return -2; | |
256 | args1 = args1->next; | |
257 | args2 = args2->next; | |
258 | } | |
259 | return (args1 || args2) ? -2 : 0; | |
bee621f2 | 260 | |
4ee9c684 | 261 | default: |
262 | return -2; | |
263 | } | |
264 | } | |
265 | ||
266 | ||
267 | /* Returns 1 if the two ranges are the same, 0 if they are not, and def | |
268 | if the results are indeterminate. N is the dimension to compare. */ | |
269 | ||
270 | int | |
1a9745d2 | 271 | gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def) |
4ee9c684 | 272 | { |
273 | gfc_expr *e1; | |
274 | gfc_expr *e2; | |
275 | int i; | |
276 | ||
277 | /* TODO: More sophisticated range comparison. */ | |
22d678e8 | 278 | gcc_assert (ar1 && ar2); |
4ee9c684 | 279 | |
22d678e8 | 280 | gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]); |
4ee9c684 | 281 | |
282 | e1 = ar1->stride[n]; | |
283 | e2 = ar2->stride[n]; | |
284 | /* Check for mismatching strides. A NULL stride means a stride of 1. */ | |
285 | if (e1 && !e2) | |
286 | { | |
287 | i = gfc_expr_is_one (e1, -1); | |
288 | if (i == -1) | |
289 | return def; | |
290 | else if (i == 0) | |
291 | return 0; | |
292 | } | |
293 | else if (e2 && !e1) | |
294 | { | |
295 | i = gfc_expr_is_one (e2, -1); | |
296 | if (i == -1) | |
297 | return def; | |
298 | else if (i == 0) | |
299 | return 0; | |
300 | } | |
301 | else if (e1 && e2) | |
302 | { | |
303 | i = gfc_dep_compare_expr (e1, e2); | |
304 | if (i == -2) | |
305 | return def; | |
306 | else if (i != 0) | |
307 | return 0; | |
308 | } | |
309 | /* The strides match. */ | |
310 | ||
311 | /* Check the range start. */ | |
312 | e1 = ar1->start[n]; | |
313 | e2 = ar2->start[n]; | |
a7455f80 | 314 | if (e1 || e2) |
315 | { | |
316 | /* Use the bound of the array if no bound is specified. */ | |
317 | if (ar1->as && !e1) | |
318 | e1 = ar1->as->lower[n]; | |
4ee9c684 | 319 | |
a7455f80 | 320 | if (ar2->as && !e2) |
321 | e2 = ar2->as->lower[n]; | |
4ee9c684 | 322 | |
a7455f80 | 323 | /* Check we have values for both. */ |
324 | if (!(e1 && e2)) | |
325 | return def; | |
4ee9c684 | 326 | |
a7455f80 | 327 | i = gfc_dep_compare_expr (e1, e2); |
328 | if (i == -2) | |
329 | return def; | |
330 | else if (i != 0) | |
331 | return 0; | |
332 | } | |
4ee9c684 | 333 | |
a7455f80 | 334 | /* Check the range end. */ |
335 | e1 = ar1->end[n]; | |
336 | e2 = ar2->end[n]; | |
337 | if (e1 || e2) | |
338 | { | |
339 | /* Use the bound of the array if no bound is specified. */ | |
340 | if (ar1->as && !e1) | |
341 | e1 = ar1->as->upper[n]; | |
4ee9c684 | 342 | |
a7455f80 | 343 | if (ar2->as && !e2) |
344 | e2 = ar2->as->upper[n]; | |
4ee9c684 | 345 | |
a7455f80 | 346 | /* Check we have values for both. */ |
347 | if (!(e1 && e2)) | |
348 | return def; | |
349 | ||
350 | i = gfc_dep_compare_expr (e1, e2); | |
351 | if (i == -2) | |
352 | return def; | |
353 | else if (i != 0) | |
354 | return 0; | |
355 | } | |
356 | ||
357 | return 1; | |
4ee9c684 | 358 | } |
359 | ||
360 | ||
018ef8b8 | 361 | /* Some array-returning intrinsics can be implemented by reusing the |
22046c26 | 362 | data from one of the array arguments. For example, TRANSPOSE does |
018ef8b8 | 363 | not necessarily need to allocate new data: it can be implemented |
364 | by copying the original array's descriptor and simply swapping the | |
365 | two dimension specifications. | |
366 | ||
367 | If EXPR is a call to such an intrinsic, return the argument | |
368 | whose data can be reused, otherwise return NULL. */ | |
369 | ||
370 | gfc_expr * | |
1a9745d2 | 371 | gfc_get_noncopying_intrinsic_argument (gfc_expr *expr) |
018ef8b8 | 372 | { |
373 | if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym) | |
374 | return NULL; | |
375 | ||
376 | switch (expr->value.function.isym->generic_id) | |
377 | { | |
378 | case GFC_ISYM_TRANSPOSE: | |
379 | return expr->value.function.actual->expr; | |
380 | ||
381 | default: | |
382 | return NULL; | |
383 | } | |
384 | } | |
385 | ||
386 | ||
c99d633f | 387 | /* Return true if the result of reference REF can only be constructed |
388 | using a temporary array. */ | |
389 | ||
390 | bool | |
391 | gfc_ref_needs_temporary_p (gfc_ref *ref) | |
392 | { | |
393 | int n; | |
394 | bool subarray_p; | |
395 | ||
396 | subarray_p = false; | |
397 | for (; ref; ref = ref->next) | |
398 | switch (ref->type) | |
399 | { | |
400 | case REF_ARRAY: | |
401 | /* Vector dimensions are generally not monotonic and must be | |
402 | handled using a temporary. */ | |
403 | if (ref->u.ar.type == AR_SECTION) | |
404 | for (n = 0; n < ref->u.ar.dimen; n++) | |
405 | if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR) | |
406 | return true; | |
407 | ||
408 | subarray_p = true; | |
409 | break; | |
410 | ||
411 | case REF_SUBSTRING: | |
412 | /* Within an array reference, character substrings generally | |
413 | need a temporary. Character array strides are expressed as | |
414 | multiples of the element size (consistent with other array | |
415 | types), not in characters. */ | |
416 | return subarray_p; | |
417 | ||
418 | case REF_COMPONENT: | |
419 | break; | |
420 | } | |
421 | ||
422 | return false; | |
423 | } | |
424 | ||
425 | ||
018ef8b8 | 426 | /* Return true if array variable VAR could be passed to the same function |
427 | as argument EXPR without interfering with EXPR. INTENT is the intent | |
428 | of VAR. | |
429 | ||
430 | This is considerably less conservative than other dependencies | |
431 | because many function arguments will already be copied into a | |
432 | temporary. */ | |
433 | ||
434 | static int | |
1a9745d2 | 435 | gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent, |
436 | gfc_expr *expr) | |
018ef8b8 | 437 | { |
438 | gcc_assert (var->expr_type == EXPR_VARIABLE); | |
439 | gcc_assert (var->rank > 0); | |
440 | ||
441 | switch (expr->expr_type) | |
442 | { | |
443 | case EXPR_VARIABLE: | |
444 | return (gfc_ref_needs_temporary_p (expr->ref) | |
dded0b23 | 445 | || gfc_check_dependency (var, expr, 1)); |
018ef8b8 | 446 | |
447 | case EXPR_ARRAY: | |
dded0b23 | 448 | return gfc_check_dependency (var, expr, 1); |
018ef8b8 | 449 | |
450 | case EXPR_FUNCTION: | |
451 | if (intent != INTENT_IN && expr->inline_noncopying_intrinsic) | |
452 | { | |
453 | expr = gfc_get_noncopying_intrinsic_argument (expr); | |
454 | return gfc_check_argument_var_dependency (var, intent, expr); | |
455 | } | |
456 | return 0; | |
457 | ||
458 | default: | |
459 | return 0; | |
460 | } | |
461 | } | |
462 | ||
463 | ||
464 | /* Like gfc_check_argument_var_dependency, but extended to any | |
465 | array expression OTHER, not just variables. */ | |
466 | ||
467 | static int | |
1a9745d2 | 468 | gfc_check_argument_dependency (gfc_expr *other, sym_intent intent, |
469 | gfc_expr *expr) | |
018ef8b8 | 470 | { |
471 | switch (other->expr_type) | |
472 | { | |
473 | case EXPR_VARIABLE: | |
474 | return gfc_check_argument_var_dependency (other, intent, expr); | |
475 | ||
476 | case EXPR_FUNCTION: | |
477 | if (other->inline_noncopying_intrinsic) | |
478 | { | |
479 | other = gfc_get_noncopying_intrinsic_argument (other); | |
480 | return gfc_check_argument_dependency (other, INTENT_IN, expr); | |
481 | } | |
482 | return 0; | |
483 | ||
484 | default: | |
485 | return 0; | |
486 | } | |
487 | } | |
488 | ||
489 | ||
490 | /* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL. | |
491 | FNSYM is the function being called, or NULL if not known. */ | |
4ee9c684 | 492 | |
493 | int | |
1a9745d2 | 494 | gfc_check_fncall_dependency (gfc_expr *other, sym_intent intent, |
495 | gfc_symbol *fnsym, gfc_actual_arglist *actual) | |
4ee9c684 | 496 | { |
018ef8b8 | 497 | gfc_formal_arglist *formal; |
4ee9c684 | 498 | gfc_expr *expr; |
4ee9c684 | 499 | |
018ef8b8 | 500 | formal = fnsym ? fnsym->formal : NULL; |
501 | for (; actual; actual = actual->next, formal = formal ? formal->next : NULL) | |
4ee9c684 | 502 | { |
503 | expr = actual->expr; | |
504 | ||
505 | /* Skip args which are not present. */ | |
506 | if (!expr) | |
507 | continue; | |
9960dc89 | 508 | |
509 | /* Skip other itself. */ | |
510 | if (expr == other) | |
511 | continue; | |
4ee9c684 | 512 | |
018ef8b8 | 513 | /* Skip intent(in) arguments if OTHER itself is intent(in). */ |
1a9745d2 | 514 | if (formal && intent == INTENT_IN |
018ef8b8 | 515 | && formal->sym->attr.intent == INTENT_IN) |
516 | continue; | |
517 | ||
518 | if (gfc_check_argument_dependency (other, intent, expr)) | |
519 | return 1; | |
4ee9c684 | 520 | } |
521 | ||
522 | return 0; | |
523 | } | |
524 | ||
525 | ||
0b5dc8b5 | 526 | /* Return 1 if e1 and e2 are equivalenced arrays, either |
527 | directly or indirectly; ie. equivalence (a,b) for a and b | |
528 | or equivalence (a,c),(b,c). This function uses the equiv_ | |
529 | lists, generated in trans-common(add_equivalences), that are | |
78787e4b | 530 | guaranteed to pick up indirect equivalences. We explicitly |
531 | check for overlap using the offset and length of the equivalence. | |
532 | This function is symmetric. | |
533 | TODO: This function only checks whether the full top-level | |
534 | symbols overlap. An improved implementation could inspect | |
535 | e1->ref and e2->ref to determine whether the actually accessed | |
536 | portions of these variables/arrays potentially overlap. */ | |
0b5dc8b5 | 537 | |
538 | int | |
539 | gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2) | |
540 | { | |
541 | gfc_equiv_list *l; | |
542 | gfc_equiv_info *s, *fl1, *fl2; | |
543 | ||
544 | gcc_assert (e1->expr_type == EXPR_VARIABLE | |
1a9745d2 | 545 | && e2->expr_type == EXPR_VARIABLE); |
0b5dc8b5 | 546 | |
547 | if (!e1->symtree->n.sym->attr.in_equivalence | |
1a9745d2 | 548 | || !e2->symtree->n.sym->attr.in_equivalence|| !e1->rank || !e2->rank) |
0b5dc8b5 | 549 | return 0; |
550 | ||
551 | /* Go through the equiv_lists and return 1 if the variables | |
552 | e1 and e2 are members of the same group and satisfy the | |
553 | requirement on their relative offsets. */ | |
554 | for (l = gfc_current_ns->equiv_lists; l; l = l->next) | |
555 | { | |
556 | fl1 = NULL; | |
557 | fl2 = NULL; | |
558 | for (s = l->equiv; s; s = s->next) | |
559 | { | |
560 | if (s->sym == e1->symtree->n.sym) | |
78787e4b | 561 | { |
562 | fl1 = s; | |
563 | if (fl2) | |
564 | break; | |
565 | } | |
0b5dc8b5 | 566 | if (s->sym == e2->symtree->n.sym) |
78787e4b | 567 | { |
568 | fl2 = s; | |
569 | if (fl1) | |
570 | break; | |
571 | } | |
572 | } | |
573 | ||
574 | if (s) | |
575 | { | |
576 | /* Can these lengths be zero? */ | |
577 | if (fl1->length <= 0 || fl2->length <= 0) | |
578 | return 1; | |
579 | /* These can't overlap if [f11,fl1+length] is before | |
580 | [fl2,fl2+length], or [fl2,fl2+length] is before | |
581 | [fl1,fl1+length], otherwise they do overlap. */ | |
582 | if (fl1->offset + fl1->length > fl2->offset | |
583 | && fl2->offset + fl2->length > fl1->offset) | |
0b5dc8b5 | 584 | return 1; |
585 | } | |
586 | } | |
78787e4b | 587 | return 0; |
0b5dc8b5 | 588 | } |
589 | ||
590 | ||
4ee9c684 | 591 | /* Return true if the statement body redefines the condition. Returns |
592 | true if expr2 depends on expr1. expr1 should be a single term | |
dded0b23 | 593 | suitable for the lhs of an assignment. The IDENTICAL flag indicates |
594 | whether array references to the same symbol with identical range | |
595 | references count as a dependency or not. Used for forall and where | |
4ee9c684 | 596 | statements. Also used with functions returning arrays without a |
597 | temporary. */ | |
598 | ||
599 | int | |
1a9745d2 | 600 | gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical) |
4ee9c684 | 601 | { |
c5918475 | 602 | gfc_actual_arglist *actual; |
603 | gfc_constructor *c; | |
4ee9c684 | 604 | gfc_ref *ref; |
605 | int n; | |
4ee9c684 | 606 | |
22d678e8 | 607 | gcc_assert (expr1->expr_type == EXPR_VARIABLE); |
4ee9c684 | 608 | |
4ee9c684 | 609 | switch (expr2->expr_type) |
610 | { | |
611 | case EXPR_OP: | |
dded0b23 | 612 | n = gfc_check_dependency (expr1, expr2->value.op.op1, identical); |
4ee9c684 | 613 | if (n) |
614 | return n; | |
9b773341 | 615 | if (expr2->value.op.op2) |
dded0b23 | 616 | return gfc_check_dependency (expr1, expr2->value.op.op2, identical); |
4ee9c684 | 617 | return 0; |
618 | ||
619 | case EXPR_VARIABLE: | |
e33c5890 | 620 | /* The interesting cases are when the symbols don't match. */ |
621 | if (expr1->symtree->n.sym != expr2->symtree->n.sym) | |
4ee9c684 | 622 | { |
e33c5890 | 623 | gfc_typespec *ts1 = &expr1->symtree->n.sym->ts; |
624 | gfc_typespec *ts2 = &expr2->symtree->n.sym->ts; | |
625 | ||
626 | /* Return 1 if expr1 and expr2 are equivalenced arrays. */ | |
627 | if (gfc_are_equivalenced_arrays (expr1, expr2)) | |
4ee9c684 | 628 | return 1; |
4ee9c684 | 629 | |
e33c5890 | 630 | /* Symbols can only alias if they have the same type. */ |
1a9745d2 | 631 | if (ts1->type != BT_UNKNOWN && ts2->type != BT_UNKNOWN |
632 | && ts1->type != BT_DERIVED && ts2->type != BT_DERIVED) | |
e33c5890 | 633 | { |
1a9745d2 | 634 | if (ts1->type != ts2->type || ts1->kind != ts2->kind) |
e33c5890 | 635 | return 0; |
636 | } | |
0b5dc8b5 | 637 | |
e33c5890 | 638 | /* If either variable is a pointer, assume the worst. */ |
639 | /* TODO: -fassume-no-pointer-aliasing */ | |
640 | if (expr1->symtree->n.sym->attr.pointer) | |
641 | return 1; | |
642 | for (ref = expr1->ref; ref; ref = ref->next) | |
643 | if (ref->type == REF_COMPONENT && ref->u.c.component->pointer) | |
644 | return 1; | |
645 | ||
646 | if (expr2->symtree->n.sym->attr.pointer) | |
647 | return 1; | |
648 | for (ref = expr2->ref; ref; ref = ref->next) | |
649 | if (ref->type == REF_COMPONENT && ref->u.c.component->pointer) | |
650 | return 1; | |
651 | ||
652 | /* Otherwise distinct symbols have no dependencies. */ | |
653 | return 0; | |
654 | } | |
4ee9c684 | 655 | |
dded0b23 | 656 | if (identical) |
657 | return 1; | |
658 | ||
80425127 | 659 | /* Identical and disjoint ranges return 0, |
660 | overlapping ranges return 1. */ | |
dded0b23 | 661 | /* Return zero if we refer to the same full arrays. */ |
80425127 | 662 | if (expr1->ref->type == REF_ARRAY && expr2->ref->type == REF_ARRAY) |
663 | return gfc_dep_resolver (expr1->ref, expr2->ref); | |
dded0b23 | 664 | |
4ee9c684 | 665 | return 1; |
666 | ||
667 | case EXPR_FUNCTION: | |
dded0b23 | 668 | if (expr2->inline_noncopying_intrinsic) |
669 | identical = 1; | |
231e961a | 670 | /* Remember possible differences between elemental and |
a7455f80 | 671 | transformational functions. All functions inside a FORALL |
672 | will be pure. */ | |
4ee9c684 | 673 | for (actual = expr2->value.function.actual; |
674 | actual; actual = actual->next) | |
675 | { | |
676 | if (!actual->expr) | |
677 | continue; | |
dded0b23 | 678 | n = gfc_check_dependency (expr1, actual->expr, identical); |
4ee9c684 | 679 | if (n) |
680 | return n; | |
681 | } | |
682 | return 0; | |
683 | ||
684 | case EXPR_CONSTANT: | |
11c3ed2a | 685 | case EXPR_NULL: |
4ee9c684 | 686 | return 0; |
687 | ||
688 | case EXPR_ARRAY: | |
c5918475 | 689 | /* Loop through the array constructor's elements. */ |
690 | for (c = expr2->value.constructor; c; c = c->next) | |
691 | { | |
692 | /* If this is an iterator, assume the worst. */ | |
693 | if (c->iterator) | |
694 | return 1; | |
695 | /* Avoid recursion in the common case. */ | |
696 | if (c->expr->expr_type == EXPR_CONSTANT) | |
697 | continue; | |
698 | if (gfc_check_dependency (expr1, c->expr, 1)) | |
699 | return 1; | |
700 | } | |
701 | return 0; | |
4ee9c684 | 702 | |
703 | default: | |
704 | return 1; | |
705 | } | |
706 | } | |
707 | ||
708 | ||
4ee9c684 | 709 | /* Determines overlapping for two array sections. */ |
710 | ||
711 | static gfc_dependency | |
1a9745d2 | 712 | gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n) |
4ee9c684 | 713 | { |
3f4feb44 | 714 | gfc_array_ref l_ar; |
4ee9c684 | 715 | gfc_expr *l_start; |
716 | gfc_expr *l_end; | |
717 | gfc_expr *l_stride; | |
3f4feb44 | 718 | gfc_expr *l_lower; |
719 | gfc_expr *l_upper; | |
720 | int l_dir; | |
4ee9c684 | 721 | |
3f4feb44 | 722 | gfc_array_ref r_ar; |
4ee9c684 | 723 | gfc_expr *r_start; |
3f4feb44 | 724 | gfc_expr *r_end; |
4ee9c684 | 725 | gfc_expr *r_stride; |
3f4feb44 | 726 | gfc_expr *r_lower; |
727 | gfc_expr *r_upper; | |
728 | int r_dir; | |
4ee9c684 | 729 | |
730 | l_ar = lref->u.ar; | |
731 | r_ar = rref->u.ar; | |
477c2f87 | 732 | |
733 | /* If they are the same range, return without more ado. */ | |
734 | if (gfc_is_same_range (&l_ar, &r_ar, n, 0)) | |
735 | return GFC_DEP_EQUAL; | |
4ee9c684 | 736 | |
737 | l_start = l_ar.start[n]; | |
738 | l_end = l_ar.end[n]; | |
739 | l_stride = l_ar.stride[n]; | |
3f4feb44 | 740 | |
4ee9c684 | 741 | r_start = r_ar.start[n]; |
3f4feb44 | 742 | r_end = r_ar.end[n]; |
4ee9c684 | 743 | r_stride = r_ar.stride[n]; |
744 | ||
3f4feb44 | 745 | /* If l_start is NULL take it from array specifier. */ |
746 | if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar.as)) | |
4ee9c684 | 747 | l_start = l_ar.as->lower[n]; |
3f4feb44 | 748 | /* If l_end is NULL take it from array specifier. */ |
749 | if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar.as)) | |
4ee9c684 | 750 | l_end = l_ar.as->upper[n]; |
751 | ||
3f4feb44 | 752 | /* If r_start is NULL take it from array specifier. */ |
753 | if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as)) | |
4ee9c684 | 754 | r_start = r_ar.as->lower[n]; |
3f4feb44 | 755 | /* If r_end is NULL take it from array specifier. */ |
756 | if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as)) | |
757 | r_end = r_ar.as->upper[n]; | |
758 | ||
759 | /* Determine whether the l_stride is positive or negative. */ | |
760 | if (!l_stride) | |
761 | l_dir = 1; | |
762 | else if (l_stride->expr_type == EXPR_CONSTANT | |
1a9745d2 | 763 | && l_stride->ts.type == BT_INTEGER) |
3f4feb44 | 764 | l_dir = mpz_sgn (l_stride->value.integer); |
765 | else if (l_start && l_end) | |
766 | l_dir = gfc_dep_compare_expr (l_end, l_start); | |
767 | else | |
768 | l_dir = -2; | |
769 | ||
770 | /* Determine whether the r_stride is positive or negative. */ | |
771 | if (!r_stride) | |
772 | r_dir = 1; | |
773 | else if (r_stride->expr_type == EXPR_CONSTANT | |
1a9745d2 | 774 | && r_stride->ts.type == BT_INTEGER) |
3f4feb44 | 775 | r_dir = mpz_sgn (r_stride->value.integer); |
776 | else if (r_start && r_end) | |
777 | r_dir = gfc_dep_compare_expr (r_end, r_start); | |
778 | else | |
779 | r_dir = -2; | |
4ee9c684 | 780 | |
3f4feb44 | 781 | /* The strides should never be zero. */ |
782 | if (l_dir == 0 || r_dir == 0) | |
783 | return GFC_DEP_OVERLAP; | |
4ee9c684 | 784 | |
3f4feb44 | 785 | /* Determine LHS upper and lower bounds. */ |
786 | if (l_dir == 1) | |
787 | { | |
788 | l_lower = l_start; | |
789 | l_upper = l_end; | |
790 | } | |
791 | else if (l_dir == -1) | |
792 | { | |
793 | l_lower = l_end; | |
794 | l_upper = l_start; | |
795 | } | |
4ee9c684 | 796 | else |
3f4feb44 | 797 | { |
798 | l_lower = NULL; | |
799 | l_upper = NULL; | |
800 | } | |
4ee9c684 | 801 | |
3f4feb44 | 802 | /* Determine RHS upper and lower bounds. */ |
803 | if (r_dir == 1) | |
804 | { | |
805 | r_lower = r_start; | |
806 | r_upper = r_end; | |
807 | } | |
808 | else if (r_dir == -1) | |
809 | { | |
810 | r_lower = r_end; | |
811 | r_upper = r_start; | |
812 | } | |
813 | else | |
814 | { | |
815 | r_lower = NULL; | |
816 | r_upper = NULL; | |
817 | } | |
818 | ||
819 | /* Check whether the ranges are disjoint. */ | |
820 | if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1) | |
821 | return GFC_DEP_NODEP; | |
822 | if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1) | |
823 | return GFC_DEP_NODEP; | |
824 | ||
825 | /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL. */ | |
826 | if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0) | |
827 | { | |
828 | if (l_dir == 1 && r_dir == -1) | |
1a9745d2 | 829 | return GFC_DEP_EQUAL; |
3f4feb44 | 830 | if (l_dir == -1 && r_dir == 1) |
1a9745d2 | 831 | return GFC_DEP_EQUAL; |
3f4feb44 | 832 | } |
833 | ||
834 | /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL. */ | |
835 | if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0) | |
836 | { | |
837 | if (l_dir == 1 && r_dir == -1) | |
1a9745d2 | 838 | return GFC_DEP_EQUAL; |
3f4feb44 | 839 | if (l_dir == -1 && r_dir == 1) |
1a9745d2 | 840 | return GFC_DEP_EQUAL; |
3f4feb44 | 841 | } |
842 | ||
843 | /* Check for forward dependencies x:y vs. x+1:z. */ | |
844 | if (l_dir == 1 && r_dir == 1 | |
845 | && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == -1 | |
846 | && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == -1) | |
847 | { | |
848 | /* Check that the strides are the same. */ | |
849 | if (!l_stride && !r_stride) | |
850 | return GFC_DEP_FORWARD; | |
851 | if (l_stride && r_stride | |
852 | && gfc_dep_compare_expr (l_stride, r_stride) == 0) | |
853 | return GFC_DEP_FORWARD; | |
854 | } | |
855 | ||
856 | /* Check for forward dependencies x:y:-1 vs. x-1:z:-1. */ | |
857 | if (l_dir == -1 && r_dir == -1 | |
858 | && l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 1 | |
859 | && l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 1) | |
860 | { | |
861 | /* Check that the strides are the same. */ | |
862 | if (!l_stride && !r_stride) | |
863 | return GFC_DEP_FORWARD; | |
864 | if (l_stride && r_stride | |
865 | && gfc_dep_compare_expr (l_stride, r_stride) == 0) | |
866 | return GFC_DEP_FORWARD; | |
867 | } | |
868 | ||
869 | return GFC_DEP_OVERLAP; | |
4ee9c684 | 870 | } |
871 | ||
872 | ||
a6c8790e | 873 | /* Determines overlapping for a single element and a section. */ |
4ee9c684 | 874 | |
875 | static gfc_dependency | |
1a9745d2 | 876 | gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n) |
4ee9c684 | 877 | { |
a6c8790e | 878 | gfc_array_ref *ref; |
879 | gfc_expr *elem; | |
880 | gfc_expr *start; | |
881 | gfc_expr *end; | |
882 | gfc_expr *stride; | |
4ee9c684 | 883 | int s; |
884 | ||
a6c8790e | 885 | elem = lref->u.ar.start[n]; |
886 | if (!elem) | |
4ee9c684 | 887 | return GFC_DEP_OVERLAP; |
888 | ||
a6c8790e | 889 | ref = &rref->u.ar; |
890 | start = ref->start[n] ; | |
891 | end = ref->end[n] ; | |
892 | stride = ref->stride[n]; | |
893 | ||
894 | if (!start && IS_ARRAY_EXPLICIT (ref->as)) | |
895 | start = ref->as->lower[n]; | |
896 | if (!end && IS_ARRAY_EXPLICIT (ref->as)) | |
897 | end = ref->as->upper[n]; | |
898 | ||
899 | /* Determine whether the stride is positive or negative. */ | |
900 | if (!stride) | |
901 | s = 1; | |
902 | else if (stride->expr_type == EXPR_CONSTANT | |
903 | && stride->ts.type == BT_INTEGER) | |
904 | s = mpz_sgn (stride->value.integer); | |
905 | else | |
906 | s = -2; | |
4ee9c684 | 907 | |
a6c8790e | 908 | /* Stride should never be zero. */ |
909 | if (s == 0) | |
4ee9c684 | 910 | return GFC_DEP_OVERLAP; |
911 | ||
a6c8790e | 912 | /* Positive strides. */ |
4ee9c684 | 913 | if (s == 1) |
914 | { | |
a6c8790e | 915 | /* Check for elem < lower. */ |
916 | if (start && gfc_dep_compare_expr (elem, start) == -1) | |
917 | return GFC_DEP_NODEP; | |
918 | /* Check for elem > upper. */ | |
919 | if (end && gfc_dep_compare_expr (elem, end) == 1) | |
920 | return GFC_DEP_NODEP; | |
921 | ||
922 | if (start && end) | |
923 | { | |
924 | s = gfc_dep_compare_expr (start, end); | |
925 | /* Check for an empty range. */ | |
926 | if (s == 1) | |
927 | return GFC_DEP_NODEP; | |
928 | if (s == 0 && gfc_dep_compare_expr (elem, start) == 0) | |
929 | return GFC_DEP_EQUAL; | |
930 | } | |
931 | } | |
932 | /* Negative strides. */ | |
933 | else if (s == -1) | |
934 | { | |
935 | /* Check for elem > upper. */ | |
936 | if (end && gfc_dep_compare_expr (elem, start) == 1) | |
937 | return GFC_DEP_NODEP; | |
938 | /* Check for elem < lower. */ | |
939 | if (start && gfc_dep_compare_expr (elem, end) == -1) | |
940 | return GFC_DEP_NODEP; | |
941 | ||
942 | if (start && end) | |
943 | { | |
944 | s = gfc_dep_compare_expr (start, end); | |
945 | /* Check for an empty range. */ | |
946 | if (s == -1) | |
947 | return GFC_DEP_NODEP; | |
948 | if (s == 0 && gfc_dep_compare_expr (elem, start) == 0) | |
949 | return GFC_DEP_EQUAL; | |
950 | } | |
4ee9c684 | 951 | } |
a6c8790e | 952 | /* Unknown strides. */ |
4ee9c684 | 953 | else |
954 | { | |
a6c8790e | 955 | if (!start || !end) |
956 | return GFC_DEP_OVERLAP; | |
957 | s = gfc_dep_compare_expr (start, end); | |
958 | if (s == -2) | |
4ee9c684 | 959 | return GFC_DEP_OVERLAP; |
a6c8790e | 960 | /* Assume positive stride. */ |
961 | if (s == -1) | |
962 | { | |
963 | /* Check for elem < lower. */ | |
964 | if (gfc_dep_compare_expr (elem, start) == -1) | |
965 | return GFC_DEP_NODEP; | |
966 | /* Check for elem > upper. */ | |
967 | if (gfc_dep_compare_expr (elem, end) == 1) | |
968 | return GFC_DEP_NODEP; | |
969 | } | |
970 | /* Assume negative stride. */ | |
971 | else if (s == 1) | |
972 | { | |
973 | /* Check for elem > upper. */ | |
974 | if (gfc_dep_compare_expr (elem, start) == 1) | |
975 | return GFC_DEP_NODEP; | |
976 | /* Check for elem < lower. */ | |
977 | if (gfc_dep_compare_expr (elem, end) == -1) | |
978 | return GFC_DEP_NODEP; | |
979 | } | |
980 | /* Equal bounds. */ | |
981 | else if (s == 0) | |
982 | { | |
983 | s = gfc_dep_compare_expr (elem, start); | |
984 | if (s == 0) | |
985 | return GFC_DEP_EQUAL; | |
986 | if (s == 1 || s == -1) | |
987 | return GFC_DEP_NODEP; | |
988 | } | |
4ee9c684 | 989 | } |
4ee9c684 | 990 | |
a6c8790e | 991 | return GFC_DEP_OVERLAP; |
4ee9c684 | 992 | } |
993 | ||
994 | ||
bf0a0eb6 | 995 | /* Traverse expr, checking all EXPR_VARIABLE symbols for their |
996 | forall_index attribute. Return true if any variable may be | |
997 | being used as a FORALL index. Its safe to pessimistically | |
998 | return true, and assume a dependency. */ | |
999 | ||
1000 | static bool | |
1a9745d2 | 1001 | contains_forall_index_p (gfc_expr *expr) |
bf0a0eb6 | 1002 | { |
1003 | gfc_actual_arglist *arg; | |
1004 | gfc_constructor *c; | |
1005 | gfc_ref *ref; | |
1006 | int i; | |
1007 | ||
1008 | if (!expr) | |
1009 | return false; | |
1010 | ||
1011 | switch (expr->expr_type) | |
1012 | { | |
1013 | case EXPR_VARIABLE: | |
1014 | if (expr->symtree->n.sym->forall_index) | |
1015 | return true; | |
1016 | break; | |
1017 | ||
1018 | case EXPR_OP: | |
1019 | if (contains_forall_index_p (expr->value.op.op1) | |
1020 | || contains_forall_index_p (expr->value.op.op2)) | |
1021 | return true; | |
1022 | break; | |
1023 | ||
1024 | case EXPR_FUNCTION: | |
1025 | for (arg = expr->value.function.actual; arg; arg = arg->next) | |
1026 | if (contains_forall_index_p (arg->expr)) | |
1027 | return true; | |
1028 | break; | |
1029 | ||
1030 | case EXPR_CONSTANT: | |
1031 | case EXPR_NULL: | |
1032 | case EXPR_SUBSTRING: | |
1033 | break; | |
1034 | ||
1035 | case EXPR_STRUCTURE: | |
1036 | case EXPR_ARRAY: | |
1037 | for (c = expr->value.constructor; c; c = c->next) | |
1038 | if (contains_forall_index_p (c->expr)) | |
1039 | return true; | |
1040 | break; | |
1041 | ||
1042 | default: | |
1043 | gcc_unreachable (); | |
1044 | } | |
1045 | ||
1046 | for (ref = expr->ref; ref; ref = ref->next) | |
1047 | switch (ref->type) | |
1048 | { | |
1049 | case REF_ARRAY: | |
1050 | for (i = 0; i < ref->u.ar.dimen; i++) | |
1051 | if (contains_forall_index_p (ref->u.ar.start[i]) | |
1052 | || contains_forall_index_p (ref->u.ar.end[i]) | |
1053 | || contains_forall_index_p (ref->u.ar.stride[i])) | |
1054 | return true; | |
1055 | break; | |
1056 | ||
1057 | case REF_COMPONENT: | |
1058 | break; | |
1059 | ||
1060 | case REF_SUBSTRING: | |
1061 | if (contains_forall_index_p (ref->u.ss.start) | |
1062 | || contains_forall_index_p (ref->u.ss.end)) | |
1063 | return true; | |
1064 | break; | |
1065 | ||
1066 | default: | |
1067 | gcc_unreachable (); | |
1068 | } | |
1069 | ||
1070 | return false; | |
1071 | } | |
1072 | ||
4ee9c684 | 1073 | /* Determines overlapping for two single element array references. */ |
1074 | ||
1075 | static gfc_dependency | |
1a9745d2 | 1076 | gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n) |
4ee9c684 | 1077 | { |
1078 | gfc_array_ref l_ar; | |
1079 | gfc_array_ref r_ar; | |
1080 | gfc_expr *l_start; | |
1081 | gfc_expr *r_start; | |
80425127 | 1082 | int i; |
4ee9c684 | 1083 | |
80425127 | 1084 | l_ar = lref->u.ar; |
1085 | r_ar = rref->u.ar; | |
1086 | l_start = l_ar.start[n] ; | |
1087 | r_start = r_ar.start[n] ; | |
1088 | i = gfc_dep_compare_expr (r_start, l_start); | |
1089 | if (i == 0) | |
1090 | return GFC_DEP_EQUAL; | |
bf0a0eb6 | 1091 | |
1092 | /* Treat two scalar variables as potentially equal. This allows | |
1093 | us to prove that a(i,:) and a(j,:) have no dependency. See | |
1094 | Gerald Roth, "Evaluation of Array Syntax Dependence Analysis", | |
1095 | Proceedings of the International Conference on Parallel and | |
1096 | Distributed Processing Techniques and Applications (PDPTA2001), | |
1097 | Las Vegas, Nevada, June 2001. */ | |
1098 | /* However, we need to be careful when either scalar expression | |
1099 | contains a FORALL index, as these can potentially change value | |
1100 | during the scalarization/traversal of this array reference. */ | |
1a9745d2 | 1101 | if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start)) |
17c67d08 | 1102 | return GFC_DEP_OVERLAP; |
bf0a0eb6 | 1103 | |
4d4677fd | 1104 | if (i != -2) |
1105 | return GFC_DEP_NODEP; | |
bf0a0eb6 | 1106 | return GFC_DEP_EQUAL; |
4ee9c684 | 1107 | } |
1108 | ||
1109 | ||
eb89ca84 | 1110 | /* Determine if an array ref, usually an array section specifies the |
1111 | entire array. */ | |
1112 | ||
1113 | bool | |
1114 | gfc_full_array_ref_p (gfc_ref *ref) | |
1115 | { | |
1116 | int i; | |
1117 | ||
1118 | if (ref->type != REF_ARRAY) | |
1119 | return false; | |
1120 | if (ref->u.ar.type == AR_FULL) | |
1121 | return true; | |
1122 | if (ref->u.ar.type != AR_SECTION) | |
1123 | return false; | |
538374c5 | 1124 | if (ref->next) |
1125 | return false; | |
eb89ca84 | 1126 | |
1127 | for (i = 0; i < ref->u.ar.dimen; i++) | |
1128 | { | |
3d3e0f7d | 1129 | /* If we have a single element in the reference, we need to check |
1130 | that the array has a single element and that we actually reference | |
1131 | the correct element. */ | |
1132 | if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT) | |
1133 | { | |
1134 | if (!ref->u.ar.as | |
1135 | || !ref->u.ar.as->lower[i] | |
1136 | || !ref->u.ar.as->upper[i] | |
1137 | || gfc_dep_compare_expr (ref->u.ar.as->lower[i], | |
1138 | ref->u.ar.as->upper[i]) | |
1139 | || !ref->u.ar.start[i] | |
1140 | || gfc_dep_compare_expr (ref->u.ar.start[i], | |
1141 | ref->u.ar.as->lower[i])) | |
1142 | return false; | |
1143 | else | |
1144 | continue; | |
1145 | } | |
1146 | ||
eb89ca84 | 1147 | /* Check the lower bound. */ |
1148 | if (ref->u.ar.start[i] | |
1149 | && (!ref->u.ar.as | |
1150 | || !ref->u.ar.as->lower[i] | |
1151 | || gfc_dep_compare_expr (ref->u.ar.start[i], | |
1152 | ref->u.ar.as->lower[i]))) | |
1153 | return false; | |
1154 | /* Check the upper bound. */ | |
1155 | if (ref->u.ar.end[i] | |
1156 | && (!ref->u.ar.as | |
1157 | || !ref->u.ar.as->upper[i] | |
1158 | || gfc_dep_compare_expr (ref->u.ar.end[i], | |
1159 | ref->u.ar.as->upper[i]))) | |
1160 | return false; | |
1161 | /* Check the stride. */ | |
1a9745d2 | 1162 | if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0)) |
eb89ca84 | 1163 | return false; |
1164 | } | |
1165 | return true; | |
1166 | } | |
1167 | ||
1168 | ||
4ee9c684 | 1169 | /* Finds if two array references are overlapping or not. |
1170 | Return value | |
1171 | 1 : array references are overlapping. | |
80425127 | 1172 | 0 : array references are identical or not overlapping. */ |
4ee9c684 | 1173 | |
1174 | int | |
1a9745d2 | 1175 | gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref) |
4ee9c684 | 1176 | { |
1177 | int n; | |
1178 | gfc_dependency fin_dep; | |
1179 | gfc_dependency this_dep; | |
1180 | ||
4ee9c684 | 1181 | fin_dep = GFC_DEP_ERROR; |
1182 | /* Dependencies due to pointers should already have been identified. | |
1183 | We only need to check for overlapping array references. */ | |
1184 | ||
1185 | while (lref && rref) | |
1186 | { | |
1187 | /* We're resolving from the same base symbol, so both refs should be | |
a7455f80 | 1188 | the same type. We traverse the reference chain intil we find ranges |
4ee9c684 | 1189 | that are not equal. */ |
22d678e8 | 1190 | gcc_assert (lref->type == rref->type); |
4ee9c684 | 1191 | switch (lref->type) |
1192 | { | |
1193 | case REF_COMPONENT: | |
1194 | /* The two ranges can't overlap if they are from different | |
1195 | components. */ | |
1196 | if (lref->u.c.component != rref->u.c.component) | |
1197 | return 0; | |
1198 | break; | |
1199 | ||
1200 | case REF_SUBSTRING: | |
1201 | /* Substring overlaps are handled by the string assignment code. */ | |
1202 | return 0; | |
1203 | ||
1204 | case REF_ARRAY: | |
1a9745d2 | 1205 | if (lref->u.ar.dimen != rref->u.ar.dimen) |
eb89ca84 | 1206 | { |
1207 | if (lref->u.ar.type == AR_FULL) | |
1208 | fin_dep = gfc_full_array_ref_p (rref) ? GFC_DEP_EQUAL | |
1209 | : GFC_DEP_OVERLAP; | |
1210 | else if (rref->u.ar.type == AR_FULL) | |
1211 | fin_dep = gfc_full_array_ref_p (lref) ? GFC_DEP_EQUAL | |
1212 | : GFC_DEP_OVERLAP; | |
1213 | else | |
1a9745d2 | 1214 | return 1; |
eb89ca84 | 1215 | break; |
1216 | } | |
1217 | ||
4ee9c684 | 1218 | for (n=0; n < lref->u.ar.dimen; n++) |
1219 | { | |
1220 | /* Assume dependency when either of array reference is vector | |
a7455f80 | 1221 | subscript. */ |
4ee9c684 | 1222 | if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR |
1223 | || rref->u.ar.dimen_type[n] == DIMEN_VECTOR) | |
1224 | return 1; | |
1225 | if (lref->u.ar.dimen_type[n] == DIMEN_RANGE | |
1226 | && rref->u.ar.dimen_type[n] == DIMEN_RANGE) | |
1227 | this_dep = gfc_check_section_vs_section (lref, rref, n); | |
1228 | else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT | |
1229 | && rref->u.ar.dimen_type[n] == DIMEN_RANGE) | |
1230 | this_dep = gfc_check_element_vs_section (lref, rref, n); | |
1231 | else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT | |
1232 | && lref->u.ar.dimen_type[n] == DIMEN_RANGE) | |
1233 | this_dep = gfc_check_element_vs_section (rref, lref, n); | |
1234 | else | |
1235 | { | |
22d678e8 | 1236 | gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT |
a7455f80 | 1237 | && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT); |
4ee9c684 | 1238 | this_dep = gfc_check_element_vs_element (rref, lref, n); |
1239 | } | |
1240 | ||
1241 | /* If any dimension doesn't overlap, we have no dependency. */ | |
1242 | if (this_dep == GFC_DEP_NODEP) | |
1243 | return 0; | |
1244 | ||
1245 | /* Overlap codes are in order of priority. We only need to | |
a7455f80 | 1246 | know the worst one.*/ |
4ee9c684 | 1247 | if (this_dep > fin_dep) |
1248 | fin_dep = this_dep; | |
1249 | } | |
1250 | /* Exactly matching and forward overlapping ranges don't cause a | |
1251 | dependency. */ | |
1252 | if (fin_dep < GFC_DEP_OVERLAP) | |
1253 | return 0; | |
1254 | ||
1255 | /* Keep checking. We only have a dependency if | |
1256 | subsequent references also overlap. */ | |
1257 | break; | |
1258 | ||
1259 | default: | |
22d678e8 | 1260 | gcc_unreachable (); |
4ee9c684 | 1261 | } |
1262 | lref = lref->next; | |
1263 | rref = rref->next; | |
1264 | } | |
1265 | ||
1266 | /* If we haven't seen any array refs then something went wrong. */ | |
22d678e8 | 1267 | gcc_assert (fin_dep != GFC_DEP_ERROR); |
4ee9c684 | 1268 | |
80425127 | 1269 | /* Assume the worst if we nest to different depths. */ |
1270 | if (lref || rref) | |
4ee9c684 | 1271 | return 1; |
80425127 | 1272 | |
1273 | return fin_dep == GFC_DEP_OVERLAP; | |
4ee9c684 | 1274 | } |
1275 |