Esempio n. 1
0
void    AsgnChar( void ) {
//========================

// Perform character assignment.

    itnode      *save_cit;
    uint        num_args;
    uint        i;
    uint        j;

    save_cit = CITNode;
    AdvanceITPtr();
    num_args = AsgnCat();
    i = SrcChar( CITNode );
    j = TargChar( save_cit );
    if( ( num_args == 1 ) && ( i > 0 ) && ( j > 0 ) ) {
        if( OptimalChSize( i ) && OptimalChSize( j ) && ( i == j ) ) {
            PushOpn( save_cit );
            EmitOp( FC_CHAR_1_MOVE );
            DumpType( MapTypes( FT_INTEGER, i ), i );
            GenChar1Op( CITNode );
            if( ( CITNode->opn.us & USOPN_WHAT ) == USOPN_CON ) {
                CITNode->sym_ptr->u.lt.flags &= ~LT_SCB_TMP_REFERENCE;
            }
            CITNode = save_cit;
        } else {
#if ( _CPU == 386 || _CPU == 8086 )
            if( j < i ) {
                i = j;
            }
            CITNode = save_cit;
            PushOpn( CITNode );
            EmitOp( FC_CHAR_N_MOVE );
            OutInt( i );
            OutInt( j );
#else
            CatArgs( num_args );
            CITNode = save_cit;
            PushOpn( CITNode );
            EmitOp( FC_CAT );
            OutU16( (uint_16)num_args );
#endif
        }
    } else {
        CatArgs( num_args );
        CITNode = save_cit;
        PushOpn( CITNode );
        EmitOp( FC_CAT );
        OutU16( (uint_16)num_args );
    }
}
Esempio n. 2
0
static  void    ParenExpr( void ) {
//=================================

// Finish off evaluation of a parenthesized expression.

    // don't evaluate constants enclosed in parentheses
    // so that they can be folded. Consider: (3+4)+5
    if( CITNode->opn.us != USOPN_CON ) {
        // Consider: CHARACTER A
        //           IF( ('9') .NE. (A) ) CONTINUE
        // make sure that we can optimize the character operation
        if( CITNode->opn.us == USOPN_NNL ) {
            if( CITNode->typ == FT_CHAR ) {
                int     ch_size;

                ch_size = CITNode->size;
                if( OptimalChSize( ch_size ) ) {
                    CITNode->value.st.ss_size = ch_size;
                    CITNode->opn.us |= USOPN_SS1;
                }
            }
        }
        PushOpn( CITNode );
        GParenExpr();
    }
    BackTrack();
}
Esempio n. 3
0
void    RelOp( TYPE typ1, TYPE typ2, OPTR optr ) {
//================================================

// Generate code for a relational operator.

    bool        flip;
    bool        associative;
    bool        char_1_cmp;
    uint        i;
    uint        j;
    OPR         opr_code;
    FCODE       op_code;

    optr = optr;
    // must check for "flip" before we call "CharLength" since they may
    // call "PushOpn"
    flip = FALSE;
    if( ( ( CITNode->opn.us & USOPN_WHERE ) == USOPN_SAFE ) &&
        ( ( CITNode->link->opn.us & USOPN_WHERE ) != USOPN_SAFE ) ) {
        flip = TRUE;
    }
    // must do "CITNode->link" first to get operands in the right order
    i = CharLength( CITNode->link );
    j = CharLength( CITNode );
    opr_code = CITNode->link->opr;
    if( ( opr_code == OPR_EQ ) || ( opr_code == OPR_NE ) ) {
        char_1_cmp = OptimalChSize( i ) && OptimalChSize( j ) && ( i == j );
        associative = TRUE;
    } else {
        char_1_cmp = (i == 1 ) && ( j == 1 );
        associative = FALSE;
    }
    PushOpn( CITNode->link );
    PushOpn( CITNode );
    op_code = opr_code - OPR_FIRST_RELOP;
    if( TypeCmplx( typ1 ) && TypeCmplx( typ2 ) ) {
        op_code += FC_CC_RELOPS;
    } else if( TypeCmplx( typ1 ) ) {
        if( flip ) {
            op_code += FC_XC_RELOPS;
        } else {
            op_code += FC_CX_RELOPS;
        }
    } else if( TypeCmplx( typ2 ) ) {
        if( flip ) {
            op_code += FC_CX_RELOPS;
        } else {
            op_code += FC_XC_RELOPS;
        }
    } else {
        if( flip && !associative ) {
            EmitOp( FC_FLIP );
        }
        if( typ1 == TY_CHAR ) {
            if( char_1_cmp ) {
                op_code += FC_CHAR_1_RELOPS;
            } else {
                op_code += FC_CHAR_RELOPS;
            }
        } else {
            op_code += FC_RELOPS;
        }
    }
    EmitOp( op_code );
    if( char_1_cmp ) {
        if( associative ) {
            DumpType( MapTypes( TY_INTEGER, i ), i );
        } else {
            // Assert: comparing CHARACTER*1 with LT, LE, GT, or GE
            // Consider: CHARACTER A/'a'/
            //           IF( A .lt. CHAR(159) ) PRINT *, 'OK'
            // we must generate an unsigned comparison
            DumpType( MapTypes( TY_LOGICAL, i ), i );
        }
        if( flip && associative ) {
            GenChar1Op( CITNode->link );
            GenChar1Op( CITNode );
        } else {
            GenChar1Op( CITNode );
            GenChar1Op( CITNode->link );
        }
    } else if( typ1 != TY_CHAR ) {
        if( flip && associative ) {
            GenTypes( CITNode->link, CITNode );
        } else {
            GenTypes( CITNode, CITNode->link );
        }
    }
}