|
|
BSD 3.0
/*
* functions to help pi put out
* polish postfix binary portable c compiler intermediate code
* thereby becoming the portable pascal compiler
*/
#include "whoami"
#ifdef PPC
#include "0.h"
#include "opcode.h"
#include "ppc.h"
/*
* extract from pi's format
*/
#define FROMPI( nth , word ) ( ( ( word ) >> ( (nth) * 8 ) ) & 0377 )
/*
* mash into f77's format
*/
#define TOF77( fop,val,rest ) ( ( ( (rest) & 0177777 ) << 16 ) \
| ( ( (val) & 0377 ) << 8 ) \
| ( (fop) & 0377 ) )
/*
* this version of put generates stephen c johnson intermediate code
* as modified for the fortran77 compiler, to be both
* binary and postfix.
* it still uses the address of its argument
* as the address of its (variable length) argument list.
* the name is changed by a #define for the ctags program.
*/
#define ppcput put
ppcput( arglist )
{
register int *argp;
int narg;
int op;
int subop;
/*
* are we not generating code?
*/
if ( cgenflg )
return;
argp = &arglist;
narg = *argp++;
op = FROMPI( 0 , *argp );
subop = FROMPI( 1 , *argp );
putprintf( "# [put] op = 0%o subop = %d argp[1] = %d"
, op , subop , argp[1] );
switch( op ) {
default:
/*
* panic( "[put] op" );
*/
putprintf( "# [put] op ignored" );
break;
case O_LV:
putLV( subop >> 1 , argp[1] , P2PTR | P2INT );
break;
case O_RV1:
case O_RV2:
case O_RV4:
case O_RV8:
putRV( op , subop >> 1 , argp[1] , 0 );
break;
case O_RV:
putRV( op , subop >> 1 , argp[1] , argp[2] );
break;
case O_CON1:
case O_CON2:
case O_CON4:
putCON( op , argp[1] );
break;
case O_CON8:
putCON( op , *( (double *) &argp[1] ) );
break;
case O_AS21:
case O_AS41:
case O_AS2:
case O_AS42:
case O_AS24:
case O_AS4:
case O_AS28:
case O_AS48:
case O_AS8:
putAS( op , 0 );
break;
case O_AS:
putAS( op , argp[1] );
break;
case O_ADD2:
case O_ADD42:
case O_ADD82:
case O_ADD24:
case O_ADD4:
case O_ADD84:
case O_ADD28:
case O_ADD48:
case O_ADD8:
putADD( op );
break;
case O_SUB2:
case O_SUB42:
case O_SUB82:
case O_SUB24:
case O_SUB4:
case O_SUB84:
case O_SUB28:
case O_SUB48:
case O_SUB8:
putSUB( op );
break;
case O_MUL2:
case O_MUL42:
case O_MUL82:
case O_MUL24:
case O_MUL4:
case O_MUL84:
case O_MUL28:
case O_MUL48:
case O_MUL8:
putMUL( op );
break;
case O_DVD2:
case O_DVD42:
case O_DVD82:
case O_DVD24:
case O_DVD4:
case O_DVD84:
case O_DVD28:
case O_DVD48:
case O_DVD8:
putDVD( op );
break;
case O_DIV2:
case O_DIV42:
case O_DIV24:
case O_DIV4:
putDIV( op );
break;
case O_MOD2:
case O_MOD42:
case O_MOD24:
case O_MOD4:
putMOD( op );
break;
}
}
putLV( level , offset , type )
int level;
int offset;
int type;
{
if ( level == cbn ) {
putleaf( P2REG , 0 , P2FP , P2PTR | P2INT , 0 );
} else {
putleaf( P2NAME , level * sizeof (int *) , 0 , P2PTR | P2INT
, "_display" );
}
putleaf( P2ICON , offset , 0 , P2INT , 0 );
putop( P2PLUS , P2PTR | P2INT );
putop( P2UNARY P2MUL , type );
}
/*
* an operand, given its level and offset,
* and its length if it is other than 1, 2, 4, or 8
*/
putRV( op , level , offset , length )
int op;
int level;
int offset;
int length;
{
int type;
switch ( op ) {
default:
panic( "putRV" );
case O_RV:
/*
* no structures, yet
*/
panic( "putRV O_RV" );
case O_RV1:
type = P2CHAR;
break;
case O_RV2:
type = P2SHORT;
break;
case O_RV4:
type = P2LONG;
break;
case O_RV8:
type = P2DOUBLE;
break;
}
putLV( level , offset , type );
}
putCON( op , value )
int op;
int value;
{
int type;
switch( op ) {
case O_CON1:
type = P2CHAR;
break;
case O_CON2:
type = P2SHORT;
break;
case O_CON4:
type = P2LONG;
break;
case O_CON8:
type = P2DOUBLE;
break;
}
if ( type != P2DOUBLE ) {
putleaf( P2ICON , value , 0 , type , 0 );
} else {
char name[8];
sprintf( name , "D%d" , newlabel() );
puttext( " .data" );
puttext( " .align 2" );
putprintf( "%s:" , name );
putprintf( " .double 0d%.20e" , *( (double *) &value ) );
puttext( " .text" );
puttext( " .align 1" );
putleaf( P2NAME , 0 , 0 , P2DOUBLE , name );
}
}
/*
* generate an assignment
* given the length of the destination if not 1, 2, 4, or 8
*/
putAS( op , length )
int op;
int length;
{
int type;
switch ( op ) {
default:
panic( "[putAS]" );
case O_AS:
/*
* no structures, yet
*/
panic( "[putAS] O_AS" );
case O_AS21:
case O_AS41:
type = P2CHAR;
break;
case O_AS2:
case O_AS42:
type = P2SHORT;
break;
case O_AS24:
case O_AS4:
type = P2LONG;
break;
case O_AS28:
case O_AS48:
case O_AS8:
type = P2DOUBLE;
break;
}
putop( P2ASSIGN , type );
}
/*
* the various additions
*/
putADD( op )
int op;
{
int type;
switch ( op ) {
case O_ADD2:
case O_ADD42:
case O_ADD82:
type = P2SHORT;
break;
case O_ADD24:
case O_ADD4:
case O_ADD84:
type = P2LONG;
break;
case O_ADD28:
case O_ADD48:
case O_ADD8:
type = P2DOUBLE;
break;
}
putop( P2PLUS , type );
}
/*
* the various subtractions
*/
putSUB( op )
int op;
{
int type;
switch ( op ) {
case O_SUB2:
case O_SUB42:
case O_SUB82:
type = P2SHORT;
break;
case O_SUB24:
case O_SUB4:
case O_SUB84:
type = P2LONG;
break;
case O_SUB28:
case O_SUB48:
case O_SUB8:
type = P2DOUBLE;
break;
}
putop( P2MINUS , type );
}
/*
* the various multiplications
*/
putMUL( op )
int op;
{
int type;
switch ( op ) {
case O_MUL2:
case O_MUL42:
case O_MUL82:
type = P2SHORT;
break;
case O_MUL24:
case O_MUL4:
case O_MUL84:
type = P2LONG;
break;
case O_MUL28:
case O_MUL48:
case O_MUL8:
type = P2DOUBLE;
break;
}
putop( P2MUL , type );
}
/*
* the various divisions (floating results)
*/
putDVD( op )
int op;
{
int type;
switch ( op ) {
case O_DVD2:
case O_DVD42:
case O_DVD82:
type = P2SHORT;
break;
case O_DVD24:
case O_DVD4:
case O_DVD84:
type = P2LONG;
break;
case O_DVD28:
case O_DVD48:
case O_DVD8:
type = P2DOUBLE;
break;
}
/*
* convert the right operand to a double to force floating result
* putop( P2SCONV , P2DOUBLE );
* unfortunately, this doesn't work, and both operands have to
* be converted, and it's too late to get the left one. (sigh).
* that would work if the left operand were already a double,
* but for now ...
*/
if ( op != O_DVD8 )
panic( "[putDVD]" );
putop( P2DIV , type );
}
/*
* the various DIVs (truncated integer results)
*/
putDIV( op )
int op;
{
int type;
switch ( op ) {
case O_DIV2:
case O_DIV42:
type = P2SHORT;
break;
case O_DIV24:
case O_DIV4:
type = P2LONG;
break;
}
putop( P2DIV , type );
}
/*
* the various MODs (truncated integer results)
*/
putMOD( op )
int op;
{
int type;
switch ( op ) {
case O_MOD2:
case O_MOD42:
type = P2SHORT;
break;
case O_MOD24:
case O_MOD4:
type = P2LONG;
break;
}
putop( P2MOD , type );
}
/*
* this returns a unique integer to be made into a label
*/
int
newlabel()
{
static lastlabel = 0;
return ++lastlabel;
}
/*
* to round string lengths up to 0 mod 4
*/
str4len( string )
char *string;
{
return ( ( strlen( string ) + 3 ) / 4 );
}
/*
* emits an ftext operator and a string to the ppcstream
*/
puttext( string )
char *string;
{
int length = str4len( string );
emitword( TOF77( P2FTEXT , length , 0 ) );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "P2FTEXT | %d | 0\n" , length );
}
# endif
emitstring( string );
}
/*
* puts out formatted text to the ppcstream.
* none of arg1 .. arg5 need be present.
* and you can add more if you need them.
*/
/* VARARGS */
putprintf( format , arg1 , arg2 , arg3 , arg4 , arg5 )
char *format;
{
char buffer[128];
sprintf( buffer , format , arg1 , arg2 , arg3 , arg4 , arg5 );
puttext( buffer );
}
/*
* emit a left bracket operator to ppcstream
* with function number, the maximum temp register, and total locals
* from globals ftnno and sizes[ cbn ]
* until i figure out how to use them, regs 0 .. 11 are free.
* one idea for one reg is to save the display pointer on block entry
*/
putlbracket()
{
# define MAXTP2REG 11
# define BITSPERBYTE 8
emitword( TOF77( P2FLBRAC , MAXTP2REG , ftnno ) );
emitword( BITSPERBYTE * -sizes[ cbn ].om_off );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "P2FLBRAC | %d | %d\n" , MAXTP2REG , ftnno );
fprintf( ppcdstream , "%d\n"
, BITSPERBYTE * -sizes[ cbn ].om_off );
}
# endif
}
/*
* emit a right bracket operator
* which for the binary (fortran) interface
* doesn't have any (label) arguments,
* it just forces the stack allocate and register mask
*/
putrbracket()
{
emitword( P2FRBRAC );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "P2FRBRAC\n" );
}
# endif
}
/*
* emit an eof operator
*/
puteof()
{
emitword( P2FEOF );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "P2FEOF\n" );
}
# endif
}
/*
* emit a dot operator,
* with a source file line number and name
* from globals filename and line
*/
putexpr()
{
int length = str4len( filename );
emitword( TOF77( P2FEXPR , length , line ) );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "P2FEXPR | %d | %d\n" , length , line );
}
# endif
emitstring( filename );
}
/*
* put out a leaf node
*/
putleaf( op , lval , rval , type , name )
int op;
int lval;
int rval;
int type;
char *name;
{
switch ( op ) {
default:
panic( "[putleaf]" );
case P2ICON:
emitword( TOF77( P2ICON , name != NIL , type ) );
emitword( lval );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "P2ICON | %d | %d\n"
, name != NIL , type );
fprintf( ppcdstream , "%d\n" , lval );
}
# endif
if ( name )
emitname( name );
break;
case P2NAME:
emitword( TOF77( P2NAME , lval != 0 , type ) );
if ( lval )
emitword( lval );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "P2NAME | %d | %d\n"
, lval != 0 , type );
if ( lval )
fprintf( ppcdstream , "%d\n" , lval );
}
# endif
emitname( name );
break;
case P2REG:
emitword( TOF77( P2REG , rval , type ) );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "P2REG | %d | %d\n" , rval , type );
}
# endif
break;
}
}
/*
* put a typed operator to the ppcstream
*/
putop( op , type )
int op;
int type;
{
emitword( TOF77( op , 0 , type ) );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "%d | 0 | %d\n" , op , type );
}
# endif
}
/*
* puts a long word on the ppcstream
*/
emitword( word )
long word;
{
putw( word , ppcstream );
};
/*
* put a length 0 mod 4 null padded string onto the ppcstream
* this would use
* fprintf( ppcstream , "%*s" , -str4len( string ) , string )
* except that doesn't work, and also it wants to be padded with nulls.
*/
emitstring( string )
char *string;
{
int slen = strlen( string );
int wlen = ( slen + 3 ) / 4;
int plen = ( wlen * 4 ) - slen;
char *cp;
int p;
for ( cp = string ; *cp ; cp++ )
putc( *cp , ppcstream );
for ( p = 1 ; p <= plen ; p++ )
putc( '\0' , ppcstream );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "\"%s" , string );
for ( p = 1 ; p <= plen ; p++ )
fprintf( ppcdstream , "\\0" );
fprintf( ppcdstream , "\"\n" );
}
# endif
}
/*
* puts a blank-padded 8 character name on the ppcstream
*/
emitname( name )
char *name;
{
fprintf( ppcstream , "%-8.8s" , name );
# ifdef DEBUG
if ( ppcdebug ) {
fprintf( ppcdstream , "<%-8.8s>\n" , name );
}
# endif
}
#endif PPC
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.