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[] = "@(#)optim.c 5.2 (Berkeley) 6/9/85"; 9 #endif not lint 10 11 /* 12 * optim.c 13 * 14 * Miscellaneous optimizer routines, f77 compiler pass 1. 15 * 16 * UCSD Chemistry modification history: 17 * 18 * $Log: optim.c,v $ 19 * Revision 2.12 85/06/08 22:57:01 donn 20 * Prevent core dumps -- bug in optinsert was causing lastslot to be wrong 21 * when a slot was inserted at the end of the buffer. 22 * 23 * Revision 2.11 85/03/18 08:05:05 donn 24 * Prevent warnings about implicit conversions. 25 * 26 * Revision 2.10 85/02/12 20:13:00 donn 27 * Resurrected the hack in 2.6.1.1 to avoid creating a temporary when 28 * there is a concatenation on the rhs of an assignment, and threw out 29 * all the code dealing with starcat(). It seems that we can't use a 30 * temporary because the lhs as well as the rhs may have nonconstant length. 31 * 32 * Revision 2.9 85/01/18 00:53:52 donn 33 * Missed a call to free() in the last change... 34 * 35 * Revision 2.8 85/01/18 00:50:03 donn 36 * Fixed goof made when modifying buffmnmx() to explicitly call expand(). 37 * 38 * Revision 2.7 85/01/15 18:47:35 donn 39 * Changes to allow character*(*) variables to appear in concatenations in 40 * the rhs of an assignment statement. 41 * 42 * Revision 2.6 84/12/16 21:46:27 donn 43 * Fixed bug that prevented concatenations from being run together. Changed 44 * buffpower() to not touch exponents greater than 64 -- let putpower do them. 45 * 46 * Revision 2.5 84/10/29 08:41:45 donn 47 * Added hack to flushopt() to prevent the compiler from trying to generate 48 * intermediate code after an error. 49 * 50 * Revision 2.4 84/08/07 21:28:00 donn 51 * Removed call to p2flush() in putopt() -- this allows us to make better use 52 * of the buffering on the intermediate code file. 53 * 54 * Revision 2.3 84/08/01 16:06:24 donn 55 * Forced expand() to expand subscripts. 56 * 57 * Revision 2.2 84/07/19 20:21:55 donn 58 * Decided I liked the expression tree algorithm after all. The algorithm 59 * which repeatedly squares temporaries is now checked in as rev. 2.1. 60 * 61 * Revision 1.3.1.1 84/07/10 14:18:18 donn 62 * I'm taking this branch off the trunk -- it works but it's not as good as 63 * the old version would be if it worked right. 64 * 65 * Revision 1.5 84/07/09 22:28:50 donn 66 * Added fix to buffpower() to prevent it chasing after huge exponents. 67 * 68 * Revision 1.4 84/07/09 20:13:59 donn 69 * Replaced buffpower() routine with a new one that generates trees which can 70 * be handled by CSE later on. 71 * 72 * Revision 1.3 84/05/04 21:02:07 donn 73 * Added fix for a bug in buffpower() that caused func(x)**2 to turn into 74 * func(x) * func(x). This bug had already been fixed in putpower()... 75 * 76 * Revision 1.2 84/03/23 22:47:21 donn 77 * The subroutine argument temporary fixes from Bob Corbett didn't take into 78 * account the fact that the code generator collects all the assignments to 79 * temporaries at the start of a statement -- hence the temporaries need to 80 * be initialized once per statement instead of once per call. 81 * 82 */ 83 84 #include "defs.h" 85 #include "optim.h" 86 87 88 89 /* 90 * Information buffered for each slot type 91 * 92 * slot type expptr integer pointer 93 * 94 * IFN expr label - 95 * GOTO - label - 96 * LABEL - label - 97 * EQ expr - - 98 * CALL expr - - 99 * CMGOTO expr num labellist* 100 * STOP expr - - 101 * DOHEAD [1] - ctlframe* 102 * ENDDO [1] - ctlframe* 103 * ARIF expr - labellist* 104 * RETURN expr label - 105 * ASGOTO expr - labellist* 106 * PAUSE expr - - 107 * ASSIGN expr label - 108 * SKIOIFN expr label - 109 * SKFRTEMP expr - - 110 * 111 * Note [1]: the nullslot field is a pointer to a fake slot which is 112 * at the end of the slots which may be replaced by this slot. In 113 * other words, it looks like this: 114 * DOHEAD slot 115 * slot \ 116 * slot > ordinary IF, GOTO, LABEL slots which implement the DO 117 * slot / 118 * NULL slot 119 */ 120 121 122 expptr expand(); 123 124 Slotp firstslot = NULL; 125 Slotp lastslot = NULL; 126 int numslots = 0; 127 128 129 /* 130 * turns off optimization option 131 */ 132 133 optoff() 134 135 { 136 flushopt(); 137 optimflag = 0; 138 } 139 140 141 142 /* 143 * initializes the code buffer for optimization 144 */ 145 146 setopt() 147 148 { 149 register Slotp sp; 150 151 for (sp = firstslot; sp; sp = sp->next) 152 free ( (charptr) sp); 153 firstslot = lastslot = NULL; 154 numslots = 0; 155 } 156 157 158 159 /* 160 * flushes the code buffer 161 */ 162 163 LOCAL int alreadycalled = 0; 164 165 flushopt() 166 { 167 register Slotp sp; 168 int savelineno; 169 170 if (alreadycalled) return; /* to prevent recursive call during errors */ 171 alreadycalled = 1; 172 173 if (debugflag[1]) 174 showbuffer (); 175 176 frtempbuff (); 177 178 savelineno = lineno; 179 for (sp = firstslot; sp; sp = sp->next) 180 { 181 if (nerr == 0) 182 putopt (sp); 183 else 184 frexpr (sp->expr); 185 if(sp->ctlinfo) free ( (charptr) sp->ctlinfo); 186 free ( (charptr) sp); 187 numslots--; 188 } 189 firstslot = lastslot = NULL; 190 numslots = 0; 191 clearbb(); 192 lineno = savelineno; 193 194 alreadycalled = 0; 195 } 196 197 198 199 /* 200 * puts out code for the given slot (from the code buffer) 201 */ 202 203 LOCAL putopt (sp) 204 register Slotp sp; 205 { 206 lineno = sp->lineno; 207 switch (sp->type) { 208 case SKNULL: 209 break; 210 case SKIFN: 211 case SKIOIFN: 212 putif(sp->expr, sp->label); 213 break; 214 case SKGOTO: 215 putgoto(sp->label); 216 break; 217 case SKCMGOTO: 218 putcmgo(sp->expr, sp->label, sp->ctlinfo); 219 break; 220 case SKCALL: 221 putexpr(sp->expr); 222 break; 223 case SKSTOP: 224 putexpr (call1 (TYSUBR, "s_stop", sp->expr)); 225 break; 226 case SKPAUSE: 227 putexpr (call1 (TYSUBR, "s_paus", sp->expr)); 228 break; 229 case SKASSIGN: 230 puteq (sp->expr, 231 intrconv(sp->expr->headblock.vtype, mkaddcon(sp->label))); 232 break; 233 case SKDOHEAD: 234 case SKENDDO: 235 break; 236 case SKEQ: 237 putexpr(sp->expr); 238 break; 239 case SKARIF: 240 #define LM ((struct Labelblock * *)sp->ctlinfo)[0]->labelno 241 #define LZ ((struct Labelblock * *)sp->ctlinfo)[1]->labelno 242 #define LP ((struct Labelblock * *)sp->ctlinfo)[2]->labelno 243 prarif(sp->expr, LM, LZ, LP); 244 break; 245 case SKASGOTO: 246 putbranch((Addrp) sp->expr); 247 break; 248 case SKLABEL: 249 putlabel(sp->label); 250 break; 251 case SKRETURN: 252 if (sp->expr) 253 { 254 putforce(TYINT, sp->expr); 255 putgoto(sp->label); 256 } 257 else 258 putgoto(sp->label); 259 break; 260 case SKFRTEMP: 261 templist = mkchain (sp->expr,templist); 262 break; 263 default: 264 badthing("SKtype", "putopt", sp->type); 265 break; 266 } 267 268 /* 269 * Recycle argument temporaries here. This must get done on a 270 * statement-by-statement basis because the code generator 271 * makes side effects happen at the start of a statement. 272 */ 273 argtemplist = hookup(argtemplist, activearglist); 274 activearglist = CHNULL; 275 } 276 277 278 279 /* 280 * copies one element of the control stack 281 */ 282 283 LOCAL struct Ctlframe *cpframe(p) 284 register char *p; 285 { 286 static int size = sizeof (struct Ctlframe); 287 register int n; 288 register char *q; 289 struct Ctlframe *q0; 290 291 q0 = ALLOC(Ctlframe); 292 q = (char *) q0; 293 n = size; 294 while(n-- > 0) 295 *q++ = *p++; 296 return( q0); 297 } 298 299 300 301 /* 302 * copies an array of labelblock pointers 303 */ 304 305 LOCAL struct Labelblock **cplabarr(n,arr) 306 struct Labelblock *arr[]; 307 int n; 308 { 309 struct Labelblock **newarr; 310 register char *in, *out; 311 register int i,j; 312 313 newarr = (struct Labelblock **) ckalloc (n * sizeof (char *)); 314 for (i = 0; i < n; i++) 315 { 316 newarr[i] = ALLOC (Labelblock); 317 out = (char *) newarr[i]; 318 in = (char *) arr[i]; 319 j = sizeof (struct Labelblock); 320 while (j-- > 0) 321 *out++ = *in++; 322 } 323 return (newarr); 324 } 325 326 327 328 /* 329 * creates a new slot in the code buffer 330 */ 331 332 LOCAL Slotp newslot() 333 { 334 register Slotp sp; 335 336 ++numslots; 337 sp = ALLOC( slt ); 338 sp->next = NULL ; 339 if (lastslot) 340 { 341 sp->prev = lastslot; 342 lastslot = lastslot->next = sp; 343 } 344 else 345 { 346 firstslot = lastslot = sp; 347 sp->prev = NULL; 348 } 349 sp->lineno = lineno; 350 return (sp); 351 } 352 353 354 355 /* 356 * removes (but not deletes) the specified slot from the code buffer 357 */ 358 359 removeslot (sl) 360 Slotp sl; 361 362 { 363 if (sl->next) 364 sl->next->prev = sl->prev; 365 else 366 lastslot = sl->prev; 367 if (sl->prev) 368 sl->prev->next = sl->next; 369 else 370 firstslot = sl->next; 371 sl->next = sl->prev = NULL; 372 373 --numslots; 374 } 375 376 377 378 /* 379 * inserts slot s1 before existing slot s2 in the code buffer; 380 * appends to end of list if s2 is NULL. 381 */ 382 383 insertslot (s1,s2) 384 Slotp s1,s2; 385 386 { 387 if (s2) 388 { 389 if (s2->prev) 390 s2->prev->next = s1; 391 else 392 firstslot = s1; 393 s1->prev = s2->prev; 394 s2->prev = s1; 395 } 396 else 397 { 398 s1->prev = lastslot; 399 lastslot->next = s1; 400 lastslot = s1; 401 } 402 s1->next = s2; 403 404 ++numslots; 405 } 406 407 408 409 /* 410 * deletes the specified slot from the code buffer 411 */ 412 413 delslot (sl) 414 Slotp sl; 415 416 { 417 removeslot (sl); 418 419 if (sl->ctlinfo) 420 free ((charptr) sl->ctlinfo); 421 frexpr (sl->expr); 422 free ((charptr) sl); 423 numslots--; 424 } 425 426 427 428 /* 429 * inserts a slot before the specified slot; if given NULL, it is 430 * inserted at the end of the buffer 431 */ 432 433 Slotp optinsert (type,p,l,c,currslot) 434 int type; 435 expptr p; 436 int l; 437 int *c; 438 Slotp currslot; 439 440 { 441 Slotp savelast,new; 442 443 savelast = lastslot; 444 if (currslot) 445 lastslot = currslot->prev; 446 new = optbuff (type,p,l,c); 447 new->next = currslot; 448 if (currslot) 449 currslot->prev = new; 450 new->lineno = -1; /* who knows what the line number should be ??!! */ 451 if (currslot) 452 lastslot = savelast; 453 return (new); 454 } 455 456 457 458 /* 459 * buffers the FRTEMP slots which have been waiting 460 */ 461 462 frtempbuff () 463 464 { 465 chainp ht; 466 register Slotp sp; 467 468 for (ht = holdtemps; ht; ht = ht->nextp) 469 { 470 sp = newslot(); 471 /* this slot actually belongs to some previous source line */ 472 sp->lineno = sp->lineno - 1; 473 sp->type = SKFRTEMP; 474 sp->expr = (expptr) ht->datap; 475 sp->label = 0; 476 sp->ctlinfo = NULL; 477 } 478 holdtemps = NULL; 479 } 480 481 482 483 /* 484 * puts the given information into a slot at the end of the code buffer 485 */ 486 487 Slotp optbuff (type,p,l,c) 488 int type; 489 expptr p; 490 int l; 491 int *c; 492 493 { 494 register Slotp sp; 495 496 if (debugflag[1]) 497 { 498 fprintf (diagfile,"-----optbuff-----"); showslottype (type); 499 showexpr (p,0); fprintf (diagfile,"\n"); 500 } 501 502 p = expand (p); 503 sp = newslot(); 504 sp->type = type; 505 sp->expr = p; 506 sp->label = l; 507 sp->ctlinfo = NULL; 508 switch (type) 509 { 510 case SKCMGOTO: 511 sp->ctlinfo = (int*) cplabarr (l, (struct Labelblock**) c); 512 break; 513 case SKARIF: 514 sp->ctlinfo = (int*) cplabarr (3, (struct Labelblock**) c); 515 break; 516 case SKDOHEAD: 517 case SKENDDO: 518 sp->ctlinfo = (int*) cpframe ((struct Ctlframe*) c); 519 break; 520 default: 521 break; 522 } 523 524 frtempbuff (); 525 526 return (sp); 527 } 528 529 530 531 /* 532 * expands the given expression, if possible (e.g., concat, min, max, etc.); 533 * also frees temporaries when they are indicated as being the last use 534 */ 535 536 #define APPEND(z) \ 537 res = res->exprblock.rightp = mkexpr (OPCOMMA, z, newtemp) 538 539 LOCAL expptr expand (p) 540 tagptr p; 541 542 { 543 Addrp t; 544 expptr q; 545 expptr buffmnmx(), buffpower(); 546 547 if (!p) 548 return (ENULL); 549 switch (p->tag) 550 { 551 case TEXPR: 552 switch (p->exprblock.opcode) 553 { 554 case OPASSIGN: /* handle a = b // c */ 555 if (p->exprblock.vtype != TYCHAR) 556 goto standard; 557 q = p->exprblock.rightp; 558 if (!(q->tag == TEXPR && 559 q->exprblock.opcode == OPCONCAT)) 560 goto standard; 561 t = (Addrp) expand(p->exprblock.leftp); 562 frexpr(p->exprblock.vleng); 563 free( (charptr) p ); 564 p = (tagptr) q; 565 goto cat; 566 case OPCONCAT: 567 t = mktemp (TYCHAR, ICON(lencat(p))); 568 cat: 569 q = (expptr) cpexpr (p->exprblock.vleng); 570 buffcat (cpexpr(t),p); 571 frexpr (t->vleng); 572 t->vleng = q; 573 p = (tagptr) t; 574 break; 575 case OPMIN: 576 case OPMAX: 577 p = (tagptr) buffmnmx (p); 578 break; 579 case OPPOWER: 580 p = (tagptr) buffpower (p); 581 break; 582 default: 583 standard: 584 p->exprblock.leftp = 585 expand (p->exprblock.leftp); 586 if (p->exprblock.rightp) 587 p->exprblock.rightp = 588 expand (p->exprblock.rightp); 589 break; 590 } 591 break; 592 593 case TLIST: 594 { 595 chainp t; 596 for (t = p->listblock.listp; t; t = t->nextp) 597 t->datap = (tagptr) expand (t->datap); 598 } 599 break; 600 601 case TTEMP: 602 if (p->tempblock.istemp) 603 frtemp(p); 604 break; 605 606 case TADDR: 607 p->addrblock.memoffset = expand( p->addrblock.memoffset ); 608 break; 609 610 default: 611 break; 612 } 613 return ((expptr) p); 614 } 615 616 617 618 /* 619 * local version of routine putcat in putpcc.c, called by expand 620 */ 621 622 LOCAL buffcat(lhs, rhs) 623 register Addrp lhs; 624 register expptr rhs; 625 { 626 int n; 627 Addrp lp, cp; 628 629 n = ncat(rhs); 630 lp = (Addrp) mkaltmpn(n, TYLENG, PNULL); 631 cp = (Addrp) mkaltmpn(n, TYADDR, PNULL); 632 633 n = 0; 634 buffct1(rhs, lp, cp, &n); 635 636 optbuff (SKCALL, call4(TYSUBR, "s_cat", lhs, cp, lp, mkconv(TYLONG, ICON(n))), 637 0, 0); 638 } 639 640 641 642 /* 643 * local version of routine putct1 in putpcc.c, called by expand 644 */ 645 646 LOCAL buffct1(q, lp, cp, ip) 647 register expptr q; 648 register Addrp lp, cp; 649 int *ip; 650 { 651 int i; 652 Addrp lp1, cp1; 653 654 if(q->tag==TEXPR && q->exprblock.opcode==OPCONCAT) 655 { 656 buffct1(q->exprblock.leftp, lp, cp, ip); 657 buffct1(q->exprblock.rightp, lp, cp, ip); 658 frexpr(q->exprblock.vleng); 659 free( (charptr) q ); 660 } 661 else 662 { 663 i = (*ip)++; 664 lp1 = (Addrp) cpexpr(lp); 665 lp1->memoffset = mkexpr(OPPLUS,lp1->memoffset, ICON(i*SZLENG)); 666 cp1 = (Addrp) cpexpr(cp); 667 cp1->memoffset = mkexpr(OPPLUS, cp1->memoffset, ICON(i*SZADDR)); 668 optbuff (SKEQ, (mkexpr(OPASSIGN, lp1, cpexpr(q->headblock.vleng))), 669 0,0); 670 optbuff (SKEQ, (mkexpr(OPASSIGN, cp1, addrof(expand (q)))), 0, 0); 671 } 672 } 673 674 675 676 /* 677 * local version of routine putmnmx in putpcc.c, called by expand 678 */ 679 680 LOCAL expptr buffmnmx(p) 681 register expptr p; 682 { 683 int op, type; 684 expptr qp; 685 chainp p0, p1; 686 Addrp sp, tp; 687 Addrp newtemp; 688 expptr result, res; 689 690 if(p->tag != TEXPR) 691 badtag("buffmnmx", p->tag); 692 693 type = p->exprblock.vtype; 694 op = (p->exprblock.opcode==OPMIN ? OPLT : OPGT ); 695 qp = expand(p->exprblock.leftp); 696 if(qp->tag != TLIST) 697 badtag("buffmnmx list", qp->tag); 698 p0 = qp->listblock.listp; 699 free( (charptr) qp ); 700 free( (charptr) p ); 701 702 sp = mktemp(type, PNULL); 703 tp = mktemp(type, PNULL); 704 qp = mkexpr(OPCOLON, cpexpr(tp), cpexpr(sp)); 705 qp = mkexpr(OPQUEST, mkexpr(op, cpexpr(tp),cpexpr(sp)), qp); 706 qp = fixexpr(qp); 707 708 newtemp = mktemp (type,PNULL); 709 710 result = res = mkexpr (OPCOMMA, 711 mkexpr( OPASSIGN, cpexpr(sp), p0->datap ), cpexpr(newtemp)); 712 713 for(p1 = p0->nextp ; p1 ; p1 = p1->nextp) 714 { 715 APPEND (mkexpr( OPASSIGN, cpexpr(tp), p1->datap )); 716 if(p1->nextp) 717 APPEND (mkexpr (OPASSIGN, cpexpr(sp), cpexpr(qp)) ); 718 else 719 APPEND (mkexpr (OPASSIGN, cpexpr(newtemp), qp)); 720 } 721 722 frtemp(sp); 723 frtemp(tp); 724 frtemp(newtemp); 725 frchain( &p0 ); 726 727 return (result); 728 } 729 730 731 732 /* 733 * Called by expand() to eliminate exponentiations to integer constants. 734 */ 735 LOCAL expptr buffpower( p ) 736 expptr p; 737 { 738 expptr base; 739 Addrp newtemp; 740 expptr storetemp = ENULL; 741 expptr powtree(); 742 expptr result; 743 ftnint exp; 744 745 if ( ! ISICON( p->exprblock.rightp ) ) 746 fatal( "buffpower: bad non-integer exponent" ); 747 748 base = expand(p->exprblock.leftp); 749 exp = p->exprblock.rightp->constblock.const.ci; 750 if ( exp < 2 ) 751 fatal( "buffpower: bad exponent less than 2" ); 752 753 if ( exp > 64 ) { 754 /* 755 * Let's be reasonable, here... Let putpower() do the job. 756 */ 757 p->exprblock.leftp = base; 758 return ( p ); 759 } 760 761 /* 762 * If the base is not a simple variable, evaluate it and copy the 763 * result into a temporary. 764 */ 765 if ( ! (base->tag == TADDR && ISCONST( base->addrblock.memoffset )) ) { 766 newtemp = mktemp( base->headblock.vtype, PNULL ); 767 storetemp = mkexpr( OPASSIGN, 768 cpexpr( (expptr) newtemp ), 769 cpexpr( base ) ); 770 base = (expptr) newtemp; 771 } 772 773 result = powtree( base, exp ); 774 775 if ( storetemp != ENULL ) 776 result = mkexpr( OPCOMMA, storetemp, result ); 777 frexpr( p ); 778 779 return ( result ); 780 } 781 782 783 784 /* 785 * powtree( base, exp ) -- Create a tree of multiplications which computes 786 * base ** exp. The tree is built so that CSE will compact it if 787 * possible. The routine works by creating subtrees that compute 788 * exponents which are powers of two, then multiplying these 789 * together to get the result; this gives a log2( exp ) tree depth 790 * and lots of subexpressions which can be eliminated. 791 */ 792 LOCAL expptr powtree( base, exp ) 793 expptr base; 794 register ftnint exp; 795 { 796 register expptr r = ENULL, r1; 797 register int i; 798 799 for ( i = 0; exp; ++i, exp >>= 1 ) 800 if ( exp & 1 ) 801 if ( i == 0 ) 802 r = (expptr) cpexpr( base ); 803 else { 804 r1 = powtree( base, 1 << (i - 1) ); 805 r1 = mkexpr( OPSTAR, r1, cpexpr( r1 ) ); 806 r = (r ? mkexpr( OPSTAR, r1, r ) : r1); 807 } 808 809 return ( r ); 810 } 811