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