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