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