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 
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 
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 
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 
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 
222 optloop()
223 
224 {
225 newcode = NULL;
226 
227 modify();
228 
229 return;
230 }
231 
232 
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 
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 
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 
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 
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 
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 
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 
734 LOCAL Addrp gettemp(p)
735 expptr p;
736 
737 {
738   return mktemp(p->headblock.vtype, p->headblock.vleng);
739 }
740 
741 
742 
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