4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/optim.c

   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: }

Defined functions

Defined variables

Defined macros