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