# 2.11BSD#431 - /usr/src/usr.bin/f77/equiv.c

##### Functions

    doequiv           X
    eqvcommon         X
    eqveqv            X
    freqchain         X
    nsubs             X

       1: #include "defs"
       2: #include "string_defs"
       3:
       4: extern ftnint iarrlen(), lmin(), lmax();
       5: /* ROUTINES RELATED TO EQUIVALENCE CLASS PROCESSING */
       6:
       7: /* called at end of declarations section to process chains
       8:    created by EQUIVALENCE statements
       9:  */
      10: doequiv()
      11: {
      12: register int i;
      13: int inequiv, comno, ovarno;
      14: ftnint comoffset, offset, leng;
      15: register struct equivblock *p;
      16: register struct eqvchain *q;
      17: struct primblock *itemp;
      18: register struct nameblock *np;
      19: expptr offp, suboffset();
      20: int ns, nsubs();
      21: chainp cp;
      22:
      23: for(i = 0 ; i < nequiv ; ++i)
      24:     {
      25:     p = &eqvclass[i];
      26:     p->eqvbottom = p->eqvtop = 0;
      27:     comno = -1;
      28:
      29:     for(q = p->equivs ; q ; q = q->nextp)
      30:         {
      31:         itemp = q->eqvitem;
      32:         vardcl(np = itemp->namep);
      33:         if(itemp->argsp || itemp->fcharp)
      34:             {
      35:             if(np->vdim!=NULL && np->vdim->ndim>1 &&
      36:                nsubs(itemp->argsp)==1 )
      37:                 {
      38:                 if(! ftn66flag)
      39:                     error("1-dim subscript in EQUIVALENCE",0,0,WARN);
      40:                 cp = NULL;
      41:                 ns = np->vdim->ndim;
      42:                 while(--ns > 0)
      43:                     cp = mkchain( ICON(1), cp);
      44:                 itemp->argsp->listp->nextp = cp;
      45:                 }
      46:             offp = suboffset(itemp);
      47:             }
      48:         else    offp = ICON(0);
      49:         if(ISICON(offp))
      50:             offset = q->eqvoffset = offp->const.ci;
      51:         else    {
      52:             error("nonconstant subscript in equivalence ", np, 0, DCLERR);
      53:             np = NULL;
      54:             goto endit;
      55:             }
      56:         if( (leng = iarrlen(np)) < 0)
      57:             {
      58:             error("adjustable in equivalence", np, 0, DCLERR);
      59:             np = NULL;
      60:             goto endit;
      61:             }
      62:         p->eqvbottom = lmin(p->eqvbottom, -offset);
      63:         p->eqvtop = lmax(p->eqvtop, leng-offset);
      64:
      65:         switch(np->vstg)
      66:             {
      67:             case STGUNKNOWN:
      68:             case STGBSS:
      69:             case STGEQUIV:
      70:                 break;
      71:
      72:             case STGCOMMON:
      73:                 comno = np->vardesc.varno;
      74:                 comoffset = np->voffset + offset;
      75:                 break;
      76:
      77:             default:
      78:                 error("bad storage class in equivalence", np, 0, DCLERR);
      79:                 np = NULL;
      80:                 goto endit;
      81:             }
      82:     endit:
      83:         frexpr(offp);
      84:         q->eqvitem = np;
      85:         }
      86:
      87:     if(comno >= 0)
      88:         eqvcommon(p, comno, comoffset);
      89:     else  for(q = p->equivs ; q ; q = q->nextp)
      90:         {
      91:         if(np = q->eqvitem)
      92:             {
      93:             inequiv = NO;
      94:             if(np->vstg==STGEQUIV)
      95:                 if( (ovarno = np->vardesc.varno) == i)
      96:                     {
      97:                     if(np->voffset + q->eqvoffset != 0)
      98:                         error("inconsistent equivalence", np, 0, DCLERR);
      99:                     }
     100:                 else    {
     101:                     offset = np->voffset;
     102:                     inequiv = YES;
     103:                     }
     104:
     105:             np->vstg = STGEQUIV;
     106:             np->vardesc.varno = i;
     107:             np->voffset = - q->eqvoffset;
     108:
     109:             if(inequiv)
     110:                 eqveqv(i, ovarno, q->eqvoffset + offset);
     111:             }
     112:         }
     113:     }
     114:
     115: for(i = 0 ; i < nequiv ; ++i)
     116:     {
     117:     p = & eqvclass[i];
     118:     if(p->eqvbottom!=0 || p->eqvtop!=0)
     119:         {
     120:         for(q = p->equivs ; q; q = q->nextp)
     121:             {
     122:             np = q->eqvitem;
     123:             np->voffset -= p->eqvbottom;
     124:             if(np->voffset % typealign[np->vtype] != 0)
     125:                 error("bad alignment forced by equivalence", np, 0, DCLERR);
     126:             }
     127:         p->eqvtop -= p->eqvbottom;
     128:         p->eqvbottom = 0;
     129:         }
     130:     freqchain(p);
     131:     }
     132: }
     133:
     134:
     135:
     136:
     137:
     138: /* put equivalence chain p at common block comno + comoffset */
     139:
     140: LOCAL eqvcommon(p, comno, comoffset)
     141: struct equivblock *p;
     142: int comno;
     143: ftnint comoffset;
     144: {
     145: int ovarno;
     146: ftnint k, offq;
     147: register struct nameblock *np;
     148: register struct eqvchain *q;
     149:
     150: if(comoffset + p->eqvbottom < 0)
     151:     {
     152:     error("attempt to extend common %s backward",
     153:         nounder(XL, extsymtab[comno].extname) ,0,ERR1);
     154:     freqchain(p);
     155:     return;
     156:     }
     157:
     158: if( (k = comoffset + p->eqvtop) > extsymtab[comno].extleng)
     159:     extsymtab[comno].extleng = k;
     160:
     161: for(q = p->equivs ; q ; q = q->nextp)
     162:     if(np = q->eqvitem)
     163:         {
     164:         switch(np->vstg)
     165:             {
     166:             case STGUNKNOWN:
     167:             case STGBSS:
     168:                 np->vstg = STGCOMMON;
     169:                 np->vardesc.varno = comno;
     170:                 np->voffset = comoffset - q->eqvoffset;
     171:                 break;
     172:
     173:             case STGEQUIV:
     174:                 ovarno = np->vardesc.varno;
     175:                 offq = comoffset - q->eqvoffset - np->voffset;
     176:                 np->vstg = STGCOMMON;
     177:                 np->vardesc.varno = comno;
     178:                 np->voffset = comoffset - q->eqvoffset;
     179:                 if(ovarno != (p - eqvclass))
     180:                     eqvcommon(&eqvclass[ovarno], comno, offq);
     181:                 break;
     182:
     183:             case STGCOMMON:
     184:                 if(comno != np->vardesc.varno ||
     185:                    comoffset != np->voffset+q->eqvoffset)
     186:                     error("inconsistent common usage", np, 0, DCLERR);
     187:                 break;
     188:
     189:
     190:             default:
     191:                 error("eqvcommon: impossible vstg %d", np->vstg,0,FATAL1);
     192:             }
     193:         }
     194:
     195: freqchain(p);
     196: p->eqvbottom = p->eqvtop = 0;
     197: }
     198:
     199:
     200: /* put all items on ovarno chain on front of nvarno chain
     201:  * adjust offsets of ovarno elements and top and bottom of nvarno chain
     202:  */
     203:
     204: LOCAL eqveqv(nvarno, ovarno, delta)
     205: int ovarno, nvarno;
     206: ftnint delta;
     207: {
     208: register struct equivblock *p0, *p;
     209: register struct nameblock *np;
     210: struct eqvchain *q, *q1;
     211:
     212: p0 = eqvclass + nvarno;
     213: p = eqvclass + ovarno;
     214: p0->eqvbottom = lmin(p0->eqvbottom, p->eqvbottom - delta);
     215: p0->eqvtop = lmax(p0->eqvtop, p->eqvtop - delta);
     216: p->eqvbottom = p->eqvtop = 0;
     217:
     218: for(q = p->equivs ; q ; q = q1)
     219:     {
     220:     q1 = q->nextp;
     221:     if( (np = q->eqvitem) && np->vardesc.varno==ovarno)
     222:         {
     223:         q->nextp = p0->equivs;
     224:         p0->equivs = q;
     225:         q->eqvoffset -= delta;
     226:         np->vardesc.varno = nvarno;
     227:         np->voffset -= delta;
     228:         }
     229:     else    free(q);
     230:     }
     231: p->equivs = NULL;
     232: }
     233:
     234:
     235:
     236:
     237: LOCAL freqchain(p)
     238: register struct equivblock *p;
     239: {
     240: register struct eqvchain *q, *oq;
     241:
     242: for(q = p->equivs ; q ; q = oq)
     243:     {
     244:     oq = q->nextp;
     245:     free(q);
     246:     }
     247: p->equivs = NULL;
     248: }
     249:
     250:
     251:
     252:
     253:
     254: LOCAL nsubs(p)
     255: register struct listblock *p;
     256: {
     257: register int n;
     258: register chainp q;
     259:
     260: n = 0;
     261: if(p)
     262:     for(q = p->listp ; q ; q = q->nextp)
     263:         ++n;
     264:
     265: return(n);
     266: }

#### Defined functions

doequiv defined in line 10; used 1 times

- in /usr/src/usr.bin/f77/proc.c line 56

eqvcommon defined in line 140; used 2 times

- in line 88, 180

eqveqv defined in line 204; used 1 times

- in line 110

freqchain defined in line 237; used 3 times

- in line 130, 154, 195

nsubs defined in line 254; used 2 times

- in line 20, 36

Last modified: 1989-06-28 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 733 |