![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to p2put.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 p2put.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[] = "@(#)p2put.c 1.14 9/5/83";
4:
5: /*
6: * functions to help pi put out
7: * polish postfix binary portable c compiler intermediate code
8: * thereby becoming the portable pascal compiler
9: */
10:
11: #include "whoami.h"
12: #ifdef PC
13: #include "0.h"
14: #include "objfmt.h"
15: #include "pcops.h"
16: #include "pc.h"
17: #include "align.h"
18: #include "tmps.h"
19:
20: /*
21: * mash into f77's format
22: * lovely, isn't it?
23: */
24: #define TOF77( fop,val,rest ) ( ( ( (rest) & 0177777 ) << 16 ) \
25: | ( ( (val) & 0377 ) << 8 ) \
26: | ( (fop) & 0377 ) )
27:
28: /*
29: * emits an ftext operator and a string to the pcstream
30: */
31: puttext( string )
32: char *string;
33: {
34: int length = str4len( string );
35:
36: if ( !CGENNING )
37: return;
38: p2word( TOF77( P2FTEXT , length , 0 ) );
39: # ifdef DEBUG
40: if ( opt( 'k' ) ) {
41: fprintf( stdout , "P2FTEXT | %3d | 0 " , length );
42: }
43: # endif
44: p2string( string );
45: }
46:
47: int
48: str4len( string )
49: char *string;
50: {
51:
52: return ( ( strlen( string ) + 3 ) / 4 );
53: }
54:
55: /*
56: * put formatted text into a buffer for printing to the pcstream.
57: * a call to putpflush actually puts out the text.
58: * none of arg1 .. arg5 need be present.
59: * and you can add more if you need them.
60: */
61: /* VARARGS */
62: putprintf( format , incomplete , arg1 , arg2 , arg3 , arg4 , arg5 )
63: char *format;
64: int incomplete;
65: {
66: static char ppbuffer[ BUFSIZ ];
67: static char *ppbufp = ppbuffer;
68:
69: if ( !CGENNING )
70: return;
71: sprintf( ppbufp , format , arg1 , arg2 , arg3 , arg4 , arg5 );
72: ppbufp = &( ppbuffer[ strlen( ppbuffer ) ] );
73: if ( ppbufp >= &( ppbuffer[ BUFSIZ ] ) )
74: panic( "putprintf" );
75: if ( ! incomplete ) {
76: puttext( ppbuffer );
77: ppbufp = ppbuffer;
78: }
79: }
80:
81: /*
82: * emit a left bracket operator to pcstream
83: * with function number, the maximum temp register, and total local bytes
84: */
85: putlbracket(ftnno, sizesp)
86: int ftnno;
87: struct om *sizesp;
88: {
89: int maxtempreg;
90: int alignedframesize;
91:
92: # ifdef vax
93: maxtempreg = sizesp->curtmps.next_avail[REG_GENERAL];
94: # endif vax
95: # ifdef mc68000
96: /*
97: * this is how /lib/f1 wants it.
98: */
99: maxtempreg = (sizesp->curtmps.next_avail[REG_ADDR] << 4)
100: | (sizesp->curtmps.next_avail[REG_DATA]);
101: # endif mc68000
102: alignedframesize =
103: roundup(BITSPERBYTE * -sizesp->curtmps.om_off, BITSPERBYTE * A_STACK);
104: p2word( TOF77( P2FLBRAC , maxtempreg , ftnno ) );
105: p2word(alignedframesize);
106: # ifdef DEBUG
107: if ( opt( 'k' ) ) {
108: fprintf(stdout, "P2FLBRAC | %3d | %d %d\n",
109: maxtempreg, ftnno, alignedframesize);
110: }
111: # endif
112: }
113:
114: /*
115: * emit a right bracket operator
116: * which for the binary interface
117: * forces the stack allocate and register mask
118: */
119: putrbracket( ftnno )
120: int ftnno;
121: {
122:
123: p2word( TOF77( P2FRBRAC , 0 , ftnno ) );
124: # ifdef DEBUG
125: if ( opt( 'k' ) ) {
126: fprintf( stdout , "P2FRBRAC | 0 | %d\n" , ftnno );
127: }
128: # endif
129: }
130:
131: /*
132: * emit an eof operator
133: */
134: puteof()
135: {
136:
137: p2word( P2FEOF );
138: # ifdef DEBUG
139: if ( opt( 'k' ) ) {
140: fprintf( stdout , "P2FEOF\n" );
141: }
142: # endif
143: }
144:
145: /*
146: * emit a dot operator,
147: * with a source file line number and name
148: * if line is negative, there was an error on that line, but who cares?
149: */
150: putdot( filename , line )
151: char *filename;
152: int line;
153: {
154: int length = str4len( filename );
155:
156: if ( line < 0 ) {
157: line = -line;
158: }
159: p2word( TOF77( P2FEXPR , length , line ) );
160: # ifdef DEBUG
161: if ( opt( 'k' ) ) {
162: fprintf( stdout , "P2FEXPR | %3d | %d " , length , line );
163: }
164: # endif
165: p2string( filename );
166: }
167:
168: /*
169: * put out a leaf node
170: */
171: putleaf( op , lval , rval , type , name )
172: int op;
173: int lval;
174: int rval;
175: int type;
176: char *name;
177: {
178: if ( !CGENNING )
179: return;
180: switch ( op ) {
181: default:
182: panic( "[putleaf]" );
183: case P2ICON:
184: p2word( TOF77( P2ICON , name != NIL , type ) );
185: p2word( lval );
186: # ifdef DEBUG
187: if ( opt( 'k' ) ) {
188: fprintf( stdout , "P2ICON | %3d | 0x%x "
189: , name != NIL , type );
190: fprintf( stdout , "%d\n" , lval );
191: }
192: # endif
193: if ( name )
194: p2name( name );
195: break;
196: case P2NAME:
197: p2word( TOF77( P2NAME , lval != 0 , type ) );
198: if ( lval )
199: p2word( lval );
200: # ifdef DEBUG
201: if ( opt( 'k' ) ) {
202: fprintf( stdout , "P2NAME | %3d | 0x%x "
203: , lval != 0 , type );
204: if ( lval )
205: fprintf( stdout , "%d " , lval );
206: }
207: # endif
208: p2name( name );
209: break;
210: case P2REG:
211: p2word( TOF77( P2REG , rval , type ) );
212: # ifdef DEBUG
213: if ( opt( 'k' ) ) {
214: fprintf( stdout , "P2REG | %3d | 0x%x\n" ,
215: rval , type );
216: }
217: # endif
218: break;
219: }
220: }
221:
222: /*
223: * rvalues are just lvalues with indirection, except
224: * special cases for registers and for named globals,
225: * whose names are their rvalues.
226: */
227: putRV( name , level , offset , other_flags , type )
228: char *name;
229: int level;
230: int offset;
231: char other_flags;
232: int type;
233: {
234: char extname[ BUFSIZ ];
235: char *printname;
236: int regnumber;
237:
238: if ( !CGENNING )
239: return;
240: if ( other_flags & NREGVAR ) {
241: if ( ( offset < 0 ) || ( offset > P2FP ) ) {
242: panic( "putRV regvar" );
243: }
244: putleaf( P2REG , 0 , offset , type , 0 );
245: return;
246: }
247: if ( whereis( level , offset , other_flags ) == GLOBALVAR ) {
248: if ( name != 0 ) {
249: if ( name[0] != '_' ) {
250: sprintf( extname , EXTFORMAT , name );
251: printname = extname;
252: } else {
253: printname = name;
254: }
255: putleaf( P2NAME , offset , 0 , type , printname );
256: return;
257: } else {
258: panic( "putRV no name" );
259: }
260: }
261: putLV( name , level , offset , other_flags , type );
262: putop( P2UNARY P2MUL , type );
263: }
264:
265: /*
266: * put out an lvalue
267: * given a level and offset
268: * special case for
269: * named globals, whose lvalues are just their names as constants.
270: */
271: putLV( name , level , offset , other_flags , type )
272: char *name;
273: int level;
274: int offset;
275: char other_flags;
276: int type;
277: {
278: char extname[ BUFSIZ ];
279: char *printname;
280:
281: if ( !CGENNING )
282: return;
283: if ( other_flags & NREGVAR ) {
284: panic( "putLV regvar" );
285: }
286: switch ( whereis( level , offset , other_flags ) ) {
287: case GLOBALVAR:
288: if ( ( name != 0 ) ) {
289: if ( name[0] != '_' ) {
290: sprintf( extname , EXTFORMAT , name );
291: printname = extname;
292: } else {
293: printname = name;
294: }
295: putleaf( P2ICON , offset , 0 , ADDTYPE( type , P2PTR )
296: , printname );
297: return;
298: } else {
299: panic( "putLV no name" );
300: }
301: case PARAMVAR:
302: if ( level == cbn ) {
303: putleaf( P2REG , 0 , P2AP , ADDTYPE( type , P2PTR ) , 0 );
304: } else {
305: putleaf( P2NAME , (level * sizeof(struct dispsave)) + AP_OFFSET
306: , 0 , P2PTR | P2CHAR , DISPLAYNAME );
307: parts[ level ] |= NONLOCALVAR;
308: }
309: putleaf( P2ICON , offset , 0 , P2INT , 0 );
310: putop( P2PLUS , P2PTR | P2CHAR );
311: break;
312: case LOCALVAR:
313: if ( level == cbn ) {
314: putleaf( P2REG , 0 , P2FP , ADDTYPE( type , P2PTR ) , 0 );
315: } else {
316: putleaf( P2NAME , (level * sizeof(struct dispsave)) + FP_OFFSET
317: , 0 , P2PTR | P2CHAR , DISPLAYNAME );
318: parts[ level ] |= NONLOCALVAR;
319: }
320: putleaf( P2ICON , -offset , 0 , P2INT , 0 );
321: putop( P2MINUS , P2PTR | P2CHAR );
322: break;
323: case NAMEDLOCALVAR:
324: if ( level == cbn ) {
325: putleaf( P2REG , 0 , P2FP , ADDTYPE( type , P2PTR ) , 0 );
326: } else {
327: putleaf( P2NAME , (level * sizeof(struct dispsave)) + FP_OFFSET
328: , 0 , P2PTR | P2CHAR , DISPLAYNAME );
329: parts[ level ] |= NONLOCALVAR;
330: }
331: putleaf( P2ICON , 0 , 0 , P2INT , name );
332: putop( P2MINUS , P2PTR | P2CHAR );
333: break;
334: }
335: return;
336: }
337:
338: /*
339: * put out a floating point constant leaf node
340: * the constant is declared in aligned data space
341: * and a P2NAME leaf put out for it
342: */
343: putCON8( val )
344: double val;
345: {
346: int label;
347: char name[ BUFSIZ ];
348:
349: if ( !CGENNING )
350: return;
351: label = getlab();
352: putprintf( " .data" , 0 );
353: aligndot(A_DOUBLE);
354: putlab( label );
355: # ifdef vax
356: putprintf( " .double 0d%.20e" , 0 , val );
357: # endif vax
358: # ifdef mc68000
359: putprintf( " .long 0x%x,0x%x", 0, val);
360: # endif mc68000
361: putprintf( " .text" , 0 );
362: sprintf( name , PREFIXFORMAT , LABELPREFIX , label );
363: putleaf( P2NAME , 0 , 0 , P2DOUBLE , name );
364: }
365:
366: /*
367: * put out either an lvalue or an rvalue for a constant string.
368: * an lvalue (for assignment rhs's) is the name as a constant,
369: * an rvalue (for parameters) is just the name.
370: */
371: putCONG( string , length , required )
372: char *string;
373: int length;
374: int required;
375: {
376: char name[ BUFSIZ ];
377: int label;
378: char *cp;
379: int pad;
380: int others;
381:
382: if ( !CGENNING )
383: return;
384: putprintf( " .data" , 0 );
385: aligndot(A_STRUCT);
386: label = getlab();
387: putlab( label );
388: cp = string;
389: while ( *cp ) {
390: putprintf( " .byte 0%o" , 1 , *cp ++ );
391: for ( others = 2 ; ( others <= 8 ) && *cp ; others ++ ) {
392: putprintf( ",0%o" , 1 , *cp++ );
393: }
394: putprintf( "" , 0 );
395: }
396: pad = length - strlen( string );
397: while ( pad-- > 0 ) {
398: putprintf( " .byte 0%o" , 1 , ' ' );
399: for ( others = 2 ; ( others <= 8 ) && ( pad-- > 0 ) ; others++ ) {
400: putprintf( ",0%o" , 1 , ' ' );
401: }
402: putprintf( "" , 0 );
403: }
404: putprintf( " .byte 0" , 0 );
405: putprintf( " .text" , 0 );
406: sprintf( name , PREFIXFORMAT , LABELPREFIX , label );
407: if ( required == RREQ ) {
408: putleaf( P2NAME , 0 , 0 , P2ARY | P2CHAR , name );
409: } else {
410: putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR , name );
411: }
412: }
413:
414: /*
415: * map a pascal type to a c type
416: * this would be tail recursive, but i unfolded it into a for (;;).
417: * this is sort of like isa and lwidth
418: * a note on the types used by the portable c compiler:
419: * they are divided into a basic type (char, short, int, long, etc.)
420: * and qualifications on those basic types (pointer, function, array).
421: * the basic type is kept in the low 4 bits of the type descriptor,
422: * and the qualifications are arranged in two bit chunks, with the
423: * most significant on the right,
424: * and the least significant on the left
425: * e.g. int *foo();
426: * (a function returning a pointer to an integer)
427: * is stored as
428: * <ptr><ftn><int>
429: * so, we build types recursively
430: * also, we know that /lib/f1 can only deal with 6 qualifications
431: * so we stop the recursion there. this stops infinite type recursion
432: * through mutually recursive pointer types.
433: */
434: #define MAXQUALS 6
435: int
436: p2type( np )
437: {
438:
439: return typerecur( np , 0 );
440: }
441: typerecur( np , quals )
442: struct nl *np;
443: int quals;
444: {
445:
446: if ( np == NIL || quals > MAXQUALS ) {
447: return P2UNDEF;
448: }
449: switch ( np -> class ) {
450: case SCAL :
451: case RANGE :
452: if ( np -> type == ( nl + TDOUBLE ) ) {
453: return P2DOUBLE;
454: }
455: switch ( bytes( np -> range[0] , np -> range[1] ) ) {
456: case 1:
457: return P2CHAR;
458: case 2:
459: return P2SHORT;
460: case 4:
461: return P2INT;
462: default:
463: panic( "p2type int" );
464: }
465: case STR :
466: return ( P2ARY | P2CHAR );
467: case RECORD :
468: case SET :
469: return P2STRTY;
470: case FILET :
471: return ( P2PTR | P2STRTY );
472: case CONST :
473: case VAR :
474: case FIELD :
475: return p2type( np -> type );
476: case TYPE :
477: switch ( nloff( np ) ) {
478: case TNIL :
479: return ( P2PTR | P2UNDEF );
480: case TSTR :
481: return ( P2ARY | P2CHAR );
482: case TSET :
483: return P2STRTY;
484: default :
485: return ( p2type( np -> type ) );
486: }
487: case REF:
488: case WITHPTR:
489: case PTR :
490: return ADDTYPE( typerecur( np -> type , quals + 1 ) , P2PTR );
491: case ARRAY :
492: return ADDTYPE( typerecur( np -> type , quals + 1 ) , P2ARY );
493: case FUNC :
494: /*
495: * functions are really pointers to functions
496: * which return their underlying type.
497: */
498: return ADDTYPE( ADDTYPE( typerecur( np -> type , quals + 2 ) ,
499: P2FTN ) , P2PTR );
500: case PROC :
501: /*
502: * procedures are pointers to functions
503: * which return integers (whether you look at them or not)
504: */
505: return ADDTYPE( ADDTYPE( P2INT , P2FTN ) , P2PTR );
506: case FFUNC :
507: case FPROC :
508: /*
509: * formal procedures and functions are pointers
510: * to structures which describe their environment.
511: */
512: return ( P2PTR | P2STRTY );
513: default :
514: panic( "p2type" );
515: }
516: }
517:
518: /*
519: * add a most significant type modifier to a type
520: */
521: long
522: addtype( underlying , mtype )
523: long underlying;
524: long mtype;
525: {
526: return ( ( ( underlying & ~P2BASETYPE ) << P2TYPESHIFT )
527: | mtype
528: | ( underlying & P2BASETYPE ) );
529: }
530:
531: /*
532: * put a typed operator to the pcstream
533: */
534: putop( op , type )
535: int op;
536: int type;
537: {
538: extern char *p2opnames[];
539:
540: if ( !CGENNING )
541: return;
542: p2word( TOF77( op , 0 , type ) );
543: # ifdef DEBUG
544: if ( opt( 'k' ) ) {
545: fprintf( stdout , "%s (%d) | 0 | 0x%x\n"
546: , p2opnames[ op ] , op , type );
547: }
548: # endif
549: }
550:
551: /*
552: * put out a structure operator (STASG, STARG, STCALL, UNARY STCALL )
553: * which looks just like a regular operator, only the size and
554: * alignment go in the next consecutive words
555: */
556: putstrop( op , type , size , alignment )
557: int op;
558: int type;
559: int size;
560: int alignment;
561: {
562: extern char *p2opnames[];
563:
564: if ( !CGENNING )
565: return;
566: p2word( TOF77( op , 0 , type ) );
567: p2word( size );
568: p2word( alignment );
569: # ifdef DEBUG
570: if ( opt( 'k' ) ) {
571: fprintf( stdout , "%s (%d) | 0 | 0x%x %d %d\n"
572: , p2opnames[ op ] , op , type , size , alignment );
573: }
574: # endif
575: }
576:
577: /*
578: * the string names of p2ops
579: */
580: char *p2opnames[] = {
581: "",
582: "P2UNDEFINED", /* 1 */
583: "P2NAME", /* 2 */
584: "P2STRING", /* 3 */
585: "P2ICON", /* 4 */
586: "P2FCON", /* 5 */
587: "P2PLUS", /* 6 */
588: "",
589: "P2MINUS", /* 8 also unary == P2NEG */
590: "",
591: "P2NEG",
592: "P2MUL", /* 11 also unary == P2INDIRECT */
593: "",
594: "P2INDIRECT",
595: "P2AND", /* 14 also unary == P2ADDROF */
596: "",
597: "P2ADDROF",
598: "P2OR", /* 17 */
599: "",
600: "P2ER", /* 19 */
601: "",
602: "P2QUEST", /* 21 */
603: "P2COLON", /* 22 */
604: "P2ANDAND", /* 23 */
605: "P2OROR", /* 24 */
606: "", /* 25 */
607: "", /* 26 */
608: "", /* 27 */
609: "", /* 28 */
610: "", /* 29 */
611: "", /* 30 */
612: "", /* 31 */
613: "", /* 32 */
614: "", /* 33 */
615: "", /* 34 */
616: "", /* 35 */
617: "", /* 36 */
618: "", /* 37 */
619: "", /* 38 */
620: "", /* 39 */
621: "", /* 40 */
622: "", /* 41 */
623: "", /* 42 */
624: "", /* 43 */
625: "", /* 44 */
626: "", /* 45 */
627: "", /* 46 */
628: "", /* 47 */
629: "", /* 48 */
630: "", /* 49 */
631: "", /* 50 */
632: "", /* 51 */
633: "", /* 52 */
634: "", /* 53 */
635: "", /* 54 */
636: "", /* 55 */
637: "P2LISTOP", /* 56 */
638: "",
639: "P2ASSIGN", /* 58 */
640: "P2COMOP", /* 59 */
641: "P2DIV", /* 60 */
642: "",
643: "P2MOD", /* 62 */
644: "",
645: "P2LS", /* 64 */
646: "",
647: "P2RS", /* 66 */
648: "",
649: "P2DOT", /* 68 */
650: "P2STREF", /* 69 */
651: "P2CALL", /* 70 also unary */
652: "",
653: "P2UNARYCALL",
654: "P2FORTCALL", /* 73 also unary */
655: "",
656: "P2UNARYFORTCALL",
657: "P2NOT", /* 76 */
658: "P2COMPL", /* 77 */
659: "P2INCR", /* 78 */
660: "P2DECR", /* 79 */
661: "P2EQ", /* 80 */
662: "P2NE", /* 81 */
663: "P2LE", /* 82 */
664: "P2LT", /* 83 */
665: "P2GE", /* 84 */
666: "P2GT", /* 85 */
667: "P2ULE", /* 86 */
668: "P2ULT", /* 87 */
669: "P2UGE", /* 88 */
670: "P2UGT", /* 89 */
671: "P2SETBIT", /* 90 */
672: "P2TESTBIT", /* 91 */
673: "P2RESETBIT", /* 92 */
674: "P2ARS", /* 93 */
675: "P2REG", /* 94 */
676: "P2OREG", /* 95 */
677: "P2CCODES", /* 96 */
678: "P2FREE", /* 97 */
679: "P2STASG", /* 98 */
680: "P2STARG", /* 99 */
681: "P2STCALL", /* 100 also unary */
682: "",
683: "P2UNARYSTCALL",
684: "P2FLD", /* 103 */
685: "P2SCONV", /* 104 */
686: "P2PCONV", /* 105 */
687: "P2PMCONV", /* 106 */
688: "P2PVCONV", /* 107 */
689: "P2FORCE", /* 108 */
690: "P2CBRANCH", /* 109 */
691: "P2INIT", /* 110 */
692: "P2CAST", /* 111 */
693: };
694:
695: /*
696: * low level routines
697: */
698:
699: /*
700: * puts a long word on the pcstream
701: */
702: p2word( word )
703: long word;
704: {
705:
706: putw( word , pcstream );
707: }
708:
709: /*
710: * put a length 0 mod 4 null padded string onto the pcstream
711: */
712: p2string( string )
713: char *string;
714: {
715: int slen = strlen( string );
716: int wlen = ( slen + 3 ) / 4;
717: int plen = ( wlen * 4 ) - slen;
718: char *cp;
719: int p;
720:
721: for ( cp = string ; *cp ; cp++ )
722: putc( *cp , pcstream );
723: for ( p = 1 ; p <= plen ; p++ )
724: putc( '\0' , pcstream );
725: # ifdef DEBUG
726: if ( opt( 'k' ) ) {
727: fprintf( stdout , "\"%s" , string );
728: for ( p = 1 ; p <= plen ; p++ )
729: fprintf( stdout , "\\0" );
730: fprintf( stdout , "\"\n" );
731: }
732: # endif
733: }
734:
735: /*
736: * puts a name on the pcstream
737: */
738: p2name( name )
739: char *name;
740: {
741: int pad;
742:
743: fprintf( pcstream , NAMEFORMAT , name );
744: pad = strlen( name ) % sizeof (long);
745: for ( ; pad < sizeof (long) ; pad++ ) {
746: putc( '\0' , pcstream );
747: }
748: # ifdef DEBUG
749: if ( opt( 'k' ) ) {
750: fprintf( stdout , NAMEFORMAT , name );
751: pad = strlen( name ) % sizeof (long);
752: for ( ; pad < sizeof (long) ; pad++ ) {
753: fprintf( stdout , "\\0" );
754: }
755: fprintf( stdout , "\n" );
756: }
757: # endif
758: }
759:
760: /*
761: * put out a jump to a label
762: */
763: putjbr( label )
764: long label;
765: {
766:
767: printjbr( LABELPREFIX , label );
768: }
769:
770: /*
771: * put out a jump to any kind of label
772: */
773: printjbr( prefix , label )
774: char *prefix;
775: long label;
776: {
777:
778: # ifdef vax
779: putprintf( " jbr " , 1 );
780: putprintf( PREFIXFORMAT , 0 , prefix , label );
781: # endif vax
782: # ifdef mc68000
783: putprintf( " jra " , 1 );
784: putprintf( PREFIXFORMAT , 0 , prefix , label );
785: # endif mc68000
786: }
787:
788: /*
789: * another version of put to catch calls to put
790: */
791: put( arg1 , arg2 )
792: {
793:
794: panic("put()");
795: }
796:
797: #endif PC
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.