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