示例#1
0
bool    RecIntVar( void ) {
//===================

    if( !IsVariable() )
        return( false );
    return( _IsTypeInteger( CITNode->typ ) );
}
示例#2
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 );
            }
        }
    }
}
示例#3
0
static  void    ExpOp( TYPE typ1, TYPE typ2, OPTR op ) {
//======================================================

    op = op;
    if( !_IsTypeInteger( typ2 ) ) {
        Convert();
        GenExp( ResultType );
    } else {
        CnvTo( CITNode, ResultType, TypeSize( ResultType ) );
        ExpI( typ1, &CITNode->value, ITIntValue( CITNode->link ) );
    }
}
示例#4
0
static  void    LogOp( TYPE typ1, TYPE typ2, OPTR op ) {
//======================================================

    typ1 = typ1;
    op -= OPTR_FIRST_LOGOP;
    if( _IsTypeInteger( typ2 ) ) {
        Convert();
        XBitWiseTab[ op ]( &CITNode->value, &CITNode->link->value );
    } else {
        XLogicalTab[ op ]( &CITNode->value, &CITNode->link->value );
    }
    CITNode->opn.us = USOPN_CON; // this is required for .not. operator
}
示例#5
0
void    LogOp( TYPE typ1, TYPE typ2, OPTR op ) {
//==============================================

// Generate code for a relational operator.

    bool        flip;

    op -= OPTR_FIRST_LOGOP;
    flip = FALSE;
    if( ( ( CITNode->opn.us & USOPN_WHERE ) == USOPN_SAFE ) &&
        ( ( CITNode->link->opn.us & USOPN_WHERE ) != USOPN_SAFE ) ) {
        flip = TRUE;
    }
    PushOpn( CITNode->link );
    if( typ1 == TY_NO_TYPE ) {  // unary
        if( _IsTypeInteger( typ2 ) ) {
            EmitOp( FC_BIT_NOT );
        } else {
            EmitOp( FC_NOT );
        }
        GenType( CITNode->link );
        SetOpn( CITNode, USOPN_SAFE );
    } else {
        PushOpn( CITNode );
        if( _IsTypeInteger( typ2 ) ) {
            EmitOp( FC_BITOPS + op );
        } else {
            EmitOp( FC_LOGOPS + op );
        }
        if( flip ) {
            GenTypes( CITNode->link, CITNode );
        } else {
            GenTypes( CITNode, CITNode->link );
        }
    }
}
示例#6
0
static bool UnaryMul( TYPE typ1, TYPE typ2 ) {
//============================================

    if( typ1 > FT_EXTENDED )
        return( FALSE );
    if( !_IsTypeInteger( typ2 ) )
        return( FALSE );
    if( CITNode->link->opn.us != USOPN_CON )
        return( FALSE );
    if( ITIntValue( CITNode->link ) < 0 )
        return( FALSE );
    if( ITIntValue( CITNode->link ) > 8 )
        return( FALSE );
    return( TRUE );
}
示例#7
0
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;
    }
}
示例#8
0
static void Unary( TYPE typ, OPTR opr ) {
//=======================================

// Generate code for unary plus or unary minus.

    PushOpn( CITNode->link );
    if( opr == OPTR_SUB ) {             // unary minus
        if( TypeCmplx( typ ) ) {
            EmitOp( FC_CUMINUS );
        } else {
            EmitOp( FC_UMINUS );
        }
        GenType( CITNode->link );
    } else if( ( _IsTypeInteger( CITNode->link->typ ) ) &&
               ( CITNode->link->size < sizeof( intstar4 ) ) ) {
        // convert INTEGER*1 or INTEGER*2 to INTEGER*4
        EmitOp( FC_CONVERT );
        DumpTypes( CITNode->link->typ, CITNode->link->size, FT_INTEGER, sizeof( intstar4 ) );
    }
    SetOpn( CITNode, USOPN_SAFE );
}
示例#9
0
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 );
    }
}
示例#10
0
static  void    DoLoop( TYPE do_type ) {
//=====================================

// Generate code for DO statement or implied-DO.

    do_entry    *doptr;
    uint        do_size;
    intstar4    incr;
    intstar4    limit;
    sym_id      loop_ctrl;
    TYPE        e1_type;
    uint        e1_size;
    itnode      *e2_node;
    itnode      *e3_node;
    bool        e2_const;

    doptr = CSHead->cs_info.do_parms;
    do_size = CITNode->sym_ptr->u.ns.xt.size;
    doptr->do_parm = CITNode->sym_ptr;          // save ptr to do variable
    AdvanceITPtr();                             // bump past the '='
    EatDoParm();                                // process e1
    PushOpn( CITNode );
    e1_type = CITNode->typ;
    e1_size = CITNode->size;
    AdvanceITPtr();
    if( ReqComma() ) {
        EatDoParm();                            // process e2
        e2_const = CITNode->opn.us == USOPN_CON;
        PushOpn( CITNode );
        e2_node = CITNode;
        AdvanceITPtr();
        e3_node = NULL;
        if( RecComma() ) {
            EatDoParm();                        // process e3
            e3_node = CITNode;
            if( !AError ) {
                if( (CITNode->opn.us == USOPN_CON) && _IsTypeInteger( do_type ) ) {
                    incr = GetIntValue( CITNode );
                    doptr->incr_value = incr;
                    doptr->increment = NULL;
                    if( (OZOpts & OZOPT_O_FASTDO) == 0 ) {
                        if( e2_const ) {
                            limit = GetIntValue( e2_node );
                            if( NeedIncrement( limit, incr, do_type ) ) {
                                PushOpn( CITNode );
                                doptr->increment = StaticAlloc( do_size, do_type );
                            }
                        } else {
                            PushOpn( CITNode );
                            doptr->increment = StaticAlloc( do_size, do_type );
                        }
                    }
                } else {
                    PushOpn( CITNode );
                    doptr->increment = StaticAlloc( do_size, do_type );
                }
                AdvanceITPtr();
            }
        } else {
            if( _IsTypeInteger( do_type ) ) {
                doptr->increment = NULL;
                doptr->incr_value = 1;
                if( (OZOpts & OZOPT_O_FASTDO) == 0 ) {
                    if( e2_const ) {
                        limit = GetIntValue( e2_node );
                        if( NeedIncrement( limit, 1, do_type ) ) {
                            PushConst( 1 );
                            doptr->increment = StaticAlloc( do_size, do_type );
                        }
                    } else {
                        PushConst( 1 );
                        doptr->increment = StaticAlloc( do_size, do_type );
                    }
                }
            } else {
                PushConst( 1 );
                doptr->increment = StaticAlloc( do_size, do_type );
            }
        }
        EmitOp( FC_DO_BEGIN );
        OutPtr( doptr->do_parm );
        OutPtr( doptr->increment );
        if( doptr->increment == NULL ) { // INTEGER do-loop with constant incr
            loop_ctrl = StaticAlloc( do_size, do_type );
            OutConst32( doptr->incr_value );
            OutPtr( loop_ctrl );
        } else {
            if( _IsTypeInteger( do_type ) ) {
                loop_ctrl = StaticAlloc( do_size, do_type );
            } else {
                loop_ctrl = StaticAlloc( sizeof( intstar4 ), FT_INTEGER );
            }
            doptr->iteration = loop_ctrl;
            OutPtr( loop_ctrl );
            if( e3_node == NULL ) {
                DumpType( FT_INTEGER, TypeSize( FT_INTEGER ) );
            } else {
                GenType( e3_node );
            }
        }
        GenType( e2_node );
        DumpType( e1_type, e1_size );
        OutU16( CSHead->branch );
        OutU16( CSHead->bottom );
    }
}
示例#11
0
static  void    Generate( void ) {
//================================

// Generate code.

    TYPE        typ1;
    TYPE        typ2;
    OPTR        op;
    OPR         opr;
    itnode      *next;
    unsigned_16 mask;
    uint        res_size;

    next = CITNode->link;
    if( next->opn.ds == DSOPN_PHI ) {
        BadSequence();
    } else {
        typ1 = CITNode->typ;
        typ2 = next->typ;
        opr = next->opr;
        if( RecNOpn() ) {
            typ1 = FT_NO_TYPE;
            CITNode->size = next->size;
            if( (opr != OPR_PLS) && (opr != OPR_MIN) && (opr != OPR_NOT) ) {
                BadSequence();
                return;
            }
        }
        op = OprNum[ opr ];
        if( typ1 == FT_NO_TYPE ) {
            mask = LegalOprsU[ typ2 - FT_FIRST ];
        } else {
            mask = LegalOprsB[ ( typ2 - FT_FIRST ) * LEGALOPR_TAB_COLS + typ1 - FT_FIRST ];
        }
        if( (( mask >> ( op - OPTR_FIRST ) ) & 1) == 0 ) {
            // illegal combination
            MoveDown();
            if( typ1 == FT_NO_TYPE ) {
                TypeErr( MD_UNARY_OP, typ2 );
            } else if( typ1 == typ2 ) {
                TypeErr( MD_ILL_OPR, typ1 );
            } else {
                TypeTypeErr( MD_MIXED, typ1, typ2 );
            }
            BackTrack();
        } else if( DoGenerate( typ1, typ2, &res_size ) ) {
            if( ( opr >= OPR_FIRST_RELOP ) && ( opr <= OPR_LAST_RELOP ) &&
                ( (ResultType == FT_COMPLEX) || (ResultType == FT_DCOMPLEX) ||
                (ResultType == FT_XCOMPLEX) ) &&
                ( opr != OPR_EQ ) && ( opr != OPR_NE ) ) {
                // can only compare complex with .EQ. and .NE.
                Error( MD_RELOP_OPND_COMPLEX );
            } else {
                if( ( next->opn.us == USOPN_CON ) &&
                    ( ( CITNode->opn.us == USOPN_CON ) || ( typ1 == FT_NO_TYPE ) ) ) {
                    // we can do some constant folding
                    ConstTable[ op ]( typ1, typ2, op );
                } else {
                    // we have to generate code
                    if( CITNode->opn.us == USOPN_CON ) {
                        AddConst( CITNode );
                    } else if( next->opn.us == USOPN_CON ) {
                        AddConst( next );
                    }
                    GenOprTable[ op ]( typ1, typ2, op );
                }
            }
            switch( opr ) {
            case OPR_EQV:
            case OPR_NEQV:
            case OPR_OR:
            case OPR_AND:
            case OPR_NOT:
                if( _IsTypeInteger( typ1 ) ) {
                    Extension( MD_LOGOPR_INTOPN );
                }
                break;
            case OPR_EQ:        // relational operators
            case OPR_NE:
            case OPR_LT:
            case OPR_GE:
            case OPR_LE:
            case OPR_GT:
                ResultType = FT_LOGICAL;
                res_size = TypeSize( ResultType );
                break;
            case OPR_FLD:
            case OPR_DPT:
                // set result size to size of field
                res_size = next->size;
                FixFldNode();
                break;
            }
            CITNode->size = res_size;
            CITNode->typ = ResultType;
            FixList();
        }
    }