Return to equiv.c CVS log

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

Annotation of 43BSD/usr.bin/f77/src/f77pass1/equiv.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[] = "@(#)equiv.c   5.1 (Berkeley) 6/7/85";
        !             9: #endif not lint
        !            10: 
        !            11: /*
        !            12:  * equiv.c
        !            13:  *
        !            14:  * Routines related to equivalence class processing, f77 compiler, 4.2 BSD.
        !            15:  *
        !            16:  * University of Utah CS Dept modification history:
        !            17:  * 
        !            18:  * Revision 3.2  85/01/14  00:14:12  donn
        !            19:  * Fixed bug in eqvcommon that was causing the calculations of multilevel
        !            20:  * equivalences to be screwed up.
        !            21:  * 
        !            22:  * Revision 3.1  84/10/13  01:16:08  donn
        !            23:  * Installed Jerry Berkman's version; added UofU comment header.
        !            24:  * 
        !            25:  */
        !            26: 
        !            27: 
        !            28: #include "defs.h"
        !            29: 
        !            30: #ifdef SDB
        !            31: #      include <a.out.h>
        !            32: #      ifndef N_SO
        !            33: #              include <stab.h>
        !            34: #      endif
        !            35: #endif
        !            36: 
        !            37: /* called at end of declarations section to process chains
        !            38:    created by EQUIVALENCE statements
        !            39:  */
        !            40: 
        !            41: doequiv()
        !            42: {
        !            43: register int i;
        !            44: int inequiv, comno, ovarno;
        !            45: ftnint comoffset, offset, leng;
        !            46: register struct Equivblock *p;
        !            47: register struct Eqvchain *q;
        !            48: struct Primblock *itemp;
        !            49: register Namep np;
        !            50: expptr offp, suboffset();
        !            51: int ns, nsubs();
        !            52: chainp cp;
        !            53: char *memname();
        !            54: int doeqverr = 0;
        !            55: 
        !            56: for(i = 0 ; i < nequiv ; ++i)
        !            57:        {
        !            58:        p = &eqvclass[i];
        !            59:        p->eqvbottom = p->eqvtop = 0;
        !            60:        comno = -1;
        !            61: 
        !            62:        for(q = p->equivs ; q ; q = q->eqvnextp)
        !            63:                {
        !            64:                offset = 0;
        !            65:                itemp = q->eqvitem.eqvlhs;
        !            66:                if( itemp == NULL ) fatal("error processing equivalence");
        !            67:                equivdcl = YES;
        !            68:                vardcl(np = itemp->namep);
        !            69:                equivdcl = NO;
        !            70:                if(itemp->argsp || itemp->fcharp)
        !            71:                        {
        !            72:                        if(np->vdim!=NULL && np->vdim->ndim>1 &&
        !            73:                           nsubs(itemp->argsp)==1 )
        !            74:                                {
        !            75:                                if(! ftn66flag)
        !            76:                                        warn("1-dim subscript in EQUIVALENCE");
        !            77:                                cp = NULL;
        !            78:                                ns = np->vdim->ndim;
        !            79:                                while(--ns > 0)
        !            80:                                        cp = mkchain( ICON(1), cp);
        !            81:                                itemp->argsp->listp->nextp = cp;
        !            82:                                }
        !            83: 
        !            84:                        offp = suboffset(itemp);
        !            85:                        if(ISICON(offp))
        !            86:                                offset = offp->constblock.const.ci;
        !            87:                        else    {
        !            88:                                dclerr("illegal subscript in equivalence ",
        !            89:                                        np);
        !            90:                                np = NULL;
        !            91:                                doeqverr = 1;
        !            92:                                }
        !            93:                        frexpr(offp);
        !            94:                        }
        !            95:                frexpr(itemp);
        !            96: 
        !            97:                if(np && (leng = iarrlen(np))<0)
        !            98:                        {
        !            99:                        dclerr("argument in equivalence", np);
        !           100:                        np = NULL;
        !           101:                        doeqverr =1;
        !           102:                        }
        !           103: 
        !           104:                if(np) switch(np->vstg)
        !           105:                        {
        !           106:                        case STGUNKNOWN:
        !           107:                        case STGBSS:
        !           108:                        case STGEQUIV:
        !           109:                                break;
        !           110: 
        !           111:                        case STGCOMMON:
        !           112:                                comno = np->vardesc.varno;
        !           113:                                comoffset = np->voffset + offset;
        !           114:                                break;
        !           115: 
        !           116:                        default:
        !           117:                                dclerr("bad storage class in equivalence", np);
        !           118:                                np = NULL;
        !           119:                                doeqverr = 1;
        !           120:                                break;
        !           121:                        }
        !           122: 
        !           123:                if(np)
        !           124:                        {
        !           125:                        q->eqvoffset = offset;
        !           126:                        p->eqvbottom = lmin(p->eqvbottom, -offset);
        !           127:                        p->eqvtop = lmax(p->eqvtop, leng-offset);
        !           128:                        }
        !           129:                q->eqvitem.eqvname = np;
        !           130:                }
        !           131: 
        !           132:        if(comno >= 0)
        !           133:                eqvcommon(p, comno, comoffset);
        !           134:        else  for(q = p->equivs ; q ; q = q->eqvnextp)
        !           135:                {
        !           136:                if(np = q->eqvitem.eqvname)
        !           137:                        {
        !           138:                        inequiv = NO;
        !           139:                        if(np->vstg==STGEQUIV)
        !           140:                                if( (ovarno = np->vardesc.varno) == i)
        !           141:                                        {
        !           142:                                        if(np->voffset + q->eqvoffset != 0)
        !           143:                                                dclerr("inconsistent equivalence", np);
        !           144:                                                doeqverr = 1;
        !           145:                                        }
        !           146:                                else    {
        !           147:                                        offset = np->voffset;
        !           148:                                        inequiv = YES;
        !           149:                                        }
        !           150: 
        !           151:                        np->vstg = STGEQUIV;
        !           152:                        np->vardesc.varno = i;
        !           153:                        np->voffset = - q->eqvoffset;
        !           154: 
        !           155:                        if(inequiv)
        !           156:                                eqveqv(i, ovarno, q->eqvoffset + offset);
        !           157:                        }
        !           158:                }
        !           159:        }
        !           160: 
        !           161: if( !doeqverr )
        !           162:   for(i = 0 ; i < nequiv ; ++i)
        !           163:        {
        !           164:        p = & eqvclass[i];
        !           165:        if(p->eqvbottom!=0 || p->eqvtop!=0)     /* a live chain */
        !           166:                {
        !           167:                for(q = p->equivs ; q; q = q->eqvnextp)
        !           168:                        {
        !           169:                        np = q->eqvitem.eqvname;
        !           170:                        np->voffset -= p->eqvbottom;
        !           171:                        if(np->voffset % typealign[np->vtype] != 0)
        !           172:                                dclerr("bad alignment forced by equivalence", np);
        !           173:                        }
        !           174:                p->eqvtop -= p->eqvbottom;
        !           175:                p->eqvbottom = 0;
        !           176:                }
        !           177:        freqchain(p);
        !           178:        }
        !           179: }
        !           180: 
        !           181: 
        !           182: 
        !           183: 
        !           184: 
        !           185: /* put equivalence chain p at common block comno + comoffset */
        !           186: 
        !           187: LOCAL eqvcommon(p, comno, comoffset)
        !           188: struct Equivblock *p;
        !           189: int comno;
        !           190: ftnint comoffset;
        !           191: {
        !           192: int ovarno;
        !           193: ftnint k, offq;
        !           194: register Namep np;
        !           195: register struct Eqvchain *q;
        !           196: 
        !           197: if(comoffset + p->eqvbottom < 0)
        !           198:        {
        !           199:        errstr("attempt to extend common %s backward",
        !           200:                nounder(XL, extsymtab[comno].extname) );
        !           201:        freqchain(p);
        !           202:        return;
        !           203:        }
        !           204: 
        !           205: if( (k = comoffset + p->eqvtop) > extsymtab[comno].extleng)
        !           206:        extsymtab[comno].extleng = k;
        !           207: 
        !           208: #ifdef SDB
        !           209: if(sdbflag)
        !           210:        prstab( varstr(XL,extsymtab[comno].extname), N_BCOMM,0,0);
        !           211: #endif
        !           212: 
        !           213: for(q = p->equivs ; q ; q = q->eqvnextp)
        !           214:        if(np = q->eqvitem.eqvname)
        !           215:                {
        !           216:                switch(np->vstg)
        !           217:                        {
        !           218:                        case STGUNKNOWN:
        !           219:                        case STGBSS:
        !           220:                                np->vstg = STGCOMMON;
        !           221:                                np->vardesc.varno = comno;
        !           222:                                np->voffset = comoffset - q->eqvoffset;
        !           223: #ifdef SDB
        !           224:                                if(sdbflag)
        !           225:                                        {
        !           226:                                        namestab(np);
        !           227:                                        }
        !           228: #endif
        !           229:                                break;
        !           230: 
        !           231:                        case STGEQUIV:
        !           232:                                ovarno = np->vardesc.varno;
        !           233:                                offq = comoffset - q->eqvoffset - np->voffset;
        !           234:                                np->vstg = STGCOMMON;
        !           235:                                np->vardesc.varno = comno;
        !           236:                                np->voffset = comoffset + q->eqvoffset;
        !           237:                                if(ovarno != (p - eqvclass))
        !           238:                                        eqvcommon(&eqvclass[ovarno], comno, offq);
        !           239: #ifdef SDB
        !           240:                                if(sdbflag)
        !           241:                                        {
        !           242:                                        namestab(np);
        !           243:                                        }
        !           244: #endif
        !           245:                                break;
        !           246: 
        !           247:                        case STGCOMMON:
        !           248:                                if(comno != np->vardesc.varno ||
        !           249:                                   comoffset != np->voffset+q->eqvoffset)
        !           250:                                        dclerr("inconsistent common usage", np);
        !           251:                                break;
        !           252: 
        !           253: 
        !           254:                        default:
        !           255:                                badstg("eqvcommon", np->vstg);
        !           256:                        }
        !           257:                }
        !           258: 
        !           259: #ifdef SDB
        !           260: if(sdbflag)
        !           261:        prstab( varstr(XL,extsymtab[comno].extname), N_ECOMM,0,0);
        !           262: #endif
        !           263: 
        !           264: freqchain(p);
        !           265: p->eqvbottom = p->eqvtop = 0;
        !           266: }
        !           267: 
        !           268: 
        !           269: /* put all items on ovarno chain on front of nvarno chain
        !           270:  * adjust offsets of ovarno elements and top and bottom of nvarno chain
        !           271:  */
        !           272: 
        !           273: LOCAL eqveqv(nvarno, ovarno, delta)
        !           274: int ovarno, nvarno;
        !           275: ftnint delta;
        !           276: {
        !           277: register struct Equivblock *p0, *p;
        !           278: register Namep np;
        !           279: struct Eqvchain *q, *q1;
        !           280: 
        !           281: p0 = eqvclass + nvarno;
        !           282: p = eqvclass + ovarno;
        !           283: p0->eqvbottom = lmin(p0->eqvbottom, p->eqvbottom - delta);
        !           284: p0->eqvtop = lmax(p0->eqvtop, p->eqvtop - delta);
        !           285: p->eqvbottom = p->eqvtop = 0;
        !           286: 
        !           287: for(q = p->equivs ; q ; q = q1)
        !           288:        {
        !           289:        q1 = q->eqvnextp;
        !           290:        if( (np = q->eqvitem.eqvname) && np->vardesc.varno==ovarno)
        !           291:                {
        !           292:                q->eqvnextp = p0->equivs;
        !           293:                p0->equivs = q;
        !           294:                q->eqvoffset -= delta;
        !           295:                np->vardesc.varno = nvarno;
        !           296:                np->voffset -= delta;
        !           297:                }
        !           298:        else    free( (charptr) q);
        !           299:        }
        !           300: p->equivs = NULL;
        !           301: }
        !           302: 
        !           303: 
        !           304: 
        !           305: 
        !           306: LOCAL freqchain(p)
        !           307: register struct Equivblock *p;
        !           308: {
        !           309: register struct Eqvchain *q, *oq;
        !           310: 
        !           311: for(q = p->equivs ; q ; q = oq)
        !           312:        {
        !           313:        oq = q->eqvnextp;
        !           314:        free( (charptr) q);
        !           315:        }
        !           316: p->equivs = NULL;
        !           317: }
        !           318: 
        !           319: 
        !           320: 
        !           321: 
        !           322: 
        !           323: LOCAL nsubs(p)
        !           324: register struct Listblock *p;
        !           325: {
        !           326: register int n;
        !           327: register chainp q;
        !           328: 
        !           329: n = 0;
        !           330: if(p)
        !           331:        for(q = p->listp ; q ; q = q->nextp)
        !           332:                ++n;
        !           333: 
        !           334: return(n);
        !           335: }

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