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