void GArg( void ) {
//==============
// Generate an argument for subprogram, subscript, or substring.
if( (CITNode->opn.us & USOPN_WHERE) == USOPN_SAFE ) {
if( (CITNode->opn.us & USOPN_FLD) &&
((CITNode->opn.us & USOPN_WHAT) == USOPN_ARR) &&
(CITNode->typ == FT_CHAR) ) {
EmitOp( FC_PASS_FIELD_CHAR_ARRAY );
OutPtr( CITNode->value.st.field_id );
OutPtr( GTempString( 0 ) );
}
return;
}
if( (CITNode->opn.us & USOPN_WHAT) == USOPN_SSR ) {
EmitOp( FC_PUSH_SCB_LEN );
} else if( (CITNode->opn.us & USOPN_WHAT) == USOPN_CON ) {
PushOpn( CITNode );
} else if( (CITNode->opn.us & USOPN_WHAT) == USOPN_ARR ) {
PushOpn( CITNode );
if( CITNode->typ == FT_CHAR ) {
EmitOp( FC_PASS_CHAR_ARRAY );
SymRef( CITNode );
OutPtr( GTempString( 0 ) );
}
} else {
PushOpn( CITNode );
}
}
void GFiniSS( itnode *sym_node, itnode *ss_node ) {
//====================================================
// Finish a substring operation.
if( sym_node->opn.us & USOPN_FLD ) {
PushOpn( sym_node );
EmitOp( FC_FIELD_SUBSTRING );
OutPtr( sym_node->sym_ptr );
if( sym_node->opn.us & USOPN_SS1 ) { // length known at compile-time
OutInt( sym_node->value.st.ss_size );
} else {
OutInt( 0 ); // we don't know the length
}
} else {
EmitOp( FC_SUBSTRING );
if( sym_node->opn.us & USOPN_SS1 ) { // length known at compile-time
OutPtr( NULL );
} else {
SymRef( sym_node ); // in case we need the length of SCB if
} // character*(*) and no upper bound specified
}
GenTypes( ss_node, ss_node->link );
if( (sym_node->opn.us & USOPN_FLD) == 0 ) {
if( sym_node->opn.us & USOPN_SS1 ) { // length known at compile-time
OutInt( sym_node->value.st.ss_size );
}
if( (StmtSw & SS_DATA_INIT) == 0 ) {
sym_node->value.st.ss_id = sym_node->sym_ptr;
sym_node->sym_ptr = GTempString( 0 );
OutPtr( sym_node->sym_ptr );
sym_node->opn.us |= USOPN_ASY;
}
}
}
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 );
}
}