1 /*
2 * Copyright (c) 1994-2019, NVIDIA CORPORATION. All rights reserved.
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 *
16 */
17
18 /* optutil.c - miscellaneous optimizer utility routines
19
20 LOGICAL is_optsym(int)
21 determine if nme represents an optimizable sym
22
23 LOGICAL is_sym_optsafe(int)
24 determine if there are side-effect or alias conflicts for nme
25
26 LOGICAL is_call_safe(int)
27 determine if nme can be affected by a call
28
29 LOGICAL is_based_safe(int, int, int)
30 determine if based symbol is safe to optimize
31
32 int pred_of_loop(int)
33 find a flowgraph node which is a predecessor of a loop
34
35 int find_rdef(int, int, LOGICAL)
36 find a single def of a nme which reaches a flowgraph node (either the
37 beginning or end of the node)
38
39 LOGICAL is_sym_entry_live(int)
40 determine if a symbol is live upon entry to a function/subprogram
41
42 LOGICAL is_sym_exit_live(int)
43 determine if a symbol is live upon exit from a function/subprogram
44
45 LOGICAL is_sym_imp_live(int)
46 determine if a symbol is live because of implicit uses
47
48 LOGICAL can_copy_def(int, int, LOGICAL)
49 determine if a def's value can be copied to a flowgraph node (either
50 the beginning or end of the node).
51
52 LOIGCAL def_ok(int, int, int)
53 LOGICAL is_avail_expr(int, int, int, int, LOGICAL) (static)
54 LOGICAL avail_expr(int) (static)
55
56 LOGICAL single_ud(int)
57 determine if a single def reaches a use.
58 LOGICAL only_one_ud(int)
59 similar to single_ud except left-hand side must be available rather
60 than the right-hand side.
61
62 LOGICAL is_def_imp_live(int)
63 determine if a definition is live because of implicit uses
64
65 void rm_def_rloop(int, int)
66 remove a def, where its uses in a loop have been deleted, if it has
67 no other uses.
68 */
69 #include "gbldefs.h"
70 #include "global.h"
71 #include "error.h"
72 #include "symtab.h"
73 #include "semant.h"
74 #include "nme.h"
75 #include "ast.h"
76 #include "optimize.h"
77
78 int basesym_of(int);
79
80 /* forward declarations */
81
82 /*
83
84 The bit vector representation for a set of size N is a sequence of
85 bits ordered right to left. For i, 1<=i<=N,
86 w = (i-1) / #bits in a BV unit
87 r = (i-1) % #bits in a BV unit
88 then the rth bit in the wth BV unit represents the set membership
89 for i.
90
91 Bit vector support routines:
92 bv_zero - a = 0
93 bv_copy - a = b
94 bv_union - a = a U b
95 bv_sub - a = a - b
96 bv_set - add element to a
97 bv_off - remove element from a
98 bv_notequal - a != b
99 bv_mem - is element a member of a
100 */
101
102 void
bv_zero(BV * a,int len)103 bv_zero(BV *a, int len)
104 {
105 while (len--)
106 *a++ = 0;
107 }
108
109 void
bv_copy(BV * a,BV * b,int len)110 bv_copy(BV *a, BV *b, int len)
111 {
112 while (len--)
113 *a++ = *b++;
114 }
115
116 void
bv_union(BV * a,BV * b,int len)117 bv_union(BV *a, BV *b, int len)
118 {
119 while (len--)
120 *a++ |= *b++;
121 }
122
123 void
bv_sub(BV * a,BV * b,int len)124 bv_sub(BV *a, BV *b, int len)
125 {
126 while (len--)
127 *a++ &= ~(*b++);
128 }
129
130 void
bv_intersect(BV * a,BV * b,UINT len)131 bv_intersect(BV *a, BV *b, UINT len)
132 {
133 while (len--)
134 *a++ &= *b++;
135 }
136
137 void
bv_intersect3(BV * a,BV * b,BV * c,UINT len)138 bv_intersect3(BV *a, BV *b, BV *c, UINT len)
139 {
140 while (len--)
141 *a++ = (*b++) & (*c++);
142 }
143
144 void
bv_set(BV * a,int elem)145 bv_set(BV *a, int elem)
146 {
147 int w, r;
148
149 w = (elem - 1) / BV_BITS;
150 r = (elem - 1) - w * BV_BITS;
151 *(a + w) |= 1 << r;
152 }
153
154 void
bv_off(BV * a,int elem)155 bv_off(BV *a, int elem)
156 {
157 int w, r;
158
159 w = (elem - 1) / BV_BITS;
160 r = (elem - 1) - w * BV_BITS;
161 *(a + w) &= (BV) ~(1 << r);
162 }
163
164 LOGICAL
bv_notequal(BV * a,BV * b,int len)165 bv_notequal(BV *a, BV *b, int len)
166 {
167 while (len--)
168 if (*a++ != *b++)
169 return (TRUE);
170 return (FALSE);
171 }
172
173 LOGICAL
bv_mem(BV * a,int elem)174 bv_mem(BV *a, int elem)
175 {
176 int w, r;
177
178 #if DEBUG
179 assert(a != NULL, "bv_mem: bv null", 0, 3);
180 #endif
181 w = (elem - 1) / BV_BITS;
182 r = (elem - 1) - w * BV_BITS;
183 if (*(a + w) & (BV)(1 << r))
184 return (TRUE);
185 return (FALSE);
186 }
187
188 void
bv_print(BV * bv,int maxlen)189 bv_print(BV *bv, int maxlen)
190 {
191 int i, j, w;
192
193 j = 0;
194 w = *bv++;
195 for (i = 1; i <= maxlen; i++) {
196 if (w & 1) {
197 if (j == 11) {
198 fprintf(gbl.dbgfil, "\n ");
199 j = 0;
200 }
201 j++;
202 fprintf(gbl.dbgfil, " %5d", i);
203 }
204 w = w >> 1;
205 if (i % BV_BITS == 0)
206 w = *bv++;
207 }
208 fprintf(gbl.dbgfil, "\n");
209
210 }
211
212 /* this routine checks the names entry to determine if it is allowed
213 * to enter in the global flow analysis
214 */
215 LOGICAL
is_optsym(int nme)216 is_optsym(int nme)
217 {
218 if (NME_TYPE(nme) != NT_VAR) /* var names only */
219 return (FALSE);
220 return (TRUE);
221 }
222
223 LOGICAL
is_sym_optsafe(int nme,int lpx)224 is_sym_optsafe(int nme, int lpx)
225 {
226 int sym;
227 /*
228 * a symbol is not safe (potential "side-effect" or alias conflicts
229 * exist) if:
230 * 1. for C and Fortran, the symbol is volatile
231 *
232 * 2. for Fortran, the symbol is equivalenced
233 *
234 * 3. loop contains a call AND
235 * a. sym's address has been taken, or
236 * b. sym's storage class is not auto (it is static or extern), or
237 * c. for c++, sym is used in two or more nested scope levels
238 *
239 * 4. loop contains a store or load via a pointer AND the sym could
240 * conflict with a pointer (see optutil.c:is_sym_ptrsafe()).
241 *
242 * 6. the symbol is private and the loop is not a parallel loop.
243 *
244 * 7. the symbol is not a private variable and the loop contains
245 * a parallel section.
246 *
247 * 8. the symbol is threadprivate and the current region is 0; in
248 * region 0, its address can't computed before the call to mp_cdecl().
249 *
250 * WARNING - Any new constraints may need to be added to
251 * invar.c:is_sym_invariant_safe() as well.
252 *
253 */
254 sym = NME_SYM(nme);
255
256 if (VOLG(sym))
257 return (FALSE);
258
259 if (!XBIT(19, 0x1) && SOCPTRG(sym)) /* noeqvchk => XBIT(19,0x1) set */
260 return (FALSE);
261
262 if (LP_CALLFG(lpx) && (ADDRTKNG(sym)
263 || !IS_LCL_OR_DUM(sym))) {
264 return (FALSE);
265 }
266
267 if ((LP_PTR_STORE(lpx) || LP_PTR_LOAD(lpx)) && !is_sym_ptrsafe(sym))
268 return (FALSE);
269
270 if (IS_PRIVATE(sym) && !LP_PARLOOP(lpx))
271 return (FALSE);
272
273 if ((LP_CSECT(lpx) || LP_PARREGN(lpx)) && !IS_PRIVATE(sym)) {
274 Q_ITEM *q;
275 for (q = LP_STL_PAR(lpx); q != NULL; q = q->next)
276 if (q->info == nme)
277 return (FALSE);
278 }
279
280 if (LP_PARSECT(lpx) && !IS_PRIVATE(sym)) {
281 return (FALSE);
282 }
283
284 if (lpx == 0 && THREADG(sym)) /* not going to qualify any further */
285 return FALSE;
286
287 return (TRUE);
288 }
289
290 LOGICAL
is_sym_live_safe(int nme,int lpx)291 is_sym_live_safe(int nme, int lpx)
292 {
293 int sym;
294 /*
295 * Less conservative form of is_sym_optsafe() for flow.c:is_live_out()/
296 * is_live_in(). The is_live routines used to call is_sym_optsafe()
297 * with a loop value of 0 to catch cases such as passing the address
298 * of a variable to a subroutine (i.e., its ADDRTKN flag is set and
299 * LP_CALLFG(0) is set). Using 0 had the effect of returning FALSE
300 * for any variable appearing in a critical section; however, it's
301 * sufficient to use the actual loop index for which the is_live
302 * inquiry. In this function, explicitly use a loop value of 0 (LPZ)
303 * where it's necesary to be convservative; flow.c will call this
304 * function with the actual loop index.
305 */
306 #define LPZ 0
307 /*
308 * a symbol is not safe (potential "side-effect" or alias conflicts
309 * exist) if:
310 * 1. for C and Fortran, the symbol is volatile
311 *
312 * 2. for Fortran, the symbol is equivalenced
313 *
314 * 3. loop contains a call AND
315 * a. sym's address has been taken, or
316 * b. sym's storage class is not auto (it is static or extern), or
317 * c. for c++, sym is used in two or more nested scope levels
318 *
319 * 4. loop contains a store or load via a pointer AND the sym could
320 * conflict with a pointer (see optutil.c:is_sym_ptrsafe()).
321 *
322 * 6. the symbol is private and the loop is not a parallel loop.
323 *
324 * 7. the symbol is not a private variable and the loop contains
325 * a parallel section.
326 *
327 * 8. the symbol is threadprivate and the current region is 0; in
328 * region 0, its address can't computed before the call to mp_cdecl().
329 *
330 * WARNING - Any new constraints may need to be added to
331 * invar.c:is_sym_invariant_safe() as well.
332 *
333 */
334 sym = NME_SYM(nme);
335
336 if (VOLG(sym))
337 return (FALSE);
338
339 if (!XBIT(19, 0x1) && SOCPTRG(sym)) /* noeqvchk => XBIT(19,0x1) set */
340 return (FALSE);
341
342 if (LP_CALLFG(LPZ) && (ADDRTKNG(sym)
343 || !IS_LCL_OR_DUM(sym))) {
344 return (FALSE);
345 }
346
347 if ((LP_PTR_STORE(LPZ) || LP_PTR_LOAD(LPZ)) && !is_sym_ptrsafe(sym))
348 return (FALSE);
349
350 if (IS_PRIVATE(sym) && !LP_PARLOOP(lpx))
351 return (FALSE);
352
353 if ((LP_CSECT(lpx) || LP_PARREGN(lpx)) && !IS_PRIVATE(sym)) {
354 Q_ITEM *q;
355 for (q = LP_STL_PAR(lpx); q != NULL; q = q->next)
356 if (q->info == nme)
357 return (FALSE);
358 }
359
360 if (LP_PARSECT(lpx) && !IS_PRIVATE(sym)) {
361 return (FALSE);
362 }
363
364 return (TRUE);
365 }
366
367 LOGICAL
is_call_safe(int nme)368 is_call_safe(int nme)
369 {
370 int sym;
371 /*
372 * a symbol can be modified by a call if:
373 * 1. for C, the symbol is extern or file static
374 *
375 * 2. for Fortran, the symbol is extern (common block)
376 *
377 * 3. its address is taken
378 *
379 * 4. for C++, sym is accessed from separate scoping units
380 *
381 * 5. for Fortran, the call is to an contained subprogram
382 * Unfortunately, we don't distinguish between internal and
383 * external calls as yet, so if there are contained subprograms,
384 * outer-block symbols are marked as not call-safe.
385 */
386 sym = NME_SYM(nme);
387
388 if (IS_CMNBLK(sym))
389 return FALSE;
390 if ((POINTERG(sym) || ALLOCATTRG(sym)) && MIDNUMG(sym) &&
391 IS_CMNBLK(MIDNUMG(sym))) {
392 return FALSE;
393 }
394 if (gbl.internal && !INTERNALG(sym))
395 return FALSE;
396 if (ADDRTKNG(sym))
397 return FALSE;
398
399 return TRUE;
400 }
401
402 /*
403 * determine, given an pointer nme (type NT_IND), if it's safe to ignore
404 * any pointer conflicts. This is based on a combination of the storage
405 * class of the pointer variable involved in the reference and the value
406 * of the -x 2 flag.
407 */
408 LOGICAL
is_ptr_safe(int nme)409 is_ptr_safe(int nme)
410 {
411 int sym;
412 int sc;
413
414 #if DEBUG
415 assert(NME_TYPE(nme) == NT_IND || NME_TYPE(nme) == NT_VAR ||
416 NME_TYPE(nme) == NT_MEM,
417 "is_ptr_safe: nme not ind", nme, 3);
418 #endif
419 if (0 != (sym = basesym_of(nme))) {
420 sc = SCG(sym);
421 if ((XBIT(2, 0x1) && sc == SC_DUMMY) || (XBIT(2, 0x2) && sc == SC_LOCAL) ||
422 (XBIT(2, 0x4) && sc == SC_STATIC) ||
423 (XBIT(2, 0x8) && (sc == SC_CMBLK || sc == SC_EXTERN)))
424 return TRUE;
425 }
426
427 return FALSE;
428 }
429
430 /*
431 * Determine if a symbol does not conflict with a pointer reference.
432 * A pointer can conflict with a symbol if:
433 * 1. the symbol's addrtkn flag is set,
434 *
435 * 2. for C, the symbol is extern or file static,
436 *
437 * 3. for fortran, the symbol is in common or is an external,
438 *
439 * 4. for C++, sym is accessed from separate scoping units
440 *
441 * The storage class tests may be inhibited by the -x 2 flag or the
442 * presence of -Mnodepchk.
443 */
444 LOGICAL
is_sym_ptrsafe(int sym)445 is_sym_ptrsafe(int sym)
446 {
447 int sc;
448
449 if (ADDRTKNG(sym))
450 return FALSE;
451 sc = SCG(sym);
452 if (flg.depchk && (sc == SC_CMBLK || sc == SC_EXTERN) && !XBIT(2, 0x8))
453 return FALSE;
454
455 return TRUE;
456 }
457
458 /*
459 * find the flowgraph node which is the predecessor of the indicated loop.
460 * If there is more than 1, 0 is returned.
461 */
462 int
pred_of_loop(int lpx)463 pred_of_loop(int lpx)
464 {
465 PSI_P pred;
466 int fgx;
467
468 fgx = 0;
469 pred = FG_PRED(LP_HEAD(lpx));
470 for (; pred != PSI_P_NULL; pred = PSI_NEXT(pred)) {
471 if (FG_LOOP(PSI_NODE(pred)) == lpx)
472 continue;
473 if (fgx) {
474 fgx = 0;
475 break;
476 }
477 fgx = PSI_NODE(pred);
478 }
479
480 return fgx;
481 }
482
483 /*
484 * find a single definition for the symbol indicated by its names entry
485 * which reaches the beginning or the end of the flowgraph node, fgx.
486 * If a definition isn't found or if more than one def reaches the node,
487 * 0 is returned.
488 */
489 /* TRUE if def is to reach the beginning */
490 int
find_rdef(int nme,int fgx,LOGICAL begin)491 find_rdef(int nme, int fgx, LOGICAL begin)
492 {
493 int def;
494 int rdef;
495 BV *inout;
496
497 /* ensure that the variable is an "optimizable" symbol */
498
499 if (!is_optsym(nme))
500 return 0;
501
502 inout = begin ? FG_IN(fgx) : FG_OUT(fgx);
503 /*
504 * if the node doesn't have a IN/OUT set (node added after flow analysis),
505 * return "no def".
506 */
507 if (inout == NULL)
508 return 0;
509 /*
510 * scan the defs for the induction variable for a single reaching
511 * definition.
512 */
513 rdef = 0;
514 for (def = NME_DEF(nme); def; def = DEF_NEXT(def)) {
515 if (bv_mem(inout, def)) {
516 if (rdef) {
517 rdef = 0;
518 break;
519 }
520 rdef = def;
521 }
522 }
523
524 return (rdef);
525 }
526
527 /*
528 * determine if a symbol is live upon exit from a function/
529 * subprogram.
530 */
531 LOGICAL
is_sym_exit_live(int nme)532 is_sym_exit_live(int nme)
533 {
534 int sym;
535
536 #if DEBUG
537 assert(nme > 0 && nme <= nmeb.stg_avail, "is_sym_exit_live, bad nme", nme, 3);
538 #endif
539 sym = NME_SYM(nme);
540 #if DEBUG
541 assert(sym <= stb.stg_avail, "is_sym_exit_live, bad sym", nme, 3);
542 #endif
543 if (IS_STATIC(sym) || IS_EXTERN(sym))
544 return TRUE;
545 if (SAVEG(sym))
546 return TRUE;
547 if (IS_DUM(sym) && INTENTG(sym) != INTENT_IN)
548 return TRUE;
549 /* if this is the result variable */
550 if (RESULTG(sym))
551 return TRUE;
552 /* in a program that contains others, or in a contained program,
553 * outer-block variables are live */
554 if (gbl.internal && !INTERNALG(sym))
555 return TRUE;
556 if (SCG(sym) == SC_LOCAL && DINITG(sym) && (ADDRTKNG(sym) || ASSNG(sym)) &&
557 gbl.rutype != RU_PROG)
558 /*
559 * if a local variable is data initialized, disallow it if it
560 * has been stored; the thinking is that it falls into the
561 * same category of a saved variable -- someday, may want
562 * to override this if XBIT(124,0x80) is set (also expreg.c)
563 */
564 return TRUE;
565 if (SCG(sym) == SC_BASED) {
566 int s;
567 for (s = MIDNUMG(sym); s; s = MIDNUMG(s))
568 if (IS_DUM(s) || IS_STATIC(s) || IS_EXTERN(s) || DINITG(s) || SAVEG(s))
569 return TRUE;
570 }
571 if (THREADG(sym)) /* not going to qualify any further */
572 return TRUE;
573
574 return FALSE;
575 }
576
577 /*
578 * determine if a symbol is live because of implicit uses -- live upon
579 * exit from a function, has its address taken, is volatile, etc.
580 */
581 LOGICAL
is_sym_imp_live(int nme)582 is_sym_imp_live(int nme)
583 {
584 int sym;
585
586 #if DEBUG
587 assert(nme > 0 && nme <= nmeb.stg_avail, "is_sym_imp_live, bad nme", nme, 3);
588 #endif
589 if (is_sym_exit_live(nme))
590 return TRUE;
591 sym = NME_SYM(nme);
592 if (ADDRTKNG(sym) || VOLG(sym))
593 return TRUE;
594 if (ARGG(sym))
595 return TRUE;
596 #ifdef PTRSTOREP
597 if (PTRSTOREG(sym))
598 return TRUE;
599 #endif
600 if (!XBIT(19, 0x1) && SOCPTRG(sym)) /* noeqvchk => XBIT(19,0x1) set */
601 return TRUE;
602 if (SCG(sym) == SC_BASED && MIDNUMG(sym))
603 return TRUE;
604 if (PTRVG(sym))
605 return TRUE;
606 if (STYPEG(sym) == ST_VAR && HCCSYMG(sym) && !VCSYMG(sym))
607 /* ...implicit uses of compiler-created bounds variables. */
608 return TRUE;
609 return FALSE;
610 }
611
612 /*
613 * determine if a symbol is live upon entry to a function/
614 * subprogram.
615 */
616 LOGICAL
is_sym_entry_live(int nme)617 is_sym_entry_live(int nme)
618 {
619 int sym;
620
621 #if DEBUG
622 assert(nme > 0 && nme <= nmeb.stg_avail, "is_sym_entry_live, bad nme", nme,
623 3);
624 #endif
625 sym = NME_SYM(nme);
626 #if DEBUG
627 assert(sym <= stb.stg_avail, "is_sym_entry_live, bad sym", nme, 3);
628 #endif
629 if (IS_STATIC(sym) || IS_EXTERN(sym))
630 return TRUE;
631 if (IS_DUM(sym))
632 return (INTENTG(sym) != INTENT_OUT);
633 if (DINITG(sym) || SAVEG(sym))
634 return TRUE;
635 if (SCG(sym) == SC_BASED) {
636 int s;
637 for (s = MIDNUMG(sym); s; s = MIDNUMG(s))
638 if (IS_DUM(s) || IS_STATIC(s) || IS_EXTERN(s) || DINITG(s) || SAVEG(s))
639 return TRUE;
640 }
641 if (THREADG(sym)) /* not going to qualify any further */
642 return TRUE;
643
644 return FALSE;
645 }
646
647 LOGICAL
is_store_via_ptr(int astx)648 is_store_via_ptr(int astx)
649 {
650 int nme;
651
652 if (A_TYPEG(astx) != A_ASN)
653 return FALSE;
654 astx = A_DESTG(astx);
655 if ((nme = A_NMEG(astx)) == 0)
656 return FALSE;
657
658 for (nme = A_NMEG(astx); TRUE; nme = NME_NM(nme)) {
659 switch (NME_TYPE(nme)) {
660 case NT_ARR:
661 case NT_MEM:
662 continue;
663 case NT_VAR:
664 if (POINTERG(NME_SYM(nme)))
665 return (!is_ptr_safe(nme));
666 return FALSE;
667 case NT_IND:
668 return (!is_ptr_safe(nme));
669 default:
670 break;
671 }
672 break;
673 }
674
675 return TRUE;
676 }
677
678 static struct {/* global info needed when checking expressions */
679 struct { /* defines start of path */
680 int stmt; /* ilt */
681 int fg; /* flowgraph node containing stmt */
682 } start;
683 struct {/* defines end of path */
684 int stmt;
685 int fg;
686 } end;
687 int eob; /* checking to end of block */
688 } srch_ae;
689
690 static int visit_list; /* list of nodes visited in in_path(),
691 * call_in_path() */
692
693 extern LOGICAL def_ok(int def, int fgx, int stmt);
694 extern LOGICAL is_avail_expr(int expr, int start_ilt, int start_fg, int end_ilt,
695 int end_fg);
696 static LOGICAL avail_expr(int expr);
697 static LOGICAL is_in_path(int fg);
698 static LOGICAL in_path(int cur, int fg);
699 static LOGICAL iscall_in_path(void);
700 static LOGICAL isptr_in_path(void);
701 static LOGICAL call_in_path(int cur);
702
703 /*
704 * determine if it's safe to copy the value of the def to either the
705 * beginning of the flowgraph node or to the end of the flowgraph
706 * node. We've already determined that the def reaches the flowgraph node.
707 */
708 LOGICAL
can_copy_def(int def,int fgx,LOGICAL begin)709 can_copy_def(int def, int fgx, LOGICAL begin)
710 {
711 int nme;
712 int sym;
713 int end_ilt;
714
715 #if DEBUG
716 assert(def, "can_copy_def: def is 0", 0, 3);
717 #endif
718 if (OPTDBG(9, 16384))
719 fprintf(gbl.dbgfil, "can_copy_def trace for %s, def %d, expr %d, to fg %d",
720 getprint(basesym_of(DEF_NM(def))), def, DEF_RHS(def), fgx);
721 if (begin)
722 end_ilt = BIH_ILTFIRST(FG_TO_BIH(fgx));
723 else
724 end_ilt = BIH_ILTLAST(FG_TO_BIH(fgx));
725 if (OPTDBG(9, 16384))
726 fprintf(gbl.dbgfil, ", ilt %d\n", end_ilt);
727
728 if (!def_ok(def, fgx, end_ilt))
729 return FALSE;
730
731 if (DEF_CONST(def)) {
732 if (OPTDBG(9, 16384))
733 fprintf(gbl.dbgfil, "can copy const def %d\n", def);
734 return TRUE;
735 }
736
737 if (XBIT(7, 1)) {
738 if (OPTDBG(9, 16384))
739 fprintf(gbl.dbgfil, "can't copy def %d, inhibited\n", def);
740 return FALSE;
741 }
742
743 if (DEF_DOINIT(def))
744 srch_ae.start.stmt = FG_STDLAST(DEF_FG(def));
745 else
746 srch_ae.start.stmt = DEF_STD(def);
747 srch_ae.start.fg = DEF_FG(def);
748 srch_ae.end.stmt = end_ilt;
749 srch_ae.end.fg = fgx;
750 srch_ae.eob = TRUE;
751 return (avail_expr((int)DEF_RHS(def)));
752 }
753
754 /*
755 * determine if it's safe to copy the value of the def to a statement
756 * by checking attributes about the def.
757 * We've already determined that the def reaches the flowgraph node.
758 */
759 LOGICAL
def_ok(int def,int fgx,int stmt)760 def_ok(int def, int fgx, int stmt)
761 {
762 int nme;
763 int sym;
764 int def_fg, def_std;
765 int iltx;
766
767 #if DEBUG
768 assert(def, "def_ok: def is 0", 0, 3);
769 #endif
770 if (OPTDBG(9, 16384))
771 fprintf(gbl.dbgfil, "def_ok trace for def %d of %s\n", def,
772 getprint(basesym_of(DEF_NM(def))));
773
774 /* does the storing expr contain a use of the symbol being defined */
775
776 if (DEF_SELF(def)) {
777 if (OPTDBG(9, 16384))
778 fprintf(gbl.dbgfil, "def %d not ok, self.\n", def);
779 return FALSE;
780 }
781
782 def_fg = DEF_FG(def);
783
784 if (def_fg != fgx && BIH_CS(FG_TO_BIH(fgx))) {
785 if (OPTDBG(9, 16384))
786 fprintf(gbl.dbgfil, "def %d not ok, use in critical sec\n", def);
787 return FALSE;
788 }
789
790 nme = DEF_NM(def);
791 sym = NME_SYM(nme);
792 if (is_sym_entry_live(nme) && !is_dominator(def_fg, fgx)) {
793 if (OPTDBG(9, 16384))
794 fprintf(gbl.dbgfil, "def %d not ok, not dom.\n", def);
795 return FALSE;
796 }
797 def_std = DEF_STD(def);
798 if (STD_EX(def_std)) {
799 if (OPTDBG(9, 16384))
800 fprintf(gbl.dbgfil, "def %d not, ilt_ex\n", def);
801 return FALSE;
802 }
803
804 if (VOLG(sym)) {
805 if (OPTDBG(9, 16384))
806 fprintf(gbl.dbgfil, "def %d not ok, sym %d VOL\n", def, sym);
807 return FALSE;
808 }
809 if (!XBIT(19, 0x1) && SOCPTRG(sym)) { /* noeqvchk => XBIT(19,0x1) set */
810 if (OPTDBG(9, 16384))
811 fprintf(gbl.dbgfil, "def %d not ok, sym %d EQUIV\n", def, sym);
812 return FALSE;
813 }
814
815 if (FG_IN(fgx) == NULL) {
816 if (OPTDBG(9, 16384))
817 fprintf(gbl.dbgfil, "can't copy def %d, no in of fg %d\n", def, fgx);
818 return FALSE;
819 }
820
821 /* does stmt precede the def?
822 *
823 * if def and stmt are in the same block, it's necessary to
824 * scan backwards from the def.
825 *
826 * if they aren't in the same block, the dominator test is
827 * sufficient.
828 *
829 */
830 if (def_fg == fgx) {
831 if (DEF_DOINIT(def))
832 /* defs which initialize do variables never precedes a stmt */
833 ;
834 else
835 for (iltx = (def_std); iltx; iltx = STD_PREV(iltx)) {
836 if (iltx == stmt) {
837 if (OPTDBG(9, 16384))
838 fprintf(gbl.dbgfil, "def %d not ok, ilt %d precedes def\n", def,
839 stmt);
840 return FALSE;
841 }
842 }
843 } else if (!is_dominator(def_fg, fgx)) {
844 if (OPTDBG(9, 16384))
845 fprintf(gbl.dbgfil, "def %d not ok, def does not dominator ilt %d\n", def,
846 stmt);
847 return FALSE;
848 }
849
850 /*
851 * If variable is "call" unsafe, then:
852 * 1. a call cannot exist between the def and the point.
853 * 2. If the variable has its address taken, then a store via a ptr
854 * cannot exist between the def and the point.
855 */
856 if (!is_call_safe(nme)) {
857 if (is_call_in_path(def_std, def_fg, stmt, fgx)) {
858 if (OPTDBG(9, 16384))
859 fprintf(gbl.dbgfil, "def %d not ok, call in path (%d, %d), (%d, %d)\n",
860 def, def_fg, def_std, fgx, stmt);
861 return FALSE;
862 }
863 if (!is_sym_ptrsafe(sym)) {
864 if (is_ptr_in_path(def_std, def_fg, stmt, fgx)) {
865 if (OPTDBG(9, 16384))
866 fprintf(gbl.dbgfil, "def %d not ok, ptr in path (%d, %d), (%d, %d)\n",
867 def, def_fg, def_std, fgx, stmt);
868 return FALSE;
869 }
870 }
871 }
872
873 return TRUE;
874 }
875
876 /*
877 * determine if an expression is available along a path which is defined as
878 * two points in a flowgraph node, (start_ilt, start_fg) and (end_ilt, end_ilt)
879 * NOTES:
880 * 1. starting point is always the <fg, ilt> of a def
881 * 2. the end of the path "follows" the def (i.e., def_ok has been called
882 * to ensure that the end of the path does not precede the def).
883 */
884 LOGICAL
is_avail_expr(int expr,int start_ilt,int start_fg,int end_ilt,int end_fg)885 is_avail_expr(int expr, int start_ilt, int start_fg, int end_ilt, int end_fg)
886 {
887
888 if (OPTDBG(9, 16384))
889 fprintf(gbl.dbgfil, "is_avail_expr(expr:%d, s:%d, sfg:%d, e:%d, efg:%d)\n",
890 expr, start_ilt, start_fg, end_ilt, end_fg);
891
892 if (A_TYPEG(expr) == A_CNST) {
893 if (OPTDBG(9, 16384))
894 fprintf(gbl.dbgfil, "const expr is avail.\n");
895 return TRUE;
896 }
897 srch_ae.start.stmt = start_ilt;
898 srch_ae.start.fg = start_fg;
899 srch_ae.end.stmt = end_ilt;
900 srch_ae.end.fg = end_fg;
901 srch_ae.eob = FALSE;
902
903 return (avail_expr(expr));
904 }
905
906 static LOGICAL _avail(int expr, LOGICAL *av_p);
907
908 /*
909 * determine if an expression reaches the beginning or end of a block
910 * starting at the end of a block containing a given point.
911 * Note that this recurses thru the original expression passed to
912 * is_avail_expr.
913
914 * For each "variable" found in the expression, it's determined if its
915 * value is available at the end of the path.
916 */
917 static LOGICAL
avail_expr(int expr)918 avail_expr(int expr)
919 {
920 LOGICAL av;
921 ast_visit(1, 1);
922 av = TRUE;
923 ast_traverse(expr, _avail, NULL, &av);
924 ast_unvisit();
925 if (OPTDBG(9, 16384) && av)
926 fprintf(gbl.dbgfil, "expr avail.\n");
927 return av;
928 }
929
930 static LOGICAL
_avail(int expr,LOGICAL * av_p)931 _avail(int expr, LOGICAL *av_p)
932 {
933 int opc;
934 int nme, sym;
935 int i;
936 int def;
937 int iltx;
938
939 if (!*av_p)
940 return TRUE; /* don't continue if already not available */
941 if (OPTDBG(9, 16384))
942 fprintf(gbl.dbgfil, "_avail(%d)\n", expr);
943 opc = A_TYPEG(expr);
944 switch (opc) {
945 case A_CNST:
946 if (OPTDBG(9, 16384))
947 fprintf(gbl.dbgfil, "const expr is avail.\n");
948 return TRUE; /* stop */
949 case A_ID:
950 sym = A_SPTRG(expr);
951 if (!ST_ISVAR(STYPEG(sym)))
952 return TRUE; /* ignore ST_PROC, ST_INTRIN, etc. */
953 nme = A_NMEG(expr);
954 if (OPTDBG(9, 16384))
955 fprintf(gbl.dbgfil, "avail_expr. nme %d, load %d\n", nme, expr);
956 if (!is_optsym(nme)) {
957 switch (NME_TYPE(nme)) {
958 case NT_VAR:
959 if ((SCG(NME_SYM(nme)) == SC_BASED || POINTERG(NME_SYM(nme))) &&
960 isptr_in_path()) {
961 *av_p = FALSE;
962 return TRUE;
963 }
964 case NT_ARR:
965 case NT_MEM:
966 case NT_UNK:
967 if (OPTDBG(9, 16384))
968 fprintf(gbl.dbgfil, "expr not avail %d, nme.\n", expr);
969 *av_p = FALSE;
970 return TRUE;
971 case NT_IND:
972 if (isptr_in_path()) {
973 *av_p = FALSE;
974 return TRUE;
975 }
976 break;
977 default:
978 interr("avail_expr: unk nme", expr, 3);
979 break;
980 }
981 break; /* recurse */
982 }
983 /*
984 * A load of an optimizable symbol has been found.
985 * Step 1. If variable is "call" unsafe, then:
986 * 1. a call cannot be in the path defined from start to end
987 * (precise analysis).
988 * 2. If the variable has its address taken, then a store via a ptr
989 * cannot be in the path defined from start to end
990 */
991 sym = NME_SYM(nme);
992 #ifdef RESHAPEDG
993 if (SCG(sym) == SC_BASED && RESHAPEDG(sym)) {
994 *av_p = FALSE;
995 return TRUE;
996 }
997 #endif
998 if (!is_call_safe(nme)) {
999 if (iscall_in_path()) {
1000 *av_p = FALSE;
1001 return TRUE;
1002 }
1003 if (ADDRTKNG(sym)) {
1004 if (isptr_in_path()) {
1005 *av_p = FALSE;
1006 return TRUE;
1007 }
1008 }
1009 }
1010 /*
1011 * Step2. determine if there are any defs of the variable after the
1012 * point in the flowgraph node to the end of the same node.
1013 * Note that if the path is in one block, we'll terminate the
1014 * search at the end of the path; otherwise, we check until the
1015 * end of the block.
1016 */
1017 if (srch_ae.eob)
1018 iltx = 0; /* ==> end of block */
1019 else if (srch_ae.start.fg == srch_ae.end.fg)
1020 iltx = srch_ae.end.stmt;
1021 else
1022 iltx = 0; /* ==> end of block */
1023 /*
1024 * scan the defs in the node to find the stmt containing the expression.
1025 * NOTE: works only because we've defined the point in the node to
1026 * be a def of an optimizable symbol.
1027 */
1028 def = FG_FDEF(srch_ae.start.fg);
1029 for (; def; def = DEF_LNEXT(def))
1030 if (DEF_STD(def) == srch_ae.start.stmt) {
1031 if (DEF_NM(def) == nme && DEF_SELF(def)) {
1032 /* At the starting point, there is a def which defines
1033 * the variable and includes itself; normally, this is
1034 * caught by def_ok(), but is_avail_expr() may be called
1035 * without first calling def_ok().
1036 */
1037 if (OPTDBG(9, 16384))
1038 fprintf(gbl.dbgfil, "expr not avail. DEF_SELF(%d) for nme %d\n",
1039 def, nme);
1040 *av_p = FALSE;
1041 return TRUE;
1042 }
1043 break;
1044 }
1045
1046 /* scan all the defs after the point */
1047 rdilts(FG_TO_BIH(srch_ae.start.fg));
1048 for (def = DEF_LNEXT(def); def; def = DEF_LNEXT(def))
1049 if (DEF_NM(def) == nme) {
1050 for (i = STD_NEXT(srch_ae.start.stmt);; i = STD_NEXT(i)) {
1051 if (i == iltx)
1052 break;
1053 if (DEF_STD(def) == i) {
1054 if (OPTDBG(9, 16384))
1055 fprintf(gbl.dbgfil, "expr not avail. def %d after\n", def);
1056 wrilts(FG_TO_BIH(srch_ae.start.fg));
1057 *av_p = FALSE;
1058 return TRUE;
1059 }
1060 }
1061 }
1062 wrilts(FG_TO_BIH(srch_ae.start.fg));
1063
1064 /*
1065 * Step 3. scan all defs of the variable. If one reaches the end
1066 * of the path, then the expression is unavailble.
1067 */
1068 for (def = NME_DEF(nme); def; def = DEF_NEXT(def)) {
1069 if (DEF_FG(def) == srch_ae.start.fg)
1070 continue; /* def is in same block -- it must precede */
1071 /*
1072 * if def is in the flow graph node containing end point, we need
1073 * to ensure that the def does not precede end.stmt. WARNING:
1074 * steps should have already been taken to ensure that start
1075 * dominates end.
1076 */
1077 if (DEF_FG(def) == srch_ae.end.fg) {
1078 if (DEF_DOINIT(def) && srch_ae.eob) {
1079 if (OPTDBG(9, 16384))
1080 fprintf(gbl.dbgfil, "expr not avail. dodef %d bef\n", def);
1081 *av_p = FALSE;
1082 return TRUE;
1083 }
1084 if (srch_ae.eob)
1085 iltx = 0; /* ==> end of block */
1086 else
1087 iltx = srch_ae.end.stmt;
1088 rdilts(FG_TO_BIH(srch_ae.end.fg));
1089 for (iltx = STD_PREV(iltx); iltx; iltx = STD_PREV(iltx))
1090 if (DEF_STD(def) == iltx) {
1091 if (OPTDBG(9, 16384))
1092 fprintf(gbl.dbgfil, "expr not avail. def %d bef\n", def);
1093 wrilts(FG_TO_BIH(srch_ae.end.fg));
1094 *av_p = FALSE;
1095 return TRUE;
1096 }
1097 wrilts(FG_TO_BIH(srch_ae.end.fg));
1098 continue;
1099 }
1100 if (is_dominator((int)DEF_FG(def), srch_ae.start.fg))
1101 continue; /* if def dominates point, it's ok */
1102 if (bv_mem(FG_IN(srch_ae.end.fg), def)) {
1103 if (srch_ae.start.fg == srch_ae.end.fg &&
1104 !bv_mem(FG_OUT(srch_ae.end.fg), def)) {
1105 /*
1106 * start and end are in the same block. A def is in its
1107 * IN set but is killed. check where the def is killed.
1108 * if it's at the start or before, then all is ok.
1109 */
1110 int d;
1111 d = FG_FDEF(srch_ae.end.fg);
1112 while (d) {
1113 if (DEF_NM(d) == nme) {
1114 for (iltx = srch_ae.start.stmt; iltx; iltx = STD_PREV(iltx)) {
1115 if (DEF_STD(d) == iltx)
1116 goto next_def;
1117 }
1118 }
1119 d = DEF_LNEXT(d);
1120 }
1121 if (OPTDBG(9, 16384))
1122 fprintf(gbl.dbgfil, "expr not avail. def %d IN.1\n", def);
1123 *av_p = FALSE;
1124 return TRUE;
1125 }
1126 /*
1127 * although def is in IN(end), is it in the path (start, end).
1128 */
1129 if (is_dominator(srch_ae.start.fg, srch_ae.end.fg) &&
1130 !is_in_path((int)DEF_FG(def)))
1131 ;
1132 else {
1133 if (OPTDBG(9, 16384))
1134 fprintf(gbl.dbgfil, "expr not avail. def %d IN.2\n", def);
1135 *av_p = FALSE;
1136 return TRUE;
1137 }
1138 }
1139 next_def:;
1140 }
1141
1142 if (OPTDBG(9, 16384))
1143 fprintf(gbl.dbgfil, "expr avail.\n");
1144 return (TRUE);
1145
1146 case A_CALL:
1147 case A_FUNC:
1148 if (OPTDBG(9, 16384))
1149 fprintf(gbl.dbgfil, "expr %d not avail. contains call\n", expr);
1150 *av_p = FALSE;
1151 return TRUE;
1152
1153 default:
1154 break;
1155 }
1156
1157 return FALSE; /* recurse on expr's operands */
1158 }
1159
1160 /*
1161 * is node fg in the path (srch_ae.start.fg, srch_ae.end.fg) where
1162 * start dominates end.
1163 */
1164 static LOGICAL
is_in_path(int fg)1165 is_in_path(int fg)
1166 {
1167 LOGICAL ret;
1168
1169 if (srch_ae.start.fg == fg)
1170 return TRUE;
1171
1172 /* use the "natnxt" field to link together nodes visited during in_path */
1173 visit_list = srch_ae.start.fg;
1174 FG_NATNXT(visit_list) = 0;
1175 FG_VISITED(srch_ae.start.fg) = 1;
1176
1177 ret = in_path(srch_ae.end.fg, fg);
1178
1179 /* unvisit the nodes visited during in_path */
1180 while (visit_list) {
1181 FG_VISITED(visit_list) = 0;
1182 visit_list = FG_NATNXT(visit_list);
1183 }
1184
1185 return ret;
1186 }
1187
1188 static LOGICAL
in_path(int cur,int fg)1189 in_path(int cur, int fg)
1190 {
1191 PSI_P pred;
1192 int pred_fg;
1193
1194 if (FG_VISITED(cur))
1195 return FALSE;
1196 if (cur == fg)
1197 return TRUE;
1198
1199 FG_VISITED(cur) = 1;
1200 FG_NATNXT(cur) = visit_list;
1201 visit_list = cur;
1202
1203 for (pred = FG_PRED(cur); pred != PSI_P_NULL; pred = PSI_NEXT(pred)) {
1204 pred_fg = PSI_NODE(pred);
1205 if (in_path(pred_fg, fg))
1206 return TRUE;
1207 }
1208 return FALSE;
1209 }
1210
1211 /*
1212 * is a call in the path <srch_ae.start.fg, srch_ae.start.stmt>,
1213 * <srch_ae.end.fg, srch_ae.end.stmt>.
1214 */
1215 static LOGICAL
iscall_in_path(void)1216 iscall_in_path(void)
1217 {
1218 int iltx;
1219 int save_ex;
1220 LOGICAL ret;
1221 int term_std;
1222 /*
1223 * examine the ilts from the start stmt to the end of the start node.
1224 */
1225 if (srch_ae.start.fg == srch_ae.end.fg) {
1226 /* nodes are the same; check ilts after the start and before the
1227 * end stmt.
1228 */
1229 if (srch_ae.start.stmt == srch_ae.end.stmt)
1230 return FALSE;
1231 iltx = STD_NEXT(srch_ae.start.stmt);
1232 while (iltx) { /* WARNING: end.stmt could have been deleted */
1233 if (iltx == srch_ae.end.stmt)
1234 break;
1235 if (STD_EX(iltx)) {
1236 if (OPTDBG(9, 16384))
1237 fprintf(gbl.dbgfil, "call is in path, after def in fg %d, ilt %d\n",
1238 srch_ae.start.fg, iltx);
1239 return TRUE;
1240 }
1241 iltx = STD_NEXT(iltx);
1242 }
1243 return FALSE;
1244 }
1245 /*
1246 * nodes are not the same; check ilts after the start and thru the
1247 * end of the block.
1248 */
1249 iltx = srch_ae.start.stmt;
1250 term_std = FG_STDLAST(srch_ae.start.fg);
1251 while (term_std != iltx) {
1252 iltx = STD_NEXT(iltx);
1253 if (iltx == 0)
1254 break;
1255 if (STD_EX(iltx)) {
1256 if (OPTDBG(9, 16384))
1257 fprintf(gbl.dbgfil, "call is in path, after def in fg %d, ilt %d\n",
1258 srch_ae.start.fg, iltx);
1259 return TRUE;
1260 }
1261 }
1262
1263 /* nodes are different, examine ilts between start of the end node and
1264 * the end statement.
1265 */
1266 term_std = FG_STDFIRST(srch_ae.end.fg);
1267 for (iltx = (srch_ae.end.stmt); iltx; iltx = STD_PREV(iltx)) {
1268 if (STD_EX(iltx)) {
1269 if (OPTDBG(9, 16384))
1270 fprintf(gbl.dbgfil, "call is in path, before end of fg %d, ilt %d\n",
1271 srch_ae.start.fg, iltx);
1272 return TRUE;
1273 }
1274 if (iltx == term_std)
1275 break;
1276 }
1277
1278 /* if start does not dominate end, check if a call (the call "def")
1279 * reaches then end node.
1280 */
1281 if (!is_dominator(srch_ae.start.fg, srch_ae.end.fg)) {
1282 if (bv_mem(FG_IN(srch_ae.end.fg), CALL_DEF)) {
1283 if (OPTDBG(9, 16384))
1284 fprintf(gbl.dbgfil, "call is in path, calldef IN fg %d\n",
1285 srch_ae.end.fg);
1286 return TRUE;
1287 }
1288 return FALSE;
1289 }
1290
1291 /*
1292 * nodes are not the same & start dominates the end.
1293 * if the end node is in a loop and start is NOT in the same loop
1294 * then it's necessary to check the block's * external flag.
1295 * Even if the call exists after the end stmt, it can
1296 * still reach the statement.
1297 */
1298 if (FG_LOOP(srch_ae.end.fg) &&
1299 FG_LOOP(srch_ae.end.fg) != FG_LOOP(srch_ae.start.fg) &&
1300 BIH_EX(FG_TO_BIH(srch_ae.end.fg))) {
1301 if (OPTDBG(9, 16384))
1302 fprintf(gbl.dbgfil, "call is in path, fg %d in loop %d contains call\n",
1303 srch_ae.end.fg, FG_LOOP(srch_ae.end.fg));
1304 return TRUE;
1305 }
1306
1307 /* traverse the path start to end bottom-up, checking if a call exists
1308 * in each node. To setup, start's visit flag is set (=> if a call exists
1309 * at the beginning of the block, it will be ignored), and the "EX" flag
1310 * of the end's bih must be cleared then restored.
1311 */
1312 /* use the "natnxt" field to link together nodes visited during in_path */
1313 visit_list = srch_ae.start.fg;
1314 FG_NATNXT(visit_list) = 0;
1315 FG_VISITED(srch_ae.start.fg) = 1;
1316 save_ex = BIH_EX(FG_TO_BIH(srch_ae.end.fg));
1317 BIH_EX(FG_TO_BIH(srch_ae.end.fg)) = 0;
1318
1319 ret = call_in_path(srch_ae.end.fg);
1320
1321 /* unvisit the nodes visited during in_path */
1322 while (visit_list) {
1323 FG_VISITED(visit_list) = 0;
1324 visit_list = FG_NATNXT(visit_list);
1325 }
1326
1327 BIH_EX(FG_TO_BIH(srch_ae.end.fg)) = save_ex;
1328
1329 return ret;
1330 }
1331
1332 static LOGICAL
call_in_path(int cur)1333 call_in_path(int cur)
1334 {
1335 PSI_P pred;
1336 int pred_fg;
1337
1338 if (FG_VISITED(cur))
1339 return FALSE;
1340 if (BIH_EX(FG_TO_BIH(cur)))
1341 return TRUE;
1342
1343 FG_VISITED(cur) = 1;
1344 FG_NATNXT(cur) = visit_list;
1345 visit_list = cur;
1346
1347 for (pred = FG_PRED(cur); pred != PSI_P_NULL; pred = PSI_NEXT(pred)) {
1348 pred_fg = PSI_NODE(pred);
1349 if (call_in_path(pred_fg)) {
1350 if (OPTDBG(9, 16384))
1351 fprintf(gbl.dbgfil, "call is in path, call in fg %d\n", pred_fg);
1352 return TRUE;
1353 }
1354 }
1355 return FALSE;
1356 }
1357
1358 /*
1359 * external version is iscall_in_path(). sets up search structure (srch_ae).
1360 * for iscall_in_path().
1361 */
1362 LOGICAL
is_call_in_path(int start_ilt,int start_fg,int end_ilt,int end_fg)1363 is_call_in_path(int start_ilt, int start_fg, int end_ilt, int end_fg)
1364 {
1365
1366 srch_ae.start.stmt = start_ilt;
1367 srch_ae.start.fg = start_fg;
1368 srch_ae.end.stmt = end_ilt;
1369 srch_ae.end.fg = end_fg;
1370
1371 return (iscall_in_path());
1372 }
1373
1374 /*
1375 * is a ptr store in the path <srch_ae.start.fg, srch_ae.start.stmt>,
1376 * <srch_ae.end.fg, srch_ae.end.stmt>.
1377 */
1378 static LOGICAL
isptr_in_path(void)1379 isptr_in_path(void)
1380 {
1381 int iltx;
1382 int term_std;
1383 /*
1384 * examine the ilts from the start stmt to the end of the start node.
1385 * only search if there exists a store via a pointer in the node.
1386 */
1387 if (srch_ae.start.fg == srch_ae.end.fg) {
1388 if (srch_ae.start.stmt == srch_ae.end.stmt)
1389 return FALSE;
1390 if (FG_PTR_STORE(srch_ae.start.fg)) {
1391 /* nodes are the same; check ilts after the start and before the
1392 * end stmt.
1393 */
1394 iltx = STD_NEXT(srch_ae.start.stmt);
1395 while (iltx) { /* WARNING: end.stmt could have been deleted */
1396 if (iltx == srch_ae.end.stmt)
1397 break;
1398 if (is_store_via_ptr((int)STD_AST(iltx))) {
1399 if (OPTDBG(9, 16384))
1400 fprintf(gbl.dbgfil, "ptr in path, ptr def in start fg %d\n",
1401 srch_ae.end.fg);
1402 return TRUE;
1403 }
1404 iltx = STD_NEXT(iltx);
1405 }
1406 }
1407 return FALSE;
1408 }
1409
1410 if (FG_PTR_STORE(srch_ae.start.fg)) {
1411 /* nodes are not the same; check ilts after the start and thru the
1412 * end of the block.
1413 */
1414 iltx = srch_ae.start.stmt;
1415 term_std = FG_STDLAST(srch_ae.start.fg);
1416 while (term_std != iltx) {
1417 iltx = STD_NEXT(iltx);
1418 if (iltx == 0)
1419 break;
1420 if (is_store_via_ptr((int)STD_AST(iltx))) {
1421 if (OPTDBG(9, 16384))
1422 fprintf(gbl.dbgfil, "ptr in path, ptr def in start fg %d\n",
1423 srch_ae.end.fg);
1424 return TRUE;
1425 }
1426 }
1427 }
1428 /*
1429 * nodes are different. the "ptr store" def cannot reach the
1430 * beginning of the end node (i.e., it's not a member of the node's
1431 * IN set).
1432 */
1433 if (bv_mem(FG_IN(srch_ae.end.fg), PTR_STORE_DEF)) {
1434 if (OPTDBG(9, 16384))
1435 fprintf(gbl.dbgfil, "ptr in path, ptr def IN\n");
1436 return TRUE;
1437 }
1438 /*
1439 * nodes are different. examine ilts between the start of the end
1440 * node and the end statement, inclusive.
1441 * only search if there exists a store via a pointer in the node.
1442 */
1443 if (FG_PTR_STORE(srch_ae.end.fg)) {
1444 term_std = FG_STDFIRST(srch_ae.end.fg);
1445 for (iltx = (srch_ae.end.stmt); iltx; iltx = STD_PREV(iltx)) {
1446 if (is_store_via_ptr((int)STD_AST(iltx))) {
1447 if (OPTDBG(9, 16384))
1448 fprintf(gbl.dbgfil, "ptr in path, ptr def in end fg %d\n",
1449 srch_ae.end.fg);
1450 return TRUE;
1451 }
1452 if (iltx == term_std)
1453 break;
1454 }
1455 }
1456
1457 return FALSE;
1458 }
1459
1460 /*
1461 * external version is isptr_in_path(). sets up search structure (srch_ae).
1462 * for isptr_in_path().
1463 */
1464 LOGICAL
is_ptr_in_path(int start_ilt,int start_fg,int end_ilt,int end_fg)1465 is_ptr_in_path(int start_ilt, int start_fg, int end_ilt, int end_fg)
1466 {
1467
1468 srch_ae.start.stmt = start_ilt;
1469 srch_ae.start.fg = start_fg;
1470 srch_ae.end.stmt = end_ilt;
1471 srch_ae.end.fg = end_fg;
1472
1473 return (isptr_in_path());
1474 }
1475
1476 /*
1477 * determine if a use has a single reaching def which can be copied
1478 */
1479 LOGICAL
single_ud(int use)1480 single_ud(int use)
1481 {
1482 UD *ud;
1483 int def;
1484 int nme;
1485 int use_fg;
1486 int use_std;
1487
1488 #if DEBUG
1489 assert(use > 0 && use <= opt.useb.stg_avail, "single_ud: bad use", use, 3);
1490 #endif
1491 nme = USE_NM(use);
1492 use_fg = USE_FG(use);
1493 use_std = USE_STD(use);
1494 if (OPTDBG(9, 16384))
1495 fprintf(gbl.dbgfil, "single_ud trace for %s, use %d, ilt %d, to fg %d\n",
1496 getprint(basesym_of(nme)), use, use_std, use_fg);
1497
1498 if ((ud = USE_UD(use)) == NULL || ud->next != NULL) {
1499 if (OPTDBG(9, 16384))
1500 fprintf(gbl.dbgfil, "single_ud, mult/0 reaching defs\n");
1501 return FALSE;
1502 }
1503
1504 def = ud->def;
1505 if (!def_ok(def, use_fg, use_std))
1506 return FALSE;
1507
1508 return (is_avail_expr((int)DEF_RHS(def), (int)DEF_STD(def), (int)DEF_FG(def),
1509 use_std, use_fg));
1510 }
1511
1512 /*
1513 * determine if a use has a single reaching def.
1514 * like single_ud except only lhs must be avail, not rhs
1515 * (since we're not copying it).
1516 */
1517 LOGICAL
only_one_ud(int use)1518 only_one_ud(int use)
1519 {
1520 UD *ud;
1521 int def;
1522 int nme;
1523 int use_fg;
1524 int use_std;
1525 int t;
1526
1527 #if DEBUG
1528 assert(use > 0 && use <= opt.useb.stg_avail, "only_one_ud: bad use", use, 3);
1529 #endif
1530 nme = USE_NM(use);
1531 use_fg = USE_FG(use);
1532 use_std = USE_STD(use);
1533 if ((ud = USE_UD(use)) == NULL || ud->next != NULL) {
1534 if (OPTDBG(9, 16384))
1535 fprintf(gbl.dbgfil, "only_one_ud, mult/0 reaching defs\n");
1536 return FALSE;
1537 }
1538
1539 def = ud->def;
1540 if (OPTDBG(9, 16384))
1541 fprintf(gbl.dbgfil, "only_one_ud trace for %s, use %d, ilt %d, to fg %d\n",
1542 getprint(basesym_of(nme)), use, use_std, use_fg);
1543 /* HACK HACK! */
1544 if (0 != (t = DEF_SELF(def))) {
1545 DU *du;
1546 for (du = DEF_DU(def); du != NULL; du = du->next)
1547 if (USE_STD(du->use) == DEF_STD(def))
1548 return FALSE;
1549 }
1550 DEF_SELF(def) = 0;
1551 if (!def_ok(def, use_fg, use_std)) {
1552 DEF_SELF(def) = t;
1553 return FALSE;
1554 }
1555 DEF_SELF(def) = t;
1556 return (is_avail_expr((int)USE_AST(use), (int)DEF_STD(def), (int)DEF_FG(def),
1557 use_std, use_fg));
1558 }
1559
1560 LOGICAL
is_def_imp_live(int def)1561 is_def_imp_live(int def)
1562 {
1563 int nme, sym;
1564
1565 #if DEBUG
1566 assert(def && def < opt.defb.stg_avail, "is_def_imp_live: bad def", def, 3);
1567 #endif
1568 /*
1569 * first, if the def is of a symbol which is live upon exit (i.e., due to
1570 * storage class), it's live at exit if it's a member of the exit's
1571 * IN set.
1572 */
1573 nme = DEF_NM(def);
1574 if (is_sym_exit_live(nme)) {
1575 BV *in_exit;
1576
1577 in_exit = FG_IN(opt.exitfg);
1578 if (in_exit == NULL) {
1579 /* situation arises if the function can't exit, i.e., an
1580 * infinite loop which dominates the exit
1581 */
1582 if (OPTDBG(9, 8192))
1583 fprintf(gbl.dbgfil,
1584 "is_def_imp_live - can't exit, def %d is dead at exit\n", def);
1585 return FALSE;
1586 }
1587 if (bv_mem(in_exit, def)) {
1588 if (OPTDBG(9, 8192))
1589 fprintf(gbl.dbgfil, "is_def_imp_live - def %d is live at exit\n", def);
1590 return TRUE;
1591 }
1592 }
1593 if (is_sym_exit_live(nme) && bv_mem(FG_IN(opt.exitfg), def)) {
1594 if (OPTDBG(9, 8192))
1595 fprintf(gbl.dbgfil, "is_def_imp_live - def %d is live at exit\n", def);
1596 return TRUE;
1597 }
1598 /*
1599 * second, check a few attributes about the symbol (see the second
1600 * part of is_sym_imp_live).
1601 */
1602 sym = NME_SYM(nme);
1603 if (ADDRTKNG(sym) || VOLG(sym))
1604 return TRUE;
1605 #ifdef PTRSTOREP
1606 if (PTRSTOREG(sym))
1607 return TRUE;
1608 #endif
1609 if (!XBIT(19, 0x1) && SOCPTRG(sym))
1610 return TRUE;
1611 return FALSE;
1612 }
1613
1614 /*
1615 * a def's uses have been removed from a loop. check if there are any
1616 * other uses of the def; if none and it meets other criteria, delete
1617 * the definition.
1618 */
1619 void
rm_def_rloop(int def,int lpx)1620 rm_def_rloop(int def, int lpx)
1621 {
1622 int def_fg, def_std;
1623 int use;
1624 int count; /* # of uses of def in same block */
1625 int i;
1626 DU *du;
1627
1628 #if DEBUG
1629 assert(def && def < opt.defb.stg_avail, "rm_def_rloop: bad def", def, 3);
1630 assert(lpx, "rm_def_rloop: lpx", 0, 3);
1631 #endif
1632 /*
1633 * first, if the def is of a symbol which is live upon exit (i.e., due to
1634 * storage class), it can't be deleted if it reaches the exit from the
1635 * function.
1636 */
1637 if (is_def_imp_live(def)) {
1638 if (OPTDBG(9, 8192))
1639 fprintf(gbl.dbgfil, "rm_def_rloop - def %d is live at exit\n", def);
1640 return;
1641 }
1642
1643 def_fg = DEF_FG(def);
1644 def_std = DEF_STD(def);
1645 count = 0;
1646 for (du = DEF_DU(def); du != NULL; du = du->next) {
1647 int use_fg;
1648 use_fg = USE_FG(use = du->use);
1649 if (FG_LOOP(use_fg) == lpx)
1650 continue;
1651 if (use_fg != def_fg) {
1652 if (OPTDBG(9, 8192))
1653 fprintf(gbl.dbgfil, "rm_def_rloop - def %d has other uses\n", def);
1654 return;
1655 }
1656 /* use in same block as def: scan ilts before use, searching for def */
1657 for (i = (USE_STD(use)); i; i = STD_PREV(i)) {
1658 if (i == def_std) {
1659 count++;
1660 goto next_use;
1661 }
1662 }
1663 if (OPTDBG(9, 8192))
1664 fprintf(gbl.dbgfil, "rm_def_rloop - def %d has uses bef\n", def);
1665 return;
1666 next_use:;
1667 }
1668
1669 if (count) {
1670 STD_DELETE(def_std) = 1;
1671 DEF_DELETE(def) = 1;
1672 if (OPTDBG(9, 8192))
1673 fprintf(gbl.dbgfil, "rm_def_rloop - def %d, ilt %d marked deleted\n", def,
1674 def_std);
1675 return;
1676 }
1677
1678 DEF_DELETE(def) = 1;
1679 unlnkilt(def_std, (int)FG_TO_BIH(def_fg), FALSE);
1680 if (OPTDBG(9, 8192))
1681 fprintf(gbl.dbgfil, "rm_def_rloop - def %d, ilt %d deleted\n", def,
1682 def_std);
1683 }
1684
1685 /* structure to aid copy propagation */
1686
1687 static struct {
1688 int lp;
1689 int new;
1690 int *stg_base; /* table of candidate loads to replace */
1691 int stg_size;
1692 int stg_avail;
1693 } copyb;
1694
1695 static LOGICAL collect_loads(int, int *);
1696 static LOGICAL cp_loop(int);
1697
1698 /*
1699 * propagate the definitions of any variables in 'expr' which is
1700 * considered to be at the point immediately preceding the loop.
1701 */
1702 int
copy_to_loop(int tree,int lp)1703 copy_to_loop(int tree, int lp)
1704 {
1705 int i;
1706 LOGICAL changes;
1707
1708 copyb.lp = lp;
1709 copyb.new = tree;
1710 if (OPTDBG(9, 65536)) {
1711 fprintf(gbl.dbgfil, "copy_to_loop %d, ast %d:\n", lp, tree);
1712 dbg_print_ast(tree, gbl.dbgfil);
1713 }
1714 OPT_ALLOC(copyb, int, 32);
1715 while (TRUE) {
1716 /*
1717 * Recursively search 'tree' and collect all loads which are
1718 * candidates for copy propagation.
1719 */
1720 copyb.stg_avail = 0;
1721 ast_visit(1, 1);
1722 ast_traverse(copyb.new, collect_loads, NULL, NULL);
1723 ast_unvisit();
1724 changes = FALSE;
1725 /*
1726 * For all candidate loads, attempt to copy their values. cp_loop()
1727 * updates copyb.new if replacement occurs.
1728 */
1729 for (i = 0; i < copyb.stg_avail; i++) {
1730 if (cp_loop(copyb.stg_base[i])) {
1731 if (OPTDBG(9, 65536)) {
1732 fprintf(gbl.dbgfil, "recur copy_to_loop %d, ast: %d\n", lp,
1733 copyb.new);
1734 dbg_print_ast(copyb.new, gbl.dbgfil);
1735 }
1736 changes = TRUE;
1737 }
1738 }
1739 if (!changes)
1740 break;
1741 }
1742
1743 OPT_FREE(copyb);
1744 return copyb.new;
1745 }
1746
1747 static LOGICAL
collect_loads(int expr,int * dummy)1748 collect_loads(int expr, int *dummy)
1749 {
1750 int opc;
1751 int nme;
1752 int i;
1753
1754 opc = A_TYPEG(expr);
1755 switch (opc) {
1756 case A_ID:
1757 case A_MEM:
1758 case A_SUBSCR:
1759 nme = A_NMEG(expr);
1760 if (OPTDBG(9, 65536))
1761 fprintf(gbl.dbgfil, " collect_loads. nme %d, load %d\n", nme, expr);
1762 if (is_optsym(nme)) {
1763 i = copyb.stg_avail++;
1764 OPT_NEED(copyb, int, 32);
1765 copyb.stg_base[i] = expr;
1766 }
1767 return TRUE; /* stop traversal */
1768
1769 default:
1770 break;
1771 }
1772
1773 return FALSE; /* continue to traverse */
1774 }
1775
1776 static LOGICAL
cp_loop(int expr)1777 cp_loop(int expr)
1778 {
1779 int nme;
1780 int i;
1781 int rdef;
1782 PSI_P pred;
1783
1784 nme = A_NMEG(expr);
1785 if (OPTDBG(9, 65536))
1786 fprintf(gbl.dbgfil, " cp_loop. nme %d, load %d\n", nme, expr);
1787 /*
1788 * A load of an optimizable symbol has been found.
1789 * for the predecessors of the loop, determine if there is one
1790 * and only one def of the variable which reaches the end of
1791 * the predecessors. This def must be live for all paths to the
1792 * predecessors.
1793 */
1794 rdef = 0;
1795 pred = FG_PRED(LP_HEAD(copyb.lp));
1796 for (; pred != PSI_P_NULL; pred = PSI_NEXT(pred)) {
1797 if (FG_LOOP(PSI_NODE(pred)) == copyb.lp)
1798 continue;
1799 i = find_rdef(nme, PSI_NODE(pred), FALSE /* end of block */);
1800 if (i == 0) {
1801 rdef = 0;
1802 if (OPTDBG(9, 65536))
1803 fprintf(gbl.dbgfil, " cp_loop: rdef nfnd to end of fg %d\n",
1804 PSI_NODE(pred));
1805 break;
1806 }
1807 if (rdef) {
1808 if (i != rdef) {
1809 if (OPTDBG(9, 65536))
1810 fprintf(gbl.dbgfil, " cp_loop: mult rdefs fnd, %d & %d\n", rdef,
1811 i);
1812 rdef = 0;
1813 break;
1814 }
1815 } else
1816 rdef = i;
1817
1818 if (!can_copy_def(rdef, PSI_NODE(pred), FALSE /* end of block */)) {
1819 if (OPTDBG(9, 65536))
1820 fprintf(gbl.dbgfil,
1821 " cp_loop: def %d cannot be copied to end of %d\n", rdef,
1822 PSI_NODE(pred));
1823 rdef = 0;
1824 break;
1825 }
1826 }
1827 if (rdef) {
1828 if (OPTDBG(9, 65536))
1829 fprintf(gbl.dbgfil, " cp_loop: copy def %d\n", rdef);
1830 i = DEF_RHS(rdef);
1831 if (A_TYPEG(i) == A_CONV) {
1832 switch (DTY(A_DTYPEG(i))) {
1833 case TY_INT:
1834 case TY_SINT:
1835 case TY_BINT:
1836 if (OPTDBG(9, 65536))
1837 fprintf(gbl.dbgfil, " cp_loop: def %d - I_INT(rhs %d)\n", rdef, i);
1838 i = ast_intr(I_INT, DT_INT, 1, A_LOPG(i));
1839 break;
1840 case TY_REAL:
1841 if (OPTDBG(9, 65536))
1842 fprintf(gbl.dbgfil, " cp_loop: def %d - I_REAL(rhs %d)\n", rdef,
1843 i);
1844 i = ast_intr(I_REAL, DT_REAL4, 1, A_LOPG(i));
1845 break;
1846 case TY_DBLE:
1847 if (OPTDBG(9, 65536))
1848 fprintf(gbl.dbgfil, " cp_loop: def %d - I_DBLE(rhs %d)\n", rdef,
1849 i);
1850 i = ast_intr(I_DBLE, DT_DBLE, 1, A_LOPG(i));
1851 break;
1852 default:
1853 if (OPTDBG(9, 65536))
1854 fprintf(gbl.dbgfil,
1855 " cp_loop: def %d cannot be copied - ugly A_CONV %d\n",
1856 rdef, i);
1857 return FALSE;
1858 }
1859 }
1860 if (OPTDBG(9, 65536))
1861 fprintf(gbl.dbgfil, " cp_loop: replace ast %d with %d\n", expr, i);
1862 ast_visit(1, 1);
1863 ast_replace(expr, i);
1864 ast_rewrite(copyb.new);
1865 copyb.new = A_REPLG(copyb.new);
1866 ast_unvisit();
1867 return TRUE; /* replacement occurred */
1868 }
1869 return FALSE; /* replacement did not occur */
1870 }
1871
1872 typedef struct ptrnmestr {
1873 int nme;
1874 int std; /* unused */
1875 int isdummy; /* is dummy or global */
1876 } ptrdefstr;
1877
1878 #define MAX_DEF 10
1879 static ptrdefstr lhsdefs[MAX_DEF];
1880 static int lhscount = 0;
1881
1882 /* if def == 0, then start at NME_DEF
1883 * if def == x, then start at DEF_NEXT(def)
1884 */
1885 int
find_next_reaching_def(int nme,int fgx,int def)1886 find_next_reaching_def(int nme, int fgx, int def)
1887 {
1888 int next = def;
1889 int nextdef;
1890 BV *inout;
1891
1892 if (def) {
1893 nextdef = DEF_NEXT(def);
1894 } else {
1895 nextdef = NME_DEF(nme);
1896 }
1897
1898 /* find def reaching this fg */
1899 inout = FG_IN(fgx);
1900
1901 for (; nextdef; nextdef = DEF_NEXT(nextdef)) {
1902 if (bv_mem(inout, nextdef)) {
1903 return nextdef;
1904 }
1905 }
1906 return 0;
1907 }
1908
1909 static int
ast_grandparent(int astptr)1910 ast_grandparent(int astptr)
1911 {
1912 while (1) {
1913 switch (A_TYPEG(astptr)) {
1914 case A_SUBSCR:
1915 astptr = A_LOPG(astptr);
1916 break;
1917 case A_ID:
1918 return astptr;
1919 case A_MEM:
1920 astptr = A_PARENTG(astptr);
1921 break;
1922 default:
1923 return astptr;
1924 }
1925 }
1926 return astptr;
1927 }
1928
1929 static int
get_next_parent(int astptr,int myparent)1930 get_next_parent(int astptr, int myparent)
1931 {
1932 int currast;
1933 while (1) {
1934 switch (A_TYPEG(astptr)) {
1935 case A_SUBSCR:
1936 astptr = A_LOPG(astptr);
1937 break;
1938 case A_ID:
1939 return astptr;
1940 break;
1941 case A_MEM:
1942 currast = A_PARENTG(astptr);
1943 if (A_TYPEG(currast) == A_SUBSCR) {
1944 currast = A_LOPG(currast);
1945 }
1946 if (currast == myparent)
1947 return astptr;
1948 else
1949 astptr = A_PARENTG(astptr);
1950 break;
1951 default:
1952 return astptr;
1953 break;
1954 }
1955 }
1956 return astptr;
1957 }
1958
1959 /* All of following should consider true
1960 * astptr is p%p1%p2%p3
1961 * astx may be one of the following: p, p%p1, p%p1, p%p1%p2%p3
1962 * Currently ignore subscript.
1963 */
1964 static LOGICAL
is_this_astptr(int astptr,int astx,int std)1965 is_this_astptr(int astptr, int astx, int std)
1966 {
1967 int i = 0;
1968 int astptr_p, astx_p;
1969
1970 /* strip off subscript so that we can use it to break a while loop */
1971 if (A_TYPEG(astptr) == A_SUBSCR)
1972 astptr = A_LOPG(astptr);
1973 if (A_TYPEG(astx) == A_SUBSCR)
1974 astx = A_LOPG(astx);
1975
1976 /* top level parent */
1977 astptr_p = ast_grandparent(astptr);
1978 astx_p = ast_grandparent(astx);
1979
1980 if (astptr_p != astx_p)
1981 return FALSE;
1982
1983 while (1) {
1984 ++i;
1985 if (i > 100) {
1986 #if DEBUG
1987 interr("is_this_astptr: infinite loop ", astptr, 3);
1988 #endif
1989 return FALSE;
1990 }
1991 astptr_p = get_next_parent(astptr, astptr_p);
1992 astx_p = get_next_parent(astx, astx_p);
1993
1994 /* member must be the same */
1995 if (A_TYPEG(astptr_p) == A_MEM && A_TYPEG(astx_p) == A_MEM) {
1996 if (A_MEMG(astptr_p) != A_MEMG(astx_p))
1997 return FALSE;
1998 }
1999
2000 /* reach the leaf ast */
2001 if (astptr_p == astptr || astx_p == astx)
2002 return TRUE;
2003
2004 if (astptr_p != astx_p)
2005 return FALSE;
2006 }
2007
2008 return FALSE;
2009 }
2010
2011 /*
2012 * it check if astc is a child of astp, ignoring subscript
2013 * the expression of astp must be equeal or shorter than astc
2014 * For example:
2015 * astp: a%b%c%d, a%b, a%b%c true for following ast expr
2016 * astc: a%b%c%d, a%b%c%d%p
2017 */
2018 static LOGICAL
is_parentof_ast(int astp,int astc)2019 is_parentof_ast(int astp, int astc)
2020 {
2021 int i = 0;
2022 int astp_p, astc_p;
2023
2024 /* strip off subscript so that we can use it to break a while loop */
2025 if (A_TYPEG(astp) == A_SUBSCR)
2026 astp = A_LOPG(astp);
2027 if (A_TYPEG(astc) == A_SUBSCR)
2028 astc = A_LOPG(astc);
2029
2030 /* top level parent */
2031 astp_p = ast_grandparent(astp);
2032 astc_p = ast_grandparent(astc);
2033
2034 if (astp_p != astc_p)
2035 return FALSE;
2036
2037 if (A_TYPEG(astp) == A_ID) /* astp is top most parent */
2038 return TRUE;
2039 else if (A_TYPEG(astc) == A_ID) /* astc is top most parent */
2040 return FALSE;
2041
2042 while (1) {
2043 ++i;
2044 if (i > 100) {
2045 #if DEBUG
2046 interr("is_parentof_ast: infinite loop ", astp, 3);
2047 #endif
2048 return FALSE;
2049 }
2050
2051 astp_p = get_next_parent(astp, astp_p);
2052 astc_p = get_next_parent(astc, astc_p);
2053
2054 /* member must be the same */
2055 if (A_TYPEG(astp_p) == A_MEM && A_TYPEG(astc_p) == A_MEM) {
2056 if (A_MEMG(astp_p) != A_MEMG(astc_p))
2057 return FALSE;
2058 else if (astp_p != astp && astc_p != astc)
2059 continue;
2060 }
2061
2062 /* reach the leaf ast, astp covers ast */
2063 if (astp_p == astp) {
2064 int p_mem, c_mem;
2065 #if DEBUG
2066 /* expect a mem ast */
2067 if (A_TYPEG(astp_p) != A_MEM || A_TYPEG(astc_p) != A_MEM) {
2068 interr("is_parentof_ast: expect member ast ", astp_p, 3);
2069 }
2070 #endif
2071 c_mem = A_MEMG(astp_p);
2072 p_mem = A_MEMG(astc_p);
2073 if (c_mem != p_mem)
2074 return FALSE;
2075
2076 return TRUE;
2077 }
2078
2079 /* astp expression is longer than ast expression */
2080 if (astc_p == astc)
2081 return FALSE;
2082
2083 if (astp_p != astc_p)
2084 return FALSE;
2085 }
2086
2087 return FALSE;
2088 }
2089
2090 /* Return the base nme of ast
2091 * Note: this routine can be expanded to handle other type of ast
2092 */
2093 int
nme_of_ast(int ast)2094 nme_of_ast(int ast)
2095 {
2096 while (1) {
2097 switch (A_TYPEG(ast)) {
2098 case A_ID:
2099 return basenme_of(A_NMEG(ast));
2100 case A_SUBSCR:
2101 case A_SUBSTR:
2102 ast = A_LOPG(ast);
2103 break;
2104 case A_MEM:
2105 ast = A_PARENTG(ast);
2106 break;
2107 default:
2108 return 0;
2109 }
2110 }
2111 return 0;
2112 }
2113
2114 /* ast is a func call, ptr is an ast of lhs pointer
2115 * up to this point, descriptor has been added but the arguments has
2116 * not been rearranged, it is in the foram or
2117 * sub(ptr1, ptr2, ,ptr3, ptr1$sd, ptr2$sd, ptr3$sd) */
2118 static LOGICAL
is_ptrast_arg(int ptrast,int ast)2119 is_ptrast_arg(int ptrast, int ast)
2120 {
2121 int i, nargs, argt, ele, is_ent, sptr, astx;
2122 int iface, entry, dscptr, fval, paramcnt;
2123 int inface_arg = 0;
2124
2125 switch (A_TYPEG(ast)) {
2126 case A_CALL:
2127 case A_FUNC:
2128 nargs = A_ARGCNTG(ast);
2129 argt = A_ARGSG(ast);
2130 break;
2131 default:
2132 #if DEBUG
2133 interr("is_astptr_arg: expect call ", ptrast, 3);
2134 #endif
2135 return TRUE;
2136 }
2137
2138 entry = procsym_of_ast(A_LOPG(ast));
2139 proc_arginfo(entry, NULL, &dscptr, &iface);
2140 if (iface && PUREG(iface))
2141 return TRUE;
2142 if (A_TYPEG(ast) == A_INTR && INKINDG(entry == IK_ELEMENTAL))
2143 return FALSE;
2144
2145 /*
2146 if (!is_procedure_ptr(entry)) {
2147 is_ent = 1;
2148 } else {
2149 is_ent = 0;
2150 }
2151 if (is_ent && NODESCG(entry))
2152 return FALSE;
2153 */
2154
2155 /* don't handle type bound procedure for now */
2156 if (STYPEG(entry) == ST_MEMBER && CLASSG(entry) && CCSYMG(entry) &&
2157 VTABLEG(entry) && NOPASSG(entry))
2158 return TRUE;
2159
2160 /* get number of parameter */
2161 fval = A_SPTRG(A_LOPG(ast));
2162 paramcnt = PARAMCTG(fval);
2163
2164 if (!dscptr) {
2165 for (i = 0; i < nargs && i < paramcnt; ++i) {
2166 if (DTY(DDTG(A_DTYPEG(ele))) == TY_DERIVED)
2167 if (is_parentof_ast(ele, ptrast))
2168 return TRUE;
2169 }
2170 return FALSE;
2171 }
2172
2173 for (i = 0; i < nargs && i < paramcnt; ++i) {
2174 inface_arg = aux.dpdsc_base[dscptr + i];
2175 if (inface_arg) {
2176 ele = ARGT_ARG(argt, i);
2177 if (ele == 0)
2178 continue;
2179 if (POINTERG(inface_arg)) {
2180 switch (A_TYPEG(ele)) {
2181 case A_ID:
2182 sptr = memsym_of_ast(ele);
2183 if (CLASSG(sptr) && VTABLEG(sptr) && BINDG(sptr))
2184 sptr = pass_sym_of_ast(ele);
2185 if (STYPEG(sptr) == ST_PROC)
2186 break;
2187 astx = ptrast;
2188 if (A_TYPEG(ptrast) == A_SUBSCR)
2189 astx = A_LOPG(ptrast);
2190 if (memsym_of_ast(astx) == sptr)
2191 return FALSE; /* not safe */
2192 case A_MEM:
2193 if (is_parentof_ast(ele, ptrast))
2194 return FALSE;
2195 case A_SUBSCR:
2196 default:
2197 break;
2198 }
2199 } else {
2200 if (DTY(DDTG(A_DTYPEG(ele))) == TY_DERIVED)
2201 if (is_parentof_ast(ele, ptrast))
2202 return TRUE;
2203 }
2204 }
2205 }
2206 return FALSE;
2207 }
2208
2209 /* 1) a=>b return 1
2210 * 2) call(a) return 2
2211 * 3) all else return 0
2212 */
2213 static int
isstd_ptrdef(int std)2214 isstd_ptrdef(int std)
2215 {
2216 int astx = STD_AST(std);
2217 if (A_TYPEG(astx) == A_ICALL) {
2218 if (A_OPTYPEG(astx) == I_PTR2_ASSIGN) {
2219 return 1;
2220 }
2221 } else if (A_TYPEG(astx) == A_CALL || A_TYPEG(astx) == A_FUNC) {
2222 return 2; /* This is def std for pointer */
2223 }
2224 return 0;
2225 }
2226
2227 /*
2228 * is a ptr def in the path <srch_ae.start.fg, srch_ae.start.stmt>,
2229 * <srch_ae.end.fg, srch_ae.end.stmt>.
2230 * If nme is 0, return if there is any ptr def in the path
2231 * to do: member_ast, only for member - check if for this particular member
2232 * assume ast to be in the form of a%b%x... (can be subscript)
2233 * the nme must be the parent nme of member_ast.
2234 */
2235 static LOGICAL
isptrdef_in_path(int nme,int ptrast)2236 isptrdef_in_path(int nme, int ptrast)
2237 {
2238 int iltx;
2239 int term_std;
2240 int astx;
2241 /*
2242 * examine the ilts from the start stmt to the end of the start node.
2243 * only search if there exists a store via a pointer in the node.
2244 */
2245 if (srch_ae.start.fg == srch_ae.end.fg) {
2246 if (srch_ae.start.stmt == srch_ae.end.stmt)
2247 return FALSE;
2248 iltx = STD_NEXT(srch_ae.start.stmt);
2249 while (iltx) { /* WARNING: end.stmt could have been deleted */
2250 if (iltx == srch_ae.end.stmt)
2251 break;
2252 astx = STD_AST(iltx);
2253 switch (A_TYPEG(astx)) {
2254 case A_ICALL:
2255 if (A_OPTYPEG(astx) == I_PTR2_ASSIGN) {
2256 int args, lastx, rastx;
2257 args = A_ARGSG(astx);
2258 lastx = ARGT_ARG(args, 0);
2259 rastx = ARGT_ARG(args, 2);
2260 if (nme) {
2261 /* being conservative, for derived type-consider the nme
2262 * of parent instead of looking at the particular member
2263 * It is on to-do-list to check on this particular member.
2264 */
2265 if (nme_of_ast(astx) != nme)
2266 break;
2267 }
2268 if (OPTDBG(9, 16384))
2269 fprintf(gbl.dbgfil, "ptrdef in path, ptr def in start fg %d\n",
2270 srch_ae.end.fg);
2271 return TRUE;
2272 }
2273 break;
2274 case A_CALL:
2275 case A_FUNC:
2276 if (is_ptrast_arg(ptrast, astx)) {
2277 if (OPTDBG(9, 16384))
2278 fprintf(gbl.dbgfil,
2279 "ptrdef in path -- arg, ptr def in start fg %d\n",
2280 srch_ae.end.fg);
2281 return TRUE;
2282 }
2283 break;
2284 }
2285 iltx = STD_NEXT(iltx);
2286 }
2287 return FALSE;
2288 }
2289
2290 iltx = srch_ae.start.stmt;
2291 term_std = FG_STDLAST(srch_ae.start.fg);
2292 while (term_std != iltx) {
2293 iltx = STD_NEXT(iltx);
2294 if (iltx == 0)
2295 break;
2296 astx = STD_AST(iltx);
2297 switch (A_TYPEG(astx)) {
2298 case A_ICALL:
2299 if (A_OPTYPEG(astx) == I_PTR2_ASSIGN) {
2300 int args, lastx, rastx;
2301 args = A_ARGSG(astx);
2302 lastx = ARGT_ARG(args, 0);
2303 rastx = ARGT_ARG(args, 2);
2304 if (nme) {
2305 if (nme_of_ast(astx) != nme) {
2306 break;
2307 }
2308 }
2309 if (OPTDBG(9, 16384))
2310 fprintf(gbl.dbgfil, "ptrdef in path, ptr def in start fg %d\n",
2311 srch_ae.end.fg);
2312 return TRUE;
2313 }
2314 break;
2315 case A_CALL:
2316 case A_FUNC:
2317 if (is_ptrast_arg(ptrast, astx)) {
2318 if (OPTDBG(9, 16384))
2319 fprintf(gbl.dbgfil, "ptrdef in path -- arg, ptr def in start fg %d\n",
2320 srch_ae.end.fg);
2321 return TRUE;
2322 }
2323 break;
2324 }
2325 }
2326 /*
2327 * nodes are different. examine ilts between the start of the end
2328 * node and the end statement, inclusive.
2329 * only search if there exists a store via a pointer in the node.
2330 */
2331 term_std = FG_STDFIRST(srch_ae.end.fg);
2332 for (iltx = (srch_ae.end.stmt); iltx; iltx = STD_PREV(iltx)) {
2333 astx = STD_AST(iltx);
2334 switch (A_TYPEG(astx)) {
2335 case A_ICALL:
2336 if (A_OPTYPEG(astx) == I_PTR2_ASSIGN) {
2337 int args, lastx, rastx;
2338 args = A_ARGSG(astx);
2339 lastx = ARGT_ARG(args, 0);
2340 rastx = ARGT_ARG(args, 2);
2341 if (nme) {
2342 if (nme_of_ast(astx) != nme) {
2343 break;
2344 }
2345 }
2346 if (OPTDBG(9, 16384))
2347 fprintf(gbl.dbgfil, "ptrdef in path, ptr def in start fg %d\n",
2348 srch_ae.end.fg);
2349 return TRUE;
2350 }
2351 break;
2352 case A_CALL:
2353 case A_FUNC:
2354 if (is_ptrast_arg(ptrast, astx)) {
2355 if (OPTDBG(9, 16384))
2356 fprintf(gbl.dbgfil, "ptrdef in path -- arg, ptr def in start fg %d\n",
2357 srch_ae.end.fg);
2358 return TRUE;
2359 }
2360 break;
2361 }
2362
2363 if (iltx == term_std)
2364 break;
2365 }
2366
2367 return FALSE;
2368 }
2369
2370 /*
2371 * If there is a pointer def(a=>b) or sub(b)
2372 * If there is the lhs is a member, the nme must be the nme of parent
2373 */
2374 LOGICAL
is_ptrdef_in_path(int start_ilt,int start_fg,int end_ilt,int end_fg,int nme,int ast)2375 is_ptrdef_in_path(int start_ilt, int start_fg, int end_ilt, int end_fg, int nme,
2376 int ast)
2377 {
2378
2379 srch_ae.start.stmt = start_ilt;
2380 srch_ae.start.fg = start_fg;
2381 srch_ae.end.stmt = end_ilt;
2382 srch_ae.end.fg = end_fg;
2383
2384 return (isptrdef_in_path(basenme_of(nme), ast));
2385 }
2386
2387 /* check if all def of this ast is in allocate statement and it is safe */
2388 LOGICAL
alldefs_allocsafe(int ast,int stmt)2389 alldefs_allocsafe(int ast, int stmt)
2390 {
2391 int astx, lastx;
2392 int def = 0;
2393 int fgx = STD_FG(stmt);
2394 int std = 0;
2395 int hasalloc = 0;
2396 int hasdom = 0;
2397 BV *bv = NULL;
2398 LOGICAL is_inited = FALSE;
2399
2400 int nme = nme_of_ast(ast);
2401
2402 if (!fgx)
2403 return FALSE;
2404 if (nme) {
2405 bv = FG_UNINITED(STD_FG(stmt));
2406 is_inited = is_initialized(bv, nme);
2407 if (!is_inited) /* must be defined in this routine */
2408 return FALSE;
2409 while ((def = find_next_reaching_def(nme, fgx, def))) {
2410 std = DEF_STD(def);
2411 if (std == stmt) {
2412 continue;
2413 }
2414 if (is_alloc_std(std)) {
2415 int allocast = STD_AST(std);
2416
2417 if (!is_parentof_ast(A_SRCG(allocast), ast))
2418 continue;
2419
2420 hasalloc = 1;
2421 /* check if there is a pointer def or a call with this pointer */
2422 if (is_ptrdef_in_path(std, STD_FG(std), stmt, STD_FG(stmt), nme, ast)) {
2423 return FALSE;
2424 }
2425 } else {
2426 /* an assignment of a parent will cause an unsafe. */
2427 if (A_ASN == A_TYPEG(STD_AST(std))) {
2428 int destast = STD_AST(std);
2429 if (is_parentof_ast(A_DESTG(destast), ast)) {
2430 if (A_TYPEG(destast) == A_SUBSCR) {
2431 destast = A_LOPG(destast);
2432 if (ast == destast) /* normal assignment */
2433 continue;
2434 }
2435 return FALSE;
2436 }
2437 continue;
2438 } else if (A_TYPEG(STD_AST(std)) == A_ICALL &&
2439 A_OPTYPEG(STD_AST(std)) == I_PTR2_ASSIGN) {
2440 /* pointer associate constructs are ok; we already processed them,
2441 e.g., in ptrdefs_has_lhsconflict */
2442 hasalloc = 1;
2443 continue;
2444 } else
2445 return FALSE;
2446 }
2447 }
2448 /* all pointer defs are in allocate stmt and it is safe */
2449 if (hasalloc)
2450 return TRUE;
2451 }
2452 return FALSE;
2453 }
2454
2455 /* find all reaching def of this nme and check if it has conflict(nme appears in
2456 * lhsdefs
2457 * struct
2458 */
2459 static LOGICAL
ptrdefs_has_lhsconflict(int nme,int std,int def)2460 ptrdefs_has_lhsconflict(int nme, int std, int def)
2461 {
2462 int i, astx, rhsnme, rastx, args;
2463
2464 def = find_next_reaching_def(nme, STD_FG(std), def);
2465 if (!def) return FALSE;
2466
2467 /* if it is not initialized, then need temp */
2468 if (!is_initialized(FG_UNINITED(STD_FG(std)), nme))
2469 return TRUE;
2470
2471 while (def) {
2472 int def_std = DEF_STD(def);
2473 if (def_std == std) {
2474 def = find_next_reaching_def(nme, STD_FG(std), def);
2475 continue;
2476 }
2477 astx = STD_AST(def_std);
2478 switch (A_TYPEG(astx)) {
2479 case A_ICALL:
2480 if (A_OPTYPEG(astx) == I_PTR2_ASSIGN) {
2481 for (i = 0; i < lhscount; ++i) {
2482 if (nme == lhsdefs[i].nme) {
2483 return TRUE;
2484 }
2485 }
2486 /* recursive find its def's def, i.e., a=>b, b=>c, current=>d ,
2487 * may be a also point by lhs.
2488 */
2489 args = A_ARGSG(astx);
2490 rastx = ARGT_ARG(args, 2);
2491 rhsnme = nme_of_ast(rastx);
2492
2493 if (!rhsnme || ptrdefs_has_lhsconflict(rhsnme, def_std, def))
2494 return TRUE;
2495 }
2496 break;
2497 case A_CALL:
2498 case A_FUNC:
2499 return TRUE;
2500 break;
2501 case A_ALLOC:
2502 break;
2503 case A_ASN:
2504 /* if it is an assignment of its parent, then it is not safe */
2505 /* check if it is the same type */
2506 break;
2507 default:
2508 return TRUE;
2509 break;
2510 }
2511 def = find_next_reaching_def(nme, STD_FG(std), def);
2512 }
2513 return FALSE;
2514 }
2515
2516 static LOGICAL
is_member_ast(int ast)2517 is_member_ast(int ast)
2518 {
2519 while (ast) {
2520 switch (A_TYPEG(ast)) {
2521 case A_MEM:
2522 return TRUE;
2523 case A_ID:
2524 return FALSE;
2525 case A_SUBSCR:
2526 ast = A_LOPG(ast);
2527 break;
2528 default:
2529 return FALSE;
2530 }
2531 }
2532 return FALSE;
2533 }
2534
2535 static void
_find_rhs_def_conflict(int ast,int * args)2536 _find_rhs_def_conflict(int ast, int *args)
2537 {
2538 int i, sptr, ast_opnd, lhs_opnd;
2539 int std = args[0];
2540 int lhs = args[2];
2541 int allochk = args[3];
2542 int nme = nme_of_ast(ast);
2543 int lhs_sptr = basesym_of(nme_of_ast(lhs));
2544 int def = 0;
2545 if (lhscount >= MAX_DEF) {
2546 args[1] = 1;
2547 return;
2548 }
2549
2550 if (nme && args[1] == 0) { /* args[1] == 0 -- no conflict found so far */
2551 switch (A_TYPEG(ast)) {
2552 case A_ID:
2553 if (lhs == ast) {
2554 return; /* impossible to get here, lhs is supposed to be subscript */
2555 }
2556 sptr = A_SPTRG(ast);
2557 if (sptr == lhs_sptr) /* will check at A_SUBSCR */
2558 return;
2559 if (TARGETG(sptr)) {
2560 args[1] = 1;
2561 return;
2562 } else if (POINTERG(sptr)) {
2563 if (allochk) {
2564 if (!alldefs_allocsafe(ast, std)) {
2565 args[1] = 1;
2566 return;
2567 }
2568 }
2569 /* check current nme against all the nme's on the lhs */
2570 for (i = 0; i < lhscount; ++i) {
2571 if (nme == lhsdefs[i].nme) {
2572 args[1] = 1;
2573 return;
2574 }
2575 }
2576
2577 /* check all of the defs of the current nme */
2578 if (ptrdefs_has_lhsconflict(nme, std, 0)) {
2579 args[1] = 1;
2580 return;
2581 }
2582 }
2583 break;
2584 case A_SUBSCR:
2585 ast_opnd = A_LOPG(ast);
2586 lhs_opnd = A_LOPG(lhs);
2587 if (A_TYPEG(lhs_opnd) == A_MEM) {
2588 if (A_TYPEG(ast_opnd) == A_MEM) {
2589 if (A_MEMG(ast_opnd) == A_MEMG(lhs_opnd))
2590 if (A_ASDG(lhs) != A_ASDG(ast))
2591 args[1] = 1;
2592 }
2593 } else if (A_TYPEG(lhs_opnd) != A_MEM) {
2594 if (lhs_opnd == ast_opnd)
2595 if (A_ASDG(lhs) != A_ASDG(ast))
2596 args[1] = 1;
2597 }
2598
2599 break;
2600 default:
2601 break;
2602 }
2603 }
2604 }
2605
2606 static void
_find_lhs_on_rhs_conflict(int ast,int * args)2607 _find_lhs_on_rhs_conflict(int ast, int *args)
2608 {
2609 int i, sptr, ast_opnd, lhs_opnd;
2610 int std = args[0];
2611 int lhs = args[2];
2612 int allochk = args[3];
2613 int nme = nme_of_ast(ast);
2614 int lhs_sptr = basesym_of(nme_of_ast(lhs));
2615 int def = 0;
2616 if (lhscount >= MAX_DEF) {
2617 args[1] = 1;
2618 return;
2619 }
2620
2621 /*
2622 * Possible conflict:
2623 * abc = sub(abc)
2624 * abc%mem = sub(abc)
2625 * abc%mem = sub(abc%mem)
2626 * abc(1:3) = abc(2:4) op ..
2627 *
2628 */
2629
2630 if (nme && args[1] == 0) { /* args[1] == 0 -- no conflict found so far */
2631 switch (A_TYPEG(ast)) {
2632 case A_ID:
2633 if (lhs == ast) {
2634 return; /* impossible to get here, lhs is supposed to be subscript */
2635 }
2636 sptr = A_SPTRG(ast);
2637 if (sptr == lhs_sptr) /* will check at A_SUBSCR */
2638 return;
2639 if (TARGETG(sptr)) {
2640 args[1] = 1;
2641 return;
2642 }
2643 /* if it is a parent, then it is not safe */
2644 if (DTY(DDTG(DTYPEG(sptr))) == TY_DERIVED && is_parentof_ast(ast, lhs)) {
2645 args[1] = 1;
2646 return;
2647 }
2648 break;
2649 case A_SUBSCR:
2650 /* next 2 lines checking may not be sufficient -- need to find example for
2651 * it
2652 * if (ast == lhs)
2653 * break;
2654 */
2655 ast_opnd = A_LOPG(ast);
2656 lhs_opnd = A_LOPG(lhs);
2657 if (A_TYPEG(lhs_opnd) == A_MEM) {
2658 if (A_TYPEG(ast_opnd) == A_MEM) {
2659 if (A_MEMG(ast_opnd) == A_MEMG(lhs_opnd))
2660 if (A_ASDG(lhs) != A_ASDG(ast))
2661 args[1] = 1;
2662 }
2663 } else if (A_TYPEG(lhs_opnd) != A_MEM) {
2664 if (lhs_opnd == ast_opnd)
2665 if (A_ASDG(lhs) != A_ASDG(ast))
2666 args[1] = 1;
2667 }
2668
2669 break;
2670 case A_MEM:
2671 /* if it is a parent of lhs, then it is not safe */
2672 if (is_parentof_ast(ast, lhs)) {
2673 args[1] = 1;
2674 return;
2675 }
2676 break;
2677 default:
2678 break;
2679 }
2680 }
2681 }
2682
2683 static void
find_rhs_conflict(int lhs,int rhs,int stmt,int allochk,int * result)2684 find_rhs_conflict(int lhs, int rhs, int stmt, int allochk, int *result)
2685 {
2686
2687 int args[4];
2688 args[0] = stmt, args[1] = 0;
2689 args[2] = lhs;
2690 args[3] = allochk;
2691 if (lhscount >= MAX_DEF) {
2692 *result = 1;
2693 return;
2694 }
2695 ast_visit(1, 1);
2696 ast_traverse(rhs, NULL, _find_rhs_def_conflict, args);
2697 *result = args[1];
2698 ast_unvisit();
2699 }
2700
2701 static void
find_lhs_on_rhs_conflict(int lhs,int rhs,int stmt,int allochk,int * result)2702 find_lhs_on_rhs_conflict(int lhs, int rhs, int stmt, int allochk, int *result)
2703 {
2704
2705 int args[4];
2706 args[0] = stmt, args[1] = 0;
2707 args[2] = lhs;
2708 args[3] = allochk;
2709 if (lhscount >= MAX_DEF) {
2710 *result = 1;
2711 return;
2712 }
2713 ast_visit(1, 1);
2714 ast_traverse(rhs, NULL, _find_lhs_on_rhs_conflict, args);
2715 *result = args[1];
2716 ast_unvisit();
2717 }
2718
2719 int
add_lhs_nme(int nme,int std,int isdummy)2720 add_lhs_nme(int nme, int std, int isdummy)
2721 {
2722 if (lhscount >= MAX_DEF)
2723 return MAX_DEF + 1;
2724
2725 lhsdefs[lhscount].nme = nme;
2726 lhsdefs[lhscount].std = std;
2727 lhsdefs[lhscount].isdummy = isdummy;
2728 lhscount++;
2729
2730 return lhscount;
2731 }
2732
2733 #if DEBUG
2734 static void
dump_lhs_nme(int nme,int std,int isdummy)2735 dump_lhs_nme(int nme, int std, int isdummy)
2736 {
2737 int i;
2738 for (i = 0; i < lhscount; ++i) {
2739 fprintf(gbl.dbgfil, "std: %d\n", std);
2740 print_nme(nme);
2741 }
2742 }
2743 #endif
2744
2745 /* find all origin of lhs defs */
2746 static void
get_lhs_first_defs(int stmt,int lhs)2747 get_lhs_first_defs(int stmt, int lhs)
2748 {
2749 int lop, allglobals, allargs, dpdsc, funcsptr;
2750 int dummy, args, argcnt, a, arg, argsptr, nme;
2751 int forall_lhs;
2752 int astx = STD_AST(stmt);
2753 if (lhscount >= MAX_DEF)
2754 return;
2755 switch (A_TYPEG(astx)) {
2756 case A_ICALL:
2757 /* intrinsic call, see if it is ptr assignment */
2758 if (A_OPTYPEG(astx) == I_PTR2_ASSIGN) {
2759 /* pointer assignment */
2760 int args, lhsastx, rhsastx, lhsdsx, rhsdsx, stride;
2761 args = A_ARGSG(astx);
2762 lhsastx = ARGT_ARG(args, 0);
2763 rhsastx = ARGT_ARG(args, 2);
2764 nme = 0;
2765 switch (A_TYPEG(rhsastx)) {
2766 case A_ID:
2767 nme = nme_of_ast(rhsastx);
2768 break;
2769 case A_MEM:
2770 nme = nme_of_ast(rhsastx);
2771 a = A_PARENTG(rhsastx);
2772 break;
2773 case A_SUBSCR:
2774 nme = nme_of_ast(rhsastx);
2775 a = A_LOPG(rhsastx);
2776 break;
2777 default:
2778 lhscount = MAX_DEF + 1; /* don't handle other kinds if any */
2779 return;
2780 }
2781 if (nme) {
2782 int def, isdummy;
2783 int fgx = STD_FG(stmt);
2784 int sym = basesym_of(nme);
2785 isdummy = FALSE;
2786 def = 0;
2787 if (sym) {
2788 isdummy = (SCG(sym) == SC_DUMMY) ? TRUE : FALSE;
2789 if (!isdummy)
2790 isdummy = !(is_sym_ptrsafe(sym));
2791 }
2792 def = find_next_reaching_def(nme, fgx, def);
2793 if (def) {
2794 while ((def = find_next_reaching_def(nme, fgx, def))) {
2795 int std = DEF_STD(def);
2796 if (std == stmt)
2797 continue;
2798 if (lhs != lhsastx)
2799 if (!is_parentof_ast(lhsastx, lhs))
2800 continue;
2801 lhscount++; /* not safe , too many defs */
2802 get_lhs_first_defs(std, rhsastx);
2803 if (lhscount >= MAX_DEF)
2804 return;
2805 }
2806 } else {
2807 /* very first defs in this function */
2808 add_lhs_nme(nme, stmt, isdummy);
2809 return;
2810 }
2811 }
2812 }
2813 break;
2814 case A_CALL:
2815 case A_FUNC:
2816 lhscount = MAX_DEF + 1; /* not safe */
2817 break;
2818 case A_ALLOC:
2819 nme = nme_of_ast(lhs);
2820 add_lhs_nme(nme, stmt, 0);
2821 break;
2822 case A_ASN:
2823 break;
2824 case A_FORALL:
2825 forall_lhs = A_IFSTMTG(astx); /* look for lhs of the forall assignment */
2826 if (A_TYPEG(forall_lhs) == A_ASN) {
2827 forall_lhs = A_DESTG(forall_lhs);
2828 if (A_TYPEG(forall_lhs) == A_SUBSCR) {
2829 nme = nme_of_ast(forall_lhs);
2830 add_lhs_nme(nme, stmt, 0);
2831 }
2832 else
2833 lhscount = MAX_DEF + 1; /* error */
2834 }
2835 else
2836 lhscount = MAX_DEF + 1; /* error */
2837 break;
2838 default:
2839 lhscount = MAX_DEF + 1; /* error */
2840 break;
2841 }
2842 } /* _find_pointer_defs */
2843
2844 /* determine if the lhs need temp array */
2845 LOGICAL
lhs_needtmp(int lhs,int rhs,int stmt)2846 lhs_needtmp(int lhs, int rhs, int stmt)
2847 {
2848 int def = 0;
2849 int nme;
2850 int fgx = STD_FG(stmt);
2851 int result;
2852
2853 if (!fgx)
2854 return FALSE;
2855
2856 /* init lhscount for each stmt*/
2857 lhscount = 0;
2858
2859 /* if all pointer defs are allocated and along the path from all allocate
2860 * stmt(s) to
2861 * current statement there is no pointer def where lhs is on the rhs and lhs
2862 * is not pointer argument to a call which has interface, then it it safe
2863 */
2864
2865 if (alldefs_allocsafe(lhs, stmt)) {
2866 /* if all def of lhs is allocated and it is available from the allocated
2867 * stmt to forall stmt
2868 * Then check if lhs also presents in rhs in this forall and have different
2869 * index(overlapped).
2870 */
2871 find_lhs_on_rhs_conflict(lhs, rhs, stmt, 0, &result);
2872 if (result == 0)
2873 return FALSE;
2874 } else {
2875 /* find and store the nme's of all lhs defs, to be checking with rhs later
2876 */
2877 int nme = nme_of_ast(lhs);
2878 if (nme) {
2879 while ((def = find_next_reaching_def(nme, fgx, def))) {
2880 int std = DEF_STD(def);
2881 if (std == stmt)
2882 continue;
2883 get_lhs_first_defs(std, lhs);
2884 }
2885 } else {
2886 return TRUE;
2887 }
2888 }
2889
2890 /* do check on the rhs */
2891 find_rhs_conflict(lhs, rhs, stmt, 1, &result);
2892 if (result != 1)
2893 return FALSE;
2894 /* yes need temp */
2895 return TRUE;
2896 }
2897