static int ScanCat( int *size_ptr ) {
//========================================
// Scan for strings to be concatenated.
uint cat_size;
itnode *itptr;
uint num_cats;
itptr = CITNode;
cat_size = 0;
num_cats = 0;
for(;;) {
if( CITNode->opn.ds == DSOPN_PHI ) {
// no operand (A = B // // C)
TypeErr( SX_WRONG_TYPE, FT_CHAR );
} else if( CITNode->typ != FT_CHAR ) {
TypeTypeErr( MD_MIXED, FT_CHAR, CITNode->typ );
} else if( ( CITNode->size == 0 ) && ( size_ptr != NULL ) ) {
// NULL 'size_ptr' means we are concatenating into a character
// variable so character*(*) variables are allowed.
OpndErr( CV_BAD_LEN );
} else {
cat_size += CITNode->size;
}
CITNode = CITNode->link;
num_cats++;
if( CITNode->opr != OPR_CAT ) break;
}
CITNode = itptr;
if( size_ptr != NULL ) {
*size_ptr = cat_size;
}
return( num_cats );
}
static void Generate( void ) {
//================================
// Generate code.
TYPE typ1;
TYPE typ2;
OPTR op;
OPR opr;
itnode *next;
unsigned_16 mask;
uint res_size;
next = CITNode->link;
if( next->opn.ds == DSOPN_PHI ) {
BadSequence();
} else {
typ1 = CITNode->typ;
typ2 = next->typ;
opr = next->opr;
if( RecNOpn() ) {
typ1 = FT_NO_TYPE;
CITNode->size = next->size;
if( (opr != OPR_PLS) && (opr != OPR_MIN) && (opr != OPR_NOT) ) {
BadSequence();
return;
}
}
op = OprNum[ opr ];
if( typ1 == FT_NO_TYPE ) {
mask = LegalOprsU[ typ2 - FT_FIRST ];
} else {
mask = LegalOprsB[ ( typ2 - FT_FIRST ) * LEGALOPR_TAB_COLS + typ1 - FT_FIRST ];
}
if( (( mask >> ( op - OPTR_FIRST ) ) & 1) == 0 ) {
// illegal combination
MoveDown();
if( typ1 == FT_NO_TYPE ) {
TypeErr( MD_UNARY_OP, typ2 );
} else if( typ1 == typ2 ) {
TypeErr( MD_ILL_OPR, typ1 );
} else {
TypeTypeErr( MD_MIXED, typ1, typ2 );
}
BackTrack();
} else if( DoGenerate( typ1, typ2, &res_size ) ) {
if( ( opr >= OPR_FIRST_RELOP ) && ( opr <= OPR_LAST_RELOP ) &&
( (ResultType == FT_COMPLEX) || (ResultType == FT_DCOMPLEX) ||
(ResultType == FT_XCOMPLEX) ) &&
( opr != OPR_EQ ) && ( opr != OPR_NE ) ) {
// can only compare complex with .EQ. and .NE.
Error( MD_RELOP_OPND_COMPLEX );
} else {
if( ( next->opn.us == USOPN_CON ) &&
( ( CITNode->opn.us == USOPN_CON ) || ( typ1 == FT_NO_TYPE ) ) ) {
// we can do some constant folding
ConstTable[ op ]( typ1, typ2, op );
} else {
// we have to generate code
if( CITNode->opn.us == USOPN_CON ) {
AddConst( CITNode );
} else if( next->opn.us == USOPN_CON ) {
AddConst( next );
}
GenOprTable[ op ]( typ1, typ2, op );
}
}
switch( opr ) {
case OPR_EQV:
case OPR_NEQV:
case OPR_OR:
case OPR_AND:
case OPR_NOT:
if( _IsTypeInteger( typ1 ) ) {
Extension( MD_LOGOPR_INTOPN );
}
break;
case OPR_EQ: // relational operators
case OPR_NE:
case OPR_LT:
case OPR_GE:
case OPR_LE:
case OPR_GT:
ResultType = FT_LOGICAL;
res_size = TypeSize( ResultType );
break;
case OPR_FLD:
case OPR_DPT:
// set result size to size of field
res_size = next->size;
FixFldNode();
break;
}
CITNode->size = res_size;
CITNode->typ = ResultType;
FixList();
}
}