void CpCall(void) {
//================
itnode *next;
unsigned_16 sp_type;
next = CITNode->link;
if( next->opr == OPR_TRM ) {
ASType = AST_CNA; // call with no parameter list
} else if( ( next->opr == OPR_LBR ) &&
( next->opn.ds == DSOPN_PHI ) &&
( next->link->opr == OPR_RBR ) &&
( next->link->opn.ds == DSOPN_PHI ) &&
( next->link->link->opr == OPR_TRM ) ) {
next->opr = OPR_TRM; // make CALL SAM() same as CALL SAM
ASType = AST_CNA; // call with no parameter list
} else {
ReqNextOpr( OPR_LBR, SX_SURP_OPR );
if( ( SPtr1 != NULL ) && ( SPtr1->link->opr != OPR_TRM ) ) {
Error( SX_JUNK_AFTER_RBR ); // ignore anything after
SPtr1->link->opr = OPR_TRM; // closing parenthesis
}
ASType = AST_OFF;
}
if( ReqName( NAME_SUBROUTINE ) ) {
LkSym();
if( ClassIs( SY_SUBPROGRAM ) ) {
sp_type = CITNode->flags & SY_SUBPROG_TYPE;
if( sp_type == SY_SUBROUTINE ) {
ASType |= AST_ALT;
Arith();
} else if( sp_type == SY_FUNCTION ) {
Extension( SR_FUNC_AS_SUB );
Arith();
} else if( sp_type == 0 ) {
ArithNewSubr();
} else {
Error( SR_NO_SUBRTN_NAME );
}
} else {
if( CITNode->flags & SY_USAGE ) {
Error( SR_NO_SUBRTN_NAME );
} else if( CITNode->flags & SY_SAVED ) {
Error( SA_SAVED );
} else {
ArithNewSubr();
}
}
}
}
void InitDo( signed_32 term )
{
// Initialize a DO or implied DO.
// Process "do i=e1,e2,e3" where e1, e2 and e3 are numeric expressions.
//
do_entry *do_pointer;
sym_id do_var;
if( ( StmtSw & SS_DATA_INIT ) == 0 ) {
CSHead->branch = NextLabel();
CSHead->bottom = NextLabel();
CSHead->cycle = NextLabel();
}
do_pointer = FMemAlloc( sizeof( do_entry ) );
CSHead->cs_info.do_parms = do_pointer;
do_pointer->do_term = term;
do_pointer->do_parm = NULL;
if( ReqDoVar() ) {
CkTypeDeclared();
do_var = CITNode->sym_ptr;
BIOutSymbol( do_var );
do_var->u.ns.flags |= SY_REFERENCED;
do_var->u.ns.u1.s.xflags |= SY_DEFINED;
if( do_var->u.ns.flags & SY_DO_PARM ) {
Error( DO_PARM_REDEFINED );
}
do_pointer->do_parm = do_var; // remember id of "i"
ReqNextOpr( OPR_EQU, EQ_NO_EQUALS );
if( StmtSw & SS_DATA_INIT ) {
if( !_IsTypeInteger( do_var->u.ns.u1.s.typ ) ) {
NameErr( DA_BAD_DO_VAR, do_var );
}
do_var = STShadow( do_var );
CITNode->flags = do_var->u.ns.flags;
}
CITNode->sym_ptr = do_var;
GDoInit( do_var->u.ns.u1.s.typ );
do_var->u.ns.flags |= SY_DO_PARM;
}
}
