![[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] / 42BSD / ucb / pascal / src|
Return to put.c CVS log | Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src |
1.1 root 1: /* Copyright (c) 1979 Regents of the University of California */
2:
3: static char sccsid[] = "@(#)put.c 1.23 4/8/83";
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: # include "align.h"
12: #endif PC
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: #include "OPnames.h"
22: #endif
23:
24: #ifdef OBJ
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: register short *sp;
35: register long *lp;
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 ( !CGENNING )
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: case O_ABORT:
67: cp = "*";
68: break;
69: case O_AS:
70: switch(p[1]) {
71: case 0:
72: break;
73: case 2:
74: op = O_AS2;
75: n = 1;
76: break;
77: case 4:
78: op = O_AS4;
79: n = 1;
80: break;
81: case 8:
82: op = O_AS8;
83: n = 1;
84: break;
85: default:
86: goto pack;
87: }
88: # ifdef DEBUG
89: cp = otext[op];
90: # endif DEBUG
91: break;
92: case O_FOR1U:
93: case O_FOR2U:
94: case O_FOR4U:
95: case O_FOR1D:
96: case O_FOR2D:
97: case O_FOR4D:
98: /* relative addressing */
99: p[1] -= ( unsigned ) lc + sizeof(short);
100: /* try to pack the jump */
101: if (p[1] <= 127 && p[1] >= -128) {
102: suboppr = subop = p[1];
103: p++;
104: n--;
105: } else {
106: /* have to allow for extra displacement */
107: p[1] -= sizeof(short);
108: }
109: break;
110: case O_CONG:
111: case O_LVCON:
112: case O_CON:
113: case O_LINO:
114: case O_NEW:
115: case O_DISPOSE:
116: case O_DFDISP:
117: case O_IND:
118: case O_OFF:
119: case O_INX2:
120: case O_INX4:
121: case O_CARD:
122: case O_ADDT:
123: case O_SUBT:
124: case O_MULT:
125: case O_IN:
126: case O_CASE1OP:
127: case O_CASE2OP:
128: case O_CASE4OP:
129: case O_FRTN:
130: case O_WRITES:
131: case O_WRITEC:
132: case O_WRITEF:
133: case O_MAX:
134: case O_MIN:
135: case O_ARGV:
136: case O_CTTOT:
137: case O_INCT:
138: case O_RANG2:
139: case O_RSNG2:
140: case O_RANG42:
141: case O_RSNG42:
142: case O_SUCC2:
143: case O_SUCC24:
144: case O_PRED2:
145: case O_PRED24:
146: if (p[1] == 0)
147: break;
148: case O_CON2:
149: case O_CON24:
150: pack:
151: if (p[1] <= 127 && p[1] >= -128) {
152: suboppr = subop = p[1];
153: p++;
154: n--;
155: if (op == O_CON2) {
156: op = O_CON1;
157: # ifdef DEBUG
158: cp = otext[O_CON1];
159: # endif DEBUG
160: }
161: if (op == O_CON24) {
162: op = O_CON14;
163: # ifdef DEBUG
164: cp = otext[O_CON14];
165: # endif DEBUG
166: }
167: }
168: break;
169: case O_CON8:
170: {
171: short *sp = &p[1];
172:
173: #ifdef DEBUG
174: if ( opt( 'k' ) )
175: printf ( "%5d\tCON8\t%22.14e\n" ,
176: lc - HEADER_BYTES ,
177: * ( ( double * ) &p[1] ) );
178: #endif
179: # ifdef DEC11
180: word(op);
181: # else
182: word(op << 8);
183: # endif DEC11
184: for ( i = 1 ; i <= 4 ; i ++ )
185: word ( *sp ++ );
186: return ( oldlc );
187: }
188: default:
189: if (op >= O_REL2 && op <= O_REL84) {
190: if ((i = (subop >> INDX) * 5 ) >= 30)
191: i -= 30;
192: else
193: i += 2;
194: #ifdef DEBUG
195: string = &"IFEQ\0IFNE\0IFLT\0IFGT\0IFLE\0IFGE"[i];
196: #endif
197: suboppr = 0;
198: }
199: break;
200: case O_IF:
201: case O_TRA:
202: /*****
203: codeline = 0;
204: *****/
205: /* relative addressing */
206: p[1] -= ( unsigned ) lc + sizeof(short);
207: break;
208: case O_CONC:
209: #ifdef DEBUG
210: (string = "'x'")[1] = p[1];
211: #endif
212: suboppr = 0;
213: op = O_CON1;
214: # ifdef DEBUG
215: cp = otext[O_CON1];
216: # endif DEBUG
217: subop = p[1];
218: goto around;
219: case O_CONC4:
220: #ifdef DEBUG
221: (string = "'x'")[1] = p[1];
222: #endif
223: suboppr = 0;
224: op = O_CON14;
225: subop = p[1];
226: goto around;
227: case O_CON1:
228: case O_CON14:
229: suboppr = subop = p[1];
230: around:
231: n--;
232: break;
233: case O_CASEBEG:
234: casewrd = 0;
235: return (oldlc);
236: case O_CASEEND:
237: if ((unsigned) lc & 1) {
238: lc--;
239: word(casewrd);
240: }
241: return (oldlc);
242: case O_CASE1:
243: #ifdef DEBUG
244: if (opt('k'))
245: printf("%5d\tCASE1\t%d\n"
246: , lc - HEADER_BYTES, p[1]);
247: #endif
248: /*
249: * this to build a byte size case table
250: * saving bytes across calls in casewrd
251: * so they can be put out by word()
252: */
253: lc++;
254: if ((unsigned) lc & 1)
255: # ifdef DEC11
256: casewrd = p[1] & 0377;
257: # else
258: casewrd = (p[1] & 0377) << 8;
259: # endif DEC11
260: else {
261: lc -= 2;
262: # ifdef DEC11
263: word(((p[1] & 0377) << 8) | casewrd);
264: # else
265: word((p[1] & 0377) | casewrd);
266: # endif DEC11
267: }
268: return (oldlc);
269: case O_CASE2:
270: #ifdef DEBUG
271: if (opt('k'))
272: printf("%5d\tCASE2\t%d\n"
273: , lc - HEADER_BYTES , p[1]);
274: #endif
275: word(p[1]);
276: return (oldlc);
277: case O_PUSH:
278: lp = (long *)&p[1];
279: if (*lp == 0)
280: return (oldlc);
281: /* and fall through */
282: case O_RANG4:
283: case O_RANG24:
284: case O_RSNG4:
285: case O_RSNG24:
286: case O_SUCC4:
287: case O_PRED4:
288: /* sub opcode optimization */
289: lp = (long *)&p[1];
290: if (*lp < 128 && *lp >= -128 && *lp != 0) {
291: suboppr = subop = *lp;
292: p += (sizeof(long) / sizeof(int));
293: n--;
294: }
295: goto longgen;
296: case O_TRA4:
297: case O_CALL:
298: case O_FSAV:
299: case O_GOTO:
300: case O_NAM:
301: case O_READE:
302: /* absolute long addressing */
303: lp = (long *)&p[1];
304: *lp -= HEADER_BYTES;
305: goto longgen;
306: case O_RV1:
307: case O_RV14:
308: case O_RV2:
309: case O_RV24:
310: case O_RV4:
311: case O_RV8:
312: case O_RV:
313: case O_LV:
314: /*
315: * positive offsets represent arguments
316: * and must use "ap" display entry rather
317: * than the "fp" entry
318: */
319: if (p[1] >= 0) {
320: subop++;
321: suboppr++;
322: }
323: # ifdef PDP11
324: break;
325: # else
326: /*
327: * offsets out of range of word addressing
328: * must use long offset opcodes
329: */
330: if (p[1] < SHORTADDR && p[1] >= -SHORTADDR)
331: break;
332: else {
333: op += O_LRV - O_RV;
334: # ifdef DEBUG
335: cp = otext[op];
336: # endif DEBUG
337: }
338: /* and fall through */
339: # endif PDP11
340: case O_BEG:
341: case O_NODUMP:
342: case O_CON4:
343: case O_CASE4:
344: longgen:
345: n = (n << 1) - 1;
346: if ( op == O_LRV ) {
347: n--;
348: # if defined(ADDR32) && !defined(DEC11)
349: p[n / 2] <<= 16;
350: # endif
351: }
352: #ifdef DEBUG
353: if (opt('k')) {
354: printf("%5d\t%s", lc - HEADER_BYTES, cp+1);
355: if (suboppr)
356: printf(":%d", suboppr);
357: for ( i = 2, lp = (long *)&p[1]; i < n
358: ; i += sizeof ( long )/sizeof ( short ) )
359: printf( "\t%D " , *lp ++ );
360: if (i == n) {
361: sp = (short *)lp;
362: printf( "\t%d ", *sp );
363: }
364: pchr ( '\n' );
365: }
366: #endif
367: if ( op != O_CASE4 )
368: # ifdef DEC11
369: word((op & 0377) | subop << 8);
370: # else
371: word(op << 8 | (subop & 0377));
372: # endif DEC11
373: for ( i = 1, sp = (short *)&p[1]; i < n; i++)
374: word ( *sp ++ );
375: return ( oldlc );
376: }
377: #ifdef DEBUG
378: if (opt('k')) {
379: printf("%5d\t%s", lc - HEADER_BYTES, cp+1);
380: if (suboppr)
381: printf(":%d", suboppr);
382: if (string)
383: printf("\t%s",string);
384: if (n > 1)
385: pchr('\t');
386: for (i=1; i<n; i++)
387: printf("%d ", p[i]);
388: pchr('\n');
389: }
390: #endif
391: if (op != NIL)
392: # ifdef DEC11
393: word((op & 0377) | subop << 8);
394: # else
395: word(op << 8 | (subop & 0377));
396: # endif DEC11
397: for (i=1; i<n; i++)
398: word(p[i]);
399: return (oldlc);
400: }
401: #endif OBJ
402:
403: /*
404: * listnames outputs a list of enumerated type names which
405: * can then be selected from to output a TSCAL
406: * a pointer to the address in the code of the namelist
407: * is kept in value[ NL_ELABEL ].
408: */
409: listnames(ap)
410:
411: register struct nl *ap;
412: {
413: struct nl *next;
414: register int oldlc, len;
415: register unsigned w;
416: register char *strptr;
417:
418: if ( !CGENNING )
419: /* code is off - do nothing */
420: return(NIL);
421: if (ap->class != TYPE)
422: ap = ap->type;
423: if (ap->value[ NL_ELABEL ] != 0) {
424: /* the list already exists */
425: return( ap -> value[ NL_ELABEL ] );
426: }
427: # ifdef OBJ
428: oldlc = lc;
429: put(2, O_TRA, lc);
430: ap->value[ NL_ELABEL ] = lc;
431: # endif OBJ
432: # ifdef PC
433: putprintf(" .data", 0);
434: aligndot(A_STRUCT);
435: ap -> value[ NL_ELABEL ] = getlab();
436: putlab( ap -> value[ NL_ELABEL ] );
437: # endif PC
438: /* number of scalars */
439: next = ap->type;
440: len = next->range[1]-next->range[0]+1;
441: # ifdef OBJ
442: put(2, O_CASE2, len);
443: # endif OBJ
444: # ifdef PC
445: putprintf( " .word %d" , 0 , len );
446: # endif PC
447: /* offsets of each scalar name */
448: len = (len+1)*sizeof(short);
449: # ifdef OBJ
450: put(2, O_CASE2, len);
451: # endif OBJ
452: # ifdef PC
453: putprintf( " .word %d" , 0 , len );
454: # endif PC
455: next = ap->chain;
456: do {
457: for(strptr = next->symbol; *strptr++; len++)
458: continue;
459: len++;
460: # ifdef OBJ
461: put(2, O_CASE2, len);
462: # endif OBJ
463: # ifdef PC
464: putprintf( " .word %d" , 0 , len );
465: # endif PC
466: } while (next = next->chain);
467: /* list of scalar names */
468: strptr = getnext(ap, &next);
469: # ifdef OBJ
470: do {
471: # ifdef DEC11
472: w = (unsigned) *strptr;
473: # else
474: w = *strptr << 8;
475: # endif DEC11
476: if (!*strptr++)
477: strptr = getnext(next, &next);
478: # ifdef DEC11
479: w |= *strptr << 8;
480: # else
481: w |= (unsigned) *strptr;
482: # endif DEC11
483: if (!*strptr++)
484: strptr = getnext(next, &next);
485: word(w);
486: } while (next);
487: /* jump over the mess */
488: patch(oldlc);
489: # endif OBJ
490: # ifdef PC
491: while ( next ) {
492: while ( *strptr ) {
493: putprintf( " .byte 0%o" , 1 , *strptr++ );
494: for ( w = 2 ; ( w <= 8 ) && *strptr ; w ++ ) {
495: putprintf( ",0%o" , 1 , *strptr++ );
496: }
497: putprintf( "" , 0 );
498: }
499: putprintf( " .byte 0" , 0 );
500: strptr = getnext( next , &next );
501: }
502: putprintf( " .text" , 0 );
503: # endif PC
504: return( ap -> value[ NL_ELABEL ] );
505: }
506:
507: getnext(next, new)
508:
509: struct nl *next, **new;
510: {
511: if (next != NIL) {
512: next = next->chain;
513: *new = next;
514: }
515: if (next == NIL)
516: return("");
517: #ifdef OBJ
518: if (opt('k') && CGENNING )
519: printf("%5d\t\t\"%s\"\n", lc-HEADER_BYTES, next->symbol);
520: #endif OBJ
521: return(next->symbol);
522: }
523:
524: #ifdef OBJ
525: /*
526: * Putspace puts out a table
527: * of nothing to leave space
528: * for the case branch table e.g.
529: */
530: putspace(n)
531: int n;
532: {
533: register i;
534:
535: if ( !CGENNING )
536: /*
537: * code disabled - do nothing
538: */
539: return(lc);
540: #ifdef DEBUG
541: if (opt('k'))
542: printf("%5d\t.=.+%d\n", lc - HEADER_BYTES, n);
543: #endif
544: for (i = even(n); i > 0; i -= 2)
545: word(0);
546: }
547:
548: putstr(sptr, padding)
549:
550: char *sptr;
551: int padding;
552: {
553: register unsigned short w;
554: register char *strptr = sptr;
555: register int pad = padding;
556:
557: if ( !CGENNING )
558: /*
559: * code disabled - do nothing
560: */
561: return(lc);
562: #ifdef DEBUG
563: if (opt('k'))
564: printf("%5d\t\t\"%s\"\n", lc-HEADER_BYTES, strptr);
565: #endif
566: if (pad == 0) {
567: do {
568: # ifdef DEC11
569: w = (unsigned short) * strptr;
570: # else
571: w = (unsigned short)*strptr<<8;
572: # endif DEC11
573: if (w)
574: # ifdef DEC11
575: w |= *++strptr << 8;
576: # else
577: w |= *++strptr;
578: # endif DEC11
579: word(w);
580: } while (*strptr++);
581: } else {
582: # ifdef DEC11
583: do {
584: w = (unsigned short) * strptr;
585: if (w) {
586: if (*++strptr)
587: w |= *strptr << 8;
588: else {
589: w |= ' ' << 8;
590: pad--;
591: }
592: word(w);
593: }
594: } while (*strptr++);
595: # else
596: do {
597: w = (unsigned short)*strptr<<8;
598: if (w) {
599: if (*++strptr)
600: w |= *strptr;
601: else {
602: w |= ' ';
603: pad--;
604: }
605: word(w);
606: }
607: } while (*strptr++);
608: # endif DEC11
609: while (pad > 1) {
610: # ifdef DEC11
611: word(' ' | (' ' << 8));
612: # else
613: word((' ' << 8) | ' ');
614: # endif DEC11
615: pad -= 2;
616: }
617: if (pad == 1)
618: # ifdef DEC11
619: word(' ');
620: # else
621: word(' ' << 8);
622: # endif DEC11
623: else
624: word(0);
625: }
626: }
627: #endif OBJ
628:
629: lenstr(sptr, padding)
630:
631: char *sptr;
632: int padding;
633:
634: {
635: register int cnt;
636: register char *strptr = sptr;
637:
638: cnt = padding;
639: do {
640: cnt++;
641: } while (*strptr++);
642: return((++cnt) & ~1);
643: }
644:
645: /*
646: * Patch repairs the branch
647: * at location loc to come
648: * to the current location.
649: * for PC, this puts down the label
650: * and the branch just references that label.
651: * lets here it for two pass assemblers.
652: */
653: patch(loc)
654: {
655:
656: # ifdef OBJ
657: patchfil(loc, (long)(lc-loc-2), 1);
658: # endif OBJ
659: # ifdef PC
660: putlab( loc );
661: # endif PC
662: }
663:
664: #ifdef OBJ
665: patch4(loc)
666: {
667: patchfil(loc, (long)(lc - HEADER_BYTES), 2);
668: }
669:
670: /*
671: * Patchfil makes loc+2 have jmploc
672: * as its contents.
673: */
674: patchfil(loc, jmploc, words)
675: PTR_DCL loc;
676: long jmploc;
677: int words;
678: {
679: register i;
680: short val;
681:
682: if ( !CGENNING )
683: return;
684: if (loc > (unsigned) lc)
685: panic("patchfil");
686: #ifdef DEBUG
687: if (opt('k'))
688: printf("\tpatch %u %D\n", loc - HEADER_BYTES, jmploc);
689: #endif
690: val = jmploc;
691: do {
692: # ifndef DEC11
693: if (words > 1)
694: val = jmploc >> 16;
695: else
696: val = jmploc;
697: # endif DEC11
698: i = ((unsigned) loc + 2 - ((unsigned) lc & ~01777))/2;
699: if (i >= 0 && i < 1024) {
700: obuf[i] = val;
701: } else {
702: lseek(ofil, (long) loc+2, 0);
703: write(ofil, &val, 2);
704: lseek(ofil, (long) 0, 2);
705: }
706: loc += 2;
707: # ifdef DEC11
708: val = jmploc >> 16;
709: # endif DEC11
710: } while (--words);
711: }
712:
713: /*
714: * Put the word o into the code
715: */
716: word(o)
717: int o;
718: {
719:
720: *obufp = o;
721: obufp++;
722: lc += 2;
723: if (obufp >= obuf+512)
724: pflush();
725: }
726:
727: extern char *obj;
728: /*
729: * Flush the code buffer
730: */
731: pflush()
732: {
733: register i;
734:
735: i = (obufp - ( ( short * ) obuf ) ) * 2;
736: if (i != 0 && write(ofil, obuf, i) != i)
737: perror(obj), pexit(DIED);
738: obufp = obuf;
739: }
740: #endif OBJ
741:
742: /*
743: * Getlab - returns the location counter.
744: * included here for the eventual code generator.
745: * for PC, thank you!
746: */
747: getlab()
748: {
749: # ifdef OBJ
750:
751: return (lc);
752: # endif OBJ
753: # ifdef PC
754: static long lastlabel;
755:
756: return ( ++lastlabel );
757: # endif PC
758: }
759:
760: /*
761: * Putlab - lay down a label.
762: * for PC, just print the label name with a colon after it.
763: */
764: putlab(l)
765: int l;
766: {
767:
768: # ifdef PC
769: putprintf( PREFIXFORMAT , 1 , LABELPREFIX , l );
770: putprintf( ":" , 0 );
771: # endif PC
772: return (l);
773: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.