cpsubpgm.c

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

/****************************************************************************
*
*                            Open Watcom Project
*
*    Portions Copyright (c) 1983-2002 Sybase, Inc. All Rights Reserved.
*
*  ========================================================================
*
*    This file contains Original Code and/or Modifications of Original
*    Code as defined in and that are subject to the Sybase Open Watcom
*    Public License version 1.0 (the 'License'). You may not use this file
*    except in compliance with the License. BY USING THIS FILE YOU AGREE TO
*    ALL TERMS AND CONDITIONS OF THE LICENSE. A copy of the License is
*    provided with the Original Code and Modifications, and is also
*    available at www.sybase.com/developer/opensource.
*
*    The Original Code and all software distributed under the License are
*    distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER
*    EXPRESS OR IMPLIED, AND SYBASE AND ALL CONTRIBUTORS HEREBY DISCLAIM
*    ALL SUCH WARRANTIES, INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF
*    MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR
*    NON-INFRINGEMENT. Please see the License for the specific language
*    governing rights and limitations under the License.
*
*  ========================================================================
*
* Description:  compile SUBROUTINE, (type)FUNCTION, and related statements
*
****************************************************************************/


//      Note : "type{*n} FUNCTION" statement handled by PR_type

#include "ftnstd.h"
#include "segsw.h"
#include "errcod.h"
#include "progsw.h"
#include "opr.h"
#include "namecod.h"
#include "global.h"
#include "cpopt.h"
#include "fmemmgr.h"
#include "recog.h"
#include "types.h"
#include "ferror.h"
#include "insert.h"
#include "utility.h"

extern  TYPE            MapTypes(TYPE,int);
extern  TYPE            ImplType(char);
extern  bool            EmptyCSList(void);
extern  sym_id          LkSym(void);
extern  sym_id          LkProgram(void);
extern  sym_id          LkBlkData(void);
extern  void            FreeLabel(label_id);
extern  void            FiniSubProg(void);
extern  void            InitSubProg(void);
extern  void            GSegLabel(void);
extern  void            GPgmLabel(void);
extern  void            GBranch(label_id);
extern  void            GLabel(label_id);
extern  void            GWarp(sym_id);
extern  void            GEpilog(void);
extern  void            GGotoEpilog(void);
extern  void            GSPProlog(void);
extern  void            GEPProlog(void);
extern  void            GRetIdx(void);
extern  void            GNullRetIdx(void);
extern  void            GBlockLabel(void);
extern  bool            LenSpec(TYPE,uint *);
extern  label_id        NextLabel(void);
extern  void            CkDefStmtNo(void);
extern  bool            InArgList(entry_pt *,sym_id);
extern  sym_id          STFnShadow(sym_id);
extern  void            BIStartRBorEP( sym_id );
extern  void            BIStartBlockData( sym_id );
extern  void            BIStartSubroutine( void );
extern  void            GSetSrcLine(void);


void    CpProgram(void) {
//===================

    CkSubEnd();
    if( ReqName( NAME_PROGRAM ) ) {
        SubProgId = LkProgram();    // use default name
    } else {
        SubProgId = LkProgram();        // use default name
    }
    StartProg();
    AdvanceITPtr();
    ReqEOS();
}


void    DefProg(void) {
//=================

// Define the program unit since no PROGRAM, SUBROUTINE, FUNCTION or
// BLOCK DATA statements were specified.

    SubProgId = LkProgram();
    StartProg();
}


static  void    StartProg(void) {
//===========================

    ProgSw &= ~PS_IN_SUBPROGRAM;
    if( ProgSw & PS_PROGRAM_DONE ) {
        Error( SR_TWO_PROGRAMS );
    }
    ProgSw |= PS_PROGRAM_DONE;
    GPgmLabel();
    BIStartSubroutine();
}


static  entry_pt        *AddEntryPt( sym_id sym_ptr ) {
//=====================================================

    entry_pt    *ptr;

    if( Entries == NULL ) {
        ArgList = FMemAlloc( sizeof( entry_pt ) );
        Entries = ArgList;
        ptr     = Entries;
    } else {
        ptr = Entries;
        while( ptr->link != NULL ) {
            ptr = ptr->link;
        }
        ptr->link = FMemAlloc( sizeof( entry_pt ) );
        ptr = ptr->link;
        if( ArgList == NULL ) {
            ArgList = ptr;
        }
    }
    ptr->link = NULL;
    ptr->id = sym_ptr;
    ptr->parms = NULL;
    return( ptr );
}


