![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to put.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 put.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 "opcode.h"
12: #include "0.h"
13:
14: short *obufp = obuf;
15:
16: /*
17: * If DEBUG is defined, include the table
18: * of the printing opcode names.
19: */
20: #ifdef DEBUG
21: char *otext[] = {
22: #include "OPnames.h"
23: };
24: #endif
25:
26: #ifdef OBJ
27: /*
28: * Put is responsible for the interpreter equivalent of code
29: * generation. Since the interpreter is specifically designed
30: * for Pascal, little work is required here.
31: */
32: put(a)
33: {
34: register int *p, i;
35: register char *cp;
36: int n, subop, suboppr, op, oldlc, w;
37: char *string;
38: static int casewrd;
39:
40: /*
41: * It would be nice to do some more
42: * optimizations here. The work
43: * done to collapse offsets in lval
44: * should be done here, the IFEQ etc
45: * relational operators could be used
46: * etc.
47: */
48: oldlc = lc;
49: if (cgenflg)
50: /*
51: * code disabled - do nothing
52: */
53: return (oldlc);
54: p = &a;
55: n = *p++;
56: suboppr = subop = (*p>>8) & 0377;
57: op = *p & 0377;
58: string = 0;
59: #ifdef DEBUG
60: if ((cp = otext[op]) == NIL) {
61: printf("op= %o\n", op);
62: panic("put");
63: }
64: #endif
65: switch (op) {
66: /*****
67: case O_LINO:
68: if (line == codeline)
69: return (oldlc);
70: codeline = line;
71: *****/
72: case O_PUSH:
73: case O_POP:
74: if (p[1] == 0)
75: return (oldlc);
76: case O_NEW:
77: case O_DISPOSE:
78: case O_AS:
79: case O_IND:
80: case O_OFF:
81: case O_INX2:
82: case O_INX4:
83: case O_CARD:
84: case O_ADDT:
85: case O_SUBT:
86: case O_MULT:
87: case O_IN:
88: case O_CASE1OP:
89: case O_CASE2OP:
90: case O_CASE4OP:
91: case O_PACK:
92: case O_UNPACK:
93: case O_RANG2:
94: case O_RSNG2:
95: case O_RANG42:
96: case O_RSNG42:
97: if (p[1] == 0)
98: break;
99: case O_CON2:
100: if (p[1] < 128 && p[1] >= -128) {
101: suboppr = subop = p[1];
102: p++;
103: n--;
104: if (op == O_CON2)
105: op = O_CON1;
106: }
107: break;
108: case O_CON8:
109: {
110: short *sp = &p[1];
111:
112: #ifdef DEBUG
113: if ( opt( 'c' ) )
114: printf ( ")#%5d\tCON8\t%10.3f\n" ,
115: lc - HEAD_BYTES ,
116: * ( ( double * ) &p[1] ) );
117: #endif
118: word ( op );
119: for ( i = 1 ; i <= 4 ; i ++ )
120: word ( *sp ++ );
121: return ( oldlc );
122: }
123: default:
124: if (op >= O_REL2 && op <= O_REL84) {
125: if ((i = (subop >> 1) * 5 ) >= 30)
126: i -= 30;
127: else
128: i += 2;
129: #ifdef DEBUG
130: string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i];
131: #endif
132: suboppr = 0;
133: }
134: break;
135: case O_IF:
136: case O_TRA:
137: /*****
138: codeline = 0;
139: *****/
140: case O_FOR1U:
141: case O_FOR2U:
142: case O_FOR4U:
143: case O_FOR1D:
144: case O_FOR2D:
145: case O_FOR4D:
146: /* relative addressing */
147: p[1] -= ( unsigned ) lc + 2;
148: break;
149: case O_WRIT82:
150: #ifdef DEBUG
151: string = &"22\024\042\044"[subop*3];
152: #endif
153: suboppr = 0;
154: break;
155: case O_CONG:
156: i = p[1];
157: cp = * ( ( char ** ) &p[2] ) ;
158: #ifdef DEBUG
159: if (opt('c'))
160: printf(")#%5d\tCONG:%d\t%s\n",
161: lc - HEAD_BYTES, i, cp);
162: #endif
163: if (i <= 127)
164: word(O_CON | i << 8);
165: else {
166: word(O_CON);
167: word(i);
168: }
169: while (i > 0) {
170: w = *cp ? *cp++ : ' ';
171: w |= (*cp ? *cp++ : ' ') << 8;
172: word(w);
173: i -= 2;
174: }
175: return (oldlc);
176: case O_CONC:
177: #ifdef DEBUG
178: (string = "'x'")[1] = p[1];
179: #endif
180: suboppr = 0;
181: op = O_CON1;
182: subop = p[1];
183: goto around;
184: case O_CON1:
185: suboppr = subop = p[1];
186: around:
187: n--;
188: break;
189: case O_CASEBEG:
190: casewrd = 0;
191: return (oldlc);
192: case O_CASEEND:
193: if ((unsigned) lc & 1) {
194: lc--;
195: word(casewrd);
196: }
197: return (oldlc);
198: case O_CASE1:
199: #ifdef DEBUG
200: if (opt('c'))
201: printf(")#%5d\tCASE1\t%d\n"
202: , lc - HEAD_BYTES
203: , ( int ) *( ( long * ) &p[1] ) );
204: #endif
205: /*
206: * this to build a byte size case table
207: * saving bytes across calls in casewrd
208: * so they can be put out by word()
209: */
210: lc++;
211: if ((unsigned) lc & 1)
212: casewrd = *( ( long * ) &p[1] );
213: else {
214: lc -= 2;
215: word ( casewrd
216: | ( ( int ) *( ( long * ) &p[1] ) << 8 ) );
217: }
218: return (oldlc);
219: case O_CASE2:
220: #ifdef DEBUG
221: if (opt('c'))
222: printf(")#%5d\tCASE2\t%d\n"
223: , lc - HEAD_BYTES
224: , ( int ) *( ( long * ) &p[1] ) );
225: #endif
226: word( ( short ) *( ( long * ) &p[1] ) );
227: return (oldlc);
228: case O_TRA4:
229: case O_CALL:
230: case O_GOTO:
231: case O_TRACNT:
232: /* absolute long addressing */
233: p[1] -= HEAD_BYTES;
234: n++;
235: case O_CON4:
236: case O_CASE4:
237: case O_RANG4:
238: case O_RANG4 + 1: /* O_RANG24 */
239: case O_RSNG4:
240: case O_RSNG4 + 1: /* O_RSNG24 */
241: {
242: short *sp = &p[1];
243: long *lp = &p[1];
244:
245: #ifdef DEBUG
246: if (opt('c'))
247: {
248: printf( ")#%5d\t%s" , lc - HEAD_BYTES , cp );
249: if (suboppr)
250: printf(":%1d", suboppr);
251: for ( i = 1 ; i < n
252: ; i += sizeof ( long )/sizeof ( short ) )
253: printf( "\t%D " , *lp ++ );
254: pchr ( '\n' );
255: }
256: #endif
257: if ( op != O_CASE4 )
258: word ( op | subop<<8 );
259: for ( i = 1 ; i < n ; i ++ )
260: word ( *sp ++ );
261: return ( oldlc );
262: }
263: }
264: #ifdef DEBUG
265: if (opt('c')) {
266: printf(")#%5d\t%s", lc - HEAD_BYTES, cp);
267: if (suboppr)
268: printf(":%d", suboppr);
269: if (string)
270: printf("\t%s",string);
271: if (n > 1)
272: pchr('\t');
273: for (i=1; i<n; i++)
274: printf("%d ", ( short ) p[i]);
275: pchr('\n');
276: }
277: #endif
278: if (op != NIL)
279: word(op | subop << 8);
280: for (i=1; i<n; i++)
281: word(p[i]);
282: return (oldlc);
283: }
284: #endif OBJ
285:
286: /*
287: * Putspace puts out a table
288: * of nothing to leave space
289: * for the case branch table e.g.
290: */
291: putspace(n)
292: int n;
293: {
294: register i;
295: #ifdef DEBUG
296: if (opt('c'))
297: printf(")#%5d\t.=.+%d\n", lc - HEAD_BYTES, n);
298: #endif
299: for (i = even(n); i > 0; i -= 2)
300: word(0);
301: }
302:
303: /*
304: * Patch repairs the branch
305: * at location loc to come
306: * to the current location.
307: */
308: patch(loc)
309: {
310:
311: patchfil(loc, lc-loc-2, 1);
312: }
313:
314: patch4(loc)
315: {
316:
317: patchfil(loc, lc - HEAD_BYTES, 2);
318: }
319:
320: /*
321: * Patchfil makes loc+2 have value
322: * as its contents.
323: */
324: patchfil(loc, value, words)
325: #ifdef VAX
326: unsigned long loc;
327: #endif
328: #ifdef PDP11
329: char *loc;
330: #endif
331: int value, words;
332: {
333: register i;
334:
335: if (cgenflg < 0)
336: return;
337: if (loc > (unsigned) lc)
338: panic("patchfil");
339: #ifdef DEBUG
340: if (opt('c'))
341: printf(")#\tpatch %u %d\n", loc - HEAD_BYTES, value);
342: #endif
343: do {
344: i = ((unsigned) loc + 2 - ((unsigned) lc & ~01777))/2;
345: if (i >= 0 && i < 1024)
346: obuf[i] = value;
347: else {
348: lseek(ofil, (long) loc+2, 0);
349: write(ofil, &value, 2);
350: lseek(ofil, (long) 0, 2);
351: }
352: loc += 2;
353: value = value >> 16;
354: } while (--words);
355: }
356:
357: /*
358: * Put the word o into the code
359: */
360: word(o)
361: int o;
362: {
363:
364: *obufp = o;
365: obufp++;
366: lc += 2;
367: if (obufp >= obuf+512)
368: pflush();
369: }
370:
371: extern char *obj;
372: /*
373: * Flush the code buffer
374: */
375: pflush()
376: {
377: register i;
378:
379: i = (obufp - ( ( short * ) obuf ) ) * 2;
380: if (i != 0 && write(ofil, obuf, i) != i)
381: perror(obj), pexit(DIED);
382: obufp = obuf;
383: }
384:
385: /*
386: * Getlab - returns the location counter.
387: * included here for the eventual code generator.
388: */
389: getlab()
390: {
391:
392: return (lc);
393: }
394:
395: /*
396: * Putlab - lay down a label.
397: */
398: putlab(l)
399: int l;
400: {
401:
402: return (l);
403: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.