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