cpsubpgm.c

来自「开放源码的编译器open watcom 1.6.0版的源代码」· C语言 代码 · 共 561 行 · 第 1/2 页

                sym->ns.flags |= SY_USAGE | SY_SUBPROGRAM | SY_SENTRY |
                                     SY_SUBROUTINE | SY_REFERENCED;
            } else {
                sym->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
}


void    CpReturn(void) {
//==================

    if( !(ProgSw & PS_IN_SUBPROGRAM) ) {
        Extension( RE_IN_PROGRAM );
    }
    CkRemBlock();
    if( RecNOpn() && RecNextOpr( OPR_TRM ) ) {
        if( ( ( SubProgId->ns.flags & SY_CLASS ) == SY_SUBPROGRAM ) &&
            ( ( SubProgId->ns.flags & SY_SUBPROG_TYPE ) == SY_SUBROUTINE ) ) {
            GNullRetIdx();
        }
    } else {
        IntSubExpr();
        if( ( ( SubProgId->ns.flags & SY_CLASS ) == SY_SUBPROGRAM ) &&
            ( ( SubProgId->ns.flags & SY_SUBPROG_TYPE ) == SY_SUBROUTINE ) ) {
            GRetIdx();
        } else {
            Error( RE_ALT_IN_SUBROUTINE );
        }
    }
    AdvanceITPtr();
    ReqEOS();
    GGotoEpilog();
    Remember.transfer = TRUE;
    Remember.stop_or_return = TRUE;
}


static  void    CkRemBlock(void) {
//============================

    csnode      *csptr;

    csptr = CSHead;
    for(;;) {
        if( csptr->typ == CS_EMPTY_LIST ) return;
        if( csptr->typ == CS_REMOTEBLOCK ) break;
        csptr = csptr->link;
    }
    Error( SP_RET_IN_REMOTE );
}


static  void    CkSubEnd(void) {
//==========================

// Check if we had an END statement.

    if( ( SgmtSw & SG_STMT_PROCESSED ) && !Remember.endstmt ) {
        FiniSubProg();
        InitSubProg();
    }
    CkDefStmtNo();
}


static  parameter       *NameParm( entry_pt *entry ) {
//====================================================

// Process a symbolic dummy argument.

    parameter           *result;
    sym_id              sym;
    act_dim_list        *dim_ptr;
    unsigned_16         flags;
    unsigned_16         class;

    sym = LkSym();
    flags = sym->ns.flags;
    class = flags & SY_CLASS;
    if( class == SY_VARIABLE ) {
        if( InArgList( entry, sym ) ) {
            NameErr( AR_DUPLICATE_PARM, sym );
            return( NULL );
        } else if( flags & SY_SAVED ) {
            Error( SA_SAVED );
            return( NULL );
        } else if( flags & SY_IN_EC ) {
            IllName( sym );
            return( NULL );
        } else if( flags & SY_SUBSCRIPTED ) {
            dim_ptr = sym->ns.si.va.dim_ext;
            if( dim_ptr->dim_flags & DIM_PVD ) {
                dim_ptr->dim_flags |= DIM_ASSUMED;
                NameExt( SV_PVD, sym );
                if( dim_ptr->dim_flags & DIM_USED_IN_IO ) {
                    NameErr( SV_CANT_USE_ASSUMED, sym );
                    return( NULL );
                }
            }
        }
    } else if( class == SY_PARAMETER ) {
        IllName( sym );
        return( NULL );
    } else { // subroutine name
        class = flags & SY_SUBPROG_TYPE;
        if( ( class != SY_FUNCTION ) && ( class != SY_SUBROUTINE ) &&
            ( class != SY_FN_OR_SUB ) ) {
            IllName( sym );
            return( NULL );
        } else if( flags & ( SY_PS_ENTRY | SY_INTRINSIC ) ) {
            IllName( sym );
            return( NULL );
        }
    }
    result = FMemAlloc( sizeof( parameter ) );
    result->link = NULL;
    result->id = sym;
    result->flags = 0;
    if( sym->ns.flags & SY_SUB_PARM ) {
        result->flags |= ARG_DUPLICATE;
    }
    sym->ns.flags |= SY_SUB_PARM;
    return( result );
}


static  parameter       *StarParm(void) {
//===================================

// Process an asterisk dummy argument.

    parameter   *result;

    result = FMemAlloc( sizeof( parameter ) );
    result->link = NULL;
    result->flags |= ARG_STMTNO;
    return( result );
}


static  void    ParmList( bool star_ok, entry_pt *entry ) {
//=========================================================

// Process the formal parameter list of a FUNCTION/SUBROUTINE.

    parameter   **args;
    parameter   *new_arg;

    args = &entry->parms;
    if( RecNOpn() && RecNextOpr( OPR_RBR ) ) {
        // consider name()
        AdvanceITPtr();
    } else {
        for(;;) {       // process parm list
            if( star_ok && RecNOpn() ) {
                AdvanceITPtr();
                if( ReqMul() && ReqNOpn() ) {
                    *args = StarParm();
                    args = &(*args)->link;
                }
            } else if( ReqName( NAME_ARGUMENT ) ) {
                new_arg = NameParm( entry );
                if( new_arg != NULL ) {
                    *args = new_arg;
                    args = &(*args)->link;
                }
            }
            AdvanceITPtr();
            if( !RecComma() ) break;
        }
    }
}



void    Prologue(void) {
//==================

// Generate a FUNCTION/SUBROUTINE/ENTRY prologue starting with ArgList.

    label_id    skip_label;

    SgmtSw |= SG_PROLOG_DONE;
    if( ( ArgList != NULL ) && ( ArgList->id == SubProgId ) ) {
        GSPProlog();
        InitParms();
        ArgList = ArgList->link;
    }
    while( ArgList != NULL ) {
        skip_label = NextLabel();
        GBranch( skip_label );
        GEPProlog();
        InitParms();
        GLabel( skip_label );
        FreeLabel( skip_label );
        ArgList = ArgList->link;
    }
}


static  void    InitParms(void) {
//===========================

    DoWarps();
}


static  void    DoWarps(void) {
//=========================

// Generate calls to warp code.

    parameter   *parm;
    sym_id      sym;

    for( parm = ArgList->parms; parm != NULL; parm = parm->link ) {
        if( parm->flags & ARG_STMTNO ) continue;
        sym = parm->id;
        if( ( sym->ns.flags & SY_CLASS ) != SY_VARIABLE ) continue;
        if( ( sym->ns.flags & SY_SUBSCRIPTED ) == 0 ) continue;
        if( _AdvRequired( sym->ns.si.va.dim_ext ) == 0 ) continue;
        GWarp( sym );
    }
}


void    Epilogue(void) {
//==================

// Generate an epilogue.

    if( ( SgmtSw & SG_PROLOG_DONE ) == 0 ) {
        Prologue();
    }
    if( SubProgId != NULL ) {
        GEpilog();
    }
}


void    CpBlockData(void) {
//=====================

    sym_id  sym_ptr;

    CkSubEnd();
    ProgSw |= PS_IN_SUBPROGRAM | PS_BLOCK_DATA;
    if( RecName() ) {
        sym_ptr = LkSym();
        sym_ptr->ns.flags = SY_USAGE | SY_SUBPROGRAM | SY_BLOCK_DATA |
                            SY_PENTRY | SY_REFERENCED;
    } else {
        ReqNOpn();
        sym_ptr = LkBlkData();
    }
    SubProgId = sym_ptr;
    GBlockLabel();
    AdvanceITPtr();
    ReqEOS();
    BIStartBlockData( SubProgId );
}