Return to bb.c CVS log

Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1

Annotation of 43BSD/usr.bin/f77/src/f77pass1/bb.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[] = "@(#)bb.c       5.2 (Berkeley) 3/9/86";
        !             9: #endif not lint
        !            10: 
        !            11: /*
        !            12:  * bb.c
        !            13:  *
        !            14:  * Basic block optimizations.
        !            15:  *
        !            16:  * University of Utah CS Dept modification history:
        !            17:  *
        !            18:  * $Log:       bb.c,v $
        !            19:  * Revision 5.2  86/03/09  18:13:56  donn
        !            20:  * In tempalloc(), don't forget to treat the vleng tree of a temp block
        !            21:  * before allocating it with altmpn.
        !            22:  * 
        !            23:  * Revision 2.1  84/07/19  12:01:20  donn
        !            24:  * Changed comment headers for UofU.
        !            25:  * 
        !            26:  * Revision 1.2  84/04/02  14:22:49  donn
        !            27:  * Bug in copy propagation missed places where temporaries are assigned to
        !            28:  * by OPSTAREQ or OPPLUSEQ, e.g. exponentiation with an integer constant
        !            29:  * power, expanded inline.
        !            30:  * 
        !            31:  */
        !            32: 
        !            33: #include "defs.h"
        !            34: #include "optim.h"
        !            35: 
        !            36: /*
        !            37:  *  This file contains code for determination of basic blocks,
        !            38:  *  as well as some other optimization supporting routines
        !            39:  *  [including the main routine 'optimize()'].
        !            40:  *
        !            41:  *  The compiler's general debugging flag ['debugflag'] has been
        !            42:  *  extended to provide the capability of having multiple flags
        !            43:  *  which are contained in an array.  If the option -d is used,
        !            44:  *  then the flag debugflag[0] is set.  If a sequence of one or more
        !            45:  *  numbers are given (e.g, -d3,7,12), then the flags debugflag[3],
        !            46:  *  debugflag[7], and debugflag[12] are set.  The maximum number of
        !            47:  *  flags available is specified in the defines.h file.
        !            48:  */
        !            49: 
        !            50: 
        !            51: Bblockp        firstblock = NULL;              /* first block in buffer */
        !            52: Bblockp        lastblock = NULL;               /* last block in buffer */
        !            53: 
        !            54: expptr tempalloc();
        !            55: 
        !            56: 
        !            57: optimize ()
        !            58: 
        !            59: {
        !            60: Bblockp bb;
        !            61: Slotp  sl,nextsl;
        !            62: 
        !            63: if (debugflag[2]) showbuffer ();
        !            64: 
        !            65: optloops ();
        !            66: 
        !            67: if (debugflag[3]) showbuffer ();
        !            68: 
        !            69: formbblock ();
        !            70: optcse ();
        !            71: 
        !            72: if (debugflag[4]) showbuffer ();
        !            73: 
        !            74: if (! debugflag[7])
        !            75:        copyprop ();
        !            76: 
        !            77: if (debugflag[9]) showbuffer ();
        !            78: 
        !            79: for (sl = firstslot; sl; sl = nextsl)
        !            80:        {
        !            81:        nextsl = sl->next;
        !            82:        if (sl->type == SKFRTEMP)
        !            83:                {
        !            84:                templist = mkchain (sl->expr,templist);
        !            85:                sl->expr = NULL;
        !            86:                delslot (sl);
        !            87:                }
        !            88:        else
        !            89:                sl->expr = tempalloc (sl->expr);
        !            90:        }
        !            91: 
        !            92: if (! debugflag[10])
        !            93:        regalloc ();
        !            94: 
        !            95: flushopt ();
        !            96: }
        !            97: 
        !            98: 
        !            99: 
        !           100: /*
        !           101:  *  creates a new basic block record
        !           102:  */
        !           103: 
        !           104: LOCAL Bblockp newblock (sl)
        !           105: Slotp  sl;
        !           106: 
        !           107: {
        !           108: register Bblockp bb;
        !           109: 
        !           110: bb = ALLOC( bblock );
        !           111: bb->next = NULL ;
        !           112: if (lastblock)
        !           113:        {
        !           114:        bb->prev = lastblock;
        !           115:        lastblock->next = bb;
        !           116:        lastblock = bb;
        !           117:        }
        !           118: else
        !           119:        {
        !           120:        firstblock = lastblock = bb;
        !           121:        bb->prev = NULL;
        !           122:        }
        !           123: 
        !           124: bb->first = sl;
        !           125: return (bb);
        !           126: }
        !           127: 
        !           128: 
        !           129: 
        !           130: /*
        !           131:  *  scans slot buffer, creating basic block records
        !           132:  */
        !           133: 
        !           134: formbblock ()
        !           135: 
        !           136: {
        !           137: Slotp  sl;
        !           138: field  type;
        !           139: Bblockp        newbb;
        !           140: 
        !           141: newbb = NULL;
        !           142: for (sl = firstslot; sl; sl = sl->next)
        !           143:        {
        !           144:        type = sl->type;
        !           145:        switch (type)
        !           146:                {
        !           147:                case SKEQ:
        !           148:                        if (!newbb)
        !           149:                                newbb = newblock(sl);
        !           150:                        if (containscall(sl->expr))
        !           151:                                {
        !           152:                                newbb->last = sl;
        !           153:                                newbb = NULL;
        !           154:                                }
        !           155:                        break;
        !           156:                case SKNULL:
        !           157:                case SKASSIGN:
        !           158:                case SKFRTEMP:
        !           159:                        if (!newbb)
        !           160:                                newbb = newblock(sl);
        !           161:                        break;
        !           162:                case SKPAUSE:
        !           163:                case SKSTOP:
        !           164:                case SKIFN:
        !           165:                case SKGOTO:
        !           166:                case SKCMGOTO:
        !           167:                case SKARIF:
        !           168:                case SKASGOTO:
        !           169:                case SKIOIFN:
        !           170:                case SKCALL:
        !           171:                case SKRETURN:
        !           172:                        if (!newbb)
        !           173:                                newbb = newblock(sl);
        !           174:                        newbb->last = sl;
        !           175:                        newbb = NULL;
        !           176:                        break;
        !           177:                case SKLABEL:
        !           178:                        if (newbb)
        !           179:                                newbb->last = sl->prev;
        !           180:                        newbb = newblock(sl);
        !           181:                        break;
        !           182:                case SKDOHEAD:
        !           183:                case SKENDDO:
        !           184:                        if (!newbb)
        !           185:                                newbb = newblock(sl);
        !           186:                        break;
        !           187:                default:
        !           188:                        badthing("SKtype", "formbblock", type);
        !           189:                        break;
        !           190:                }
        !           191:        }
        !           192: if (newbb)
        !           193:        newbb->last = lastslot;
        !           194: }
        !           195: 
        !           196: 
        !           197: 
        !           198: /*
        !           199:  *  frees all basic block records
        !           200:  *  as well as the id and value node chains hanging off the bb and their
        !           201:  *  respective cross link chains (IDlist, DUPlist and NODElist structs) 
        !           202:  */
        !           203: 
        !           204: clearbb ()
        !           205: {
        !           206: Bblockp        bb,next;
        !           207: 
        !           208: for (bb = firstblock; bb; bb = next)
        !           209:        {
        !           210:        next = bb->next;
        !           211:           { 
        !           212:             idptr idp,next;
        !           213:             for(idp = bb->headid; idp; idp = next) 
        !           214:                { 
        !           215:                 next = idp->next;
        !           216:                      {
        !           217:                      nodelptr nodelp, next;
        !           218:                      for(nodelp = idp->headnodelist; nodelp; nodelp = next)
        !           219:                         {
        !           220:                            next = nodelp->next;
        !           221:                            free( (charptr) nodelp);
        !           222:                         }      
        !           223:                      }
        !           224:                  free( (charptr) idp);
        !           225:                }       
        !           226:            }
        !           227:           { 
        !           228:             valuen vp,next;
        !           229:             for(vp = bb->headnode; vp; vp = next) 
        !           230:                { 
        !           231:                 next = vp->next;
        !           232:                      {
        !           233:                      idlptr idlp, next;
        !           234:                      for(idlp = vp->headdeplist; idlp; idlp = next)
        !           235:                         {
        !           236:                            next = idlp->next;
        !           237:                            free( (charptr) idlp);
        !           238:                         }      
        !           239:                      }
        !           240:                      {
        !           241:                      duplptr duplp, next;
        !           242:                      for(duplp = vp->headduplist; duplp; duplp = next)
        !           243:                         {
        !           244:                            next = duplp->next;
        !           245:                            free( (charptr) duplp);
        !           246:                         }      
        !           247:                      }
        !           248:                  free( (charptr) vp);
        !           249:                }       
        !           250:            }
        !           251:        free ( (charptr) bb);
        !           252:        }
        !           253: firstblock = lastblock = NULL;
        !           254: }
        !           255: 
        !           256: 
        !           257: /* structure for maintaining records on copy statements */
        !           258: 
        !           259: typedef struct Subrec {
        !           260:        Addrp   lmem;
        !           261:        Addrp   rmem;
        !           262:        int     sets;
        !           263: } *Subrecp;
        !           264: 
        !           265: 
        !           266: LOCAL chainp sublist;  /* list of copy statements */
        !           267: LOCAL int prop1count;  /* count of number of temporaries eliminated */
        !           268: LOCAL int prop2count;  /* count of number of uses of temporaries replaced */
        !           269: 
        !           270: expptr rmcommaop();
        !           271: Addrp subfor();
        !           272: 
        !           273: 
        !           274: 
        !           275: /*
        !           276:  *  eliminates copy statements of the form T1 = T2 from the intermediate
        !           277:  *  code, where T1 and T2 are temporary variables which are each
        !           278:  *  set only once;  eliminates the copy statement and replaces each
        !           279:  *  use of T1 by T2 (T1 is therefore totally eliminated).
        !           280:  */
        !           281: 
        !           282: LOCAL copyprop ()
        !           283: 
        !           284: {
        !           285: Slotp  sl,nextsl;
        !           286: expptr expr;
        !           287: Tempp  lp,rp;
        !           288: 
        !           289: for (sl = firstslot; sl; sl = sl->next)
        !           290:        sl->expr = rmcommaop (sl->expr,sl);
        !           291: 
        !           292: prop1count = prop2count = 0;
        !           293: findcopies ();
        !           294: 
        !           295: for (sl = firstslot; sl; sl = nextsl)
        !           296:        {
        !           297:        nextsl = sl->next;
        !           298:        expr = sl->expr;
        !           299: 
        !           300:        if ((sl->type == SKFRTEMP) && subfor (expr))
        !           301:                {
        !           302:                delslot (sl);
        !           303:                expr = ENULL;
        !           304:                }
        !           305:        else if (expr && expr->tag == TEXPR &&
        !           306:                        expr->exprblock.opcode == OPASSIGN)
        !           307:                {
        !           308:                lp = (Tempp) expr->exprblock.leftp;
        !           309:                rp = (Tempp) expr->exprblock.rightp;
        !           310:                if (lp->tag == TTEMP && rp->tag == TTEMP)
        !           311:                        if (subfor(lp->memalloc) == rp->memalloc
        !           312:                                        && !subfor (rp->memalloc))
        !           313:                                {
        !           314:                                frexpr (expr);
        !           315:                                expr = sl->expr = ENULL;
        !           316:                                prop1count++;
        !           317:                                }
        !           318:                }
        !           319: 
        !           320:        propagate (expr);
        !           321:        }
        !           322: 
        !           323: if (debugflag[0])
        !           324:        fprintf (diagfile,
        !           325:            "%d temporarie%s replaced by copy propagation (%d use%s)\n",
        !           326:                prop1count,(prop1count==1 ? "" : "s"),
        !           327:                prop2count,(prop2count==1 ? "" : "s") );
        !           328: }
        !           329: 
        !           330: 
        !           331: 
        !           332: /*
        !           333:  *  finds copy statements and enters information in table
        !           334:  */
        !           335: 
        !           336: LOCAL findcopies ()
        !           337: 
        !           338: {
        !           339: Slotp  sl;
        !           340: expptr expr;
        !           341: chainp cp;
        !           342: 
        !           343: for (sl = firstslot; sl; sl = sl->next)
        !           344:        {
        !           345:        expr = sl->expr;
        !           346:        if (expr) switch (expr->tag)
        !           347:            {
        !           348:            case TEXPR:
        !           349:                ckexpr (expr);
        !           350:                break;
        !           351: 
        !           352:            case TLIST:
        !           353:                for (cp = expr->listblock.listp; cp; cp = cp->nextp)
        !           354:                        {
        !           355:                        expr = (expptr) cp->datap;
        !           356:                        ckexpr (expr);
        !           357:                        }
        !           358:                break;
        !           359: 
        !           360:            default:
        !           361:                break;
        !           362:            }
        !           363:        }
        !           364: }
        !           365: 
        !           366: 
        !           367: 
        !           368: /*
        !           369:  *  checks an individual expression
        !           370:  */
        !           371: 
        !           372: ckexpr (expr)
        !           373: expptr expr;
        !           374: 
        !           375: {
        !           376: Tempp  lp,rp;
        !           377: int    oc = expr->exprblock.opcode;
        !           378: 
        !           379: if (oc == OPASSIGN || oc == OPPLUSEQ || oc == OPSTAREQ)
        !           380:        {
        !           381:        lp = (Tempp) expr->exprblock.leftp;
        !           382:        rp = (Tempp) expr->exprblock.rightp;
        !           383:        if (lp->tag == TTEMP)
        !           384:                if (rp->tag == TTEMP && oc == OPASSIGN)
        !           385:                        enter (lp->memalloc, rp->memalloc);
        !           386:                else
        !           387:                        enter (lp->memalloc, ENULL);
        !           388:        }
        !           389: }
        !           390: 
        !           391: 
        !           392: 
        !           393: /*
        !           394:  *  Enters the given memalloc values in the table (or update if they
        !           395:  *  are already there), for the assignment statement m1 = m2.
        !           396:  *  If m2 is NULL, this indicates that the assignment is not a copy
        !           397:  *  statement.
        !           398:  */
        !           399: 
        !           400: LOCAL enter (m1,m2)
        !           401: Addrp  m1,m2;
        !           402: 
        !           403: {
        !           404: chainp cp;
        !           405: Subrecp old,new;
        !           406: 
        !           407: for (cp = sublist; cp; cp = cp->nextp)
        !           408:        {
        !           409:        old = (Subrecp) cp->datap;
        !           410:        if (old->lmem == m1)
        !           411:                {
        !           412:                old->sets++;
        !           413:                return;
        !           414:                }
        !           415:        }
        !           416: 
        !           417: new = ALLOC (Subrec);
        !           418: new->lmem = m1;
        !           419: new->rmem = m2;
        !           420: new->sets = 1;
        !           421: sublist = mkchain (new, sublist);
        !           422: }
        !           423: 
        !           424: 
        !           425: 
        !           426: /*
        !           427:  *  looks for record for the given memalloc value
        !           428:  */
        !           429: 
        !           430: LOCAL Subrecp lookup (mem)
        !           431: Addrp  mem;
        !           432: 
        !           433: {
        !           434: chainp cp;
        !           435: Subrecp rec;
        !           436: 
        !           437: for (cp = sublist; cp; cp = cp->nextp)
        !           438:        {
        !           439:        rec = (Subrecp) cp->datap;
        !           440:        if (rec->lmem == mem)
        !           441:                return rec;
        !           442:        }
        !           443: 
        !           444: return NULL;
        !           445: }
        !           446: 
        !           447: 
        !           448: 
        !           449: /*
        !           450:  *  checks to see if there is a substitute for given memalloc value
        !           451:  */
        !           452: 
        !           453: LOCAL Addrp subfor (mem)
        !           454: Addrp  mem;
        !           455: 
        !           456: {
        !           457: Subrecp rec,rec2;
        !           458: Addrp  sub;
        !           459: 
        !           460: rec = lookup (mem);
        !           461: if (rec && rec->sets == 1)
        !           462:        {
        !           463:        sub = rec->rmem;
        !           464:        rec2 = lookup(sub);
        !           465:        if (rec2 && rec2->sets == 1)
        !           466:                return sub;
        !           467:        }
        !           468: 
        !           469: return NULL;
        !           470: }
        !           471: 
        !           472: 
        !           473: 
        !           474: /*
        !           475:  *  actually propagates the information
        !           476:  */
        !           477: 
        !           478: LOCAL propagate (expr)
        !           479: expptr expr;
        !           480: 
        !           481: {
        !           482: chainp t;
        !           483: Addrp  new;
        !           484: 
        !           485: if (! expr) return;
        !           486: 
        !           487: switch (expr->tag)
        !           488:        {
        !           489:        case TEXPR:
        !           490:                propagate (expr->exprblock.leftp);
        !           491:                propagate (expr->exprblock.rightp);
        !           492:                break;
        !           493: 
        !           494:        case TADDR:
        !           495:                propagate (expr->addrblock.vleng);
        !           496:                propagate (expr->addrblock.memoffset);
        !           497:                break;
        !           498: 
        !           499:        case TLIST:
        !           500:                for (t = expr->listblock.listp; t; t = t->nextp)
        !           501:                        propagate (t->datap);
        !           502:                break;
        !           503: 
        !           504:        case TTEMP:
        !           505:                new = subfor (expr->tempblock.memalloc);
        !           506:                if (new)
        !           507:                        {
        !           508:                        expr->tempblock.memalloc = new;
        !           509:                        prop2count++;
        !           510:                        }
        !           511:                break;
        !           512: 
        !           513:        default:
        !           514:                break;
        !           515:        }
        !           516: }
        !           517: 
        !           518: 
        !           519: 
        !           520: /*
        !           521:  *  allocates ADDR blocks for each TEMP in the expression
        !           522:  */
        !           523: 
        !           524: LOCAL expptr tempalloc (expr)
        !           525: expptr expr;
        !           526: 
        !           527: {
        !           528: chainp t;
        !           529: 
        !           530: if (! expr)
        !           531:        return NULL;
        !           532: 
        !           533: switch (expr->tag)
        !           534:     {
        !           535:     case TEXPR:
        !           536:        expr->exprblock.leftp = tempalloc (expr->exprblock.leftp);
        !           537:        expr->exprblock.rightp = tempalloc (expr->exprblock.rightp);
        !           538:        break;
        !           539: 
        !           540:     case TADDR:
        !           541:        expr->addrblock.vleng = tempalloc (expr->addrblock.vleng);
        !           542:        expr->addrblock.memoffset = tempalloc (expr->addrblock.memoffset);
        !           543:        break;
        !           544: 
        !           545:     case TLIST:
        !           546:        for (t = expr->listblock.listp; t; t = t->nextp)
        !           547:                t->datap = (tagptr) tempalloc (t->datap);
        !           548:        break;
        !           549: 
        !           550:     case TTEMP:
        !           551:        expr->tempblock.vleng = tempalloc (expr->tempblock.vleng);
        !           552:        return (expptr) cpexpr (altmpn (expr));
        !           553:        break;
        !           554: 
        !           555:     default:
        !           556:        break;
        !           557:     }
        !           558: return expr;
        !           559: }
        !           560: 
        !           561: 
        !           562: /********************* debugging routines *********************/
        !           563: 
        !           564: 
        !           565: 
        !           566: Announce (s,q)
        !           567: char *s;
        !           568: expptr q;
        !           569: 
        !           570: {
        !           571: fprintf (diagfile,"\nAn expression [%s]----->\n",s);
        !           572: showexpr(q,0);
        !           573: fprintf (diagfile,"\n-------------end of expr--------------\n");
        !           574: }
        !           575: 
        !           576: 
        !           577: 
        !           578: /*
        !           579:  *  dump the basic block buffer, including expressions, mnemonically
        !           580:  */
        !           581: 
        !           582: showbuffer ()
        !           583: 
        !           584: {
        !           585: Slotp  sl;
        !           586: Bblockp        bb;
        !           587: int    i;
        !           588: 
        !           589: fprintf (diagfile,"Basic blocks with first and last slots ----------\n");
        !           590: for (i=1, bb = firstblock; bb; i++, bb = bb->next)
        !           591:        fprintf (diagfile,"%2d.  %d  %d\n",i,bb->first,bb->last);
        !           592: fprintf (diagfile,"\n");
        !           593: 
        !           594: fprintf (diagfile,"Slots and expressions ----------\n");
        !           595: 
        !           596: fprintf (diagfile,"tag pointer vtype vclass vstg vleng\n");
        !           597: fprintf (diagfile,"          ADDR memno memoffset istemp ntempelt varleng\n");
        !           598: fprintf (diagfile,"          TEMP memalloc istemp ntempelt varleng\n");
        !           599: fprintf (diagfile,"          EXPR opcode leftp rightp\n");
        !           600: fprintf (diagfile,"          LIST type listp\n");
        !           601: fprintf (diagfile,"\n");
        !           602: 
        !           603: for (i=1, sl = firstslot; sl; i++, sl = sl->next)
        !           604:        {
        !           605:        fprintf (diagfile,"%2d.  ",i);
        !           606:        showslt (sl);
        !           607:        }
        !           608: fprintf (diagfile,"---------- End of showbuffer ----------\n");
        !           609: }
        !           610: 
        !           611: 
        !           612: 
        !           613: /*
        !           614:  *  dumps a single slot in the code buffer
        !           615:  */
        !           616: 
        !           617: LOCAL charptr Zslot[] = {"NULL",
        !           618:        "IFN","GOTO","LABEL","EQ","CALL","CMGOTO","STOP","DOHEAD",
        !           619:        "ENDDO","ARIF","RETURN","ASGOTO","PAUSE","ASSIGN","IOIFN","FRTEMP"};
        !           620: 
        !           621: 
        !           622: 
        !           623: showslt (sl)
        !           624: Slotp sl;
        !           625: 
        !           626: {
        !           627: fprintf (diagfile,"(%2d)  %d  %s  %d\n",
        !           628:        sl->lineno,sl,Zslot[sl->type],sl->label);
        !           629: showexpr (sl->expr,0);
        !           630: fprintf (diagfile,"\n");
        !           631: }
        !           632: 
        !           633: 
        !           634: 
        !           635: showslottype (type)
        !           636: int type;
        !           637: 
        !           638: {
        !           639: fprintf (diagfile,"%s\n",Zslot[type]);
        !           640: }
        !           641: 
        !           642: 
        !           643: 
        !           644: /*
        !           645:  *  displays the given expression at the given indentation, showing
        !           646:  *  its subexpressions at further indentations
        !           647:  */
        !           648: 
        !           649: LOCAL charptr Ztag[] = {"----",
        !           650:        "NAME","CONST","EXPR","ADDR","TEMP","PRIM","LIST","IMPLDO","ERROR"};
        !           651: LOCAL charptr Zstg[] = {"unk",
        !           652:        "ARG","AUTO","BSS","INIT","CONST","EXT","INTR","STFUNCT",
        !           653:        "COMMON","EQUIV","REG","LENG","NULL","PREG"};
        !           654: LOCAL charptr Zclass[] = {"unk",
        !           655:        "PARAM","VAR","ENTRY","MAIN","BLOCK","PROC","NAMELIST"};
        !           656: LOCAL charptr Zop[] = {"----",
        !           657:        "PLUS","MINUS","STAR","SLASH","POWER","NEG","OR","AND","EQV",
        !           658:        "NEQV","NOT","CONCAT","LT","EQ","GT","LE","NE","GE","CALL",
        !           659:        "CCALL","ASSIGN","PLUSEQ","STAREQ","CONV","LSHIFT","MOD",
        !           660:        "COMMA","QUEST","COLON","ABS","MIN","MAX","ADDR","INDIRECT",
        !           661:        "BITOR","BITAND","BITXOR","BITNOT","RSHIFT","PAREN"};
        !           662: LOCAL charptr Ztype[] = {"unk",
        !           663:        "ADDR","SHORT","LONG","REAL","DREAL","COMPLEX","DCOMPLEX",
        !           664:        "LOGICAL","CHAR","SUBR","ERROR"};
        !           665: 
        !           666: 
        !           667: showexpr(p,indent)
        !           668: tagptr p;
        !           669: int indent;
        !           670: 
        !           671: {
        !           672: int i;
        !           673: int type;
        !           674: chainp q;
        !           675: 
        !           676: #define PRHEAD(q) fprintf(diagfile,"%s %d %s %s %s %d", \
        !           677:        Ztag[q->tag], q, Ztype[q->headblock.vtype], \
        !           678:        Zclass[q->headblock.vclass], Zstg[q->headblock.vstg], \
        !           679:        q->headblock.vleng);
        !           680: #define SHOWEXPR(p) showexpr(p,indent+2)
        !           681: 
        !           682: 
        !           683: 
        !           684: if(p == NULL)
        !           685:        return;
        !           686: 
        !           687: for (i=0; i<indent; i++)
        !           688:        putc(' ',diagfile);
        !           689: 
        !           690: switch(p->tag)
        !           691:          {
        !           692:          case TCONST:
        !           693:               PRHEAD(p);
        !           694: 
        !           695:               type=p->constblock.vtype;
        !           696:               if (ISCHAR(p))
        !           697:                  {
        !           698:                       fprintf(diagfile," ISCHAR ccp= %d\n",
        !           699:                                                    p->constblock.const.ccp);
        !           700:                       SHOWEXPR(p->constblock.vleng);
        !           701:                  }
        !           702:               else  if( ISINT(type) )
        !           703:                    fprintf(diagfile," ci= %d\n",p->constblock.const.ci); 
        !           704:               else if( ISREAL(type) )
        !           705:                    fprintf(diagfile," cd[0]= %e\n",p->constblock.const.cd[0]);
        !           706:               else fprintf(diagfile," cd[0]= %e  cd[1]= %e\n",
        !           707:                             p->constblock.const.cd[0],
        !           708:                             p->constblock.const.cd[1] ); 
        !           709:               break;
        !           710: 
        !           711:          case TADDR:
        !           712:               PRHEAD(p);
        !           713:               fprintf(diagfile,
        !           714:               " memno= %d %d %d %d %d\n",
        !           715:               p->addrblock.memno,p->addrblock.memoffset,p->addrblock.istemp,
        !           716:               p->addrblock.ntempelt,p->addrblock.varleng);
        !           717:               SHOWEXPR(p->addrblock.vleng);
        !           718:               SHOWEXPR(p->addrblock.memoffset);
        !           719:               break;
        !           720: 
        !           721:          case TTEMP:
        !           722:              fprintf(diagfile,"%s %d %s %s %d",
        !           723:                        Ztag[p->tag], p, Ztype[p->headblock.vtype],
        !           724:                        Zclass[p->headblock.vclass],
        !           725:                        p->headblock.vleng);
        !           726:               fprintf(diagfile,
        !           727:                " memalloc= %d %d %d %d\n",
        !           728:                p->tempblock.memalloc,p->tempblock.istemp,
        !           729:                p->tempblock.ntempelt,p->tempblock.varleng);
        !           730:               SHOWEXPR(p->tempblock.vleng);
        !           731:              SHOWEXPR(p->tempblock.memalloc);
        !           732:               break;
        !           733: 
        !           734:          case TERROR:
        !           735:               fprintf(diagfile,"ERROR %d\n",p);
        !           736:               break;
        !           737:           
        !           738:          case TNAME:
        !           739:               fprintf(diagfile,"NAME %d\n",p);
        !           740:               return;
        !           741: 
        !           742:          case TPRIM:
        !           743:               fprintf(diagfile,"PRIM %d --- not implemented\n",p);
        !           744:               break;
        !           745: 
        !           746:          case TEXPR:
        !           747:               PRHEAD(p);
        !           748:               fprintf(diagfile," opcode= %s %d %d\n",
        !           749:                      Zop[p->exprblock.opcode],p->exprblock.leftp,
        !           750:                      p->exprblock.rightp);
        !           751:               SHOWEXPR(p->exprblock.leftp);
        !           752:               if(p->exprblock.rightp)
        !           753:                     SHOWEXPR(p->exprblock.rightp);
        !           754:               break;
        !           755: 
        !           756:          case TLIST:
        !           757:               fprintf(diagfile,"LIST %d %s %d\n",p,
        !           758:                       Ztype[p->listblock.vtype],p->listblock.listp);
        !           759:               for(q= p->listblock.listp ; q ; q = q->nextp)
        !           760:                       SHOWEXPR(q->datap);
        !           761:              for (i=0; i<indent; i++)
        !           762:                putc (' ',diagfile);
        !           763:               fprintf(diagfile,"END LIST %d\n",p);
        !           764:               break;
        !           765: 
        !           766:          default:
        !           767:               fprintf(diagfile,"showexpr BAD TAG= %d at %d \n",p->tag,p);
        !           768:            }
        !           769: }
        !           770: 
        !           771: 
        !           772: 
        !           773: selective()/************************************/
        !           774: {
        !           775: int i;
        !           776: Slotp sl;
        !           777: 
        !           778: i=0;
        !           779: fprintf (stderr,"SELECTIVE OUTPUT\n");
        !           780: for (sl=firstslot;sl;sl=sl->next)
        !           781:        {
        !           782:        i++;
        !           783:        if (i>=176 && i<184)
        !           784:                {
        !           785:                fprintf (stderr,"%d.  ",i);
        !           786:                showslt(sl);
        !           787:                }
        !           788:        }
        !           789: }
        !           790: 
        !           791: 
        !           792: 
        !           793: 
        !           794: LOCAL containscall(p)
        !           795: expptr p;
        !           796: {
        !           797:   chainp cp;
        !           798: 
        !           799:   if (p == NULL)
        !           800:     return NO;
        !           801: 
        !           802:   switch (p->tag)
        !           803:     {
        !           804:     case TADDR:
        !           805:       if (containscall(p->addrblock.vleng)
        !           806:          || containscall(p->addrblock.memoffset))
        !           807:        return YES;
        !           808:       else
        !           809:         return NO;
        !           810: 
        !           811:     case TCONST:
        !           812:       return NO;
        !           813: 
        !           814:     case TERROR:
        !           815:       return NO;
        !           816: 
        !           817:     case TEXPR:
        !           818:       if (p->exprblock.opcode == OPCALL ||
        !           819:          p->exprblock.opcode == OPCCALL)
        !           820:        return YES;
        !           821:       if (containscall(p->exprblock.vleng) ||
        !           822:          containscall(p->exprblock.leftp) ||
        !           823:          containscall(p->exprblock.rightp))
        !           824:        return YES;
        !           825:       else
        !           826:        return NO;
        !           827: 
        !           828:     case TLIST:
        !           829:       cp = p->listblock.listp;
        !           830:       while (cp)
        !           831:        {
        !           832:          if (containscall(cp->datap))
        !           833:            return YES;
        !           834:          cp = cp->nextp;
        !           835:        }
        !           836:       return NO;
        !           837: 
        !           838:     default:
        !           839:       return YES;
        !           840:     }
        !           841: }

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