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