Exemplo n.º 1
0
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 );
            }
        }
    }
}
Exemplo n.º 2
0
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();
}
Exemplo n.º 3
0
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();
}
Exemplo n.º 4
0
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();
}
Exemplo n.º 5
0
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
}