void Unit(void) {
//===============
if( RecNOpn() && RecNextOpr( OPR_MUL ) ) {
if( ( StmtProc != PR_READ ) && ( StmtProc != PR_WRITE ) ) {
StmtErr( IL_STAR_NOT_ALLOWED );
}
AdvanceITPtr();
ReqNOpn();
} else {
ProcIOExpr();
if( !AError ) {
if( _IsTypeInteger( CITNode->typ ) && !RecArrName() ) {
GPassValue( FC_SET_UNIT );
} else if( CITNode->typ == FT_CHAR ) {
KWRememb( IO_INTERNAL );
CkAssignOk();
if( RecArrName() ) {
ChkAssumed();
GArrIntlSet();
} else {
GIntlSet();
}
if( ( StmtProc != PR_READ ) &&
( StmtProc != PR_WRITE ) &&
( StmtProc != PR_PRINT ) ) {
Error( IL_BAD_INTL );
}
} else {
Error( IL_NO_UNIT_ID );
}
}
}
}
static void CharItem( FCODE routine ) {
//=========================================
CharSubExpr();
if( !AError ) {
if( StmtProc == PR_INQ ) {
CkAssignOk();
}
GPassAddr( routine );
}
}
static void IntInq( FCODE routine ) {
//=======================================
sym_id sym;
IntSubExpr();
if( !AError ) {
CkSize4();
sym = CkAssignOk();
if( sym != NULL ) {
sym->u.ns.u1.s.xflags |= SY_VOLATILE;
}
GPassAddr( routine );
}
}
void ListItem( void ) {
//==================
// Process one list item.
sym_id sd;
if( RecNOpn() ) {
if( !CpError ) {
Error( SX_SURP_OPR );
}
} else if( RecArrName() ) {
CITNode->sym_ptr->ns.u1.s.xflags |= SY_DEFINED;
ChkAssumed();
if( CITNode->typ == FT_STRUCTURE ) {
ChkStructIO( CITNode->sym_ptr->ns.xt.sym_record );
GIOStructArray();
} else {
GIOArray();
}
} else if( CITNode->typ == FT_STRUCTURE ) {
CITNode->sym_ptr->ns.u1.s.xflags |= SY_DEFINED;
if( CITNode->opn.us & USOPN_FLD ) {
sd = CITNode->value.st.field_id->fd.xt.sym_record;
} else {
sd = CITNode->sym_ptr->ns.xt.sym_record;
}
ChkStructIO( sd );
GIOStruct( sd );
} else {
if( StmtProc == PR_READ ) {
CkAssignOk();
}
GIOItem();
}
AdvanceITPtr();
}
static bool DoGenerate( TYPE typ1, TYPE typ2, uint *res_size ) {
//================================================================
if( CITNode->link->opr == OPR_EQU ) {
ResultType = typ1;
*res_size = CITNode->size;
if( (ASType & AST_ASF) || CkAssignOk() ) return( true );
return( false );
} else {
if( ( ( typ1 == FT_DOUBLE ) && ( typ2 == FT_COMPLEX ) ) ||
( ( typ2 == FT_DOUBLE ) && ( typ1 == FT_COMPLEX ) ) ) {
ResultType = FT_DCOMPLEX;
*res_size = TypeSize( FT_DCOMPLEX );
Extension( MD_DBLE_WITH_CMPLX );
} else if( ( ( typ1 == FT_TRUE_EXTENDED ) && ( typ2 == FT_COMPLEX ) )
|| ( ( typ2 == FT_TRUE_EXTENDED ) && ( typ1 == FT_COMPLEX ) )
|| ( ( typ1 == FT_TRUE_EXTENDED ) && ( typ2 == FT_DCOMPLEX ) )
|| ( ( typ2 == FT_TRUE_EXTENDED ) && ( typ1 == FT_DCOMPLEX ) ) ) {
ResultType = FT_XCOMPLEX;
*res_size = TypeSize( FT_XCOMPLEX );
Extension( MD_DBLE_WITH_CMPLX );
} else if( ( typ2 > typ1 ) || ( typ1 == FT_STRUCTURE ) || ( typ1 == FT_NO_TYPE ) ) {
ResultType = typ2;
*res_size = TypeSize( typ2 );
} else {
ResultType = typ1;
if( _IsTypeInteger( ResultType ) ) {
*res_size = CITNode->size;
if( *res_size < CITNode->link->size ) {
*res_size = CITNode->link->size;
}
} else
*res_size = TypeSize( typ1 );
}
return( true );
}
}
