Commit | Line | Data |
---|---|---|
ecce6a1f CH |
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 | } |