Return to bb.c CVS log

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

Annotation of 42BSD/usr.bin/f77/src/f77pass1/bb.c, revision 1.1

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

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