![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to exec.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / old / efl|
Return to exec.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / old / efl |
1.1 root 1: #include "defs"
2:
3: exlab(n)
4: register int n;
5: {
6: if(n==0 && thisexec->labelno && !(thisexec->labused))
7: {
8: thisexec->labused = 1;
9: n = thisexec->labelno;
10: }
11:
12: if(!prevbg || n!=0) /* avoid empty statement */
13: {
14: if(comments && !afterif) putcomment();
15: putic(ICBEGIN, n);
16: putic(ICINDENT, ctllevel);
17: if(n != 0)
18: if(stnos[n] != 0)
19: fatal("statement number changed");
20: else stnos[n] = ( nxtstno += tailor.deltastno) ;
21: TEST fprintf(diagfile, "LABEL %d\n", n);
22: thisexec->nftnst++;
23: afterif = 0;
24: }
25: }
26:
27:
28: exgoto(n)
29: int n;
30: {
31: exlab(0);
32: exgo1(n);
33: }
34:
35: exgoind(n)
36: int n;
37: {
38: exlab(0);
39: putic(ICKEYWORD,FGOTO);
40: putic(ICINDPTR,n);
41: TEST fprintf(diagfile, "goto indirect %o\n", n);
42: }
43:
44:
45:
46: exgo1(n)
47: int n;
48: {
49: putic(ICKEYWORD,FGOTO);
50: putic(ICLABEL,n);
51: TEST fprintf(diagfile, "goto %d\n", n);
52: }
53:
54:
55: excompgoto(labs,index)
56: ptr labs;
57: register ptr index;
58: {
59: register int first;
60: register ptr p;
61:
62: index = simple(LVAL,index);
63: if(tailor.ftn77)
64: exlab(0);
65: else
66: {
67: int ncases = 0;
68: for(p = labs ; p ; p = p->nextp)
69: ++ncases;
70: exif1( mknode(TLOGOP, OPAND,
71: mknode(TRELOP,OPGT, cpexpr(index), mkint(0)),
72: mknode(TRELOP,OPLE, cpexpr(index), mkint(ncases)) ));
73: }
74:
75: putic(ICKEYWORD, FGOTO);
76: putic(ICOP,OPLPAR);
77:
78: first = 1;
79: for(p = labs ; p ; p = p->nextp)
80: {
81: if(first) first = 0;
82: else putic(ICOP,OPCOMMA);
83: putic(ICLABEL,p->datap);
84: }
85: putic(ICOP,OPRPAR);
86: frchain(&labs);
87:
88: putic(ICOP,OPCOMMA);
89: prexpr(index);
90: frexpr(index);
91: TEST fprintf(diagfile, "computed goto\n");
92: }
93:
94:
95:
96:
97: excall(p)
98: register ptr p;
99: {
100: register ptr q1, q2, q3;
101: ptr mkholl(), exioop();
102:
103: if(p->tag==TNAME || p->tag==TFTNBLOCK)
104: p = mkcall(p, PNULL);
105:
106: if(p->tag == TERROR)
107: {
108: frexpr(p);
109: return;
110: }
111: if(p->tag != TCALL)
112: badtag("excall", p->tag);
113:
114: q1 = p->leftp;
115: q2 = (q1->tag==TFTNBLOCK ? q1 : q1->sthead->varp);
116: if(q2->vtype!=TYUNDEFINED && q2->vtype!=TYSUBR)
117: {
118: dclerr("attempt to use a variable as a subroutine", p->sthead->namep);
119: frexpr(p);
120: return;
121: }
122: q1->vtype = q2->vtype = TYSUBR;
123: if(q1->vdcldone==0)
124: dclit(q1);
125:
126: if(q1->tag == TNAME)
127: {
128: if( equals(q2->sthead->namep, "stop") )
129: {
130: exlab(0);
131: putic(ICKEYWORD, FSTOP);
132: TEST fprintf(diagfile,"stop ");
133: if( (q1 = p->rightp) && (q1 = q1->leftp) )
134: prexpr( simple(RVAL, q1->datap) );
135: goto done;
136: }
137: if( ioop(q2->sthead->namep) )
138: {
139: exioop(p,NO);
140: goto done;
141: }
142: }
143:
144: p = simple(RVAL,p);
145: exlab(0);
146: putic(ICKEYWORD,FCALL);
147: TEST fprintf(diagfile, "call ");
148: /* replace character constant arguments with holleriths */
149: if( (q1=p->rightp) && tailor.hollincall)
150: for(q1 = q1->leftp ; q1 ; q1 = q1->nextp)
151: if( (q2 = q1->datap)->tag==TCONST
152: && q2->vtype==TYCHAR)
153: {
154: q2->vtype = TYHOLLERITH;
155: frexpr(q2->vtypep);
156: q2->vtypep = 0;
157: q2->leftp = mkholl(q3 = q2->leftp);
158: cfree(q3);
159: }
160: prexpr( p );
161:
162: done: frexpr(p);
163: }
164:
165:
166:
167:
168: ptr mkholl(p)
169: register char *p;
170: {
171: register char *q, *t, *s;
172: int n;
173:
174: n = strlen(p);
175: q = convic(n);
176: s = t = calloc(n + 2 + strlen(q) , 1);
177: while(*q)
178: *t++ = *q++;
179: *t++ = 'h';
180: while(*t++ = *p++ )
181: ;
182: return(s);
183: }
184:
185:
186: ptr ifthen()
187: {
188: ptr p;
189: ptr addexec();
190:
191: p = addexec();
192: thisexec->brnchend = 0;
193: if(thisexec->nftnst == 0)
194: {
195: exlab(0);
196: putic(ICKEYWORD,FCONTINUE);
197: thisexec->nftnst = 1;
198: }
199: if(thisexec->nftnst>1 || thisexec->labeled || thisexec->uniffable )
200: {
201: if(thisctl->breaklab == 0)
202: thisctl->breaklab = nextlab();
203: indifs[thisctl->indifn] = thisctl->breaklab;
204: }
205: else thisctl->breaklab = 0;
206: return(p);
207: }
208:
209:
210:
211: exasgn(l,o,r)
212: ptr l;
213: int o;
214: ptr r;
215: {
216: exlab(0);
217: if(l->vdcldone == 0)
218: dclit(l);
219: frexpr( simple(LVAL , mknode(TASGNOP,o,l,r)) );
220: }
221:
222: exretn(p)
223: ptr p;
224: {
225: if(p)
226: {
227: if(procname && procname->vtype && procname->vtype!=TYCHAR &&
228: (procname->vtype!=TYLCOMPLEX || tailor.lngcxtype!=NULL) )
229: {
230: if(p->tag!=TNAME || p->sthead!=procname->sthead)
231: exasgn( cpexpr(procname) , OPASGN, p);
232: }
233: else execerr("can only return values in a function", PNULL);
234: }
235: else if(procname && procname->vtype)
236: warn("function return without data value");
237: exlab(0);
238: putic(ICKEYWORD, FRETURN);
239:
240: TEST {fprintf(diagfile, "exec: return( " ); prexpr(p); fprintf(diagfile, ")\n" ); }
241: }
242:
243:
244: exnull()
245: {
246: if(thisexec->labelno && !(thisexec->labused) )
247: {
248: exlab(0);
249: putic(ICKEYWORD,FCONTINUE);
250: }
251: }
252:
253:
254:
255:
256: exbrk(opnext,levskip,btype)
257: int opnext;
258: ptr levskip;
259: int btype;
260: {
261:
262: if(opnext && (btype==STSWITCH || btype==STPROC))
263: execerr("illegal next", PNULL);
264: else if(!opnext && btype==STPROC)
265: exretn(PNULL);
266: else brknxtlab(opnext,levskip,btype);
267: TEST fprintf(diagfile, "exec: %s\n", (opnext ? "next" : "exit"));
268:
269: }
270:
271:
272:
273: exif(e)
274: register ptr e;
275: {
276: int tag;
277:
278: if( (tag = e->tag)==TERROR || e->vtype!=TYLOG)
279: {
280: frexpr(e);
281: e = mkconst(TYLOG, ".true.");
282: if(tag != TERROR)
283: execerr("non-logical conditional expression in if", PNULL);
284: }
285: TEST fprintf(diagfile, "exif called\n");
286: e = simple(RVAL,e);
287: exlab(0);
288: putic(ICKEYWORD,FIF2);
289: indifs[thisctl->indifn = nextindif()] = 0;
290: putic(ICINDPTR, thisctl->indifn);
291: putic(ICOP,OPLPAR);
292: prexpr(e);
293: putic(ICOP,OPRPAR);
294: putic(ICMARK,0);
295: putic(ICOP,OPLPAR);
296: prexpr(e = simple(RVAL, mknode(TNOTOP,OPNOT,e,PNULL)));
297: putic(ICOP,OPRPAR);
298: putic(ICMARK,0);
299: afterif = 1;
300: frexpr(e);
301: }
302:
303:
304: exifgo(e,l)
305: ptr e;
306: int l;
307: {
308: exlab(0);
309: exif1(e);
310: exgo1(l);
311: }
312:
313:
314: exif1(e)
315: register ptr e;
316: {
317: e = simple(RVAL,e);
318: exlab(0);
319: putic(ICKEYWORD,FIF1);
320: putic(ICOP,OPLPAR);
321: TEST fprintf(diagfile, "if1 ");
322: prexpr( e );
323: frexpr(e);
324: putic(ICOP,OPRPAR);
325: putic(ICBLANK, 1);
326: }
327:
328:
329:
330:
331:
332:
333:
334: brkcase()
335: {
336: ptr bgnexec();
337:
338: if(ncases==0 /* && thisexec->prevexec->brnchend==0 */ )
339: {
340: exbrk(0, PNULL, 0);
341: addexec();
342: bgnexec();
343: }
344: ncases = 1;
345: }
346:
347:
348: brknxtlab(opnext, levp, btype)
349: int opnext;
350: ptr levp;
351: int btype;
352: {
353: register ptr p;
354: int levskip;
355:
356: levskip = ( levp ? convci(levp->leftp) : 1);
357: if(levskip <= 0)
358: {
359: execerr("illegal break count %d", levskip);
360: return;
361: }
362:
363: for(p = thisctl ; p!=0 ; p = p->prevctl)
364: if( (btype==0 || p->subtype==btype) &&
365: p->subtype!=STIF && p->subtype!=STPROC &&
366: (!opnext || p->subtype!=STSWITCH) )
367: if(--levskip == 0) break;
368:
369: if(p == 0)
370: {
371: execerr("invalid break/next", PNULL);
372: return;
373: }
374:
375: if(p->subtype==STREPEAT && opnext)
376: exgoind(p->indifn);
377: else if(opnext)
378: exgoto(p->nextlab);
379: else {
380: if(p->breaklab == 0)
381: p->breaklab = nextlab();
382: exgoto(p->breaklab);
383: }
384: }
385:
386:
387:
388: ptr doloop(p1,p2,p3)
389: ptr p1;
390: ptr p2;
391: ptr p3;
392: {
393: register ptr p, q;
394: register int i;
395: int val[3];
396:
397: p = ALLOC(doblock);
398: p->tag = TDOBLOCK;
399:
400: if(p1->tag!=TASGNOP || p1->subtype!=OPASGN || p1->leftp->tag!=TNAME)
401: {
402: p->dovar = gent(TYINT, PNULL);
403: p->dopar[0] = p1;
404: }
405: else {
406: p->dovar = p1->leftp;
407: p->dopar[0] = p1->rightp;
408: frexpblock(p1);
409: }
410: if(p2 == 0)
411: {
412: p->dopar[1] = p->dopar[0];
413: p->dopar[0] = mkint(1);
414: }
415: else p->dopar[1] = p2;
416: p->dopar[2] = p3;
417:
418: for(i = 0; i<3 ; ++i)
419: {
420: if(q = p->dopar[i])
421: {
422: if( (q->tag==TNAME || q->tag==TTEMP) &&
423: (q->vsubs || q->voffset) )
424: p->dopar[i] = simple(RVAL,mknode(TASGNOP,0,
425: gent(TYINT,PNULL), q));
426: else
427: p->dopar[i] = simple(LVAL, coerce(TYINT, q) );
428:
429: if(isicon(p->dopar[i], &val[i]))
430: {
431: if(val[i] <= 0)
432: execerr("do parameter out of range", PNULL);
433: }
434: else val[i] = -1;
435: }
436: }
437:
438: if(val[0]>0 && val[1]>0 && val[0]>val[1])
439: execerr("do parameters out of order", PNULL);
440: return(p);
441: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.