|
|
1.1 root 1: #include "defs"
2:
3:
4: hide(p)
5: ptr p;
6: {
7: warn1("Name %s hidden by a new declaration", p->namep);
8: hidlist = mkchain(p->varp, hidlist);
9: p->varp = 0;
10: ++nhid[blklevel];
11: }
12:
13:
14:
15: /* remove all symbol table entries in terminated block,
16: revive old hidden names
17: */
18: unhide()
19: {
20: chainp p;
21: register ptr q;
22: register ptr v;
23: register struct stentry *s;
24: struct stentry **hp;
25:
26: for(hp = hashtab ; hp<hashend ; ++hp)
27: if(s = *hp)
28: {
29: if( (v = s->varp) && v->blklevel == blklevel)
30: {
31: if(v->tag==TLABEL)
32: if(blklevel <= 1)
33: {
34: if(v->labdefined==0)
35: laberr("%s never defined",
36: v->sthead->namep);
37: s->varp = 0;
38: }
39: else { /* move label out a level */
40: if(v->labdefined)
41: v->labinacc = 1;
42: v->blklevel--;
43: ++ndecl[blklevel-1];
44: }
45: else {
46: if(v->tag == TNAME)
47: {
48: TEST fprintf(diagfile,"gone(%s) level %d\n",
49: s->namep, blklevel);
50: gonelist = mkchain(s->varp, gonelist);
51: }
52:
53: else if(v->tag!=TSTRUCT)
54: {
55: ++ndecl[blklevel];
56: if(v->tag==TDEFINE)
57: frdef(v);
58: }
59: s->varp = 0;
60: }
61: --ndecl[blklevel];
62: }
63: }
64:
65: for( p=hidlist ; p && ((v = (q=p->datap)->sthead)->varp==NULL) ; p=hidlist )
66: {
67: v->varp = q;
68: v->tag = q->tag;
69: v->subtype = q->subtype;
70: if(v->blklevel > q->blklevel)
71: v->blklevel = q->blklevel;
72: hidlist = p->nextp;
73: p->nextp = CHNULL;
74: frchain(&p);
75: --nhid[blklevel];
76: TEST fprintf(diagfile, "unhide(%s), blklevel %d\n", v->namep, v->blklevel);
77: }
78: if(ndecl[blklevel] != 0)
79: {
80: sprintf(msg, "%d declarations leftover at block level %d",
81: ndecl[blklevel], blklevel);
82: fatal(msg);
83: }
84: if(nhid[blklevel] != 0)
85: fatal("leftover hidden variables");
86: }
87:
88:
89:
90:
91: ptr bgnexec()
92: {
93: register ptr p;
94:
95: p = allexcblock();
96: p->tag = TEXEC;
97: p->prevexec = thisexec;
98: if(thisexec && thisexec->copylab)
99: {
100: p->labelno = thisexec->labelno;
101: p->labused = thisexec->labused;
102: thisexec->labelno = 0;
103: }
104: thisexec = p;
105: return(p);
106: }
107:
108:
109: ptr addexec()
110: {
111: register ptr p;
112: register ptr q;
113:
114: q = thisexec;
115: p = q->prevexec;
116:
117: if(q->temps)
118: tempvarlist = hookup(q->temps, tempvarlist);
119:
120: p->brnchend = q->brnchend;
121: p->nftnst += q->nftnst;
122: p->labeled |= q->labeled;
123: p->uniffable |= q->uniffable;
124:
125: if(q->labelno && !(q->labused))
126: {
127: if(q->nxtlabno)
128: exnull();
129: else q->nxtlabno = q->labelno;
130: }
131:
132: thisexec = p;
133:
134: if(q->nxtlabno)
135: {
136: if(p->labelno && !(p->labused))
137: exnull();
138: p->labelno = q->nxtlabno;
139: p->labused = 0;
140: }
141:
142: frexcblock(q);
143: return(p);
144: }
145:
146:
147:
148: pushctl(t,vp)
149: int t;
150: register ptr vp;
151: {
152: register ptr q;
153: ptr p;
154: int junk;
155:
156: q = allexcblock();
157: q->tag = TCONTROL;
158: q->subtype = t;
159: q->loopvar = vp;
160: q->prevctl = thisctl;
161: thisctl = q;
162:
163: switch(t)
164: {
165: case STSWITCH:
166: q->xlab = nextlab();
167: q->nextlab = 0;
168: exgoto(q->xlab);
169: ncases = -1;
170: break;
171:
172: case STFOR:
173: exlab(0);
174: q->nextlab = nextlab();
175: q->xlab = nextlab();
176: break;
177:
178: case STWHILE:
179: q->nextlab = thislab();
180: if(vp)
181: exifgo( mknode(TNOTOP,OPNOT,vp,PNULL),
182: q->breaklab = nextlab() );
183: else thisexec->copylab = 1;
184: break;
185:
186: case STREPEAT:
187: exnull();
188: q->xlab = thislab();
189: thisexec->copylab = 1;
190: junk = nextindif();
191: indifs[junk] = 0;
192: q->indifn = junk;
193: indifs[q->indifn] = q->xlab;
194: break;
195:
196: case STDO:
197: q->nextlab = nextlab();
198: exlab(0);
199: putic(ICKEYWORD,FDO);
200: putic(ICLABEL, q->nextlab);
201: putic(ICBLANK, 1);
202: p = mknode(TASGNOP,OPASGN,vp->dovar,vp->dopar[0]);
203: prexpr(p);
204: frexpr(p);
205: putic(ICOP, OPCOMMA);
206: prexpr(vp->dopar[1]);
207: frexpr(vp->dopar[1]);
208: if(vp->dopar[2])
209: {
210: putic(ICOP, OPCOMMA);
211: prexpr(vp->dopar[2]);
212: frexpr(vp->dopar[2]);
213: }
214: cfree(vp);
215: break;
216:
217: case STIF:
218: exif(vp);
219: thisexec->nftnst = 0;
220: break;
221:
222: default:
223: fatal1("pushctl: invalid control block type %d", t);
224: }
225:
226: ++ctllevel;
227: }
228:
229:
230:
231: popctl()
232: {
233: register ptr p;
234: ptr newp;
235: chainp q;
236: int first, deflabno, blab, cmin, cmax, range, caseval, optcase;
237: int labp[MAXSWITCH];
238:
239: if(thisctl == 0)
240: fatal("empty control stack popped");
241:
242: switch(thisctl->subtype)
243: {
244: case STSWITCH:
245: /* if(thisexec->brnchend == 0) */
246: {
247: if(thisctl->breaklab == 0)
248: thisctl->breaklab = nextlab();
249: exgoto(thisctl->breaklab);
250: }
251: exlab(thisctl->xlab);
252: deflabno = 0;
253: first = YES;
254: optcase = (thisctl->loopvar->vtype == TYINT);
255:
256: for(p=thisctl->loopctl ; p!=0 ; p = p->nextcase)
257: if(p->labdefined == 0)
258: {
259: laberr("undefined case label", CNULL);
260: optcase = NO;
261: }
262: else if(p->casexpr == 0)
263: deflabno = p->labelno;
264: else if( isicon(p->casexpr, &caseval))
265: {
266: if(first)
267: {
268: first = NO;
269: cmin = cmax = caseval;
270: }
271: else {
272: if(caseval < cmin)
273: cmin = caseval;
274: if(caseval > cmax)
275: cmax = caseval;
276: }
277: ++ncases;
278: }
279: else optcase = NO;
280:
281: range = cmax - cmin + 1;
282: if(optcase && ncases>2 && range<2*ncases && range<MAXSWITCH)
283: {
284: register int i;
285: for(i=0; i<range ; ++i)
286: labp[i] = 0;
287: for(p=thisctl->loopctl ; p!=0 ; p = p->nextcase)
288: if(p->labdefined && p->casexpr)
289: {
290: isicon(p->casexpr, &caseval);
291: frexpr(p->casexpr);
292: labp[caseval-cmin] = p->labelno;
293: }
294:
295: q = CHNULL;
296: blab = (deflabno ? deflabno : thisctl->breaklab);
297: for(i=range-1 ; i>=0 ; --i)
298: q = mkchain(labp[i] ? labp[i] : blab, q);
299: excompgoto(q, mknode(TAROP,OPPLUS, mkint(1-cmin),
300: cpexpr(thisctl->loopvar) ));
301: }
302: else {
303: for(p=thisctl->loopctl ; p!=0 ; p = p->nextcase)
304: if(p->labdefined && p->casexpr)
305: exifgo( mknode(TRELOP,OPEQ,
306: cpexpr(thisctl->loopvar),p->casexpr),
307: p->labelno);
308: }
309: if(deflabno)
310: exgoto(deflabno);
311:
312: for(p = thisctl->loopctl ; p; p = newp)
313: {
314: newp = p->nextcase;
315: cfree(p);
316: }
317: thisctl->loopctl = NULL;
318: break;
319:
320: case STFOR:
321: exgoto(thisctl->nextlab);
322: break;
323:
324: case STWHILE:
325: exgoto(thisctl->nextlab);
326: break;
327:
328: case STREPEAT:
329: break;
330:
331: case STDO:
332: exnull();
333: exlab(thisctl->nextlab);
334: putic(ICKEYWORD,FCONTINUE);
335: break;
336:
337: case STIF:
338: break;
339:
340: case STPROC:
341: break;
342:
343: default:
344: fatal1("popctl: invalid control block type %d",
345: thisctl->subtype);
346: }
347:
348: if(thisctl->breaklab != 0)
349: thisexec->nxtlabno = thisctl->breaklab;
350: p = thisctl->prevctl;
351: frexcblock(thisctl);
352: thisctl = p;
353: --ctllevel;
354: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.