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