![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to stat.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / pi|
Return to stat.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2: #
3: /*
4: * pi - Pascal interpreter code translator
5: *
6: * Charles Haley, Bill Joy UCB
7: * Version 1.2 November 1978
8: */
9:
10: #include "whoami"
11: #include "0.h"
12: #include "tree.h"
13:
14: int cntstat;
15: short cnts = 2;
16: #include "opcode.h"
17:
18: /*
19: * Statement list
20: */
21: statlist(r)
22: int *r;
23: {
24: register *sl;
25:
26: for (sl=r; sl != NIL; sl=sl[2])
27: statement(sl[1]);
28: }
29:
30: /*
31: * Statement
32: */
33: statement(r)
34: int *r;
35: {
36: register *s;
37: register struct nl *snlp;
38:
39: s = r;
40: snlp = nlp;
41: top:
42: if (cntstat) {
43: cntstat = 0;
44: putcnt();
45: }
46: if (s == NIL)
47: return;
48: line = s[1];
49: if (s[0] == T_LABEL) {
50: labeled(s[2]);
51: s = s[3];
52: noreach = 0;
53: cntstat = 1;
54: goto top;
55: }
56: if (noreach) {
57: noreach = 0;
58: warning();
59: error("Unreachable statement");
60: }
61: switch (s[0]) {
62: case T_PCALL:
63: putline();
64: proc(s);
65: break;
66: case T_ASGN:
67: putline();
68: asgnop(s);
69: break;
70: case T_GOTO:
71: putline();
72: gotoop(s[2]);
73: noreach = 1;
74: cntstat = 1;
75: break;
76: default:
77: level++;
78: switch (s[0]) {
79: default:
80: panic("stat");
81: case T_IF:
82: case T_IFEL:
83: ifop(s);
84: break;
85: case T_WHILE:
86: whilop(s);
87: noreach = 0;
88: break;
89: case T_REPEAT:
90: repop(s);
91: break;
92: case T_FORU:
93: case T_FORD:
94: forop(s);
95: noreach = 0;
96: break;
97: case T_BLOCK:
98: statlist(s[2]);
99: break;
100: case T_CASE:
101: putline();
102: caseop(s);
103: break;
104: case T_WITH:
105: withop(s);
106: break;
107: case T_ASRT:
108: putline();
109: asrtop(s);
110: break;
111: }
112: --level;
113: if (gotos[cbn])
114: ungoto();
115: break;
116: }
117: /*
118: * Free the temporary name list entries defined in
119: * expressions, e.g. STRs, and WITHPTRs from withs.
120: */
121: nlfree(snlp);
122: }
123:
124: ungoto()
125: {
126: register struct nl *p;
127:
128: for (p = gotos[cbn]; p != NIL; p = p->chain)
129: if ((p->nl_flags & NFORWD) != 0) {
130: if (p->value[NL_GOLEV] != NOTYET)
131: if (p->value[NL_GOLEV] > level)
132: p->value[NL_GOLEV] = level;
133: } else
134: if (p->value[NL_GOLEV] != DEAD)
135: if (p->value[NL_GOLEV] > level)
136: p->value[NL_GOLEV] = DEAD;
137: }
138:
139: putcnt()
140: {
141:
142: if (monflg == 0)
143: return;
144: cnts++;
145: put2(O_COUNT, cnts);
146: }
147:
148: putline()
149: {
150:
151: # ifdef OBJ
152: if (opt('p') != 0)
153: put2(O_LINO, line);
154: # endif
155: }
156:
157: /*
158: * With varlist do stat
159: *
160: * With statement requires an extra word
161: * in automatic storage for each level of withing.
162: * These indirect pointers are initialized here, and
163: * the scoping effect of the with statement occurs
164: * because lookup examines the field names of the records
165: * associated with the WITHPTRs on the withlist.
166: */
167: withop(s)
168: int *s;
169: {
170: register *p;
171: register struct nl *r;
172: int i;
173: int *swl;
174: long soffset;
175:
176: putline();
177: swl = withlist;
178: soffset = sizes[cbn].om_off;
179: for (p = s[2]; p != NIL; p = p[2]) {
180: sizes[cbn].om_off -= sizeof ( int * );
181: # ifdef PPC
182: putlbracket();
183: # endif
184: put2(O_LV | cbn <<9, i = sizes[cbn].om_off);
185: r = lvalue(p[1], MOD);
186: if (r == NIL)
187: continue;
188: if (r->class != RECORD) {
189: error("Variable in with statement refers to %s, not to a record", nameof(r));
190: continue;
191: }
192: r = defnl(0, WITHPTR, r, i);
193: r->nl_next = withlist;
194: withlist = r;
195: # ifdef VAX
196: put1 ( O_AS4 );
197: # endif
198: # ifdef PDP11
199: put1(O_AS2);
200: # endif
201: }
202: if (sizes[cbn].om_off < sizes[cbn].om_max)
203: sizes[cbn].om_max = sizes[cbn].om_off;
204: statement(s[3]);
205: sizes[cbn].om_off = soffset;
206: # ifdef PPC
207: putlbracket();
208: # endif
209: withlist = swl;
210: }
211:
212: extern flagwas;
213: /*
214: * var := expr
215: */
216: asgnop(r)
217: int *r;
218: {
219: register struct nl *p;
220: register *av;
221:
222: if (r == NIL)
223: return (NIL);
224: /*
225: * Asgnop's only function is
226: * to handle function variable
227: * assignments. All other assignment
228: * stuff is handled by asgnop1.
229: */
230: av = r[2];
231: if (av != NIL && av[0] == T_VAR && av[3] == NIL) {
232: p = lookup1(av[2]);
233: if (p != NIL)
234: p->nl_flags = flagwas;
235: if (p != NIL && p->class == FVAR) {
236: /*
237: * Give asgnop1 the func
238: * which is the chain of
239: * the FVAR.
240: */
241: p->nl_flags |= NUSED|NMOD;
242: p = p->chain;
243: if (p == NIL) {
244: rvalue(r[3], NIL);
245: return;
246: }
247: put2(O_LV | bn << 9, p->value[NL_OFFS]);
248: if (isa(p->type, "i") && width(p->type) == 1)
249: asgnop1(r, nl+T2INT);
250: else
251: asgnop1(r, p->type);
252: return;
253: }
254: }
255: asgnop1(r, NIL);
256: }
257:
258: /*
259: * Asgnop1 handles all assignments.
260: * If p is not nil then we are assigning
261: * to a function variable, otherwise
262: * we look the variable up ourselves.
263: */
264: struct nl *
265: asgnop1(r, p)
266: int *r;
267: register struct nl *p;
268: {
269: register struct nl *p1;
270:
271: if (r == NIL)
272: return (NIL);
273: if (p == NIL) {
274: p = lvalue(r[2], MOD|ASGN|NOUSE);
275: if (p == NIL) {
276: rvalue(r[3], NIL);
277: return (NIL);
278: }
279: }
280: p1 = rvalue(r[3], p);
281: if (p1 == NIL)
282: return (NIL);
283: if (incompat(p1, p, r[3])) {
284: cerror("Type of expression clashed with type of variable in assignment");
285: return (NIL);
286: }
287: switch (classify(p)) {
288: case TBOOL:
289: case TCHAR:
290: case TINT:
291: case TSCAL:
292: rangechk(p, p1);
293: case TDOUBLE:
294: case TPTR:
295: gen(O_AS2, O_AS2, width(p), width(p1));
296: break;
297: default:
298: put2(O_AS, width(p));
299: }
300: # ifdef PPC
301: putexpr();
302: # endif
303: return (p); /* Used by for statement */
304: }
305:
306: /*
307: * for var := expr [down]to expr do stat
308: */
309: forop(r)
310: int *r;
311: {
312: register struct nl *t1, *t2;
313: int l1, l2, l3;
314: long soffset;
315: register op;
316: struct nl *p;
317: int *rr, goc, i;
318:
319: p = NIL;
320: goc = gocnt;
321: if (r == NIL)
322: goto aloha;
323: putline();
324: /*
325: * Start with assignment
326: * of initial value to for variable
327: */
328: t1 = asgnop1(r[2], NIL);
329: if (t1 == NIL) {
330: rvalue(r[3], NIL);
331: statement(r[4]);
332: goto aloha;
333: }
334: rr = r[2]; /* Assignment */
335: rr = rr[2]; /* Lhs variable */
336: if (rr[3] != NIL) {
337: error("For variable must be unqualified");
338: rvalue(r[3], NIL);
339: statement(r[4]);
340: goto aloha;
341: }
342: p = lookup(rr[2]);
343: p->value[NL_FORV] = 1;
344: if (isnta(t1, "bcis")) {
345: error("For variables cannot be %ss", nameof(t1));
346: statement(r[4]);
347: goto aloha;
348: }
349: /*
350: * Allocate automatic
351: * space for limit variable
352: */
353: sizes[cbn].om_off -= 4;
354: # ifdef PPC
355: putlbracket();
356: # endif
357: if (sizes[cbn].om_off < sizes[cbn].om_max)
358: sizes[cbn].om_max = sizes[cbn].om_off;
359: i = sizes[cbn].om_off;
360: /*
361: * Initialize the limit variable
362: */
363: put2(O_LV | cbn<<9, i);
364: t2 = rvalue(r[3], NIL);
365: if (incompat(t2, t1, r[3])) {
366: cerror("Limit type clashed with index type in 'for' statement");
367: statement(r[4]);
368: goto aloha;
369: }
370: put1(width(t2) <= 2 ? O_AS24 : O_AS4);
371: # ifdef PPC
372: putexpr();
373: # endif
374: /*
375: * See if we can skip the loop altogether
376: */
377: rr = r[2];
378: if (rr != NIL)
379: rvalue(rr[2], NIL);
380: put2(O_RV4 | cbn<<9, i);
381: gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4);
382: /*
383: * L1 will be patched to skip the body of the loop.
384: * L2 marks the top of the loop when we go around.
385: */
386: put2(O_IF, (l1 = getlab()));
387: putlab(l2 = getlab());
388: putcnt();
389: statement(r[4]);
390: /*
391: * now we see if we get to go again
392: */
393: if (opt('t') == 0) {
394: /*
395: * Easy if we dont have to test
396: */
397: put2(O_RV4 | cbn<<9, i);
398: if (rr != NIL)
399: lvalue(rr[2], MOD);
400: put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2);
401: } else {
402: line = r[1];
403: putline();
404: if (rr != NIL)
405: rvalue(rr[2], NIL);
406: put2(O_RV4 | cbn << 9, i);
407: gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4);
408: l3 = put2(O_IF, getlab());
409: lvalue((int *) rr[2], MOD);
410: rvalue(rr[2], NIL);
411: put2(O_CON2, 1);
412: t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2);
413: rangechk(t1, t2); /* The point of all this */
414: gen(O_AS2, O_AS2, width(t1), width(t2));
415: put2(O_TRA, l2);
416: patch(l3);
417: }
418: sizes[cbn].om_off += 4;
419: # ifdef PPC
420: putlbracket();
421: # endif
422: patch(l1);
423: aloha:
424: noreach = 0;
425: if (p != NIL)
426: p->value[NL_FORV] = 0;
427: if (goc != gocnt)
428: putcnt();
429: }
430:
431: /*
432: * if expr then stat [ else stat ]
433: */
434: ifop(r)
435: int *r;
436: {
437: register struct nl *p;
438: register l1, l2;
439: int nr, goc;
440:
441: goc = gocnt;
442: if (r == NIL)
443: return;
444: putline();
445: p = rvalue(r[2], NIL);
446: if (p == NIL) {
447: statement(r[3]);
448: noreach = 0;
449: statement(r[4]);
450: noreach = 0;
451: return;
452: }
453: if (isnta(p, "b")) {
454: error("Type of expression in if statement must be Boolean, not %s", nameof(p));
455: statement(r[3]);
456: noreach = 0;
457: statement(r[4]);
458: noreach = 0;
459: return;
460: }
461: l1 = put2(O_IF, getlab());
462: putcnt();
463: statement(r[3]);
464: nr = noreach;
465: if (r[4] != NIL) {
466: /*
467: * else stat
468: */
469: --level;
470: ungoto();
471: ++level;
472: l2 = put2(O_TRA, getlab());
473: patch(l1);
474: noreach = 0;
475: statement(r[4]);
476: noreach &= nr;
477: l1 = l2;
478: } else
479: noreach = 0;
480: patch(l1);
481: if (goc != gocnt)
482: putcnt();
483: }
484:
485: /*
486: * while expr do stat
487: */
488: whilop(r)
489: int *r;
490: {
491: register struct nl *p;
492: register l1, l2;
493: int goc;
494:
495: goc = gocnt;
496: if (r == NIL)
497: return;
498: putlab(l1 = getlab());
499: putline();
500: p = rvalue(r[2], NIL);
501: if (p == NIL) {
502: statement(r[3]);
503: noreach = 0;
504: return;
505: }
506: if (isnta(p, "b")) {
507: error("Type of expression in while statement must be Boolean, not %s", nameof(p));
508: statement(r[3]);
509: noreach = 0;
510: return;
511: }
512: put2(O_IF, (l2 = getlab()));
513: putcnt();
514: statement(r[3]);
515: put2(O_TRA, l1);
516: patch(l2);
517: if (goc != gocnt)
518: putcnt();
519: }
520:
521: /*
522: * repeat stat* until expr
523: */
524: repop(r)
525: int *r;
526: {
527: register struct nl *p;
528: register l;
529: int goc;
530:
531: goc = gocnt;
532: if (r == NIL)
533: return;
534: l = putlab(getlab());
535: putcnt();
536: statlist(r[2]);
537: line = r[1];
538: p = rvalue(r[3], NIL);
539: if (p == NIL)
540: return;
541: if (isnta(p,"b")) {
542: error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
543: return;
544: }
545: put2(O_IF, l);
546: if (goc != gocnt)
547: putcnt();
548: }
549:
550: /*
551: * assert expr
552: */
553: asrtop(r)
554: register int *r;
555: {
556: register struct nl *q;
557:
558: if (opt('s')) {
559: standard();
560: error("Assert statement is non-standard");
561: }
562: if (!opt('t'))
563: return;
564: r = r[2];
565: q = rvalue((int *) r, NLNIL);
566: if (q == NIL)
567: return;
568: if (isnta(q, "b"))
569: error("Assert expression must be Boolean, not %ss", nameof(q));
570: put1(O_ASRT);
571: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.