Return to optim.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / f77 / pass1.tahoe

Annotation of 43BSDReno/pgrm/f77/pass1.tahoe/optim.c, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.