Commit | Line | Data |
---|---|---|
16494185 BJ |
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 January 1979 | |
8 | */ | |
9 | ||
10 | #include "opcode.h" | |
11 | #include "0.h" | |
12 | ||
13 | int *obufp { obuf }; | |
14 | ||
15 | /* | |
16 | * If DEBUG is defined, include the table | |
17 | * of the printing opcode names. | |
18 | */ | |
19 | #ifdef DEBUG | |
20 | char *otext[] { | |
21 | #include "OPnames.h" | |
22 | }; | |
23 | #endif | |
24 | ||
25 | /* | |
26 | * Put is responsible for the interpreter equivalent of code | |
27 | * generation. Since the interpreter is specifically designed | |
28 | * for Pascal, little work is required here. | |
29 | */ | |
30 | put(a) | |
31 | { | |
32 | register int *p, i; | |
33 | register char *cp; | |
34 | int n, subop, suboppr, op, oldlc, w; | |
35 | char *string; | |
36 | static int casewrd; | |
37 | ||
38 | /* | |
39 | * It would be nice to do some more | |
40 | * optimizations here. The work | |
41 | * done to collapse offsets in lval | |
42 | * should be done here, the IFEQ etc | |
43 | * relational operators could be used | |
44 | * etc. | |
45 | */ | |
46 | oldlc = lc; | |
47 | if (cgenflg) | |
48 | /* | |
49 | * code disabled - do nothing | |
50 | */ | |
51 | return (oldlc); | |
52 | p = &a; | |
53 | n = *p++; | |
54 | suboppr = subop = (*p>>8) & 0377; | |
55 | op = *p & 0377; | |
56 | string = 0; | |
57 | #ifdef DEBUG | |
58 | if ((cp = otext[op]) == NIL) { | |
59 | printf("op= %o\n", op); | |
60 | panic("put"); | |
61 | } | |
62 | #endif | |
63 | switch (op) { | |
64 | /***** | |
65 | case O_LINO: | |
66 | if (line == codeline) | |
67 | return (oldlc); | |
68 | codeline = line; | |
69 | *****/ | |
70 | case O_PUSH: | |
71 | case O_POP: | |
72 | if (p[1] == 0) | |
73 | return (oldlc); | |
74 | case O_NEW: | |
75 | case O_DISPOSE: | |
76 | case O_AS: | |
77 | case O_IND: | |
78 | case O_OFF: | |
79 | case O_INX2: | |
80 | case O_INX4: | |
81 | case O_CARD: | |
82 | case O_ADDT: | |
83 | case O_SUBT: | |
84 | case O_MULT: | |
85 | case O_IN: | |
86 | case O_CASE1OP: | |
87 | case O_CASE2OP: | |
88 | case O_CASE4OP: | |
89 | case O_PACK: | |
90 | case O_UNPACK: | |
91 | case O_RANG2: | |
92 | case O_RSNG2: | |
93 | case O_RANG42: | |
94 | case O_RSNG42: | |
95 | if (p[1] == 0) | |
96 | break; | |
97 | case O_CON2: | |
98 | if (p[1] < 128 && p[1] >= -128) { | |
99 | suboppr = subop = p[1]; | |
100 | p++; | |
101 | n--; | |
102 | if (op == O_CON2) | |
103 | op = O_CON1; | |
104 | } | |
105 | break; | |
106 | default: | |
107 | if (op >= O_REL2 && op <= O_REL84) { | |
108 | if ((i = (subop >> 1) * 5 ) >= 30) | |
109 | i =- 30; | |
110 | else | |
111 | i =+ 2; | |
112 | #ifdef DEBUG | |
113 | string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i]; | |
114 | #endif | |
115 | suboppr = 0; | |
116 | } | |
117 | break; | |
118 | case O_IF: | |
119 | case O_TRA: | |
120 | /***** | |
121 | codeline = 0; | |
122 | *****/ | |
123 | case O_CALL: | |
124 | case O_FOR1U: | |
125 | case O_FOR2U: | |
126 | case O_FOR4U: | |
127 | case O_FOR1D: | |
128 | case O_FOR2D: | |
129 | case O_FOR4D: | |
130 | p[1] =- lc + 2; | |
131 | break; | |
132 | case O_WRIT82: | |
133 | #ifdef DEBUG | |
134 | string = &"22\024\042\044"[subop*3]; | |
135 | #endif | |
136 | suboppr = 0; | |
137 | break; | |
138 | case O_CONG: | |
139 | i = p[1]; | |
140 | cp = p[2]; | |
141 | #ifdef DEBUG | |
142 | if (opt('c')) | |
143 | printf("%5d\tCONG:%d\t%s\n", lc, i, cp); | |
144 | #endif | |
145 | if (i <= 127) | |
146 | word(O_CON | i << 8); | |
147 | else { | |
148 | word(O_CON); | |
149 | word(i); | |
150 | } | |
151 | while (i > 0) { | |
152 | w = *cp ? *cp++ : ' '; | |
153 | w =| (*cp ? *cp++ : ' ') << 8; | |
154 | word(w); | |
155 | i =- 2; | |
156 | } | |
157 | return (oldlc); | |
158 | case O_CONC: | |
159 | #ifdef DEBUG | |
160 | (string = "'x'")[1] = p[1]; | |
161 | #endif | |
162 | suboppr = 0; | |
163 | op = O_CON1; | |
164 | subop = p[1]; | |
165 | goto around; | |
166 | case O_CON1: | |
167 | suboppr = subop = p[1]; | |
168 | around: | |
169 | n--; | |
170 | break; | |
171 | case O_CASEBEG: | |
172 | casewrd = 0; | |
173 | return (oldlc); | |
174 | case O_CASEEND: | |
175 | if (lc & 1) { | |
176 | lc--; | |
177 | word(casewrd); | |
178 | } | |
179 | return (oldlc); | |
180 | case O_CASE1: | |
181 | #ifdef DEBUG | |
182 | if (opt('c')) | |
183 | printf("%5d\tCASE1\t%d\n", lc, p[2]); | |
184 | #endif | |
185 | lc++; | |
186 | if (lc & 1) | |
187 | casewrd = p[2]; | |
188 | else { | |
189 | lc =- 2; | |
190 | word(casewrd | p[2] << 8); | |
191 | } | |
192 | return (oldlc); | |
193 | case O_CASE2: | |
194 | #ifdef DEBUG | |
195 | if (opt('c')) | |
196 | printf("%5d\tCASE2\t%d\n", lc, p[2]); | |
197 | #endif | |
198 | word(p[2]); | |
199 | return (oldlc); | |
200 | case O_CASE4: | |
201 | #ifdef DEBUG | |
202 | if (opt('c')) | |
203 | printf("%5d\tCASE4\t%d %d\n", lc, p[1], p[2]); | |
204 | #endif | |
205 | word(p[1]); | |
206 | word(p[2]); | |
207 | return (oldlc); | |
208 | } | |
209 | #ifdef DEBUG | |
210 | if (opt('c')) { | |
211 | printf("%5d\t%s", lc, cp); | |
212 | if (suboppr) | |
213 | printf(":%d", suboppr); | |
214 | if (string) | |
215 | printf("\t%s",string); | |
216 | if (n > 1) | |
217 | putchar('\t'); | |
218 | for (i=1; i<n; i++) | |
219 | printf("%d ", p[i]); | |
220 | putchar('\n'); | |
221 | } | |
222 | #endif | |
223 | if (op != NIL) | |
224 | word(op | subop << 8); | |
225 | for (i=1; i<n; i++) | |
226 | word(p[i]); | |
227 | return (oldlc); | |
228 | } | |
229 | ||
230 | /* | |
231 | * Putspace puts out a table | |
232 | * of nothing to leave space | |
233 | * for the case branch table e.g. | |
234 | */ | |
235 | putspace(n) | |
236 | int n; | |
237 | { | |
238 | register i; | |
239 | #ifdef DEBUG | |
240 | if (opt('c')) | |
241 | printf("%5d\t.=.+%d\n", lc, i); | |
242 | #endif | |
243 | for (i = even(n); i > 0; i =- 2) | |
244 | word(0); | |
245 | } | |
246 | ||
247 | /* | |
248 | * Patch repairs the branch | |
249 | * at location loc to come | |
250 | * to the current location. | |
251 | */ | |
252 | patch(loc) | |
253 | { | |
254 | ||
255 | patchfil(loc, lc-loc-2); | |
256 | } | |
257 | ||
258 | /* | |
259 | * Patchfil makes loc+2 have value | |
260 | * as its contents. | |
261 | */ | |
262 | patchfil(loc, value) | |
263 | char *loc; | |
264 | int value; | |
265 | { | |
266 | register i; | |
267 | ||
268 | if (cgenflg < 0) | |
269 | return; | |
270 | if (loc > lc) | |
271 | panic("patchfil"); | |
272 | #ifdef DEBUG | |
273 | if (opt('c')) | |
274 | printf("\tpatch %u %d\n", loc, value); | |
275 | #endif | |
276 | i = (loc + 2 - (lc & ~0777))/2; | |
277 | if (i >= 0 && i < 512) | |
278 | obuf[i] = value; | |
279 | else { | |
280 | seek(ofil, loc+2, 0); | |
281 | write(ofil, &value, 2); | |
282 | seek(ofil, 0, 2); | |
283 | } | |
284 | } | |
285 | ||
286 | /* | |
287 | * Put the word o into the code | |
288 | */ | |
289 | word(o) | |
290 | int o; | |
291 | { | |
292 | ||
293 | *obufp = o; | |
294 | obufp++; | |
295 | lc =+ 2; | |
296 | if (obufp >= obuf+256) | |
297 | pflush(); | |
298 | } | |
299 | ||
300 | char *obj; | |
301 | /* | |
302 | * Flush the code buffer | |
303 | */ | |
304 | pflush() | |
305 | { | |
306 | register i; | |
307 | ||
308 | i = (obufp - obuf) * 2; | |
309 | if (i != 0 && write(ofil, obuf, i) != i) | |
310 | perror(obj), pexit(DIED); | |
311 | obufp = obuf; | |
312 | } | |
313 | ||
314 | /* | |
315 | * Getlab - returns the location counter. | |
316 | * included here for the eventual code generator. | |
317 | */ | |
318 | getlab() | |
319 | { | |
320 | ||
321 | return (lc); | |
322 | } | |
323 | ||
324 | /* | |
325 | * Putlab - lay down a label. | |
326 | */ | |
327 | putlab(l) | |
328 | int l; | |
329 | { | |
330 | ||
331 | return (l); | |
332 | } |