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