4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/optloop.c

   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.1 (Berkeley) 6/7/85";
   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.const.ci) <= 1)
 639:       return YES;
 640: 
 641:   if (ISREAL(p->constblock.vtype))
 642:     if (abs(p->constblock.const.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: }

Defined functions

Defined variables

Defined struct's

Defined typedef's

Defined macros