/* Copyright (c) 1979 Regents of the University of California */
static char sccsid
[] = "@(#)p2put.c 1.3 10/16/80";
* functions to help pi put out
* polish postfix binary portable c compiler intermediate code
* thereby becoming the portable pascal compiler
#define TOF77( fop,val,rest ) ( ( ( (rest) & 0177777 ) << 16 ) \
| ( ( (val) & 0377 ) << 8 ) \
* emits an ftext operator and a string to the pcstream
int length
= str4len( string
);
p2word( TOF77( P2FTEXT
, length
, 0 ) );
fprintf( stdout
, "P2FTEXT | %3d | 0 " , length
);
return ( ( strlen( string
) + 3 ) / 4 );
* put formatted text into a buffer for printing to the pcstream.
* a call to putpflush actually puts out the text.
* none of arg1 .. arg5 need be present.
* and you can add more if you need them.
putprintf( format
, incomplete
, arg1
, arg2
, arg3
, arg4
, arg5
)
static char ppbuffer
[ BUFSIZ
];
static char *ppbufp
= ppbuffer
;
sprintf( ppbufp
, format
, arg1
, arg2
, arg3
, arg4
, arg5
);
ppbufp
= &( ppbuffer
[ strlen( ppbuffer
) ] );
if ( ppbufp
>= &( ppbuffer
[ BUFSIZ
] ) )
* emit a left bracket operator to pcstream
* with function number, the maximum temp register, and total local bytes
* 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( ftnno
, localbytes
)
p2word( TOF77( P2FLBRAC
, MAXTP2REG
, ftnno
) );
p2word( BITSPERBYTE
* localbytes
);
, "P2FLBRAC | %3d | %d " , MAXTP2REG
, ftnno
);
, BITSPERBYTE
* localbytes
);
* emit a right bracket operator
* which for the binary (fortran) interface
* forces the stack allocate and register mask
p2word( TOF77( P2FRBRAC
, 0 , ftnno
) );
fprintf( stdout
, "P2FRBRAC | 0 | %d\n" , ftnno
);
fprintf( stdout
, "P2FEOF\n" );
* with a source file line number and name
* if line is negative, there was an error on that line, but who cares?
putdot( filename
, line
)
int length
= str4len( filename
);
p2word( TOF77( P2FEXPR
, length
, line
) );
fprintf( stdout
, "P2FEXPR | %3d | %d " , length
, line
);
putleaf( op
, lval
, rval
, type
, name
)
p2word( TOF77( P2ICON
, name
!= NIL
, type
) );
fprintf( stdout
, "P2ICON | %3d | %d "
fprintf( stdout
, "%d\n" , lval
);
p2word( TOF77( P2NAME
, lval
!= 0 , type
) );
fprintf( stdout
, "P2NAME | %3d | %d "
fprintf( stdout
, "%d " , lval
);
p2word( TOF77( P2REG
, rval
, type
) );
fprintf( stdout
, "P2REG | %3d | %d\n" , rval
, type
);
* rvalues are just lvalues with indirection, except
* special case for named globals, whose names are their rvalues
putRV( name
, level
, offset
, type
)
if ( ( level
<= 1 ) && ( name
!= 0 ) ) {
sprintf( extname
, EXTFORMAT
, name
);
putleaf( P2NAME
, offset
, 0 , type
, printname
);
putLV( name
, level
, offset
, type
);
putop( P2UNARY P2MUL
, type
);
* given a level and offset
* named globals, whose lvalues are just their names as constants.
* negative offsets, that are offsets from the frame pointer.
* positive offsets, that are offsets from argument pointer.
putLV( name
, level
, offset
, type
)
if ( ( level
<= 1 ) && ( name
!= 0 ) ) {
sprintf( extname
, EXTFORMAT
, name
);
putleaf( P2ICON
, offset
, 0 , ADDTYPE( type
, P2PTR
)
putleaf( P2REG
, 0 , P2FP
, ADDTYPE( type
, P2PTR
) , 0 );
putleaf( P2REG
, 0 , P2AP
, ADDTYPE( type
, P2PTR
) , 0 );
, ( level
* sizeof(struct dispsave
) ) + FP_OFFSET
, 0 , P2PTR
| P2CHAR
, DISPLAYNAME
);
, ( level
* sizeof(struct dispsave
) ) + AP_OFFSET
, 0 , P2PTR
| P2CHAR
, DISPLAYNAME
);
putleaf( P2ICON
, -offset
, 0 , P2INT
, 0 );
putop( P2MINUS
, P2PTR
| P2CHAR
);
putleaf( P2ICON
, offset
, 0 , P2INT
, 0 );
putop( P2PLUS
, P2PTR
| P2CHAR
);
* put out a floating point constant leaf node
* the constant is declared in aligned data space
* and a P2NAME leaf put out for it
putprintf( " .data" , 0 );
putprintf( " .align 2" , 0 );
putprintf( " .double 0d%.20e" , 0 , value
);
putprintf( " .text" , 0 );
sprintf( name
, PREFIXFORMAT
, LABELPREFIX
, label
);
putleaf( P2NAME
, 0 , 0 , P2DOUBLE
, name
);
* put out either an lvalue or an rvalue for a constant string.
* an lvalue (for assignment rhs's) is the name as a constant,
* an rvalue (for parameters) is just the name.
putCONG( string
, length
, required
)
putprintf( " .data" , 0 );
putprintf( " .byte 0%o" , 1 , *cp
++ );
for ( others
= 2 ; ( others
<= 8 ) && *cp
; others
++ ) {
putprintf( ",0%o" , 1 , *cp
++ );
pad
= length
- strlen( string
);
putprintf( " .byte 0%o" , 1 , ' ' );
for ( others
= 2 ; ( others
<= 8 ) && ( pad
-- > 0 ) ; others
++ ) {
putprintf( ",0%o" , 1 , ' ' );
putprintf( " .byte 0" , 0 );
putprintf( " .text" , 0 );
sprintf( name
, PREFIXFORMAT
, LABELPREFIX
, label
);
if ( required
== RREQ
) {
putleaf( P2NAME
, 0 , 0 , P2ARY
| P2CHAR
, name
);
putleaf( P2ICON
, 0 , 0 , P2PTR
| P2CHAR
, name
);
* map a pascal type to a c type
* this would be tail recursive, but i unfolded it into a for (;;).
* this is sort of like isa and lwidth
* a note on the types used by the portable c compiler:
* they are divided into a basic type (char, short, int, long, etc.)
* and qualifications on those basic types (pointer, function, array).
* the basic type is kept in the low 4 bits of the type descriptor,
* and the qualifications are arranged in two bit chunks, with the
* most significant on the right,
* and the least significant on the left
* (a function returning a pointer to an integer)
* so, we build types recursively
* also, we know that /lib/f1 can only deal with 6 qualifications
* so we stop the recursion there. this stops infinite type recursion
* through mutually recursive pointer types.
return typerecur( np
, 0 );
if ( np
== NIL
|| quals
> MAXQUALS
) {
if ( np
-> type
== ( nl
+ TDOUBLE
) ) {
switch ( bytes( np
-> range
[0] , np
-> range
[1] ) ) {
return ( P2ARY
| P2CHAR
);
return ( P2PTR
| P2STRTY
);
return p2type( np
-> type
);
return ( P2PTR
| P2UNDEF
);
return ( P2ARY
| P2CHAR
);
return ( p2type( np
-> type
) );
return ADDTYPE( typerecur( np
-> type
, quals
+ 1 ) , P2PTR
);
return ADDTYPE( typerecur( np
-> type
, quals
+ 1 ) , P2ARY
);
* functions are really pointers to functions
* which return their underlying type.
return ADDTYPE( ADDTYPE( typerecur( np
-> type
, quals
+ 2 ) ,
* procedures are pointers to functions
* which return integers (whether you look at them or not)
return ADDTYPE( ADDTYPE( P2INT
, P2FTN
) , P2PTR
);
* formal procedures and functions are pointers
* to structures which describe their environment.
return ADDTYPE( P2PTR
, P2STRTY
);
* add a most significant type modifier to a type
addtype( underlying
, mtype
)
return ( ( ( underlying
& ~P2BASETYPE
) << P2TYPESHIFT
)
| ( underlying
& P2BASETYPE
) );
* put a typed operator to the pcstream
extern char *p2opnames
[];
p2word( TOF77( op
, 0 , type
) );
fprintf( stdout
, "%s (%d) | 0 | %d\n"
, p2opnames
[ op
] , op
, type
);
* put out a structure operator (STASG, STARG, STCALL, UNARY STCALL )
* which looks just like a regular operator, only the size and
* alignment go in the next consecutive words
putstrop( op
, type
, size
, alignment
)
extern char *p2opnames
[];
p2word( TOF77( op
, 0 , type
) );
fprintf( stdout
, "%s (%d) | 0 | %d %d %d\n"
, p2opnames
[ op
] , op
, type
, size
, alignment
);
* the string names of p2ops
"P2MINUS", /* 8 also unary == P2NEG */
"P2MUL", /* 11 also unary == P2INDIRECT */
"P2AND", /* 14 also unary == P2ADDROF */
"P2CALL", /* 70 also unary */
"P2FORTCALL", /* 73 also unary */
"P2STCALL", /* 100 also unary */
* puts a long word on the pcstream
* put a length 0 mod 4 null padded string onto the pcstream
int slen
= strlen( string
);
int wlen
= ( slen
+ 3 ) / 4;
int plen
= ( wlen
* 4 ) - slen
;
for ( cp
= string
; *cp
; cp
++ )
for ( p
= 1 ; p
<= plen
; p
++ )
fprintf( stdout
, "\"%s" , string
);
for ( p
= 1 ; p
<= plen
; p
++ )
fprintf( stdout
, "\\0" );
fprintf( stdout
, "\"\n" );
* puts a name on the pcstream
fprintf( pcstream
, NAMEFORMAT
, name
);
pad
= strlen( name
) % sizeof (long);
for ( ; pad
< sizeof (long) ; pad
++ ) {
fprintf( stdout
, NAMEFORMAT
, name
);
pad
= strlen( name
) % sizeof (long);
for ( ; pad
< sizeof (long) ; pad
++ ) {
fprintf( stdout
, "\\0" );
fprintf( stdout
, "\n" );
* put out a jump to a label
printjbr( LABELPREFIX
, label
);
* put out a jump to any kind of label
printjbr( prefix
, label
)
putprintf( " jbr " , 1 );
putprintf( PREFIXFORMAT
, 0 , prefix
, label
);
* another version of put to catch calls to put
putprintf( "# PUT CALLED!: arg1 = %d arg2 = 0%o" , 0 , arg1
, arg2
);