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 ); } }
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 ); } } }