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