4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/equiv.c

   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: }

Defined functions

Defined variables