|
|
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: #include "opcode.h"
14:
15: /*
16: * The structure used to
17: * hold information about
18: * each case label.
19: */
20: struct ct {
21: long clong;
22: int cline;
23: };
24:
25: /*
26: * Caseop generates the
27: * pascal case statement code
28: */
29: caseop(r)
30: int *r;
31: {
32: register struct nl *p;
33: register struct ct *ctab;
34: register *cs;
35: int *cl;
36: double low, high;
37: short *brtab;
38: char *brtab0;
39: char *csend;
40: int w, i, j, m, n;
41: int nr, goc;
42:
43: goc = gocnt;
44: /*
45: * Obtain selector attributes:
46: * p type
47: * w width
48: * low lwb(p)
49: * high upb(p)
50: */
51: p = rvalue((int *) r[2], NLNIL);
52: if (p != NIL) {
53: if (isnta(p, "bcsi")) {
54: error("Case selectors cannot be %ss", nameof(p));
55: p = NIL;
56: } else {
57: cl = p;
58: if (p->class != RANGE)
59: cl = p->type;
60: if (cl == NIL)
61: p = NIL;
62: else {
63: w = width(p);
64: #ifdef DEBUG
65: if (hp21mx)
66: w = 2;
67: #endif
68: low = cl->range[0];
69: high = cl->range[1];
70: }
71: }
72: }
73: /*
74: * Count # of cases
75: */
76: n = 0;
77: for (cl = r[3]; cl != NIL; cl = cl[2]) {
78: cs = cl[1];
79: if (cs == NIL)
80: continue;
81: for (cs = cs[2]; cs != NIL; cs = cs[2])
82: n++;
83: }
84: /*
85: * Allocate case table space
86: */
87: ctab = i = malloc(n * sizeof *ctab);
88: if (i == -1) {
89: error("Ran out of memory (case)");
90: pexit(DIED);
91: }
92: /*
93: * Check the legality of the
94: * labels and count the number
95: * of good labels
96: */
97: m = 0;
98: for (cl = r[3]; cl != NIL; cl = cl[2]) {
99: cs = cl[1];
100: if (cs == NIL)
101: continue;
102: line = cs[1];
103: for (cs = cs[2]; cs != NIL; cs = cs[2]) {
104: gconst(cs[1]);
105: if (p == NIL || con.ctype == NIL)
106: continue;
107: if (incompat(con.ctype, p, NIL)) {
108: cerror("Case label type clashed with case selector expression type");
109: continue;
110: }
111: if (con.crval < low || con.crval > high) {
112: error("Case label out of range");
113: continue;
114: }
115: ctab[m].clong = con.crval;
116: ctab[m].cline = line;
117: m++;
118: }
119: }
120:
121: /*
122: * Check for duplicate labels
123: */
124: for (i = 0; i < m; i++)
125: for (j = 0; j < m; j++)
126: if (ctab[i].clong == ctab[j].clong) {
127: if (i == j)
128: continue;
129: if (j < i)
130: break;
131: error("Multiply defined label in case, lines %d and %d", ctab[i].cline, ctab[j].cline);
132: }
133: /*
134: * Put out case operator and
135: * leave space for the
136: * branch table
137: */
138: if (p != NIL) {
139: put2(O_CASE1OP + (w >> 1), n);
140: brtab = brtab0 = lc;
141: putspace(n * 2);
142: put1(O_CASEBEG);
143: for (i=0; i<m; i++)
144: put( 3 , O_CASE1 + (w >> 1), ctab[i].clong);
145: put1(O_CASEEND);
146: }
147: csend = getlab();
148: put2(O_TRA, csend);
149: /*
150: * Free the case
151: * table space.
152: */
153: free(ctab);
154: /*
155: * Generate code for each
156: * statement. Patch branch
157: * table to beginning of each
158: * statement and follow each
159: * statement with a branch back
160: * to the TRA above.
161: */
162: nr = 1;
163: for (cl = r[3]; cl != NIL; cl = cl[2]) {
164: cs = cl[1];
165: if (cs == NIL)
166: continue;
167: if (p != NIL)
168: for (cs = cs[2]; cs != NIL; cs = cs[2]) {
169: patchfil(brtab - 1, lc - brtab0, 1);
170: brtab++;
171: }
172: cs = cl[1];
173: putcnt();
174: level++;
175: statement(cs[3]);
176: nr &= noreach;
177: noreach = 0;
178: put2(O_TRA, csend);
179: level--;
180: if (gotos[cbn])
181: ungoto();
182: }
183: /*
184: * Patch the termination branch
185: */
186: patch(csend);
187: noreach = nr;
188: if (goc != gocnt)
189: putcnt();
190: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.