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