![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to equiv.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1|
Return to equiv.c CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1 |
1.1 ! root 1: #include "defs.h" ! 2: ! 3: #ifdef SDB ! 4: # include <a.out.h> ! 5: # ifndef N_SO ! 6: # include <stab.h> ! 7: # endif ! 8: #endif ! 9: ! 10: /* ROUTINES RELATED TO EQUIVALENCE CLASS PROCESSING */ ! 11: ! 12: /* called at end of declarations section to process chains ! 13: created by EQUIVALENCE statements ! 14: */ ! 15: ! 16: doequiv() ! 17: { ! 18: register int i; ! 19: int inequiv, comno, ovarno; ! 20: ftnint comoffset, offset, leng; ! 21: register struct Equivblock *p; ! 22: register struct Eqvchain *q; ! 23: struct Primblock *itemp; ! 24: register Namep np; ! 25: expptr offp, suboffset(); ! 26: int ns, nsubs(); ! 27: chainp cp; ! 28: char *memname(); ! 29: ! 30: for(i = 0 ; i < nequiv ; ++i) ! 31: { ! 32: p = &eqvclass[i]; ! 33: p->eqvbottom = p->eqvtop = 0; ! 34: comno = -1; ! 35: ! 36: for(q = p->equivs ; q ; q = q->eqvnextp) ! 37: { ! 38: offset = 0; ! 39: itemp = q->eqvitem.eqvlhs; ! 40: equivdcl = YES; ! 41: vardcl(np = itemp->namep); ! 42: equivdcl = NO; ! 43: if(itemp->argsp || itemp->fcharp) ! 44: { ! 45: if(np->vdim!=NULL && np->vdim->ndim>1 && ! 46: nsubs(itemp->argsp)==1 ) ! 47: { ! 48: if(! ftn66flag) ! 49: warn("1-dim subscript in EQUIVALENCE"); ! 50: cp = NULL; ! 51: ns = np->vdim->ndim; ! 52: while(--ns > 0) ! 53: cp = mkchain( ICON(1), cp); ! 54: itemp->argsp->listp->nextp = cp; ! 55: } ! 56: ! 57: offp = suboffset(itemp); ! 58: if(ISICON(offp)) ! 59: offset = offp->constblock.const.ci; ! 60: else { ! 61: dclerr("nonconstant subscript in equivalence ", ! 62: np); ! 63: np = NULL; ! 64: } ! 65: frexpr(offp); ! 66: } ! 67: frexpr(itemp); ! 68: ! 69: if(np && (leng = iarrlen(np))<0) ! 70: { ! 71: dclerr("adjustable in equivalence", np); ! 72: np = NULL; ! 73: } ! 74: ! 75: if(np) switch(np->vstg) ! 76: { ! 77: case STGUNKNOWN: ! 78: case STGBSS: ! 79: case STGEQUIV: ! 80: break; ! 81: ! 82: case STGCOMMON: ! 83: comno = np->vardesc.varno; ! 84: comoffset = np->voffset + offset; ! 85: break; ! 86: ! 87: default: ! 88: dclerr("bad storage class in equivalence", np); ! 89: np = NULL; ! 90: break; ! 91: } ! 92: ! 93: if(np) ! 94: { ! 95: q->eqvoffset = offset; ! 96: p->eqvbottom = lmin(p->eqvbottom, -offset); ! 97: p->eqvtop = lmax(p->eqvtop, leng-offset); ! 98: } ! 99: q->eqvitem.eqvname = np; ! 100: } ! 101: ! 102: if(comno >= 0) ! 103: eqvcommon(p, comno, comoffset); ! 104: else for(q = p->equivs ; q ; q = q->eqvnextp) ! 105: { ! 106: if(np = q->eqvitem.eqvname) ! 107: { ! 108: inequiv = NO; ! 109: if(np->vstg==STGEQUIV) ! 110: if( (ovarno = np->vardesc.varno) == i) ! 111: { ! 112: if(np->voffset + q->eqvoffset != 0) ! 113: dclerr("inconsistent equivalence", np); ! 114: } ! 115: else { ! 116: offset = np->voffset; ! 117: inequiv = YES; ! 118: } ! 119: ! 120: np->vstg = STGEQUIV; ! 121: np->vardesc.varno = i; ! 122: np->voffset = - q->eqvoffset; ! 123: ! 124: if(inequiv) ! 125: eqveqv(i, ovarno, q->eqvoffset + offset); ! 126: } ! 127: } ! 128: } ! 129: ! 130: for(i = 0 ; i < nequiv ; ++i) ! 131: { ! 132: p = & eqvclass[i]; ! 133: if(p->eqvbottom!=0 || p->eqvtop!=0) /* a live chain */ ! 134: { ! 135: for(q = p->equivs ; q; q = q->eqvnextp) ! 136: { ! 137: np = q->eqvitem.eqvname; ! 138: np->voffset -= p->eqvbottom; ! 139: if(np->voffset % typealign[np->vtype] != 0) ! 140: dclerr("bad alignment forced by equivalence", np); ! 141: } ! 142: p->eqvtop -= p->eqvbottom; ! 143: p->eqvbottom = 0; ! 144: } ! 145: freqchain(p); ! 146: } ! 147: } ! 148: ! 149: ! 150: ! 151: ! 152: ! 153: /* put equivalence chain p at common block comno + comoffset */ ! 154: ! 155: LOCAL eqvcommon(p, comno, comoffset) ! 156: struct Equivblock *p; ! 157: int comno; ! 158: ftnint comoffset; ! 159: { ! 160: int ovarno; ! 161: ftnint k, offq; ! 162: register Namep np; ! 163: register struct Eqvchain *q; ! 164: ! 165: if(comoffset + p->eqvbottom < 0) ! 166: { ! 167: errstr("attempt to extend common %s backward", ! 168: nounder(XL, extsymtab[comno].extname) ); ! 169: freqchain(p); ! 170: return; ! 171: } ! 172: ! 173: if( (k = comoffset + p->eqvtop) > extsymtab[comno].extleng) ! 174: extsymtab[comno].extleng = k; ! 175: ! 176: #ifdef SDB ! 177: if(sdbflag) ! 178: prstab( varstr(XL,extsymtab[comno].extname), N_BCOMM,0,0); ! 179: #endif ! 180: ! 181: for(q = p->equivs ; q ; q = q->eqvnextp) ! 182: if(np = q->eqvitem.eqvname) ! 183: { ! 184: switch(np->vstg) ! 185: { ! 186: case STGUNKNOWN: ! 187: case STGBSS: ! 188: np->vstg = STGCOMMON; ! 189: np->vardesc.varno = comno; ! 190: np->voffset = comoffset - q->eqvoffset; ! 191: #ifdef SDB ! 192: if(sdbflag) ! 193: { ! 194: namestab(np); ! 195: } ! 196: #endif ! 197: break; ! 198: ! 199: case STGEQUIV: ! 200: ovarno = np->vardesc.varno; ! 201: offq = comoffset - q->eqvoffset - np->voffset; ! 202: np->vstg = STGCOMMON; ! 203: np->vardesc.varno = comno; ! 204: np->voffset = comoffset - q->eqvoffset; ! 205: if(ovarno != (p - eqvclass)) ! 206: eqvcommon(&eqvclass[ovarno], comno, offq); ! 207: #ifdef SDB ! 208: if(sdbflag) ! 209: { ! 210: namestab(np); ! 211: } ! 212: #endif ! 213: break; ! 214: ! 215: case STGCOMMON: ! 216: if(comno != np->vardesc.varno || ! 217: comoffset != np->voffset+q->eqvoffset) ! 218: dclerr("inconsistent common usage", np); ! 219: break; ! 220: ! 221: ! 222: default: ! 223: badstg("eqvcommon", np->vstg); ! 224: } ! 225: } ! 226: ! 227: #ifdef SDB ! 228: if(sdbflag) ! 229: prstab( varstr(XL,extsymtab[comno].extname), N_ECOMM,0,0); ! 230: #endif ! 231: ! 232: freqchain(p); ! 233: p->eqvbottom = p->eqvtop = 0; ! 234: } ! 235: ! 236: ! 237: /* put all items on ovarno chain on front of nvarno chain ! 238: * adjust offsets of ovarno elements and top and bottom of nvarno chain ! 239: */ ! 240: ! 241: LOCAL eqveqv(nvarno, ovarno, delta) ! 242: int ovarno, nvarno; ! 243: ftnint delta; ! 244: { ! 245: register struct Equivblock *p0, *p; ! 246: register Namep np; ! 247: struct Eqvchain *q, *q1; ! 248: ! 249: p0 = eqvclass + nvarno; ! 250: p = eqvclass + ovarno; ! 251: p0->eqvbottom = lmin(p0->eqvbottom, p->eqvbottom - delta); ! 252: p0->eqvtop = lmax(p0->eqvtop, p->eqvtop - delta); ! 253: p->eqvbottom = p->eqvtop = 0; ! 254: ! 255: for(q = p->equivs ; q ; q = q1) ! 256: { ! 257: q1 = q->eqvnextp; ! 258: if( (np = q->eqvitem.eqvname) && np->vardesc.varno==ovarno) ! 259: { ! 260: q->eqvnextp = p0->equivs; ! 261: p0->equivs = q; ! 262: q->eqvoffset -= delta; ! 263: np->vardesc.varno = nvarno; ! 264: np->voffset -= delta; ! 265: } ! 266: else free( (charptr) q); ! 267: } ! 268: p->equivs = NULL; ! 269: } ! 270: ! 271: ! 272: ! 273: ! 274: LOCAL freqchain(p) ! 275: register struct Equivblock *p; ! 276: { ! 277: register struct Eqvchain *q, *oq; ! 278: ! 279: for(q = p->equivs ; q ; q = oq) ! 280: { ! 281: oq = q->eqvnextp; ! 282: free( (charptr) q); ! 283: } ! 284: p->equivs = NULL; ! 285: } ! 286: ! 287: ! 288: ! 289: ! 290: ! 291: LOCAL nsubs(p) ! 292: register struct Listblock *p; ! 293: { ! 294: register int n; ! 295: register chainp q; ! 296: ! 297: n = 0; ! 298: if(p) ! 299: for(q = p->listp ; q ; q = q->nextp) ! 300: ++n; ! 301: ! 302: return(n); ! 303: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.