static  entry_pt        *SubProgName( TYPE typ, unsigned_16 flags,
                                      uint def_size, bool len_spec ) {
//====================================================================

// Process the symbolic name of a SUBROUTINE or FUNCTION.

    entry_pt    *entry;
    itnode      *name_node;
    itnode      *next_node;
    sym_id      sym_ptr;
    uint        size;
    sym_ptr = LkSym();
    SubProgId = sym_ptr;
    GSegLabel();    // must be before DumpStatement() so that ISN code for
    if( Options & OPT_TRACE ) {
        GSetSrcLine();
    }
    name_node = CITNode;
    sym_ptr->ns.flags = flags;
    name_node->flags = flags;
    size = def_size;
    next_node = CITNode->link;
    if( !len_spec ) {
        AdvanceITPtr();
        if( !LenSpec( typ, &size ) ) {
            size = StorageSize( typ );
        }
        next_node = CITNode;
    }
    sym_ptr->ns.xt.size = size;
    name_node->size = size;
    typ = MapTypes( typ, size );
    sym_ptr->ns.typ = typ;
    name_node->typ = typ;
    CITNode = name_node;
    entry = AddEntryPt( sym_ptr );
    CITNode = next_node;
    return( entry );
}


void    CpSubroutine(void) {
//======================

    entry_pt    *entry;

    CkSubEnd();
    ProgSw |= PS_IN_SUBPROGRAM;
    if( ReqName( NAME_SUBROUTINE ) ) {
        entry = SubProgName( TY_NO_TYPE, SY_USAGE | SY_SUBPROGRAM | SY_PENTRY |
                              SY_SUBROUTINE | SY_REFERENCED, 0, TRUE );
        if( RecOpenParen() ) {
            ParmList( TRUE, entry );
            ReqCloseParen();
            ReqNOpn();
            AdvanceITPtr();
        }
        ReqEOS();
    } else {
        // We still want to start a subprogram even though there is no name.
        SubProgId = LkProgram();        // use default name
        GSegLabel();
    }
    BIStartSubroutine();
}


void    Function( TYPE typ, uint size, bool len_spec ) {
//=====================================================

// Compile [type] [*len] FUNCTION NAME[*len] ([d,d,...])
//            \                /
//             Already scanned
//

    unsigned_16 flags;
    entry_pt    *entry;

    flags = SY_USAGE | SY_SUBPROGRAM | SY_PENTRY | SY_FUNCTION;
    if( typ == TY_NO_TYPE ) {
        typ = ImplType( *(CITNode->opnd) );
    } else {
        flags |= SY_TYPE;
    }
    CkSubEnd();
    ProgSw |= PS_IN_SUBPROGRAM;
    if( ReqName( NAME_FUNCTION ) ) {
        entry = SubProgName( typ, flags, size, len_spec );
        STFnShadow( SubProgId );
        if( ReqOpenParen() ) {
            ParmList( FALSE, entry );
        }
        ReqCloseParen();
        ReqNOpn();
        AdvanceITPtr();
        ReqEOS();
    } else {
        // We still want to start a subprogram even though there is no name.
        SubProgId = LkProgram();        // use default name
        GSegLabel();
    }
    BIStartSubroutine();
}


void    CpFunction(void) {
//====================

    Function( TY_NO_TYPE, -1, FALSE );
}


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->ns.flags & SY_SUBPROG_TYPE) == SY_SUBROUTINE;
        sym = LkSym();
        if( ( sym->ns.flags & (SY_USAGE|SY_SUB_PARM|SY_IN_EC|SY_SAVED) ) ||
            ( in_subr && (sym->ns.flags & SY_TYPE) ) ) {
            IllName( sym );
        } else {
            sym->ns.typ = CITNode->typ;
            sym->ns.flags &= SY_TYPE;
            if( in_subr ) {