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