void GEndSubScr( itnode *arr ) {
//=================================
// Finish off a subscripting operation.
itnode *arg;
int dim_cnt;
if( arr->opn.us & USOPN_FLD ) {
PushOpn( arr );
EmitOp( FC_FIELD_SUBSCRIPT );
OutPtr( arr->sym_ptr );
dim_cnt = _DimCount( arr->sym_ptr->u.fd.dim_ext->dim_flags );
} else {
EmitOp( FC_SUBSCRIPT );
OutPtr( arr->sym_ptr );
dim_cnt = _DimCount( arr->sym_ptr->u.ns.si.va.u.dim_ext->dim_flags );
}
arg = arr->list;
while( dim_cnt-- > 0 ) {
GenType( arg );
arg = arg->link;
}
if( ( arr->opn.us & USOPN_FLD ) == 0 ) {
if( ( StmtSw & SS_DATA_INIT ) == 0 ) {
if( arr->sym_ptr->u.ns.u1.s.typ == FT_CHAR ) {
OutPtr( GTempString( 0 ) );
}
}
}
SetOpn( arr, USOPN_SAFE );
}
void GenChar1Op( itnode *op ) {
//================================
if( ( ( op->opn.us & USOPN_WHAT ) == USOPN_CON ) ) {
OutPtr( op->sym_ptr );
SetOpn( op, USOPN_SAFE );
} else {
OutPtr( NULL );
}
op->opn.us &= ~USOPN_SS1;
}
void ExpOp( TYPE typ1, TYPE typ2, OPTR opr ) {
//===============================================
// Generate code to perform exponentiation.
if( UnaryMul( typ1, typ2 ) ) {
PushOpn( CITNode );
EmitOp( FC_UNARY_MUL );
GenType( CITNode );
OutU16( ITIntValue( CITNode->link ) );
SetOpn( CITNode, USOPN_SAFE );
} else {
BinOp( typ1, typ2, opr );
}
}
void PushOpn( itnode *itptr ) {
//================================
// Generate a push of an operand.
// Also called for target of character assignment.
unsigned_16 flags;
TYPE typ;
USOPN what;
USOPN where;
where = itptr->opn.us & USOPN_WHERE;
if( ( itptr->opn.ds != DSOPN_PHI ) && ( where != USOPN_SAFE ) ) {
typ = itptr->typ;
flags = itptr->flags;
what = itptr->opn.us & USOPN_WHAT;
if( where != 0 ) {
EmitOp( FC_PUSH );
SymRef( itptr );
} else if( itptr->opn.us & USOPN_FLD ) {
PushConst( itptr->value.intstar4 );
} else if( ( flags & SY_CLASS ) == SY_SUBPROGRAM ) {
// 1. it's a statement function
// 2. it's a subprogram passed as an argument
EmitOp( FC_PUSH );
SymRef( itptr );
} else if( what == USOPN_CON ) {
if( typ == FT_CHAR ) {
EmitOp( FC_PUSH_LIT );
if( itptr->sym_ptr->u.lt.flags & LT_SCB_TMP_REFERENCE ) {
itptr->sym_ptr->u.lt.flags |= LT_SCB_REQUIRED;
} else {
// in case string optimizations use value directly,
// LT_SCB_TMP_REFERENCE will be turned off
itptr->sym_ptr->u.lt.flags |= LT_SCB_TMP_REFERENCE;
}
} else {
EmitOp( FC_PUSH_CONST );
}
SymRef( itptr );
} else {
EmitOp( FC_PUSH );
SymRef( itptr );
}
SetOpn( itptr, USOPN_SAFE );
}
}
void GSFCall( itnode *sfunc ) {
//================================
// Generate a statement function call.
sf_parm *arg;
EmitOp( FC_SF_CALL );
OutPtr( sfunc->sym_ptr );
arg = sfunc->sym_ptr->ns.si.sf.header->parm_list;
while( arg != NULL ) {
OutPtr( arg->shadow );
arg = arg->link;
}
OutPtr( NULL );
if( sfunc->typ == FT_CHAR ) {
OutPtr( GTempString( sfunc->size ) );
}
SetOpn( sfunc, USOPN_SAFE );
}
static void Unary( TYPE typ, OPTR opr ) {
//=======================================
// Generate code for unary plus or unary minus.
PushOpn( CITNode->link );
if( opr == OPTR_SUB ) { // unary minus
if( TypeCmplx( typ ) ) {
EmitOp( FC_CUMINUS );
} else {
EmitOp( FC_UMINUS );
}
GenType( CITNode->link );
} else if( ( _IsTypeInteger( CITNode->link->typ ) ) &&
( CITNode->link->size < sizeof( intstar4 ) ) ) {
// convert INTEGER*1 or INTEGER*2 to INTEGER*4
EmitOp( FC_CONVERT );
DumpTypes( CITNode->link->typ, CITNode->link->size, FT_INTEGER, sizeof( intstar4 ) );
}
SetOpn( CITNode, USOPN_SAFE );
}
void LogOp( TYPE typ1, TYPE typ2, OPTR op ) {
//==============================================
// Generate code for a relational operator.
bool flip;
op -= OPTR_FIRST_LOGOP;
flip = FALSE;
if( ( ( CITNode->opn.us & USOPN_WHERE ) == USOPN_SAFE ) &&
( ( CITNode->link->opn.us & USOPN_WHERE ) != USOPN_SAFE ) ) {
flip = TRUE;
}
PushOpn( CITNode->link );
if( typ1 == TY_NO_TYPE ) { // unary
if( _IsTypeInteger( typ2 ) ) {
EmitOp( FC_BIT_NOT );
} else {
EmitOp( FC_NOT );
}
GenType( CITNode->link );
SetOpn( CITNode, USOPN_SAFE );
} else {
PushOpn( CITNode );
if( _IsTypeInteger( typ2 ) ) {
EmitOp( FC_BITOPS + op );
} else {
EmitOp( FC_LOGOPS + op );
}
if( flip ) {
GenTypes( CITNode->link, CITNode );
} else {
GenTypes( CITNode, CITNode->link );
}
}
}
void GEndCall( itnode *itptr, int num_stmts ) {
//================================================
// Finish off a subprogram invocation.
itnode *arg;
if( num_stmts > 0 ) {
EmitOp( FC_ALT_RET );
OutU16( num_stmts );
arg = itptr->list;
for(;;) {
if( (arg->opn.us & USOPN_WHAT) == USOPN_STN ) {
GStmtAddr( arg->sym_ptr );
num_stmts--;
}
arg = arg->link;
if( num_stmts == 0 ) break;
}
} else if( (itptr->sym_ptr->u.ns.flags & SY_SUBPROG_TYPE) == SY_SUBROUTINE ) {
EmitOp( FC_EXPR_DONE );
}
SetOpn( itptr, USOPN_SAFE );
}