![[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 / old / f77|
Return to equiv.c CVS log | Up to [CSRG BSD Unix] / 42BSD / old / 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.