![[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.