![[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] / 43BSD / usr.bin / f77 / src / f77pass1|
Return to equiv.c CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.bin / f77 / src / f77pass1 |
1.1 root 1: /*
2: * Copyright (c) 1980 Regents of the University of California.
3: * All rights reserved. The Berkeley software License Agreement
4: * specifies the terms and conditions for redistribution.
5: */
6:
7: #ifndef lint
8: static char *sccsid[] = "@(#)equiv.c 5.1 (Berkeley) 6/7/85";
9: #endif not lint
10:
11: /*
12: * equiv.c
13: *
14: * Routines related to equivalence class processing, f77 compiler, 4.2 BSD.
15: *
16: * University of Utah CS Dept modification history:
17: *
18: * Revision 3.2 85/01/14 00:14:12 donn
19: * Fixed bug in eqvcommon that was causing the calculations of multilevel
20: * equivalences to be screwed up.
21: *
22: * Revision 3.1 84/10/13 01:16:08 donn
23: * Installed Jerry Berkman's version; added UofU comment header.
24: *
25: */
26:
27:
28: #include "defs.h"
29:
30: #ifdef SDB
31: # include <a.out.h>
32: # ifndef N_SO
33: # include <stab.h>
34: # endif
35: #endif
36:
37: /* called at end of declarations section to process chains
38: created by EQUIVALENCE statements
39: */
40:
41: doequiv()
42: {
43: register int i;
44: int inequiv, comno, ovarno;
45: ftnint comoffset, offset, leng;
46: register struct Equivblock *p;
47: register struct Eqvchain *q;
48: struct Primblock *itemp;
49: register Namep np;
50: expptr offp, suboffset();
51: int ns, nsubs();
52: chainp cp;
53: char *memname();
54: int doeqverr = 0;
55:
56: for(i = 0 ; i < nequiv ; ++i)
57: {
58: p = &eqvclass[i];
59: p->eqvbottom = p->eqvtop = 0;
60: comno = -1;
61:
62: for(q = p->equivs ; q ; q = q->eqvnextp)
63: {
64: offset = 0;
65: itemp = q->eqvitem.eqvlhs;
66: if( itemp == NULL ) fatal("error processing equivalence");
67: equivdcl = YES;
68: vardcl(np = itemp->namep);
69: equivdcl = NO;
70: if(itemp->argsp || itemp->fcharp)
71: {
72: if(np->vdim!=NULL && np->vdim->ndim>1 &&
73: nsubs(itemp->argsp)==1 )
74: {
75: if(! ftn66flag)
76: warn("1-dim subscript in EQUIVALENCE");
77: cp = NULL;
78: ns = np->vdim->ndim;
79: while(--ns > 0)
80: cp = mkchain( ICON(1), cp);
81: itemp->argsp->listp->nextp = cp;
82: }
83:
84: offp = suboffset(itemp);
85: if(ISICON(offp))
86: offset = offp->constblock.const.ci;
87: else {
88: dclerr("illegal subscript in equivalence ",
89: np);
90: np = NULL;
91: doeqverr = 1;
92: }
93: frexpr(offp);
94: }
95: frexpr(itemp);
96:
97: if(np && (leng = iarrlen(np))<0)
98: {
99: dclerr("argument in equivalence", np);
100: np = NULL;
101: doeqverr =1;
102: }
103:
104: if(np) switch(np->vstg)
105: {
106: case STGUNKNOWN:
107: case STGBSS:
108: case STGEQUIV:
109: break;
110:
111: case STGCOMMON:
112: comno = np->vardesc.varno;
113: comoffset = np->voffset + offset;
114: break;
115:
116: default:
117: dclerr("bad storage class in equivalence", np);
118: np = NULL;
119: doeqverr = 1;
120: break;
121: }
122:
123: if(np)
124: {
125: q->eqvoffset = offset;
126: p->eqvbottom = lmin(p->eqvbottom, -offset);
127: p->eqvtop = lmax(p->eqvtop, leng-offset);
128: }
129: q->eqvitem.eqvname = np;
130: }
131:
132: if(comno >= 0)
133: eqvcommon(p, comno, comoffset);
134: else for(q = p->equivs ; q ; q = q->eqvnextp)
135: {
136: if(np = q->eqvitem.eqvname)
137: {
138: inequiv = NO;
139: if(np->vstg==STGEQUIV)
140: if( (ovarno = np->vardesc.varno) == i)
141: {
142: if(np->voffset + q->eqvoffset != 0)
143: dclerr("inconsistent equivalence", np);
144: doeqverr = 1;
145: }
146: else {
147: offset = np->voffset;
148: inequiv = YES;
149: }
150:
151: np->vstg = STGEQUIV;
152: np->vardesc.varno = i;
153: np->voffset = - q->eqvoffset;
154:
155: if(inequiv)
156: eqveqv(i, ovarno, q->eqvoffset + offset);
157: }
158: }
159: }
160:
161: if( !doeqverr )
162: for(i = 0 ; i < nequiv ; ++i)
163: {
164: p = & eqvclass[i];
165: if(p->eqvbottom!=0 || p->eqvtop!=0) /* a live chain */
166: {
167: for(q = p->equivs ; q; q = q->eqvnextp)
168: {
169: np = q->eqvitem.eqvname;
170: np->voffset -= p->eqvbottom;
171: if(np->voffset % typealign[np->vtype] != 0)
172: dclerr("bad alignment forced by equivalence", np);
173: }
174: p->eqvtop -= p->eqvbottom;
175: p->eqvbottom = 0;
176: }
177: freqchain(p);
178: }
179: }
180:
181:
182:
183:
184:
185: /* put equivalence chain p at common block comno + comoffset */
186:
187: LOCAL eqvcommon(p, comno, comoffset)
188: struct Equivblock *p;
189: int comno;
190: ftnint comoffset;
191: {
192: int ovarno;
193: ftnint k, offq;
194: register Namep np;
195: register struct Eqvchain *q;
196:
197: if(comoffset + p->eqvbottom < 0)
198: {
199: errstr("attempt to extend common %s backward",
200: nounder(XL, extsymtab[comno].extname) );
201: freqchain(p);
202: return;
203: }
204:
205: if( (k = comoffset + p->eqvtop) > extsymtab[comno].extleng)
206: extsymtab[comno].extleng = k;
207:
208: #ifdef SDB
209: if(sdbflag)
210: prstab( varstr(XL,extsymtab[comno].extname), N_BCOMM,0,0);
211: #endif
212:
213: for(q = p->equivs ; q ; q = q->eqvnextp)
214: if(np = q->eqvitem.eqvname)
215: {
216: switch(np->vstg)
217: {
218: case STGUNKNOWN:
219: case STGBSS:
220: np->vstg = STGCOMMON;
221: np->vardesc.varno = comno;
222: np->voffset = comoffset - q->eqvoffset;
223: #ifdef SDB
224: if(sdbflag)
225: {
226: namestab(np);
227: }
228: #endif
229: break;
230:
231: case STGEQUIV:
232: ovarno = np->vardesc.varno;
233: offq = comoffset - q->eqvoffset - np->voffset;
234: np->vstg = STGCOMMON;
235: np->vardesc.varno = comno;
236: np->voffset = comoffset + q->eqvoffset;
237: if(ovarno != (p - eqvclass))
238: eqvcommon(&eqvclass[ovarno], comno, offq);
239: #ifdef SDB
240: if(sdbflag)
241: {
242: namestab(np);
243: }
244: #endif
245: break;
246:
247: case STGCOMMON:
248: if(comno != np->vardesc.varno ||
249: comoffset != np->voffset+q->eqvoffset)
250: dclerr("inconsistent common usage", np);
251: break;
252:
253:
254: default:
255: badstg("eqvcommon", np->vstg);
256: }
257: }
258:
259: #ifdef SDB
260: if(sdbflag)
261: prstab( varstr(XL,extsymtab[comno].extname), N_ECOMM,0,0);
262: #endif
263:
264: freqchain(p);
265: p->eqvbottom = p->eqvtop = 0;
266: }
267:
268:
269: /* put all items on ovarno chain on front of nvarno chain
270: * adjust offsets of ovarno elements and top and bottom of nvarno chain
271: */
272:
273: LOCAL eqveqv(nvarno, ovarno, delta)
274: int ovarno, nvarno;
275: ftnint delta;
276: {
277: register struct Equivblock *p0, *p;
278: register Namep np;
279: struct Eqvchain *q, *q1;
280:
281: p0 = eqvclass + nvarno;
282: p = eqvclass + ovarno;
283: p0->eqvbottom = lmin(p0->eqvbottom, p->eqvbottom - delta);
284: p0->eqvtop = lmax(p0->eqvtop, p->eqvtop - delta);
285: p->eqvbottom = p->eqvtop = 0;
286:
287: for(q = p->equivs ; q ; q = q1)
288: {
289: q1 = q->eqvnextp;
290: if( (np = q->eqvitem.eqvname) && np->vardesc.varno==ovarno)
291: {
292: q->eqvnextp = p0->equivs;
293: p0->equivs = q;
294: q->eqvoffset -= delta;
295: np->vardesc.varno = nvarno;
296: np->voffset -= delta;
297: }
298: else free( (charptr) q);
299: }
300: p->equivs = NULL;
301: }
302:
303:
304:
305:
306: LOCAL freqchain(p)
307: register struct Equivblock *p;
308: {
309: register struct Eqvchain *q, *oq;
310:
311: for(q = p->equivs ; q ; q = oq)
312: {
313: oq = q->eqvnextp;
314: free( (charptr) q);
315: }
316: p->equivs = NULL;
317: }
318:
319:
320:
321:
322:
323: LOCAL nsubs(p)
324: register struct Listblock *p;
325: {
326: register int n;
327: register chainp q;
328:
329: n = 0;
330: if(p)
331: for(q = p->listp ; q ; q = q->nextp)
332: ++n;
333:
334: return(n);
335: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.