![[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 [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1|
Return to optim.c CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / 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.3 (Berkeley) 3/9/86"; ! 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.const.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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.