1 /*
2 * Copyright (c) 1994-2018, 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 /**
19 \file
20 \brief optimizer submodule responsible for invariant analysis
21 for a given loop. Used by the optimizer and vectorizer.
22
23 NOTE: During the detection phase of the analysis, stores are analyzed by
24 traversing the store lists of a loop and its children. A store is marked by
25 recording the store item in the corresponding name's stl field. The lifetime
26 of the names' stl fields extends after the analysis phase so that the general
27 query function, is_invariant, can be provided. The stl fields (and ili
28 marked during the analysis) are cleaned up in unmark/unmarkv.
29 */
30
31 /* FIXME -- move these to the definition sites
32 void invariant(int) - do invariant analysis and code motion
33 void invariant_nomotion(int) - just determine which expressions are
34 invariant
35 void invariant_mark(int, int) - mark ili as invariant or not invariant
36 LOGICAL is_invariant(int) - analyze ili for invariancy
37 void invariant_unmark() - unmark ili & nmes which have been marked by the
38 invariant analysis when performing code motion. The lifetime of
39 marked ili is during invariant and other optimizations (such as
40 induction analysis) which need to know what expressions are invariant.
41 unmarking occurs after the info is no longer needed.
42 void invariant_unmarkv() - unmark ili & nmes which have been marked by the
43 invariant analysis when not performing code motion (i.e., by the
44 vectorizer).
45 static void invar_init(int)
46 static void invar_end(int)
47 static void initnames(*stl)
48 static void cleannames(*stl)
49 static LOGICAL invar_src(int)
50 static void invar_arrnme(int)
51 static void invar_motion(int)
52 static void store_ili(int)
53 LOGICAL is_sym_invariant_safe(int, int)
54
55 */
56 #include "gbldefs.h"
57 #include "global.h"
58 #include "error.h"
59 #include "symtab.h"
60 #include "ast.h"
61 #include "nme.h"
62 #include "optimize.h"
63 #include "semant.h"
64
65 static LOGICAL invar_src(int);
66 static void invar_init(int);
67 static void invar_mark(int);
68 static void invar_end(int);
69 static void invar_arrnme(int);
70 static void invar_motion(int);
71 static void store_ili(int);
72 static void initnames(STL *);
73 static void cleannames(STL *);
74
75 static int lpx, fgx, stdx;
76 static LOGICAL safe; /* safe to classify an expression invariant */
77 static LOGICAL mark_value; /* invariant mark (INV) or NOT_INV if in a
78 * critical section.
79 */
80 static LOGICAL mark_return; /* TRUE, if mark_value == INV */
81
82 /*
83 * perform invariant analysis along with code motion.
84 */
85 void
invariant(int lp)86 invariant(int lp)
87 {
88 int pre_bih, stdx, fgx, fg_tail, fg_tailnext;
89 invar_init(lp);
90
91 invar_mark(lp);
92 LP_HSTDF(lp) = 0;
93 LP_DSTDF(lp) = 0;
94
95 if (flg.opt >= 2 && !XBIT(2, 0x400000)) {
96 if (!LP_MEXITS(lp) && !LP_PARLOOP(lp) && !LP_CS(lp)) {
97 fg_tail = LP_TAIL(lp);
98 fg_tailnext = FG_LNEXT(fg_tail);
99 for (fgx = LP_HEAD(lp); fgx && fgx != fg_tailnext; fgx = FG_LNEXT(fgx)) {
100 for (stdx = FG_STDFIRST(fgx); stdx; stdx = STD_NEXT(stdx)) {
101 if (STD_ACCEL(stdx) || STD_KERNEL(stdx)) {
102 } else {
103 invar_motion((int)stdx);
104 }
105 if (stdx == FG_STDLAST(fgx))
106 break;
107 }
108 if (fgx == fg_tail)
109 break;
110 }
111 }
112 }
113
114 invar_end(lp);
115 LP_HSTDF(lp) = 0;
116 LP_DSTDF(lp) = 0;
117
118 }
119
120 /*
121 * perform invariant analysis only (no code motion); used by vectorizer
122 * to determine which expressions are invariant in a loop.
123 */
124 void
invariant_nomotion(int lp)125 invariant_nomotion(int lp)
126 {
127 invar_init(lp);
128
129 invar_mark(lp);
130
131 invar_end(lp);
132
133 }
134
135 void
invariant_mark(int ilix,int mark)136 invariant_mark(int ilix, int mark)
137 {
138 int i;
139
140 AST_INVP(ilix, mark);
141 i = opt.invb.stg_avail++;
142 OPT_NEED(opt.invb, int, 100);
143 opt.invb.stg_base[i] = ilix;
144 }
145
146 /*
147 * cleanup invariant table after it's not needed (typically during the last
148 * step in induction analysis, must be used after invariant analysis when
149 * it includes code motion.
150 */
151 void
invariant_unmark(void)152 invariant_unmark(void)
153 {
154 int i, ilix;
155 STL *stl;
156
157 for (i = opt.invb.stg_avail - 1; i; i--) {
158 ilix = opt.invb.stg_base[i];
159 if (!AST_ISINV_TEMP(ilix))
160 AST_INVP(ilix, 0);
161 }
162 /*
163 * clean up the names entries of the stores in the loop and in any nested
164 * loops
165 */
166 stl = LP_STL(lpx);
167 cleannames(stl);
168 }
169
170 /*
171 * cleanup invariant table after it's not needed by the vectorize.
172 */
173 void
invariant_unmarkv(void)174 invariant_unmarkv(void)
175 {
176 int i, ilix;
177 STL *stl;
178
179 for (i = opt.invb.stg_avail - 1; i; i--) {
180 ilix = opt.invb.stg_base[i];
181 AST_INVP(ilix, 0);
182 }
183 /*
184 * clean up the names entries of the stores in the loop and in any nested
185 * loops
186 */
187 stl = LP_STL(lpx);
188 cleannames(stl);
189 }
190
191 static void
invar_init(int lp)192 invar_init(int lp)
193 {
194 STL *stl;
195
196 opt.invb.stg_avail = 1;
197 lpx = lp;
198 if (OPTDBG(9, 256))
199 fprintf(gbl.dbgfil, "\n---------- Invariant trace of loop %d\n", lp);
200
201 stl = LP_STL(lp);
202 /*
203 * initialize the names entries of the stores in the loop and in any
204 * nested loops. Cleanup occurs in unmark/unmarkv.
205 */
206 initnames(stl);
207 }
208
209 static void
invar_mark(int lp)210 invar_mark(int lp)
211 {
212 /*
213 * If a loop contains a critical section, first traverse the blocks which
214 * have their FG_CS flags set; this ensures that any ili in the critical
215 * sections will not be considered to be invariant.
216 */
217 if (LP_CS(lp)) {
218 mark_value = NOT_INV;
219 mark_return = FALSE;
220 for (fgx = LP_FG(lp); fgx; fgx = FG_NEXT(fgx)) {
221 safe = TRUE;
222 if (FG_CS(fgx)) {
223 if (OPTDBG(9, 256))
224 fprintf(gbl.dbgfil, " flow graph node %d (LP_CS)\n", fgx);
225 for (stdx = FG_STDFIRST(fgx); stdx; stdx = STD_NEXT(stdx)) {
226 if (OPTDBG(9, 256))
227 fprintf(gbl.dbgfil, " ilt %d\n", stdx);
228 (void)invar_src((int)STD_AST(stdx));
229 if (stdx == FG_STDLAST(fgx))
230 break;
231 }
232 }
233 }
234 }
235 mark_value = INV;
236 mark_return = TRUE;
237
238 /*
239 * Next, traverse the blocks in the loop that are always executed.
240 * i.e, blocks which dominate the tail of the loop. Otherwise, could
241 * first discover an unsafe invariant expression which appears later
242 * in block that's always executed.
243 */
244 for (fgx = LP_FG(lp); fgx; fgx = FG_NEXT(fgx)) {
245 safe = is_dominator(fgx, (int)LP_TAIL(lp));
246 if (safe) {
247 if (OPTDBG(9, 256))
248 fprintf(gbl.dbgfil, " flow graph node %d (%s)\n", fgx,
249 safe ? "safe" : "unsafe");
250 for (stdx = FG_STDFIRST(fgx); stdx; stdx = STD_NEXT(stdx)) {
251 if (OPTDBG(9, 256))
252 fprintf(gbl.dbgfil, " std %d\n", stdx);
253 (void)invar_src((int)STD_AST(stdx));
254 if (stdx == FG_STDLAST(fgx))
255 break;
256 }
257 }
258 }
259 /*
260 * The last traversal is the blocks in the loop that are not always
261 * executed.
262 */
263 for (fgx = LP_FG(lp); fgx; fgx = FG_NEXT(fgx)) {
264 safe = is_dominator(fgx, (int)LP_TAIL(lp));
265 if (!safe) {
266 if (OPTDBG(9, 256))
267 fprintf(gbl.dbgfil, " flow graph node %d (%s)\n", fgx,
268 safe ? "safe" : "unsafe");
269 for (stdx = FG_STDFIRST(fgx); stdx; stdx = STD_NEXT(stdx)) {
270 if (OPTDBG(9, 256))
271 fprintf(gbl.dbgfil, " std %d\n", stdx);
272 (void)invar_src((int)STD_AST(stdx));
273 if (stdx == FG_STDLAST(fgx))
274 break;
275 }
276 }
277 }
278
279 }
280
281 extern void restore_hoist_stmt(int lp);
282
283 static void
invar_end(int lp)284 invar_end(int lp)
285 {
286 restore_hoist_stmt(lp);
287 }
288
289 /*
290 * initialize the names entries of the stores in the loop and in any nested
291 * loops
292 */
293 static void
initnames(STL * stlitem)294 initnames(STL *stlitem)
295 {
296 STL *tmp;
297 int i, j, nme;
298
299 tmp = stlitem;
300 for (i = tmp->store; i; i = STORE_NEXT(i)) {
301 nme = STORE_NM(i);
302 j = NME_STL(nme);
303 if (j)
304 STORE_TYPE(j) |= STORE_TYPE(i);
305 else
306 NME_STL(nme) = i;
307 }
308 /* init names (recursively) for nested loops too. */
309 for (tmp = tmp->childlst; tmp != NULL; tmp = tmp->nextsibl) {
310 initnames(tmp);
311 }
312 }
313
314 /*
315 * clean up the names entries of the stores in the loop and in any nested
316 * loops
317 */
318 static void
cleannames(STL * stlitem)319 cleannames(STL *stlitem)
320 {
321 STL *tmp;
322 int i;
323
324 tmp = stlitem;
325 for (i = tmp->store; i; i = STORE_NEXT(i))
326 NME_STL(STORE_NM(i)) = 0;
327
328 /* clean up (recursively) names of any descendants, too */
329 for (tmp = tmp->childlst; tmp != NULL; tmp = tmp->nextsibl) {
330 cleannames(tmp);
331 }
332 }
333
334 /*
335 * Determine if given ili is invariant. WARNING: this assumes that
336 * the regular analysis has been done; i.e., safe and lpx which are
337 * static have been set.
338 */
339 LOGICAL
is_invariant(int ilix)340 is_invariant(int ilix)
341 {
342 LOGICAL invf;
343 if (OPTDBG(9, 256))
344 fprintf(gbl.dbgfil, "is_invariant of ili %d called\n", ilix);
345 invf = invar_src(ilix);
346 if (OPTDBG(9, 256))
347 fprintf(gbl.dbgfil, "is_invariant of ili %d returns %s\n", ilix,
348 invf ? "TRUE" : "FALSE");
349 return invf;
350 }
351
352 static void compute_invariant(int, int *);
353
354 static LOGICAL
invar_src(int ast)355 invar_src(int ast)
356 {
357 ast_visit(1, 1);
358 ast_traverse(ast, NULL, compute_invariant, NULL);
359 ast_unvisit();
360 return AST_ISINV(ast);
361 }
362
363 static void
compute_invariant(int ast,int * dummy)364 compute_invariant(int ast, int *dummy)
365 {
366 int atype;
367 int sym;
368 int nme;
369 int dtype;
370 int i, asd;
371 int astli;
372 int argt;
373 int cnt;
374 LOGICAL invar_flag;
375
376 /* already done
377 if (AST_INVG(ast))
378 return;
379 */
380
381 switch (atype = A_TYPEG(ast)) {
382 case A_NULL:
383 case A_CNST:
384 case A_CMPLXC:
385 break; /* mark invariant */
386 case A_ID:
387 sym = A_SPTRG(ast);
388 if (ST_ISVAR(STYPEG(sym)) || (ST_ARRDSC == STYPEG(sym))) {
389 nme = A_NMEG(ast);
390 if (NME_STL(nme)) {
391 if (OPTDBG(9, 256))
392 fprintf(gbl.dbgfil,
393 " ast %5d-%s %s is not invariant--ST_NME %d\n", ast,
394 astb.atypes[atype], SYMNAME(sym), nme);
395 goto mark_variant;
396 }
397 if (NME_TYPE(nme) != NT_VAR)
398 goto mark_variant;
399 if (!is_sym_invariant_safe(nme, lpx)) {
400 if (OPTDBG(9, 256)) {
401 fprintf(gbl.dbgfil, " ast %5d-%s not invariant - %s unsafe\n",
402 ast, astb.atypes[atype], SYMNAME(sym));
403 }
404 goto mark_variant;
405 }
406 }
407 break;
408 case A_MEM:
409 if (!AST_ISINV(A_PARENTG(ast)))
410 goto markd_variant;
411 /* _ast_trav(A_MEMG(ast)) */
412 break;
413 case A_BINOP:
414 invar_flag = AST_ISINV(A_LOPG(ast)) && AST_ISINV(A_ROPG(ast));
415 if (!invar_flag)
416 goto markd_variant;
417 goto chk_fp_safe;
418 case A_UNOP:
419 case A_CONV:
420 case A_PAREN:
421 if (!AST_ISINV(A_LOPG(ast)))
422 goto markd_variant;
423 goto chk_fp_safe;
424 case A_SUBSCR:
425 asd = A_ASDG(ast);
426 if (!AST_ISINV(A_LOPG(ast)))
427 goto markd_variant;
428 for (i = 0; i < (int)ASD_NDIM(asd); i++)
429 if (!AST_ISINV(ASD_SUBS(asd, i)))
430 goto markd_variant;
431 break;
432 case A_SUBSTR:
433 if (!AST_ISINV(A_LOPG(ast)))
434 goto markd_variant;
435 if (A_LEFTG(ast) && !AST_ISINV(A_LEFTG(ast)))
436 goto markd_variant;
437 if (A_RIGHTG(ast) && !AST_ISINV(A_RIGHTG(ast)))
438 goto markd_variant;
439 break;
440 case A_TRIPLE:
441 /* [lb]:[ub][:stride] */
442 if (A_LBDG(ast) && !AST_ISINV(A_LBDG(ast)))
443 goto markd_variant;
444 if (A_UPBDG(ast) && !AST_ISINV(A_UPBDG(ast)))
445 goto markd_variant;
446 if (A_STRIDEG(ast) && !AST_ISINV(A_STRIDEG(ast)))
447 goto markd_variant;
448 break;
449 case A_FUNC:
450 goto markd_variant;
451 case A_ALLOC:
452
453 /* currently enabled when STD_HSTBLE(stdx) is set , this flag is set
454 * when the allocate/deallocate is for forall temp array.
455 * might need to keep track of allo/deall.
456 */
457 if (flg.opt >= 2 && !XBIT(2, 0x400000)) {
458 if (STD_HSTBLE(stdx) && is_alloc_ast(ast)) {
459 int srcast = A_SRCG(ast);
460 if (A_TYPEG(srcast) == A_SUBSCR)
461 goto markd_variant;
462 compute_invariant(srcast, NULL);
463 if (!AST_ISINV(srcast))
464 goto markd_variant;
465 if (A_SHAPEG(srcast)) {
466 int asd, i, ndim, ss;
467 asd = A_ASDG(srcast);
468 ndim = ASD_NDIM(asd);
469 for (i = 0; i < ndim; ++i) {
470 ss = ASD_SUBS(asd, i);
471 compute_invariant((ss), NULL);
472 if (!AST_ISINV(ss))
473 goto markd_variant;
474 }
475 }
476 }
477 if (STD_HSTBLE(stdx) && is_dealloc_ast(ast)) {
478 int std = STD_HSTBLE(stdx);
479 /* check if ast of std is this ast and it is hoistable and it is
480 * invariant */
481
482 if (A_TYPEG(A_SRCG(ast)) == A_SUBSCR || !STD_HSTBLE(std))
483 goto markd_variant;
484 if (AST_ISINV(A_SRCG(ast)))
485 break;
486 }
487 }
488 goto markd_variant;
489 break;
490
491 case A_INTR:
492 switch (A_OPTYPEG(ast)) {
493 case I_RAN:
494 case I_RANDOM_NUMBER:
495 case I_RANDOM_SEED:
496 goto markd_variant;
497 }
498 cnt = A_ARGCNTG(ast);
499 argt = A_ARGSG(ast);
500 if (cnt) {
501 i = 0;
502 while (TRUE) {
503 /* lfm -- optional args */
504 if (ARGT_ARG(argt, i) != 0 && !AST_ISINV(ARGT_ARG(argt, i)))
505 goto markd_variant;
506 if (++i >= cnt)
507 break;
508 }
509 }
510 chk_fp_safe:
511 if (!safe) {
512 dtype = DDTG(A_DTYPEG(ast));
513 if (DT_ISREAL(dtype) || DT_ISCMPLX(dtype))
514 goto unsafe;
515 }
516 break;
517 default:
518 AST_INVP(ast, NOT_INV);
519 return; /* default; don't add to invb list */
520 }
521
522 invariant_mark(ast, mark_value);
523 if (OPTDBG(9, 256)) {
524 if (mark_value == INV || mark_value == T_INV) {
525 fprintf(gbl.dbgfil, " ast %5d-%s", ast, astb.atypes[atype]);
526 if (A_TYPEG(ast) == A_ID)
527 fprintf(gbl.dbgfil, " %s", SYMNAME(A_SPTRG(ast)));
528 fprintf(gbl.dbgfil, " is invariant\n");
529 } else
530 fprintf(gbl.dbgfil, " ast %5d-%s is not invariant -- csec\n", ast,
531 astb.atypes[atype]);
532 }
533 return;
534
535 unsafe:
536 if (OPTDBG(9, 256))
537 fprintf(gbl.dbgfil, " ast %5d-%s -- unsafe\n", ast,
538 astb.atypes[atype]);
539 /* fall thru */
540 markd_variant:
541 if (OPTDBG(9, 256))
542 fprintf(gbl.dbgfil, " ast %5d-%s is not invariant\n", ast,
543 astb.atypes[atype]);
544 mark_variant:
545 invariant_mark(ast, NOT_INV);
546
547 }
548
549 /*
550 * for any array nme's in nme, check their subscripts. Note that this only
551 * marks the ili if necessary. Detecting an invariant subscript is not
552 * enough for it to be moved; the subscript ili must actually appear in
553 * a tree rooted by an ilt. There are situations (e.g., a[i+1]) where
554 * the subscript ili does not actually appear in the reference due to
555 * algebraic simplification.
556 */
557 static void
invar_arrnme(int nme)558 invar_arrnme(int nme)
559 {
560 int anme;
561
562 anme = nme;
563 while (NME_TYPE(anme) == NT_MEM || NME_TYPE(anme) == NT_IND)
564 anme = NME_NM(anme);
565 while (NME_TYPE(anme) == NT_ARR) {
566 if (NME_SUB(anme)) {
567 if (OPTDBG(9, 256))
568 fprintf(gbl.dbgfil, " arrnme %d, subili %d\n", anme,
569 NME_SUB(anme));
570 (void)invar_src((int)NME_SUB(anme));
571 }
572 anme = NME_NM(anme);
573 }
574 }
575
576 static LOGICAL is_std_hoistable(int, int);
577
578 /* allocate statement to move up, deallocate statement to move down */
579 static void
invar_motion(int std)580 invar_motion(int std)
581 {
582 int opc, i, j;
583 int ast, astd;
584 LOGICAL hstable = FALSE;
585 /* only STD_HSTBLE for now */
586 if (STD_HSTBLE(std)) {
587 ast = STD_AST(std);
588 if (is_alloc_ast(ast)) {
589 hstable = is_std_hoistable(std, lpx);
590 if (hstable) {
591 hoist_stmt(std, LP_FG(lpx), lpx);
592 } else {
593 /* mark not hoistable so that the deallocate will not be hoist */
594 astd = STD_HSTBLE(std);
595 STD_HSTBLE(std) = 0;
596 STD_HSTBLE(astd) = 0;
597 }
598 } else if (is_dealloc_ast(ast) && STD_HSTBLE(std)) {
599 astd = STD_HSTBLE(std);
600 if (STD_VISIT(astd)) {
601 hoist_stmt(std, LP_FG(lpx), lpx);
602
603 /* only do one level of hoisting for now */
604 STD_HSTBLE(std) = 0;
605 STD_HSTBLE(astd) = 0;
606 }
607 }
608 }
609 }
610
611 static LOGICAL
def_in_innerlp(int lpx,int def_lp)612 def_in_innerlp(int lpx, int def_lp)
613 {
614 int lp;
615 for (lp = LP_CHILD(lpx); lp; lp = LP_SIBLING(lp)) {
616 if (lp == def_lp)
617 return TRUE;
618 }
619 return FALSE;
620 }
621
622 /* return a number of def in a loop
623 * relies on LP_STL
624 * for subscript x[3]:
625 * if there is a whole array ref (x) => no
626 * if there is a subscript but variable index (x[n]) => no
627 */
628 static LOGICAL
has_def_inlp(int ast,int lp,int std)629 has_def_inlp(int ast, int lp, int std)
630 {
631 int lop, rop, def, nme, def_fg, asd, def_addr, ndim;
632 int def_count = 0;
633
634 switch (A_TYPEG(ast)) {
635
636 case A_SUBSCR:
637 lop = A_LOPG(ast);
638 if (A_TYPEG(lop) != A_ID) /* don't handle derived type yet */
639 return FALSE;
640 nme = A_NMEG(ast);
641 if (!nme)
642 return FALSE;
643 if (NME_TYPE(nme) != NT_ARR)
644 return FALSE;
645 nme = NME_NM(nme);
646
647 for (def = NME_DEF(nme); def; def = DEF_NEXT(def)) {
648 def_fg = DEF_FG(def);
649 def_addr = DEF_ADDR(def);
650 asd = A_ASDG(def_addr);
651 ndim = ASD_NDIM(asd);
652 if (FG_LOOP(def_fg) != lp && !def_in_innerlp(lp, FG_LOOP(def_fg)))
653 continue;
654 if (DEF_STD(def) == std) {
655 ++def_count;
656 } else {
657 if (def_addr == DEF_LHS(def)) /* whole array */
658 ++def_count;
659 else if (A_TYPEG(ASD_SUBS(asd, 0)) != A_CNST)
660 ++def_count; /* index is variable, don't do further */
661 else if (def_addr == ast) /* same index */
662 ++def_count;
663 }
664 if (def_count > 1)
665 return FALSE;
666 }
667 break;
668 case A_ID:
669 nme = A_NMEG(ast);
670 break;
671 default:
672 return FALSE;
673 break;
674 }
675
676 if (def_count > 1)
677 return FALSE;
678
679 return TRUE;
680 }
681
682 static LOGICAL
683 /* also do the hoist */
is_hoistable(int ast,int std,int lp)684 is_hoistable(int ast, int std, int lp)
685 {
686 int lop, rop, sym, nme, sptr, def_addr, ndim, def_std, i;
687 int asd, du_std;
688 int use_count, def_count;
689 LOGICAL can_hoist;
690 int l, u, s, r, cnme, found_nme, def, def_fg, hoistme;
691 STL *stl;
692 DU *du;
693
694 switch (A_TYPEG(ast)) {
695 case A_BINOP:
696 r = is_hoistable(A_ROPG(ast), std, lp);
697 l = is_hoistable(A_LOPG(ast), std, lp);
698 if (l & r) {
699 return TRUE;
700 }
701 break;
702 case A_UNOP:
703 l = is_hoistable(A_LOPG(ast), std, lp);
704 if (l)
705 return TRUE;
706 break;
707 case A_TRIPLE:
708 l = is_hoistable(A_LBDG(ast), std, lp);
709 u = is_hoistable(A_UPBDG(ast), std, lp);
710 s = is_hoistable(A_STRIDEG(ast), std, lp);
711
712 return (l & u & s);
713 break;
714 case A_CNST:
715 return TRUE;
716 case A_ID:
717 return FALSE; /* for now */
718 break;
719 case A_SUBSCR:
720 if (A_SHAPEG(ast)) /* currently don't do too many nested subscripts */
721 return FALSE;
722 lop = A_LOPG(ast);
723 if (A_TYPEG(lop) == A_ID) {
724 sym = A_SPTRG(lop);
725 if (ADDRTKNG(sym) && (LP_CALLFG(lp) || LP_CALLINTERNAL(lp))) {
726 /* to do list: if call is external we can check if this is passed
727 * as an argument
728 * NOTE: should I also check inner loop calls?
729 */
730 return FALSE;
731 }
732 cnme = A_NMEG(lop);
733 if (NME_SYM(cnme) == -1)
734 cnme = NME_NM(cnme);
735 if (STYPEG(sym) == ST_DESCRIPTOR) {
736 stl = LP_STL(lp);
737 /* no need to use store list */
738 found_nme = 0;
739 for (i = stl->store; i; i = STORE_NEXT(i)) {
740 nme = STORE_NM(i);
741 if (NME_SYM(nme) == -1)
742 nme = NME_NM(nme);
743 sptr = NME_SYM(nme);
744 if (cnme != nme)
745 continue;
746 if (NME_TYPE(nme) != NT_VAR)
747 return FALSE;
748
749 found_nme = 1;
750 use_count = 0;
751 def_count = 0;
752 hoistme = 0;
753 for (def = NME_DEF(nme); def; def = DEF_NEXT(def)) {
754 def_addr = DEF_ADDR(def);
755 def_std = DEF_STD(def);
756
757 /* check if this def is in a loop or inner loop */
758 def_fg = DEF_FG(def);
759 if (lp != FG_LOOP(def_fg)) {
760 if (LP_CHILD(lp) && !def_in_innerlp(lp, FG_LOOP(def_fg)))
761 continue;
762 }
763 if (def_addr && A_TYPEG(def_addr) == A_SUBSCR) {
764 asd = A_ASDG(def_addr);
765 ndim = ASD_NDIM(asd);
766 if (ndim > 1)
767 return FALSE;
768 /* don't want to do more checking if subscript is not constant */
769 if (A_TYPEG(ASD_SUBS(asd, 0)) != A_CNST)
770 return FALSE;
771
772 if (def_addr == ast) {
773
774 /* handle with 1 def for now */
775 ++def_count;
776 if (def_count > 1)
777 return FALSE;
778
779 for (du = DEF_DU(def); du; du = du->next) {
780 du_std = USE_STD(du->use);
781 if (USE_STD(du->use) == std) {
782 use_count++;
783
784 /* this check(def_std != std) is unnessary but we
785 * want to make sure that infinite recursive
786 * won't happen here.
787 */
788 if (def_std != std) {
789 if (!is_std_hoistable(def_std, lp)) {
790 return FALSE;
791 } else {
792 hoistme = 1;
793 }
794 }
795 }
796 }
797 }
798
799 } else {
800 return FALSE;
801 }
802 if (def_count > 1)
803 return FALSE;
804
805 /* do the hoist of std */
806 if (hoistme) {
807 hoist_stmt(def_std, LP_FG(lp), lp);
808 return TRUE;
809 }
810 }
811
812 if (found_nme) {
813 return TRUE;
814 }
815 /* found nme */
816 break;
817 }
818 if (found_nme == 0) { /* not found in store list */
819 return TRUE;
820 }
821 }
822 }
823 break;
824 default:
825 break;
826 }
827 return FALSE;
828 }
829
830 /* currently handle temp alloc/dealloc and assignment of descriptors */
831 static LOGICAL
is_std_hoistable(int std,int lpx)832 is_std_hoistable(int std, int lpx)
833 {
834 LOGICAL canhoist = FALSE;
835 LOGICAL l, r, s, u, all, sym, tmplog;
836 int shape, n, i, astd;
837 int ast = STD_AST(std);
838
839 switch (A_TYPEG(ast)) {
840 case A_ALLOC:
841 /* assume temp alloc */
842 if (is_alloc_ast(ast) && STD_HSTBLE(std)) {
843 ast = A_SRCG(ast);
844 switch (A_TYPEG(ast)) {
845 case A_SUBSCR:
846 shape = A_SHAPEG(ast);
847 n = SHD_NDIM(shape);
848 tmplog = FALSE;
849 for (i = 0; i < n; ++i) {
850 l = is_hoistable(SHD_LWB(shape, i), std, lpx);
851 u = is_hoistable(SHD_UPB(shape, i), std, lpx);
852 s = is_hoistable(SHD_STRIDE(shape, i), std, lpx);
853 tmplog = l && u && s;
854 if (tmplog) {
855 int fast = A_FIRSTALLOCG(ast);
856 if (fast) {
857 if (!is_hoistable(fast, std, lpx))
858 return FALSE;
859 }
860 } else {
861 return FALSE;
862 }
863 }
864 return tmplog;
865 break;
866 case A_ID:
867 return FALSE; /* To do list */
868 break;
869 default:
870 return FALSE;
871 }
872 } else if (is_dealloc_ast(ast) && STD_HSTBLE(std)) {
873 /* this assume that allocate statement is already visited */
874 astd = STD_HSTBLE(ast);
875 if (STD_HSTBLE(astd) && STD_VISIT(astd))
876 return TRUE;
877 }
878 return FALSE;
879 break;
880
881 case A_ASN:
882 l = A_DESTG(ast);
883 r = A_SRCG(ast);
884
885 if (A_TYPEG(l) == A_SUBSCR) {
886 int a = A_LOPG(l);
887 if (A_TYPEG(a) != A_ID) {
888 return FALSE;
889 }
890 } else if (A_TYPEG(l) == A_ID) {
891 sym = A_SPTRG(ast);
892 if (ADDRTKNG(sym)) {
893 if (LP_CALLFG(lpx) || LP_CALLINTERNAL(lpx))
894 return FALSE;
895 }
896 } else {
897 return FALSE;
898 }
899
900 if (has_def_inlp(l, lpx, std) <= 1) {
901 /* only hoist this std if the lhs has only one def,
902 * address taken ok but no call
903 */
904 if (is_hoistable(r, std, lpx)) {
905 return TRUE;
906 } else {
907 return FALSE;
908 }
909 }
910
911 break;
912
913 /* everything else is not hoistable for now */
914 case A_FUNC:
915 case A_INTR:
916 case A_CALL:
917 case A_ICALL:
918 case A_ASNGOTO:
919 default:
920 return FALSE;
921 break;
922 }
923
924 not_hoistable:
925
926 return canhoist;
927 }
928
929 static void
store_ili(int ilix)930 store_ili(int ilix)
931 {
932 int temp;
933
934 /* assign temp; routine marks ILI with candidate entry */
935 }
936
937 static LOGICAL
is_nme_loop_safe(int ldnme,int lpx)938 is_nme_loop_safe(int ldnme, int lpx)
939 {
940 if (flg.opt < 2)
941 return FALSE; /* copy from front end, why false? */
942
943 /*
944 int stl = LP_STL(lpx);
945 if( stl ){
946 int store;
947 for( store = stl->store; store; store = STORE_NEXT(store) ){
948 int stnme = STORE_NM(store);
949 if( conflict( ldnme, stnme ) != NOCONFLICT ){
950 return FALSE;
951 }
952 }
953 }
954 if (!is_call_safe(ldnme)) {
955 return FALSE;
956 }
957
958 for( inner = LP_CHILD(lpx); inner; inner = LP_SIBLING(inner) ){
959 if( !is_nme_loop_safe( ldnme, inner ) )
960 return FALSE;
961 }
962
963 */
964 return TRUE;
965 }
966
967 LOGICAL
is_sym_invariant_safe(int nme,int lpx)968 is_sym_invariant_safe(int nme, int lpx)
969 {
970 int sym, sflag;
971 sflag = 0;
972
973 /*
974 * a symbol is not safe (potential "side-effect" conflicts exist) if:
975 * 1. for c and fortran, the symbol is volatile
976 *
977 * 2. for fortran, the symbol is equivalenced
978 *
979 * 3. loop contains a call AND
980 * a. sym's address has been taken, or
981 * b. sym's storage class is not auto (it is static or extern).
982 * c. or for pascal- sym is used in two or more nested scope levels
983 *
984 * 4. loop contains a store via a pointer AND the sym could
985 * conflict with a pointer (see optutil.c:is_sym_ptrsafe()).
986 *
987 * 5. the symbol is private and the loop is not a parallel region.
988 *
989 * 6. the symbol is not a private variable and is stored while in a
990 * critical section in this loop or any enclosed loop, or in a
991 * parallel region.
992 *
993 * 7. the symbol is not a private variable and the loop contains
994 * a parallel section.
995 *
996 * 8. for Fortran, the loop contains a call to an internal subprogram
997 * and this is a noninternal variable.
998 *
999 * NOTE that this differs from is_sym_optsafe in that a load via a pointer
1000 * does not rule out loads of certain symbols as being invariant. This is
1001 * because the symbol cannot be redefined with a load via a pointer.
1002 */
1003 sym = NME_SYM(nme);
1004 if (VOLG(sym))
1005 return (FALSE);
1006
1007 if (SOCPTRG(sym))
1008 return (FALSE);
1009 if (LP_CALLFG(lpx) && (!IS_LCL_OR_DUM(sym)
1010 )) {
1011 return (FALSE);
1012 }
1013
1014 if (SOCPTRG(sym))
1015 return (FALSE);
1016
1017 if (LP_CALLINTERNAL(lpx) && !INTERNALG(sym))
1018 return FALSE;
1019
1020 if (IS_PRIVATE(sym) && !LP_PARREGN(lpx))
1021 return (FALSE);
1022
1023 if ((LP_CSECT(lpx) || LP_PARREGN(lpx)) && !IS_PRIVATE(sym)) {
1024 Q_ITEM *q;
1025 for (q = LP_STL_PAR(lpx); q != NULL; q = q->next)
1026 if (q->info == nme)
1027 return (FALSE);
1028 }
1029
1030 if (LP_PARSECT(lpx) && !IS_PRIVATE(sym)) {
1031 return (FALSE);
1032 }
1033
1034 if (!sflag && LP_PTR_STORE(lpx) && !is_sym_ptrsafe(sym))
1035 /* check ptr before argument */
1036 /* if (flg.opt >= 2 && XBIT (xxx)) {
1037 is_sym_invar_inlp();
1038 }*/
1039 return (FALSE);
1040
1041 if (!sflag && LP_CALLFG(lpx) && ADDRTKNG(sym)) {
1042 /* check argument in a call, if it is in then it is safe */
1043 return (FALSE);
1044 }
1045
1046 return (TRUE);
1047 }
1048