1 /*-
2 * Copyright (c) 1980 The Regents of the University of California.
3 * All rights reserved.
4 *
5 * %sccs.include.proprietary.c%
6 */
7
8 #ifndef lint
9 static char sccsid[] = "@(#)optloop.c 5.3 (Berkeley) 04/12/91";
10 #endif /* not lint */
11
12 /*
13 * optloop.c
14 *
15 * Loop optimizations, f77 compiler pass 1, 4.2 BSD.
16 *
17 * University of Utah CS Dept. modification history:
18 *
19 * $Log: optloop.c,v $
20 * Revision 1.4 84/10/25 01:27:29 donn
21 * Fixed a subtle bug in removesafe(). When the moved code is an assignment
22 * into a temporary, we use the lhs to substitute for the expression inside
23 * the loop. Previously the data structure for the temporary was not copied,
24 * so later on when the lhs was freed, the substitute was too, turning it
25 * into garbage.
26 *
27 * Revision 1.3 84/08/05 17:04:03 donn
28 * Changed worthcost() so that it skips variable length strings -- we can't
29 * make temporaries for these...
30 *
31 * Revision 1.2 84/07/19 11:50:39 donn
32 * Installed changes to force non-intrinsic subroutines and functions to define
33 * their arguments (make them ineligible for optimization), function setsuses.
34 * Fix from A.F.
35 *
36 */
37
38 #include "defs.h"
39 #include "optim.h"
40
41
42 #define SCFREE 0
43 #define SCSAFE 1
44
45
46
47 typedef
48 struct varblock
49 {
50 struct varblock *next;
51 field vstg;
52 int memno; /* holds memalloc for TTEMP */
53 short sets;
54 short uses;
55 field setfirst;
56 } VARBLOCK;
57
58 typedef VARBLOCK *Varp;
59
60 #define TABLESIZE 59
61
62 LOCAL Varp table[TABLESIZE];
63
64
65
mkbucket(vstg,memno)66 LOCAL Varp mkbucket(vstg,memno)
67 field vstg;
68 int memno;
69
70 {
71 Varp q;
72
73 q = ALLOC(varblock);
74 q->vstg = vstg;
75 q->memno = memno;
76 return q;
77 }
78
79
80
lookup(p)81 LOCAL Varp lookup(p)
82 tagptr p;
83
84 {
85 int vstg, memno;
86 int key;
87 Varp q, r;
88
89 switch (p->tag)
90 {
91 case TTEMP:
92 vstg = 0;
93 memno = (int) p->tempblock.memalloc;
94 break;
95
96 case TADDR:
97 vstg = p->addrblock.vstg;
98 memno = p->addrblock.memno;
99 break;
100
101 default:
102 badtag ("lookup",p->tag);
103 }
104 key = memno % TABLESIZE;
105 q = table[key];
106
107 if (q)
108 {
109 for (; q; r = q, q = q->next)
110 if ((q->vstg == vstg) && (q->memno == memno))
111 return q;
112 return r->next = mkbucket(vstg,memno);
113 }
114 else
115 return table[key] = mkbucket(vstg,memno);
116 }
117
118
119
freetable()120 LOCAL freetable()
121
122 {
123 int i;
124 Varp p, q;
125
126 for (i = 0; i < TABLESIZE; i++)
127 if (table[i])
128 {
129 p = table[i];
130 table[i] = NULL;
131
132 while (p)
133 {
134 q = p->next;
135 free((char *) p);
136 p = q;
137 }
138 }
139 }
140
141
142
143 Slotp newcode;
144 Slotp dohead, doend;
145 LOCAL Slotp first, last;
146 LOCAL commonset;
147 LOCAL int comocount; /* count of number of code motions done */
148
149
optloops()150 optloops()
151
152 {
153 int match;
154 Slotp nextslot;
155 Slotp sl1,sl2;
156 Slotp lastlabslot;
157 int lab;
158
159 if (! optimflag) return;
160 if (debugflag[6]) return;
161
162 lastlabslot = NULL;
163 comocount = 0;
164 for (sl1 = firstslot; sl1; sl1 = nextslot)
165 {
166 nextslot = sl1->next;
167 switch (sl1->type)
168 {
169 case SKLABEL:
170 lastlabslot = sl1;
171 break;
172
173 case SKGOTO:
174 if (lastlabslot && sl1->label == lastlabslot->label)
175 {
176 lab = newlabel ();
177 first = optinsert (SKLABEL,0,lab,0,lastlabslot->next);
178 last = sl1;
179 last->label = lab;
180 optloop ();
181 }
182 break;
183
184 case SKDOHEAD:
185 match = 0;
186 for (sl2 = sl1; sl2; sl2 = sl2->next)
187 {
188 if (sl2->type == SKDOHEAD) match++;
189 else if (sl2->type == SKENDDO) match--;
190 if (match == 0) break;
191 }
192 if (sl2)
193 last = sl2;
194 else
195 fatal ("unmatched do in code buffer");
196 if (sl2->type != SKENDDO)
197 fatal ("internal error in optloops");
198
199 /* last now points to the SKENDDO slot; the SKNULL slot
200 * is reached through last->nullslot
201 */
202 last = (Slotp) last->nullslot;
203
204 first = sl1;
205
206 optloop ();
207 break;
208
209 default:
210 break;
211 }
212 }
213
214 if (debugflag[0])
215 fprintf (diagfile,"%d code motion%s performed\n",comocount,
216 (comocount==1 ? "" : "s") );
217 return;
218 }
219
220
221
optloop()222 optloop()
223
224 {
225 newcode = NULL;
226
227 modify();
228
229 return;
230 }
231
232
modify()233 LOCAL modify()
234
235 {
236 Slotp sp;
237 int s;
238
239 scanvars();
240
241 for (sp = first; sp != last->next; sp = sp->next)
242 switch (sp->type)
243 {
244 case SKEQ:
245 s = anex(sp->expr);
246 if (s == SCSAFE)
247 removesafe (&sp->expr);
248 break;
249
250 case SKARIF:
251 case SKASGOTO:
252 case SKCALL:
253 case SKCMGOTO:
254 case SKIFN:
255 case SKSTOP:
256 case SKRETURN:
257 case SKPAUSE:
258 case SKIOIFN:
259 s = anex(sp->expr);
260 if (s == SCSAFE)
261 removesafe(&sp->expr);
262 break;
263
264 default:
265 break;
266 }
267
268 freetable();
269 return;
270 }
271
272
scanvars()273 LOCAL scanvars()
274
275 {
276 Slotp sp;
277 Varp varinfo;
278 int i;
279 Varp p;
280
281 commonset = NO;
282
283 for (sp = first; sp != last->next; sp = sp->next)
284 {
285 switch (sp->type)
286 {
287 case SKARIF:
288 case SKASGOTO:
289 case SKCALL:
290 case SKCMGOTO:
291 case SKIFN:
292 case SKSTOP:
293 case SKRETURN:
294 case SKPAUSE:
295 case SKIOIFN:
296 case SKEQ:
297 setsuses(sp->expr);
298 break;
299
300 default:
301 break;
302 }
303 }
304
305 if (commonset)
306 for (i = 0; i < TABLESIZE; i++)
307 for (p = table[i]; p; p = p->next)
308 if (p->vstg == STGCOMMON)
309 {
310 p->sets++;
311 p->setfirst = NO;
312 }
313 }
314
315
setsuses(p)316 LOCAL setsuses(p)
317 expptr p;
318
319 {
320 Addrp lhs;
321 Varp varinfo;
322 chainp args;
323
324 if (!p) return;
325
326 switch (p->tag)
327 {
328 case TEXPR:
329 switch (p->exprblock.opcode)
330 {
331 default:
332 setsuses(p->exprblock.leftp);
333 setsuses(p->exprblock.rightp);
334 setsuses(p->exprblock.vleng);
335 break;
336
337 case OPASSIGN:
338 switch (p->exprblock.leftp->tag)
339 {
340 case TTEMP:
341 lhs = (Addrp) p->exprblock.leftp;
342 goto taddr;
343
344 case TADDR:
345 lhs = (Addrp) p->exprblock.leftp;
346 setsuses(lhs->memoffset);
347 setsuses(lhs->vleng);
348 taddr:
349 setsuses(p->exprblock.rightp);
350 setsuses(p->exprblock.vleng);
351 varinfo = lookup(lhs);
352 varinfo->sets++;
353 if (varinfo->uses == 0)
354 varinfo->setfirst = YES;
355 break;
356
357 default:
358 fatal("O6: l-value expected");
359 }
360 break;
361
362 case OPSTAREQ:
363 case OPPLUSEQ:
364 switch (p->exprblock.leftp->tag)
365 {
366 case TADDR:
367 lhs = (Addrp) p->exprblock.leftp;
368 break;
369 case TTEMP:
370 lhs = (Addrp) p->exprblock.leftp;
371 break;
372 default:
373 fatal("O7: l-value expected");
374 }
375 setsuses(p->exprblock.leftp);
376 setsuses(p->exprblock.rightp);
377 setsuses(p->exprblock.vleng);
378 varinfo = lookup(lhs);
379 varinfo->sets++;
380 break;
381
382 case OPCALL:
383 if (p->exprblock.leftp->tag != TADDR)
384 fatal("O8: subprogram expected");
385 setsuses(p->exprblock.rightp);
386 setsuses(p->exprblock.vleng);
387 if (p->exprblock.leftp->addrblock.vstg == STGINTR) break;
388 commonset = YES;
389 if (p->exprblock.rightp == NULL) break;
390 args = p->exprblock.rightp->listblock.listp;
391 for (; args; args = args->nextp)
392 if (args->datap->tag == TADDR)
393 {
394 lhs = (Addrp) args->datap;
395 switch (lhs->vstg)
396 {
397 case STGARG:
398 case STGAUTO:
399 case STGBSS:
400 case STGINIT:
401 case STGCOMMON:
402 case STGEQUIV:
403 case STGREG:
404 case STGPREG:
405 varinfo = lookup(lhs);
406 varinfo->sets++;
407 }
408 }
409 else if (args->datap->tag == TTEMP)
410 {
411 lhs = (Addrp) args->datap;
412 varinfo = lookup (lhs);
413 varinfo->sets++;
414 }
415 break;
416 }
417
418 return;
419
420 case TTEMP:
421 varinfo = lookup((Addrp) p);
422 varinfo->uses++;
423 return;
424
425 case TADDR:
426 setsuses(p->addrblock.memoffset);
427 setsuses(p->addrblock.vleng);
428 varinfo = lookup((Addrp) p);
429 varinfo->uses++;
430 return;
431
432 case TLIST:
433 for (args = p->listblock.listp; args; args = args->nextp)
434 setsuses(args->datap);
435
436 case TCONST:
437 case TERROR:
438 return;
439
440 default:
441 fatal("O9: bad tag value");
442 }
443 }
444
445
anex(p)446 LOCAL int anex(p)
447 expptr p;
448
449 {
450 int s1, s2, s3;
451 expptr q;
452 Varp varinfo;
453 chainp ch;
454 int setfirst;
455 expptr expr;
456
457
458 if (p == ENULL)
459 return SCSAFE;
460
461 switch (p->tag)
462 {
463 case TCONST:
464 return SCSAFE;
465
466 case TLIST:
467 for (ch = p->listblock.listp; ch; ch = ch->nextp)
468 {
469 s1 = anex (ch->datap);
470 if (s1 == SCSAFE)
471 removesafe (&ch->datap);
472 }
473 return SCFREE;
474
475 case TEXPR:
476 s1 = anex(p->exprblock.leftp);
477 s2 = anex(p->exprblock.rightp);
478 s3 = anex(p->exprblock.vleng);
479
480 switch (p->exprblock.opcode)
481 {
482 case OPASSIGN:
483 expr = p->exprblock.leftp;
484 varinfo = lookup(expr);
485 setfirst = varinfo->setfirst && (varinfo->sets == 1);
486 if (expr->tag == TTEMP && setfirst &&
487 s2 == SCSAFE && s3 == SCSAFE)
488 {
489 movefrtemp (expr);
490 return SCSAFE;
491 }
492 else
493 {
494 if (s2 == SCSAFE) removesafe (&p->exprblock.rightp);
495 if (s3 == SCSAFE) removesafe (&p->exprblock.vleng);
496 return SCFREE;
497 }
498
499 case OPNEG:
500 case OPNOT:
501 case OPABS:
502 case OPADDR:
503 case OPBITNOT:
504 if ((s2 == SCSAFE) && (s3 == SCSAFE))
505 return s1;
506 else
507 return SCFREE;
508
509 case OPCONV:
510 if ((s2 != SCSAFE) || (s3 != SCSAFE))
511 return SCFREE;
512
513 if (ISINT(p->exprblock.vtype))
514 return s1;
515 if (ISINT(p->exprblock.leftp->headblock.vtype))
516 return s1;
517
518 return SCFREE;
519
520
521 case OPSTAR:
522 if (ISINT(p->exprblock.vtype))
523 goto safeop;
524
525 if (safefactor(p->exprblock.leftp) ||
526 safefactor(p->exprblock.rightp))
527 goto safeop;
528
529 goto floatop;
530
531
532 case OPPLUS:
533 case OPMINUS:
534 if (ISINT(p->exprblock.vtype))
535 goto safeop;
536
537 floatop:
538 if (!(ISREAL(p->exprblock.vtype) || ISCOMPLEX(p->exprblock.vtype)))
539 return SCFREE;
540
541 switch (s1)
542 {
543 case SCSAFE:
544 removesafe(&p->exprblock.leftp);
545 if (s2 == SCSAFE)
546 removesafe(&p->exprblock.leftp);
547 return SCFREE;
548
549 case SCFREE:
550 if (s2 == SCSAFE)
551 removesafe(&p->exprblock.rightp);
552 return SCFREE;
553 }
554
555 case OPOR:
556 case OPAND:
557 case OPEQV:
558 case OPNEQV:
559 case OPLT:
560 case OPEQ:
561 case OPGT:
562 case OPLE:
563 case OPNE:
564 case OPGE:
565 case OPLSHIFT:
566 case OPMIN:
567 case OPMAX:
568 case OPBITOR:
569 case OPBITAND:
570 case OPBITXOR:
571 case OPRSHIFT:
572 safeop:
573 if ((p->exprblock.vleng != ENULL) && ( ! ISCONST(p->exprblock.vleng)))
574 return SCFREE;
575
576 switch (s1)
577 {
578 case SCSAFE:
579 if (s2 == SCFREE) removesafe (&p->exprblock.leftp);
580 return s2;
581
582 case SCFREE:
583 if (s2 == SCSAFE) removesafe (&p->exprblock.rightp);
584 return SCFREE;
585 }
586
587 default:
588 if (s1 == SCSAFE) removesafe(&p->exprblock.leftp);
589 if (s2 == SCSAFE) removesafe(&p->exprblock.rightp);
590 if (s3 == SCSAFE) removesafe(&p->exprblock.vleng);
591 return SCFREE;
592 }
593
594
595 case TTEMP:
596 varinfo = lookup(p);
597 if (varinfo->sets == 0)
598 return SCSAFE;
599 else
600 return SCFREE;
601
602 case TADDR:
603 s1 = anex(p->addrblock.memoffset);
604 s2 = anex(p->addrblock.vleng);
605
606 varinfo = lookup(p);
607
608 if (varinfo->sets == 0)
609 switch (s1)
610 {
611 case SCSAFE:
612 if (s2 == SCFREE) removesafe(&p->addrblock.memoffset);
613 return s2;
614
615 case SCFREE:
616 if (s2 == SCSAFE) removesafe(&p->addrblock.vleng);
617 return SCFREE;
618 }
619
620 if (s1 == SCSAFE) removesafe(&p->addrblock.memoffset);
621 if (s2 == SCSAFE) removesafe(&p->addrblock.vleng);
622 return SCFREE;
623
624
625 default:
626 return SCFREE;
627 }
628 }
629
630
safefactor(p)631 LOCAL safefactor(p)
632 expptr p;
633
634 {
635 if ( ! ISCONST(p))
636 return NO;
637
638 if (ISINT(p->constblock.vtype))
639 if (abs(p->constblock.constant.ci) <= 1)
640 return YES;
641
642 if (ISREAL(p->constblock.vtype))
643 if (abs(p->constblock.constant.cd[0]) <= 1.0)
644 return YES;
645
646 return NO;
647 }
648
649
worthcost(p)650 LOCAL int worthcost(p)
651 expptr p;
652
653 {
654 int cost;
655 chainp q;
656 expptr memoffset,vleng;
657
658 if (p == ENULL)
659 return NO;
660
661 switch (p->tag)
662 {
663 case TCONST:
664 return NO;
665
666 case TTEMP:
667 return NO;
668
669 case TADDR:
670 if ((vleng = p->addrblock.vleng) && ! ISCONST(vleng))
671 return NO; /* Can't make variable length temporaries */
672 if ((memoffset = p->addrblock.memoffset) && ! ISCONST(memoffset))
673 return YES;
674 else
675 return NO;
676
677 case TEXPR:
678 return YES;
679
680 case TLIST:
681 cost = 0;
682 for (q = p->listblock.listp; q; q = q->nextp)
683 {
684 if (worthcost ((expptr) q->datap))
685 return YES;
686 cost++;
687 }
688 return (cost>2 ? YES : NO);
689
690 default:
691 return NO;
692 }
693 }
694
695
removesafe(refexpr)696 LOCAL removesafe(refexpr)
697 expptr *refexpr;
698
699 {
700 expptr ep;
701 Tempp ap;
702 Slotp newslot;
703
704 extern Addrp gettemp();
705
706 ep = *refexpr;
707 if (! worthcost(ep))
708 return;
709
710 if (ep->tag == TEXPR && ep->exprblock.opcode == OPASSIGN)
711 {
712 if (ep->exprblock.leftp->tag != TTEMP)
713 fatal ("non-TEMP in assignment to be moved in optloop");
714
715 newslot = optinsert (SKEQ, ep, 0, 0, first);
716 *refexpr = (expptr) cpexpr (ep->exprblock.leftp);
717 }
718 else
719 {
720 ap = (Tempp) gettemp(ep);
721 newslot = optinsert (SKEQ, mkexpr(OPASSIGN,cpexpr(ap),ep), 0, 0, first);
722 *refexpr = (expptr) ap;
723 optinsert (SKFRTEMP,ap->memalloc,0,0,last->next);
724 }
725
726 comocount++;
727 if (!newcode)
728 newcode = newslot;
729
730 return;
731 }
732
733
gettemp(p)734 LOCAL Addrp gettemp(p)
735 expptr p;
736
737 {
738 return mktemp(p->headblock.vtype, p->headblock.vleng);
739 }
740
741
742
movefrtemp(expr)743 LOCAL movefrtemp (expr)
744 Tempp expr;
745
746 {
747 Slotp s;
748
749 if (expr->tag != TTEMP)
750 badtag ("movefrtemp",expr->tag);
751
752 for (s = first; s; s = s->next)
753 if (s->type == SKFRTEMP && s->expr == (expptr) expr->memalloc)
754 {
755 removeslot (s);
756 insertslot (s,last->next);
757 return;
758 }
759 }
760