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 ); } } } }
void CpQuit(void) { //================ // Compile a QUIT statement. itnode *block_label; csnode *csblock; CSExtn(); block_label = GetBlockLabel(); csblock = CSHead; if( block_label->opnd_size != 0 ) { for(;;) { if( CmpNode2Str( block_label, &csblock->label ) ) break; if( csblock->link == NULL ) break; csblock = csblock->link; } } if( csblock->typ == CS_EMPTY_LIST ) { StmtErr( SP_BAD_QUIT ); } else if( (csblock->typ == CS_GUESS) || (csblock->typ == CS_ADMIT) ) { GBranch( csblock->branch ); } else { GBranch( csblock->bottom ); } BlockLabel(); }
void CpRemBlock( void ) { sym_id rb; if( EmptyCSList() == FALSE ) { StmtErr( SP_BLK_IN_STRUCTURE ); } AddCSNode( CS_REMOTEBLOCK ); CSHead->bottom = NextLabel(); CSHead->branch = NextLabel(); GBranch( CSHead->branch ); if( BlockName( SY_RB_DEFINED ) ) { rb = CITNode->sym_ptr; if( ( rb->ns.flags & SY_REFERENCED ) == 0 ) { rb->ns.si.rb.ref_count = 0; } rb->ns.si.rb.ref_count++; CSHead->cs_info.rb = rb; GStartBlock(); BIStartRBorEP( rb ); } AdvanceITPtr(); ReqEOS(); StNumbers.in_remote = TRUE; ClearRem(); }
void CpCycle(void) { //================= // Compile the CYCLE statement. itnode *block_label; csnode *csblock; CSExtn(); block_label = GetBlockLabel(); csblock = CSHead; for(;;) { if( ( csblock->typ == CS_DO ) || ( csblock->typ == CS_DO_WHILE ) || ( csblock->typ == CS_WHILE ) || ( csblock->typ == CS_LOOP ) ) { if( block_label->opnd_size == 0 ) break; if( CmpNode2Str( block_label, &csblock->label ) ) break; } if( csblock->link == NULL ) break; csblock = csblock->link; } if( csblock->typ == CS_EMPTY_LIST ) { StmtErr( SP_BAD_QUIT ); } else { GBranch( csblock->cycle ); } BlockLabel(); }
void CpEntry( void ) { entry_pt *entry; bool in_subr; sym_id sym; if( ( ProgSw & PS_IN_SUBPROGRAM ) == 0 ) { StmtErr( SR_ILL_IN_PROG ); } if( !EmptyCSList() ) { Error( EY_NOT_IN_CS ); } if( ReqName( NAME_FUNCTION ) ) { in_subr = (SubProgId->u.ns.flags & SY_SUBPROG_TYPE) == SY_SUBROUTINE; sym = LkSym(); if( ( sym->u.ns.flags & (SY_USAGE|SY_SUB_PARM|SY_IN_EC|SY_SAVED) ) || ( in_subr && (sym->u.ns.flags & SY_TYPE) ) ) { IllName( sym ); } else { sym->u.ns.u1.s.typ = CITNode->typ; sym->u.ns.flags &= SY_TYPE; if( in_subr ) { sym->u.ns.flags |= SY_USAGE | SY_SUBPROGRAM | SY_SENTRY | SY_SUBROUTINE | SY_REFERENCED; } else { sym->u.ns.flags |= SY_USAGE | SY_SUBPROGRAM | SY_SENTRY | SY_FUNCTION; } STFnShadow( sym ); entry = AddEntryPt( sym ); AdvanceITPtr(); if( Options & OPT_TRACE ) { GSetSrcLine(); } if( RecOpenParen() ) { ParmList( in_subr, entry ); ReqCloseParen(); ReqNOpn(); AdvanceITPtr(); } BIStartRBorEP( sym ); ReqEOS(); } } SgmtSw &= ~SG_PROLOG_DONE; // indicate we need prologue }