Exemplo n.º 1
0
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 );
    }
}
Exemplo n.º 2
0
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;
        }
    }
}
Exemplo n.º 3
0
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 );
    }
}