![[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] / 3BSD / cmd / f77|
Return to exec.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / f77 |
1.1 root 1: #include "defs"
2:
3: /* Logical IF codes
4: */
5:
6:
7: exif(p)
8: expptr p;
9: {
10: pushctl(CTLIF);
11: ctlstack->elselabel = newlabel();
12: putif(p, ctlstack->elselabel);
13: }
14:
15:
16:
17: exelif(p)
18: expptr p;
19: {
20: if(ctlstack->ctltype == CTLIF)
21: {
22: if(ctlstack->endlabel == 0)
23: ctlstack->endlabel = newlabel();
24: putgoto(ctlstack->endlabel);
25: putlabel(ctlstack->elselabel);
26: ctlstack->elselabel = newlabel();
27: putif(p, ctlstack->elselabel);
28: }
29:
30: else execerr("elseif out of place", 0);
31: }
32:
33:
34:
35:
36:
37: exelse()
38: {
39: if(ctlstack->ctltype==CTLIF)
40: {
41: if(ctlstack->endlabel == 0)
42: ctlstack->endlabel = newlabel();
43: putgoto( ctlstack->endlabel );
44: putlabel(ctlstack->elselabel);
45: ctlstack->ctltype = CTLELSE;
46: }
47:
48: else execerr("else out of place", 0);
49: }
50:
51:
52: exendif()
53: {
54: if(ctlstack->ctltype == CTLIF)
55: {
56: putlabel(ctlstack->elselabel);
57: if(ctlstack->endlabel)
58: putlabel(ctlstack->endlabel);
59: popctl();
60: }
61: else if(ctlstack->ctltype == CTLELSE)
62: {
63: putlabel(ctlstack->endlabel);
64: popctl();
65: }
66:
67: else
68: execerr("endif out of place", 0);
69: }
70:
71:
72:
73: LOCAL pushctl(code)
74: int code;
75: {
76: register int i;
77:
78: if(++ctlstack >= lastctl)
79: many("loops or if-then-elses", 'c');
80: ctlstack->ctltype = code;
81: for(i = 0 ; i < 4 ; ++i)
82: ctlstack->ctlabels[i] = 0;
83: ++blklevel;
84: }
85:
86:
87: LOCAL popctl()
88: {
89: if( ctlstack-- < ctls )
90: fatal("control stack empty");
91: --blklevel;
92: }
93:
94:
95:
96: LOCAL poplab()
97: {
98: register struct Labelblock *lp;
99:
100: for(lp = labeltab ; lp < highlabtab ; ++lp)
101: if(lp->labdefined)
102: {
103: /* mark all labels in inner blocks unreachable */
104: if(lp->blklevel > blklevel)
105: lp->labinacc = YES;
106: }
107: else if(lp->blklevel > blklevel)
108: {
109: /* move all labels referred to in inner blocks out a level */
110: lp->blklevel = blklevel;
111: }
112: }
113:
114:
115:
116: /* BRANCHING CODE
117: */
118:
119: exgoto(lab)
120: struct Labelblock *lab;
121: {
122: putgoto(lab->labelno);
123: }
124:
125:
126:
127:
128:
129:
130:
131: exequals(lp, rp)
132: register struct Primblock *lp;
133: register expptr rp;
134: {
135: if(lp->tag != TPRIM)
136: {
137: err("assignment to a non-variable");
138: frexpr(lp);
139: frexpr(rp);
140: }
141: else if(lp->namep->vclass!=CLVAR && lp->argsp)
142: {
143: if(parstate >= INEXEC)
144: err("statement function amid executables");
145: else
146: mkstfunct(lp, rp);
147: }
148: else
149: {
150: if(parstate < INDATA)
151: enddcl();
152: puteq(mklhs(lp), rp);
153: }
154: }
155:
156:
157:
158: mkstfunct(lp, rp)
159: struct Primblock *lp;
160: expptr rp;
161: {
162: register struct Primblock *p;
163: register struct Nameblock *np;
164: chainp args;
165:
166: np = lp->namep;
167: if(np->vclass == CLUNKNOWN)
168: np->vclass = CLPROC;
169: else
170: {
171: dclerr("redeclaration of statement function", np);
172: return;
173: }
174: np->vprocclass = PSTFUNCT;
175: np->vstg = STGSTFUNCT;
176: impldcl(np);
177: args = (lp->argsp ? lp->argsp->listp : NULL);
178: np->vardesc.vstfdesc = mkchain(args , rp );
179:
180: for( ; args ; args = args->nextp)
181: if( (p = args->datap)->tag!=TPRIM ||
182: p->argsp || p->fcharp || p->lcharp)
183: err("non-variable argument in statement function definition");
184: else
185: {
186: vardcl(args->datap = p->namep);
187: free(p);
188: }
189: }
190:
191:
192:
193: excall(name, args, nstars, labels)
194: struct Hashentry *name;
195: struct Listblock *args;
196: int nstars;
197: struct Labelblock *labels[ ];
198: {
199: register expptr p;
200:
201: settype(name, TYSUBR, NULL);
202: p = mkfunct( mkprim(name, args, NULL, NULL) );
203: p->exprblock.vtype = p->exprblock.leftp->headblock.vtype = TYINT;
204: if(nstars > 0)
205: putcmgo(p, nstars, labels);
206: else putexpr(p);
207: }
208:
209:
210:
211: exstop(stop, p)
212: int stop;
213: register expptr p;
214: {
215: char *q;
216: int n;
217: struct Constblock *mkstrcon();
218:
219: if(p)
220: {
221: if( ! ISCONST(p) )
222: {
223: execerr("pause/stop argument must be constant", 0);
224: frexpr(p);
225: p = mkstrcon(0, 0);
226: }
227: else if( ISINT(p->constblock.vtype) )
228: {
229: q = convic(p->constblock.const.ci);
230: n = strlen(q);
231: if(n > 0)
232: {
233: p->constblock.const.ccp = copyn(n, q);
234: p->constblock.vtype = TYCHAR;
235: p->constblock.vleng = ICON(n);
236: }
237: else
238: p = mkstrcon(0, 0);
239: }
240: else if(p->constblock.vtype != TYCHAR)
241: {
242: execerr("pause/stop argument must be integer or string", 0);
243: p = mkstrcon(0, 0);
244: }
245: }
246: else p = mkstrcon(0, 0);
247:
248: putexpr( call1(TYSUBR, (stop ? "s_stop" : "s_paus"), p) );
249: }
250:
251: /* DO LOOP CODE */
252:
253: #define DOINIT par[0]
254: #define DOLIMIT par[1]
255: #define DOINCR par[2]
256:
257: #define VARSTEP 0
258: #define POSSTEP 1
259: #define NEGSTEP 2
260:
261:
262: exdo(range, spec)
263: int range;
264: chainp spec;
265: {
266: register expptr p, q;
267: expptr *q1;
268: register struct Nameblock *np;
269: chainp cp;
270: register int i;
271: int dotype, incsign;
272: struct Addrblock *dovarp, *dostgp;
273: expptr par[3];
274:
275: pushctl(CTLDO);
276: dorange = ctlstack->dolabel = range;
277: np = spec->datap;
278: ctlstack->donamep = NULL;
279: if(np->vdovar)
280: {
281: errstr("nested loops with variable %s", varstr(VL,np->varname));
282: ctlstack->donamep = NULL;
283: return;
284: }
285:
286: dovarp = mklhs( mkprim(np, 0,0,0) );
287: if( ! ONEOF(dovarp->vtype, MSKINT|MSKREAL) )
288: {
289: err("bad type on do variable");
290: return;
291: }
292: ctlstack->donamep = np;
293:
294: np->vdovar = YES;
295: if( enregister(np) )
296: {
297: /* stgp points to a storage version, varp to a register version */
298: dostgp = dovarp;
299: dovarp = mklhs( mkprim(np, 0,0,0) );
300: }
301: else
302: dostgp = NULL;
303: dotype = dovarp->vtype;
304:
305: for(i=0 , cp = spec->nextp ; cp!=NULL && i<3 ; cp = cp->nextp)
306: {
307: p = par[i++] = fixtype(cp->datap);
308: if( ! ONEOF(p->headblock.vtype, MSKINT|MSKREAL) )
309: {
310: err("bad type on DO parameter");
311: return;
312: }
313: }
314:
315: frchain(&spec);
316: switch(i)
317: {
318: case 0:
319: case 1:
320: err("too few DO parameters");
321: return;
322:
323: default:
324: err("too many DO parameters");
325: return;
326:
327: case 2:
328: DOINCR = ICON(1);
329:
330: case 3:
331: break;
332: }
333:
334: ctlstack->endlabel = newlabel();
335: ctlstack->dobodylabel = newlabel();
336:
337: if( ISCONST(DOLIMIT) )
338: ctlstack->domax = mkconv(dotype, DOLIMIT);
339: else
340: ctlstack->domax = mktemp(dotype, NULL);
341:
342: if( ISCONST(DOINCR) )
343: {
344: ctlstack->dostep = mkconv(dotype, DOINCR);
345: if( (incsign = conssgn(ctlstack->dostep)) == 0)
346: err("zero DO increment");
347: ctlstack->dostepsign = (incsign > 0 ? POSSTEP : NEGSTEP);
348: }
349: else
350: {
351: ctlstack->dostep = mktemp(dotype, NULL);
352: ctlstack->dostepsign = VARSTEP;
353: ctlstack->doposlabel = newlabel();
354: ctlstack->doneglabel = newlabel();
355: }
356:
357: if( ISCONST(ctlstack->domax) && ISCONST(DOINIT) && ctlstack->dostepsign!=VARSTEP)
358: {
359: puteq(cpexpr(dovarp), cpexpr(DOINIT));
360: if( onetripflag )
361: frexpr(DOINIT);
362: else
363: {
364: q = mkexpr(OPPLUS, ICON(1),
365: mkexpr(OPMINUS, cpexpr(ctlstack->domax), cpexpr(DOINIT)) );
366: if(incsign != conssgn(q))
367: {
368: warn("DO range never executed");
369: putgoto(ctlstack->endlabel);
370: }
371: frexpr(q);
372: }
373: }
374: else if(ctlstack->dostepsign!=VARSTEP && !onetripflag)
375: {
376: if( ISCONST(ctlstack->domax) )
377: q = cpexpr(ctlstack->domax);
378: else
379: q = mkexpr(OPASSIGN, cpexpr(ctlstack->domax), DOLIMIT);
380:
381: q1 = mkexpr(OPASSIGN, cpexpr(dovarp), DOINIT);
382: q = mkexpr( (ctlstack->dostepsign==POSSTEP ? OPLE : OPGE), q1, q);
383: putif(q, ctlstack->endlabel);
384: }
385: else
386: {
387: if(! ISCONST(ctlstack->domax) )
388: puteq( cpexpr(ctlstack->domax), DOLIMIT);
389: q = DOINIT;
390: if( ! onetripflag )
391: q = mkexpr(OPMINUS, q,
392: mkexpr(OPASSIGN, cpexpr(ctlstack->dostep), DOINCR) );
393: puteq( cpexpr(dovarp), q);
394: if(onetripflag && ctlstack->dostepsign==VARSTEP)
395: puteq( cpexpr(ctlstack->dostep), DOINCR);
396: }
397:
398: if(ctlstack->dostepsign == VARSTEP)
399: {
400: if(onetripflag)
401: putgoto(ctlstack->dobodylabel);
402: else
403: putif( mkexpr(OPGE, cpexpr(ctlstack->dostep), ICON(0)),
404: ctlstack->doneglabel );
405: putlabel(ctlstack->doposlabel);
406: putif( mkexpr(OPLE,
407: mkexpr(OPPLUSEQ, cpexpr(dovarp), cpexpr(ctlstack->dostep)),
408: cpexpr(ctlstack->domax) ),
409: ctlstack->endlabel);
410: }
411: putlabel(ctlstack->dobodylabel);
412: if(dostgp)
413: puteq(dostgp, cpexpr(dovarp));
414: frexpr(dovarp);
415: }
416:
417:
418:
419: enddo(here)
420: int here;
421: {
422: register struct Ctlframe *q;
423: register expptr t;
424: struct Nameblock *np;
425: struct Addrblock *ap;
426: register int i;
427:
428: while(here == dorange)
429: {
430: if(np = ctlstack->donamep)
431: {
432: t = mkexpr(OPPLUSEQ, mklhs(mkprim(ctlstack->donamep, 0,0,0)),
433: cpexpr(ctlstack->dostep) );
434:
435: if(ctlstack->dostepsign == VARSTEP)
436: {
437: putif( mkexpr(OPLE, cpexpr(ctlstack->dostep), ICON(0)), ctlstack->doposlabel);
438: putlabel(ctlstack->doneglabel);
439: putif( mkexpr(OPLT, t, ctlstack->domax), ctlstack->dobodylabel);
440: }
441: else
442: putif( mkexpr( (ctlstack->dostepsign==POSSTEP ? OPGT : OPLT),
443: t, ctlstack->domax),
444: ctlstack->dobodylabel);
445: putlabel(ctlstack->endlabel);
446: if(ap = memversion(np))
447: puteq(ap, mklhs( mkprim(np,0,0,0)) );
448: for(i = 0 ; i < 4 ; ++i)
449: ctlstack->ctlabels[i] = 0;
450: deregister(ctlstack->donamep);
451: ctlstack->donamep->vdovar = NO;
452: frexpr(ctlstack->dostep);
453: }
454:
455: popctl();
456: poplab();
457: dorange = 0;
458: for(q = ctlstack ; q>=ctls ; --q)
459: if(q->ctltype == CTLDO)
460: {
461: dorange = q->dolabel;
462: break;
463: }
464: }
465: }
466:
467: exassign(vname, labelval)
468: struct Nameblock *vname;
469: struct Labelblock *labelval;
470: {
471: struct Addrblock *p;
472: struct Constblock *mkaddcon();
473:
474: p = mklhs(mkprim(vname,0,0,0));
475: if( ! ONEOF(p->vtype, MSKINT|MSKADDR) )
476: err("noninteger assign variable");
477: else
478: puteq(p, mkaddcon(labelval->labelno) );
479: }
480:
481:
482:
483: exarif(expr, neglab, zerlab, poslab)
484: expptr expr;
485: struct Labelblock *neglab, *zerlab, *poslab;
486: {
487: register int lm, lz, lp;
488:
489: lm = neglab->labelno;
490: lz = zerlab->labelno;
491: lp = poslab->labelno;
492: expr = fixtype(expr);
493:
494: if( ! ONEOF(expr->headblock.vtype, MSKINT|MSKREAL) )
495: {
496: err("invalid type of arithmetic if expression");
497: frexpr(expr);
498: }
499: else
500: {
501: if(lm == lz)
502: exar2(OPLE, expr, lm, lp);
503: else if(lm == lp)
504: exar2(OPNE, expr, lm, lz);
505: else if(lz == lp)
506: exar2(OPGE, expr, lz, lm);
507: else
508: prarif(expr, lm, lz, lp);
509: }
510: }
511:
512:
513:
514: LOCAL exar2(op, e, l1, l2)
515: int op;
516: expptr e;
517: int l1, l2;
518: {
519: putif( mkexpr(op, e, ICON(0)), l2);
520: putgoto(l1);
521: }
522:
523:
524: exreturn(p)
525: register expptr p;
526: {
527: if(procclass != CLPROC)
528: warn("RETURN statement in main or block data");
529: if(p && (proctype!=TYSUBR || procclass!=CLPROC) )
530: {
531: err("alternate return in nonsubroutine");
532: p = 0;
533: }
534:
535: if(p)
536: {
537: putforce(TYINT, p);
538: putgoto(retlabel);
539: }
540: else
541: putgoto(proctype==TYSUBR ? ret0label : retlabel);
542: }
543:
544:
545:
546: exasgoto(labvar)
547: struct Hashentry *labvar;
548: {
549: register struct Addrblock *p;
550:
551: p = mklhs( mkprim(labvar,0,0,0) );
552: if( ! ISINT(p->vtype) )
553: err("assigned goto variable must be integer");
554: else
555: putbranch(p);
556: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.