コード例 #1
0
ファイル: intrnsc.c プロジェクト: ABratovic/open-watcom-v2
void    CpIntrinsic(void) {
//=====================

// Compile INTRINSIC statement.

//     INTRINSIC FUNC {,FUNC1} . . .

    unsigned_16 flags;
    IFF         func;
    sym_id      sym_ptr;
    TYPE        func_typ;

    for(;;) {
        if( ReqName( NAME_INTRINSIC ) ) {
            func = IFLookUp();
            if( func > 0 ) {
                func_typ = IFType( func );
                sym_ptr = LkSym();
                flags = sym_ptr->u.ns.flags;
                if( ( flags & SY_USAGE ) != 0 ) {
                    if( ( flags & SY_CLASS ) == SY_SUBPROGRAM ) {
                        if( ( flags & SY_INTRINSIC ) != 0 ) {
                            Error( SR_PREV_INTRNSC );
                        } else if( ( flags & SY_EXTERNAL ) != 0 ) {
                            Error( SR_INTRNSC_EXTRN );
                        }
                    } else {
                        IllName( sym_ptr );
                    }
                } else if( flags & ERR_MASK ) {
                    IllName( sym_ptr );
                } else if( ( flags & SY_TYPE ) &&
                           ( sym_ptr->u.ns.u1.s.typ != func_typ ) ) {
                    NameTypeErr( TY_TYP_PREV_DEF, sym_ptr );
                } else {
                    // we must OR the flags since SY_TYPE and/or SY_REFERENCED
                    // bit might already be set in the symbol table
                    sym_ptr->u.ns.flags |= SY_USAGE | SY_SUBPROGRAM |
                                         SY_FUNCTION | SY_INTRINSIC;
                    func_typ = IFType( func );
                    sym_ptr->u.ns.u1.s.typ = func_typ;
                    sym_ptr->u.ns.xt.size = TypeSize( func_typ );
                    sym_ptr->u.ns.si.fi.index = func;
                }
            } else {
                Error( SR_NOT_INTRNSC );
            }
        }
        AdvanceITPtr();
        if( !RecComma() ) {
            break;
        }
    }
    ReqEOS();
}
コード例 #2
0
static  void    CkIntrinsic( void ) {
//=============================

// Check for intrinsic functions.
//
//     CASE 1: integer abs
//             y == abs( -1.0 )    -- this should call generic i.f. abs
//
//     CASE 2: real iabs
//             y == iabs( -1 )     -- this should give type mismatch error
//

    sym_id      sym_ptr;
    TYPE        typ;
    IFF         func;

    sym_ptr = CITNode->sym_ptr;
    if( ( CITNode->flags & SY_SUB_PARM ) == 0 ) {
        typ = CITNode->typ;
        func = IFLookUp();
        if( func > 0 ) {
            sym_ptr->ns.si.fi.index = func;
            if( func == IF_ISIZEOF ) {
                ASType |= AST_ISIZEOF;
            }
            sym_ptr->ns.si.fi.num_args = 0;
            CITNode->flags |= SY_INTRINSIC;
            IFChkExtension( func );
            if( !IFIsGeneric( func ) ) {
                CITNode->typ = IFType( func );
                CITNode->size = TypeSize( CITNode->typ );
                sym_ptr->ns.typ = CITNode->typ;
                sym_ptr->ns.xt.size = CITNode->size;
                if( ( CITNode->typ != typ ) && ( CITNode->flags & SY_TYPE ) ) {
                    Error( LI_WRONG_TYPE );
                }
            }
        }
    }
}