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