Return to bb.c CVS log

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

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

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