![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ppc.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 3BSD / cmd / pi|
Return to ppc.c CVS log | Up to [CSRG BSD Unix] / 3BSD / cmd / pi |
1.1 root 1: /*
2: * functions to help pi put out
3: * polish postfix binary portable c compiler intermediate code
4: * thereby becoming the portable pascal compiler
5: */
6:
7: #include "whoami"
8: #ifdef PPC
9: #include "0.h"
10: #include "opcode.h"
11: #include "ppc.h"
12:
13: /*
14: * extract from pi's format
15: */
16: #define FROMPI( nth , word ) ( ( ( word ) >> ( (nth) * 8 ) ) & 0377 )
17:
18: /*
19: * mash into f77's format
20: */
21: #define TOF77( fop,val,rest ) ( ( ( (rest) & 0177777 ) << 16 ) \
22: | ( ( (val) & 0377 ) << 8 ) \
23: | ( (fop) & 0377 ) )
24:
25: /*
26: * this version of put generates stephen c johnson intermediate code
27: * as modified for the fortran77 compiler, to be both
28: * binary and postfix.
29: * it still uses the address of its argument
30: * as the address of its (variable length) argument list.
31: * the name is changed by a #define for the ctags program.
32: */
33: #define ppcput put
34: ppcput( arglist )
35: {
36: register int *argp;
37: int narg;
38: int op;
39: int subop;
40:
41: /*
42: * are we not generating code?
43: */
44: if ( cgenflg )
45: return;
46: argp = &arglist;
47: narg = *argp++;
48: op = FROMPI( 0 , *argp );
49: subop = FROMPI( 1 , *argp );
50: putprintf( "# [put] op = 0%o subop = %d argp[1] = %d"
51: , op , subop , argp[1] );
52: switch( op ) {
53: default:
54: /*
55: * panic( "[put] op" );
56: */
57: putprintf( "# [put] op ignored" );
58: break;
59: case O_LV:
60: putLV( subop >> 1 , argp[1] , P2PTR | P2INT );
61: break;
62: case O_RV1:
63: case O_RV2:
64: case O_RV4:
65: case O_RV8:
66: putRV( op , subop >> 1 , argp[1] , 0 );
67: break;
68: case O_RV:
69: putRV( op , subop >> 1 , argp[1] , argp[2] );
70: break;
71: case O_CON1:
72: case O_CON2:
73: case O_CON4:
74: putCON( op , argp[1] );
75: break;
76: case O_CON8:
77: putCON( op , *( (double *) &argp[1] ) );
78: break;
79: case O_AS21:
80: case O_AS41:
81: case O_AS2:
82: case O_AS42:
83: case O_AS24:
84: case O_AS4:
85: case O_AS28:
86: case O_AS48:
87: case O_AS8:
88: putAS( op , 0 );
89: break;
90: case O_AS:
91: putAS( op , argp[1] );
92: break;
93: case O_ADD2:
94: case O_ADD42:
95: case O_ADD82:
96: case O_ADD24:
97: case O_ADD4:
98: case O_ADD84:
99: case O_ADD28:
100: case O_ADD48:
101: case O_ADD8:
102: putADD( op );
103: break;
104: case O_SUB2:
105: case O_SUB42:
106: case O_SUB82:
107: case O_SUB24:
108: case O_SUB4:
109: case O_SUB84:
110: case O_SUB28:
111: case O_SUB48:
112: case O_SUB8:
113: putSUB( op );
114: break;
115: case O_MUL2:
116: case O_MUL42:
117: case O_MUL82:
118: case O_MUL24:
119: case O_MUL4:
120: case O_MUL84:
121: case O_MUL28:
122: case O_MUL48:
123: case O_MUL8:
124: putMUL( op );
125: break;
126: case O_DVD2:
127: case O_DVD42:
128: case O_DVD82:
129: case O_DVD24:
130: case O_DVD4:
131: case O_DVD84:
132: case O_DVD28:
133: case O_DVD48:
134: case O_DVD8:
135: putDVD( op );
136: break;
137: case O_DIV2:
138: case O_DIV42:
139: case O_DIV24:
140: case O_DIV4:
141: putDIV( op );
142: break;
143: case O_MOD2:
144: case O_MOD42:
145: case O_MOD24:
146: case O_MOD4:
147: putMOD( op );
148: break;
149: }
150: }
151:
152:
153: putLV( level , offset , type )
154: int level;
155: int offset;
156: int type;
157: {
158: if ( level == cbn ) {
159: putleaf( P2REG , 0 , P2FP , P2PTR | P2INT , 0 );
160: } else {
161: putleaf( P2NAME , level * sizeof (int *) , 0 , P2PTR | P2INT
162: , "_display" );
163: }
164: putleaf( P2ICON , offset , 0 , P2INT , 0 );
165: putop( P2PLUS , P2PTR | P2INT );
166: putop( P2UNARY P2MUL , type );
167: }
168:
169: /*
170: * an operand, given its level and offset,
171: * and its length if it is other than 1, 2, 4, or 8
172: */
173: putRV( op , level , offset , length )
174: int op;
175: int level;
176: int offset;
177: int length;
178: {
179: int type;
180:
181: switch ( op ) {
182: default:
183: panic( "putRV" );
184: case O_RV:
185: /*
186: * no structures, yet
187: */
188: panic( "putRV O_RV" );
189: case O_RV1:
190: type = P2CHAR;
191: break;
192: case O_RV2:
193: type = P2SHORT;
194: break;
195: case O_RV4:
196: type = P2LONG;
197: break;
198: case O_RV8:
199: type = P2DOUBLE;
200: break;
201: }
202: putLV( level , offset , type );
203: }
204:
205: putCON( op , value )
206: int op;
207: int value;
208: {
209: int type;
210:
211: switch( op ) {
212: case O_CON1:
213: type = P2CHAR;
214: break;
215: case O_CON2:
216: type = P2SHORT;
217: break;
218: case O_CON4:
219: type = P2LONG;
220: break;
221: case O_CON8:
222: type = P2DOUBLE;
223: break;
224: }
225: if ( type != P2DOUBLE ) {
226: putleaf( P2ICON , value , 0 , type , 0 );
227: } else {
228: char name[8];
229:
230: sprintf( name , "D%d" , newlabel() );
231: puttext( " .data" );
232: puttext( " .align 2" );
233: putprintf( "%s:" , name );
234: putprintf( " .double 0d%.20e" , *( (double *) &value ) );
235: puttext( " .text" );
236: puttext( " .align 1" );
237: putleaf( P2NAME , 0 , 0 , P2DOUBLE , name );
238: }
239: }
240:
241: /*
242: * generate an assignment
243: * given the length of the destination if not 1, 2, 4, or 8
244: */
245: putAS( op , length )
246: int op;
247: int length;
248: {
249: int type;
250:
251: switch ( op ) {
252: default:
253: panic( "[putAS]" );
254: case O_AS:
255: /*
256: * no structures, yet
257: */
258: panic( "[putAS] O_AS" );
259: case O_AS21:
260: case O_AS41:
261: type = P2CHAR;
262: break;
263: case O_AS2:
264: case O_AS42:
265: type = P2SHORT;
266: break;
267: case O_AS24:
268: case O_AS4:
269: type = P2LONG;
270: break;
271: case O_AS28:
272: case O_AS48:
273: case O_AS8:
274: type = P2DOUBLE;
275: break;
276: }
277: putop( P2ASSIGN , type );
278: }
279:
280: /*
281: * the various additions
282: */
283: putADD( op )
284: int op;
285: {
286: int type;
287:
288: switch ( op ) {
289: case O_ADD2:
290: case O_ADD42:
291: case O_ADD82:
292: type = P2SHORT;
293: break;
294: case O_ADD24:
295: case O_ADD4:
296: case O_ADD84:
297: type = P2LONG;
298: break;
299: case O_ADD28:
300: case O_ADD48:
301: case O_ADD8:
302: type = P2DOUBLE;
303: break;
304: }
305: putop( P2PLUS , type );
306: }
307:
308: /*
309: * the various subtractions
310: */
311: putSUB( op )
312: int op;
313: {
314: int type;
315:
316: switch ( op ) {
317: case O_SUB2:
318: case O_SUB42:
319: case O_SUB82:
320: type = P2SHORT;
321: break;
322: case O_SUB24:
323: case O_SUB4:
324: case O_SUB84:
325: type = P2LONG;
326: break;
327: case O_SUB28:
328: case O_SUB48:
329: case O_SUB8:
330: type = P2DOUBLE;
331: break;
332: }
333: putop( P2MINUS , type );
334: }
335:
336: /*
337: * the various multiplications
338: */
339: putMUL( op )
340: int op;
341: {
342: int type;
343:
344: switch ( op ) {
345: case O_MUL2:
346: case O_MUL42:
347: case O_MUL82:
348: type = P2SHORT;
349: break;
350: case O_MUL24:
351: case O_MUL4:
352: case O_MUL84:
353: type = P2LONG;
354: break;
355: case O_MUL28:
356: case O_MUL48:
357: case O_MUL8:
358: type = P2DOUBLE;
359: break;
360: }
361: putop( P2MUL , type );
362: }
363:
364: /*
365: * the various divisions (floating results)
366: */
367: putDVD( op )
368: int op;
369: {
370: int type;
371:
372: switch ( op ) {
373: case O_DVD2:
374: case O_DVD42:
375: case O_DVD82:
376: type = P2SHORT;
377: break;
378: case O_DVD24:
379: case O_DVD4:
380: case O_DVD84:
381: type = P2LONG;
382: break;
383: case O_DVD28:
384: case O_DVD48:
385: case O_DVD8:
386: type = P2DOUBLE;
387: break;
388: }
389: /*
390: * convert the right operand to a double to force floating result
391: * putop( P2SCONV , P2DOUBLE );
392: * unfortunately, this doesn't work, and both operands have to
393: * be converted, and it's too late to get the left one. (sigh).
394: * that would work if the left operand were already a double,
395: * but for now ...
396: */
397: if ( op != O_DVD8 )
398: panic( "[putDVD]" );
399: putop( P2DIV , type );
400: }
401:
402: /*
403: * the various DIVs (truncated integer results)
404: */
405: putDIV( op )
406: int op;
407: {
408: int type;
409:
410: switch ( op ) {
411: case O_DIV2:
412: case O_DIV42:
413: type = P2SHORT;
414: break;
415: case O_DIV24:
416: case O_DIV4:
417: type = P2LONG;
418: break;
419: }
420: putop( P2DIV , type );
421: }
422:
423: /*
424: * the various MODs (truncated integer results)
425: */
426: putMOD( op )
427: int op;
428: {
429: int type;
430:
431: switch ( op ) {
432: case O_MOD2:
433: case O_MOD42:
434: type = P2SHORT;
435: break;
436: case O_MOD24:
437: case O_MOD4:
438: type = P2LONG;
439: break;
440: }
441: putop( P2MOD , type );
442: }
443:
444:
445: /*
446: * this returns a unique integer to be made into a label
447: */
448: int
449: newlabel()
450: {
451: static lastlabel = 0;
452:
453: return ++lastlabel;
454: }
455:
456: /*
457: * to round string lengths up to 0 mod 4
458: */
459: str4len( string )
460: char *string;
461: {
462:
463: return ( ( strlen( string ) + 3 ) / 4 );
464: }
465:
466:
467: /*
468: * emits an ftext operator and a string to the ppcstream
469: */
470: puttext( string )
471: char *string;
472: {
473: int length = str4len( string );
474:
475: emitword( TOF77( P2FTEXT , length , 0 ) );
476: # ifdef DEBUG
477: if ( ppcdebug ) {
478: fprintf( ppcdstream , "P2FTEXT | %d | 0\n" , length );
479: }
480: # endif
481: emitstring( string );
482: }
483:
484: /*
485: * puts out formatted text to the ppcstream.
486: * none of arg1 .. arg5 need be present.
487: * and you can add more if you need them.
488: */
489: /* VARARGS */
490: putprintf( format , arg1 , arg2 , arg3 , arg4 , arg5 )
491: char *format;
492: {
493: char buffer[128];
494:
495: sprintf( buffer , format , arg1 , arg2 , arg3 , arg4 , arg5 );
496: puttext( buffer );
497: }
498:
499: /*
500: * emit a left bracket operator to ppcstream
501: * with function number, the maximum temp register, and total locals
502: * from globals ftnno and sizes[ cbn ]
503: * until i figure out how to use them, regs 0 .. 11 are free.
504: * one idea for one reg is to save the display pointer on block entry
505: */
506: putlbracket()
507: {
508: # define MAXTP2REG 11
509: # define BITSPERBYTE 8
510:
511: emitword( TOF77( P2FLBRAC , MAXTP2REG , ftnno ) );
512: emitword( BITSPERBYTE * -sizes[ cbn ].om_off );
513: # ifdef DEBUG
514: if ( ppcdebug ) {
515: fprintf( ppcdstream , "P2FLBRAC | %d | %d\n" , MAXTP2REG , ftnno );
516: fprintf( ppcdstream , "%d\n"
517: , BITSPERBYTE * -sizes[ cbn ].om_off );
518: }
519: # endif
520: }
521:
522: /*
523: * emit a right bracket operator
524: * which for the binary (fortran) interface
525: * doesn't have any (label) arguments,
526: * it just forces the stack allocate and register mask
527: */
528: putrbracket()
529: {
530:
531: emitword( P2FRBRAC );
532: # ifdef DEBUG
533: if ( ppcdebug ) {
534: fprintf( ppcdstream , "P2FRBRAC\n" );
535: }
536: # endif
537: }
538:
539: /*
540: * emit an eof operator
541: */
542: puteof()
543: {
544:
545: emitword( P2FEOF );
546: # ifdef DEBUG
547: if ( ppcdebug ) {
548: fprintf( ppcdstream , "P2FEOF\n" );
549: }
550: # endif
551: }
552:
553: /*
554: * emit a dot operator,
555: * with a source file line number and name
556: * from globals filename and line
557: */
558: putexpr()
559: {
560: int length = str4len( filename );
561:
562: emitword( TOF77( P2FEXPR , length , line ) );
563: # ifdef DEBUG
564: if ( ppcdebug ) {
565: fprintf( ppcdstream , "P2FEXPR | %d | %d\n" , length , line );
566: }
567: # endif
568: emitstring( filename );
569: }
570:
571: /*
572: * put out a leaf node
573: */
574: putleaf( op , lval , rval , type , name )
575: int op;
576: int lval;
577: int rval;
578: int type;
579: char *name;
580: {
581: switch ( op ) {
582: default:
583: panic( "[putleaf]" );
584: case P2ICON:
585: emitword( TOF77( P2ICON , name != NIL , type ) );
586: emitword( lval );
587: # ifdef DEBUG
588: if ( ppcdebug ) {
589: fprintf( ppcdstream , "P2ICON | %d | %d\n"
590: , name != NIL , type );
591: fprintf( ppcdstream , "%d\n" , lval );
592: }
593: # endif
594: if ( name )
595: emitname( name );
596: break;
597: case P2NAME:
598: emitword( TOF77( P2NAME , lval != 0 , type ) );
599: if ( lval )
600: emitword( lval );
601: # ifdef DEBUG
602: if ( ppcdebug ) {
603: fprintf( ppcdstream , "P2NAME | %d | %d\n"
604: , lval != 0 , type );
605: if ( lval )
606: fprintf( ppcdstream , "%d\n" , lval );
607: }
608: # endif
609: emitname( name );
610: break;
611: case P2REG:
612: emitword( TOF77( P2REG , rval , type ) );
613: # ifdef DEBUG
614: if ( ppcdebug ) {
615: fprintf( ppcdstream , "P2REG | %d | %d\n" , rval , type );
616: }
617: # endif
618: break;
619: }
620: }
621:
622: /*
623: * put a typed operator to the ppcstream
624: */
625: putop( op , type )
626: int op;
627: int type;
628: {
629:
630: emitword( TOF77( op , 0 , type ) );
631: # ifdef DEBUG
632: if ( ppcdebug ) {
633: fprintf( ppcdstream , "%d | 0 | %d\n" , op , type );
634: }
635: # endif
636: }
637:
638:
639: /*
640: * puts a long word on the ppcstream
641: */
642: emitword( word )
643: long word;
644: {
645:
646: putw( word , ppcstream );
647: };
648:
649: /*
650: * put a length 0 mod 4 null padded string onto the ppcstream
651: * this would use
652: * fprintf( ppcstream , "%*s" , -str4len( string ) , string )
653: * except that doesn't work, and also it wants to be padded with nulls.
654: */
655: emitstring( string )
656: char *string;
657: {
658: int slen = strlen( string );
659: int wlen = ( slen + 3 ) / 4;
660: int plen = ( wlen * 4 ) - slen;
661: char *cp;
662: int p;
663:
664: for ( cp = string ; *cp ; cp++ )
665: putc( *cp , ppcstream );
666: for ( p = 1 ; p <= plen ; p++ )
667: putc( '\0' , ppcstream );
668: # ifdef DEBUG
669: if ( ppcdebug ) {
670: fprintf( ppcdstream , "\"%s" , string );
671: for ( p = 1 ; p <= plen ; p++ )
672: fprintf( ppcdstream , "\\0" );
673: fprintf( ppcdstream , "\"\n" );
674: }
675: # endif
676: }
677:
678: /*
679: * puts a blank-padded 8 character name on the ppcstream
680: */
681: emitname( name )
682: char *name;
683: {
684:
685: fprintf( ppcstream , "%-8.8s" , name );
686: # ifdef DEBUG
687: if ( ppcdebug ) {
688: fprintf( ppcdstream , "<%-8.8s>\n" , name );
689: }
690: # endif
691: }
692:
693: #endif PPC
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.