![[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] / 41BSD / cmd / pi|
Return to put.c CVS log | Up to [CSRG BSD Unix] / 41BSD / cmd / pi |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)put.c 1.3 10/2/80";
4:
5: #include "whoami.h"
6: #include "opcode.h"
7: #include "0.h"
8: #include "objfmt.h"
9: #ifdef PC
10: # include "pc.h"
11: #endif PC
12:
13: short *obufp = obuf;
14:
15: /*
16: * If DEBUG is defined, include the table
17: * of the printing opcode names.
18: */
19: #ifdef DEBUG
20: #include "OPnames.h"
21: #endif
22:
23: #ifdef OBJ
24: /*
25: * Put is responsible for the interpreter equivalent of code
26: * generation. Since the interpreter is specifically designed
27: * for Pascal, little work is required here.
28: */
29: put(a)
30: {
31: register int *p, i;
32: register char *cp;
33: int n, subop, suboppr, op, oldlc, w;
34: char *string;
35: static int casewrd;
36:
37: /*
38: * It would be nice to do some more
39: * optimizations here. The work
40: * done to collapse offsets in lval
41: * should be done here, the IFEQ etc
42: * relational operators could be used
43: * etc.
44: */
45: oldlc = lc;
46: if (cgenflg < 0)
47: /*
48: * code disabled - do nothing
49: */
50: return (oldlc);
51: p = &a;
52: n = *p++;
53: suboppr = subop = (*p>>8) & 0377;
54: op = *p & 0377;
55: string = 0;
56: #ifdef DEBUG
57: if ((cp = otext[op]) == NIL) {
58: printf("op= %o\n", op);
59: panic("put");
60: }
61: #endif
62: switch (op) {
63: case O_ABORT:
64: cp = "*";
65: break;
66: case O_LINO:
67: /*****
68: if (line == codeline)
69: return (oldlc);
70: codeline = line;
71: *****/
72: case O_NEW:
73: case O_DISPOSE:
74: case O_AS:
75: case O_IND:
76: case O_LVCON:
77: case O_CON:
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_FRTN:
90: case O_WRITES:
91: case O_WRITEF:
92: case O_MAX:
93: case O_MIN:
94: case O_PACK:
95: case O_UNPACK:
96: case O_ARGV:
97: case O_CTTOT:
98: case O_INCT:
99: case O_RANG2:
100: case O_RSNG2:
101: case O_RANG42:
102: case O_RSNG42:
103: if (p[1] == 0)
104: break;
105: case O_CON2:
106: case O_CON24:
107: if (p[1] < 128 && p[1] >= -128) {
108: suboppr = subop = p[1];
109: p++;
110: n--;
111: if (op == O_CON2) {
112: op = O_CON1;
113: cp = otext[O_CON1];
114: }
115: if (op == O_CON24) {
116: op = O_CON14;
117: cp = otext[O_CON14];
118: }
119: }
120: break;
121: case O_CON8:
122: {
123: short *sp = &p[1];
124:
125: #ifdef DEBUG
126: if ( opt( 'k' ) )
127: printf ( ")#%5d\tCON8\t%10.3f\n" ,
128: lc - HEADER_BYTES ,
129: * ( ( double * ) &p[1] ) );
130: #endif
131: word ( op );
132: for ( i = 1 ; i <= 4 ; i ++ )
133: word ( *sp ++ );
134: return ( oldlc );
135: }
136: default:
137: if (op >= O_REL2 && op <= O_REL84) {
138: if ((i = (subop >> 1) * 5 ) >= 30)
139: i -= 30;
140: else
141: i += 2;
142: #ifdef DEBUG
143: string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i];
144: #endif
145: suboppr = 0;
146: }
147: break;
148: case O_IF:
149: case O_TRA:
150: /*****
151: codeline = 0;
152: *****/
153: case O_FOR1U:
154: case O_FOR2U:
155: case O_FOR4U:
156: case O_FOR1D:
157: case O_FOR2D:
158: case O_FOR4D:
159: /* relative addressing */
160: p[1] -= ( unsigned ) lc + 2;
161: break;
162: case O_CONG:
163: i = p[1];
164: cp = * ( ( char ** ) &p[2] ) ;
165: #ifdef DEBUG
166: if (opt('k'))
167: printf(")#%5d\tCONG:%d\t%s\n",
168: lc - HEADER_BYTES, i, cp);
169: #endif
170: if (i <= 127)
171: word(O_CON | i << 8);
172: else {
173: word(O_CON);
174: word(i);
175: }
176: while (i > 0) {
177: w = *cp ? *cp++ : ' ';
178: w |= (*cp ? *cp++ : ' ') << 8;
179: word(w);
180: i -= 2;
181: }
182: return (oldlc);
183: case O_CONC:
184: #ifdef DEBUG
185: (string = "'x'")[1] = p[1];
186: #endif
187: suboppr = 0;
188: op = O_CON1;
189: cp = otext[O_CON1];
190: subop = p[1];
191: goto around;
192: case O_CONC4:
193: #ifdef DEBUG
194: (string = "'x'")[1] = p[1];
195: #endif
196: suboppr = 0;
197: op = O_CON14;
198: subop = p[1];
199: goto around;
200: case O_CON1:
201: case O_CON14:
202: suboppr = subop = p[1];
203: around:
204: n--;
205: break;
206: case O_CASEBEG:
207: casewrd = 0;
208: return (oldlc);
209: case O_CASEEND:
210: if ((unsigned) lc & 1) {
211: lc--;
212: word(casewrd);
213: }
214: return (oldlc);
215: case O_CASE1:
216: #ifdef DEBUG
217: if (opt('k'))
218: printf(")#%5d\tCASE1\t%d\n"
219: , lc - HEADER_BYTES
220: , ( int ) *( ( long * ) &p[1] ) );
221: #endif
222: /*
223: * this to build a byte size case table
224: * saving bytes across calls in casewrd
225: * so they can be put out by word()
226: */
227: lc++;
228: if ((unsigned) lc & 1)
229: casewrd = *( ( long * ) &p[1] ) & 0377;
230: else {
231: lc -= 2;
232: word ( casewrd
233: | ( ( int ) *( ( long * ) &p[1] ) << 8 ) );
234: }
235: return (oldlc);
236: case O_CASE2:
237: #ifdef DEBUG
238: if (opt('k'))
239: printf(")#%5d\tCASE2\t%d\n"
240: , lc - HEADER_BYTES
241: , ( int ) *( ( long * ) &p[1] ) );
242: #endif
243: word( ( short ) *( ( long * ) &p[1] ) );
244: return (oldlc);
245: case O_FCALL:
246: if (p[1] == 0)
247: goto longgen;
248: /* and fall through */
249: case O_PUSH:
250: if (p[1] == 0)
251: return (oldlc);
252: if (p[1] < 128 && p[1] >= -128) {
253: suboppr = subop = p[1];
254: p++;
255: n--;
256: break;
257: }
258: goto longgen;
259: case O_TRA4:
260: case O_CALL:
261: case O_FSAV:
262: case O_GOTO:
263: case O_NAM:
264: case O_READE:
265: /* absolute long addressing */
266: p[1] -= HEADER_BYTES;
267: goto longgen;
268: case O_RV1:
269: case O_RV14:
270: case O_RV2:
271: case O_RV24:
272: case O_RV4:
273: case O_RV8:
274: case O_RV:
275: case O_LV:
276: if (p[1] < SHORTADDR && p[1] >= -SHORTADDR)
277: break;
278: else {
279: op += O_LRV - O_RV;
280: cp = otext[op];
281: }
282: case O_BEG:
283: case O_NODUMP:
284: case O_CON4:
285: case O_CASE4:
286: case O_RANG4:
287: case O_RANG24:
288: case O_RSNG4:
289: case O_RSNG24:
290: longgen:
291: {
292: short *sp = &p[1];
293: long *lp = &p[1];
294:
295: n = (n << 1) - 1;
296: if ( op == O_LRV )
297: n--;
298: #ifdef DEBUG
299: if (opt('k'))
300: {
301: printf( ")#%5d\t%s" , lc - HEADER_BYTES , cp+1 );
302: if (suboppr)
303: printf(":%1d", suboppr);
304: for ( i = 1 ; i < n
305: ; i += sizeof ( long )/sizeof ( short ) )
306: printf( "\t%D " , *lp ++ );
307: pchr ( '\n' );
308: }
309: #endif
310: if ( op != O_CASE4 )
311: word ( op | subop<<8 );
312: for ( i = 1 ; i < n ; i ++ )
313: word ( *sp ++ );
314: return ( oldlc );
315: }
316: }
317: #ifdef DEBUG
318: if (opt('k')) {
319: printf(")#%5d\t%s", lc - HEADER_BYTES, cp+1);
320: if (suboppr)
321: printf(":%d", suboppr);
322: if (string)
323: printf("\t%s",string);
324: if (n > 1)
325: pchr('\t');
326: for (i=1; i<n; i++)
327: printf("%d ", ( short ) p[i]);
328: pchr('\n');
329: }
330: #endif
331: if (op != NIL)
332: word(op | subop << 8);
333: for (i=1; i<n; i++)
334: word(p[i]);
335: return (oldlc);
336: }
337: #endif OBJ
338:
339: /*
340: * listnames outputs a list of enumerated type names which
341: * can then be selected from to output a TSCAL
342: * a pointer to the address in the code of the namelist
343: * is kept in value[ NL_ELABEL ].
344: */
345: listnames(ap)
346:
347: register struct nl *ap;
348: {
349: struct nl *next;
350: register int oldlc, len;
351: register unsigned w;
352: register char *strptr;
353:
354: if (cgenflg < 0)
355: /* code is off - do nothing */
356: return(NIL);
357: if (ap->class != TYPE)
358: ap = ap->type;
359: if (ap->value[ NL_ELABEL ] != 0) {
360: /* the list already exists */
361: return( ap -> value[ NL_ELABEL ] );
362: }
363: # ifdef OBJ
364: oldlc = lc;
365: put(2, O_TRA, lc);
366: ap->value[ NL_ELABEL ] = lc;
367: # endif OBJ
368: # ifdef PC
369: putprintf( " .data" , 0 );
370: putprintf( " .align 1" , 0 );
371: ap -> value[ NL_ELABEL ] = getlab();
372: putlab( ap -> value[ NL_ELABEL ] );
373: # endif PC
374: /* number of scalars */
375: next = ap->type;
376: len = next->range[1]-next->range[0]+1;
377: # ifdef OBJ
378: put(2, O_CASE2, len);
379: # endif OBJ
380: # ifdef PC
381: putprintf( " .word %d" , 0 , len );
382: # endif PC
383: /* offsets of each scalar name */
384: len = (len+1)*sizeof(short);
385: # ifdef OBJ
386: put(2, O_CASE2, len);
387: # endif OBJ
388: # ifdef PC
389: putprintf( " .word %d" , 0 , len );
390: # endif PC
391: next = ap->chain;
392: do {
393: for(strptr = next->symbol; *strptr++; len++)
394: continue;
395: len++;
396: # ifdef OBJ
397: put(2, O_CASE2, len);
398: # endif OBJ
399: # ifdef PC
400: putprintf( " .word %d" , 0 , len );
401: # endif PC
402: } while (next = next->chain);
403: /* list of scalar names */
404: strptr = getnext(ap, &next);
405: # ifdef OBJ
406: do {
407: w = (unsigned) *strptr;
408: if (!*strptr++)
409: strptr = getnext(next, &next);
410: w |= *strptr << 8;
411: if (!*strptr++)
412: strptr = getnext(next, &next);
413: word(w);
414: } while (next);
415: /* jump over the mess */
416: patch(oldlc);
417: # endif OBJ
418: # ifdef PC
419: while ( next ) {
420: while ( *strptr ) {
421: putprintf( " .byte 0%o" , 1 , *strptr++ );
422: for ( w = 2 ; ( w <= 8 ) && *strptr ; w ++ ) {
423: putprintf( ",0%o" , 1 , *strptr++ );
424: }
425: putprintf( "" , 0 );
426: }
427: putprintf( " .byte 0" , 0 );
428: strptr = getnext( next , &next );
429: }
430: putprintf( " .text" , 0 );
431: # endif PC
432: return( ap -> value[ NL_ELABEL ] );
433: }
434:
435: getnext(next, new)
436:
437: struct nl *next, **new;
438: {
439: if (next != NIL) {
440: next = next->chain;
441: *new = next;
442: }
443: if (next == NIL)
444: return("");
445: #ifdef OBJ
446: if (opt('k') && cgenflg >= 0)
447: printf(")#%5d\t\t\"%s\"\n", lc-HEADER_BYTES, next->symbol);
448: #endif
449: return(next->symbol);
450: }
451:
452: #ifdef OBJ
453: /*
454: * Putspace puts out a table
455: * of nothing to leave space
456: * for the case branch table e.g.
457: */
458: putspace(n)
459: int n;
460: {
461: register i;
462:
463: if (cgenflg < 0)
464: /*
465: * code disabled - do nothing
466: */
467: return(lc);
468: #ifdef DEBUG
469: if (opt('k'))
470: printf(")#%5d\t.=.+%d\n", lc - HEADER_BYTES, n);
471: #endif
472: for (i = even(n); i > 0; i -= 2)
473: word(0);
474: }
475:
476: putstr(sptr, padding)
477:
478: char *sptr;
479: int padding;
480: {
481: register unsigned short w;
482: register char *strptr = sptr;
483: register int pad = padding;
484:
485: if (cgenflg < 0)
486: /*
487: * code disabled - do nothing
488: */
489: return(lc);
490: #ifdef DEBUG
491: if (opt('k'))
492: printf(")#%5D\t\t\"%s\"\n", lc-HEADER_BYTES, strptr);
493: #endif
494: if (pad == 0) {
495: do {
496: w = (unsigned short) * strptr;
497: if (w)
498: w |= *++strptr << 8;
499: word(w);
500: } while (*strptr++);
501: } else {
502: do {
503: w = (unsigned short) * strptr;
504: if (w) {
505: if (*++strptr)
506: w |= *strptr << 8;
507: else {
508: w |= ' ' << 8;
509: pad--;
510: }
511: word(w);
512: }
513: } while (*strptr++);
514: while (pad > 1) {
515: word(' ');
516: pad -= 2;
517: }
518: if (pad == 1)
519: word(' ');
520: else
521: word(0);
522: }
523: }
524: #endif OBJ
525:
526: lenstr(sptr, padding)
527:
528: char *sptr;
529: int padding;
530:
531: {
532: register int cnt;
533: register char *strptr = sptr;
534:
535: cnt = padding;
536: do {
537: cnt++;
538: } while (*strptr++);
539: return((++cnt) & ~1);
540: }
541:
542: /*
543: * Patch repairs the branch
544: * at location loc to come
545: * to the current location.
546: * for PC, this puts down the label
547: * and the branch just references that label.
548: * lets here it for two pass assemblers.
549: */
550: patch(loc)
551: {
552:
553: # ifdef OBJ
554: patchfil(loc, lc-loc-2, 1);
555: # endif OBJ
556: # ifdef PC
557: putlab( loc );
558: # endif PC
559: }
560:
561: #ifdef OBJ
562: patch4(loc)
563: {
564:
565: patchfil(loc, lc - HEADER_BYTES, 2);
566: }
567:
568: /*
569: * Patchfil makes loc+2 have value
570: * as its contents.
571: */
572: patchfil(loc, value, words)
573: PTR_DCL loc;
574: int value, words;
575: {
576: register i;
577:
578: if (cgenflg < 0)
579: return;
580: if (loc > (unsigned) lc)
581: panic("patchfil");
582: #ifdef DEBUG
583: if (opt('k'))
584: printf(")#\tpatch %u %d\n", loc - HEADER_BYTES, value);
585: #endif
586: do {
587: i = ((unsigned) loc + 2 - ((unsigned) lc & ~01777))/2;
588: if (i >= 0 && i < 1024)
589: obuf[i] = value;
590: else {
591: lseek(ofil, (long) loc+2, 0);
592: write(ofil, &value, 2);
593: lseek(ofil, (long) 0, 2);
594: }
595: loc += 2;
596: value = value >> 16;
597: } while (--words);
598: }
599:
600: /*
601: * Put the word o into the code
602: */
603: word(o)
604: int o;
605: {
606:
607: *obufp = o;
608: obufp++;
609: lc += 2;
610: if (obufp >= obuf+512)
611: pflush();
612: }
613:
614: extern char *obj;
615: /*
616: * Flush the code buffer
617: */
618: pflush()
619: {
620: register i;
621:
622: i = (obufp - ( ( short * ) obuf ) ) * 2;
623: if (i != 0 && write(ofil, obuf, i) != i)
624: perror(obj), pexit(DIED);
625: obufp = obuf;
626: }
627: #endif OBJ
628:
629: /*
630: * Getlab - returns the location counter.
631: * included here for the eventual code generator.
632: * for PC, thank you!
633: */
634: getlab()
635: {
636: # ifdef OBJ
637:
638: return (lc);
639: # endif OBJ
640: # ifdef PC
641: static long lastlabel;
642:
643: return ( ++lastlabel );
644: # endif PC
645: }
646:
647: /*
648: * Putlab - lay down a label.
649: * for PC, just print the label name with a colon after it.
650: */
651: putlab(l)
652: int l;
653: {
654:
655: # ifdef PC
656: putprintf( PREFIXFORMAT , 1 , LABELPREFIX , l );
657: putprintf( ":" , 0 );
658: # endif PC
659: return (l);
660: }
661:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.