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