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