fccall.c

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

/****************************************************************************
*
*                            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:  F-Code processor for subroutine calls.
*
****************************************************************************/


#include "ftnstd.h"
#include "global.h"
#include "wf77defs.h"
#include "wf77aux.h"
#include "wf77cg.h"
#include "tmpdefs.h"
#include "cpopt.h"
#include "fcgbls.h"
#include "iflookup.h"
#include "rtconst.h"
#include "prmcodes.h"
#include "fmemmgr.h"
#include "emitobj.h"
#include "fctypes.h"

//=================== Back End Code Generation Routines ====================

extern  void            CGProcDecl(pointer,cg_type);
extern  void            CGReturn(cg_name,cg_type);
extern  cg_name         CGUnary(cg_op,cg_name,cg_type);
extern  cg_name         CGBinary(cg_op,cg_name,cg_name,cg_type);
extern  cg_name         CGAssign(cg_name,cg_name,cg_type);
extern  cg_name         CGLVAssign(cg_name,cg_name,cg_type);
extern  cg_name         CGIndex(cg_name,cg_name,cg_type,cg_type);
extern  cg_name         CGInteger(signed_32,cg_type);
extern  cg_name         CGFEName(sym_handle,cg_type);
extern  cg_name         CGBackName(back_handle,cg_type);
extern  call_handle     CGInitCall(cg_name,cg_type,sym_handle);
extern  void            CGAddParm(call_handle,cg_name,cg_type);
extern  cg_name         CGCall(call_handle);
extern  cg_name         CGEval(cg_name);
extern  sel_handle      CGSelInit( void );
extern  void            CGSelCase(sel_handle,label_handle,signed_32);
extern  void            CGSelOther(sel_handle,label_handle);
extern  void            CGControl(cg_op,cg_name,label_handle);
extern  void            CGSelect(sel_handle,cg_name);
extern  void            CGDone(cg_name);
extern  void            CGTrash(cg_name);
extern  cg_type         CGType(cg_name);
extern  segment_id      BESetSeg(segment_id);
extern  void            BEFlushSeg(segment_id);
extern  label_handle    BENewLabel(void);
extern  void            BEFiniLabel(label_handle);
extern  unsigned long   BETypeLength(cg_type);
extern  void            DGLabel(back_handle);
extern  void            DBModSym(sym_handle,cg_type);
extern  unsigned long   DGSeek(unsigned long);
extern  unsigned long   DGTell(void);
extern  cg_name         CGTempName(temp_handle,cg_type);

//=========================================================================

extern  void            GenLocalSyms(void);
extern  void            GenLocalDbgInfo(void);
extern  void            FreeLocalBacks(bool);
extern  void            FreeGlobalBacks(void);
extern  void            XPush(cg_name);
extern  cg_name         XPop(void);
extern  void            XPopCmplx(cg_cmplx *,cg_type);
extern  cg_name         GetTypedValue(void);
extern  label_handle    GetLabel(int);
extern  label_handle    GetStmtLabel(sym_id);
extern  void            MakeSCB(sym_id,cg_name);
extern  pointer         FEBack(sym_id);
extern  void            SubCodeSeg(void);
extern  void            FiniLabels(int);
extern  void            DefineEntryPoint(entry_pt *);
extern  bool            InArgList(entry_pt *,sym_id);
extern  void            SplitCmplx(cg_name,cg_type);
extern  tmp_handle      AllocTmp(cg_type);
extern  tmp_handle      MkTmp(cg_name,cg_type);
extern  cg_name         TmpPtr(tmp_handle,cg_type);
extern  void            RefStmtLabel(sym_id);
extern  void            DoneLabel(label_id);
extern  cg_name         CmplxAddr(cg_name,cg_name);
extern  aux_info        *AuxLookup(sym_id);
extern  cg_name         SCBPointer(cg_name);
extern  cg_name         SCBPtrAddr(cg_name);
extern  cg_name         SCBLength(cg_name);
extern  cg_name         SCBLenAddr(cg_name);
extern  cg_name         ArrayEltSize(sym_id);
extern  cg_name         FieldArrayEltSize(sym_id);
extern  call_handle     InitCall(RTCODE);
extern  bool            IntType(PTYPE);
extern  void            FiniTmps(void);
extern  void            CloneCGName(cg_name,cg_name *,cg_name *);
extern  sym_id          FindArgShadow(sym_id);
extern  bool            ForceStatic(unsigned_16);
extern  bool            SCBRequired(sym_id);

extern  aux_info        FortranInfo;
extern  back_handle     TraceEntry;
extern  segment_id      CurrCodeSegId;


cg_type SPType( sym_id sym ) {
//============================

// Return subprogram cg type.

    if( (sym->ns.flags & SY_SUBPROG_TYPE) == SY_PROGRAM ) return( T_INTEGER );
    if( (sym->ns.flags & SY_SUBPROG_TYPE) == SY_SUBROUTINE ) return( T_INTEGER );
    // must be a function
    if( sym->ns.typ == TY_CHAR ) return( T_INTEGER );
    return( F772CGType( sym ) );
}


static  cg_type    CommonEntryType( void ) {
//====================================

// Generate return value for common entry point.

    return( T_INTEGER );
}


void    FCPrologue( void ) {
//====================

// Start a subprogram.

    sym_id              sym;
    entry_pt            *ep;
    int                 ep_count;
    sel_handle          sel;
    label_handle        main_entry_label;
    unsigned_16         sp_type;

    --NumSubProgs;
    sym = GetPtr();
    sp_type = sym->ns.flags & SY_SUBPROG_TYPE;
    SubCodeSeg();
    BESetSeg( WF77_LDATA );
    DGSeek( LDSegOffset );
    if( sp_type == SY_BLOCK_DATA ) {
        if( ( sym->ns.flags & SY_UNNAMED ) == 0 ) {
            DGLabel( FEBack( sym ) );
        }
    } else {
        if( CommonEntry == NULL ) {
            CGProcDecl( sym, SPType( sym ) );
        } else {
            CGProcDecl( CommonEntry, CommonEntryType() );
        }
        if( CGOpts & CGOPT_DB_LOCALS ) {
            DBModSym( sym, T_DEFAULT );
        }
    }
    GenLocalSyms();
    if( CGOpts & CGOPT_DB_LOCALS ) {
        if( sp_type != SY_BLOCK_DATA ) {
            GenLocalDbgInfo();
        }
    }
    if( sp_type != SY_BLOCK_DATA ) {
        GenTraceback();
    }
    if( CommonEntry != NULL ) {
        sel = CGSelInit();
        ep_count = 1;
        ep = Entries->link;
        while( ep != NULL ) {
            CGSelCase( sel, GetLabel( ep->id->ns.si.sp.entry ), ep_count );
            ep_count++;
            ep = ep->link;
        }
        main_entry_label = BENewLabel();
        CGSelOther( sel, main_entry_label );
        CGSelect( sel, CGUnary( O_POINTS, CGFEName( EPValue, T_INTEGER ),
                                T_INTEGER ) );
        CGControl( O_LABEL, NULL, main_entry_label );
        BEFiniLabel( main_entry_label );
    }
    BESetSeg( WF77_LDATA );
    LDSegOffset = DGTell();
}


static  void    GenTraceback( void ) {
//==============================

    call_handle         handle;

    if( Options & OPT_TRACE ) {
        handle = InitCall( RT_SET_MODULE );
        CGAddParm( handle, CGBackName( TraceEntry, T_POINTER ), T_POINTER );
        CGDone( CGCall( handle ) );
    }
}


void    FCEpilogue( void ) {
//====================

// End a subprogram.

    sym_id      sym;
    unsigned_16 sp_type;

    sym = GetPtr();
    sp_type = sym->ns.flags & SY_SUBPROG_TYPE;
    if( sp_type != SY_BLOCK_DATA ) {
        GenTraceback();
    }
    if( StNumbers.wild_goto ) {
        DoneLabel( StNumbers.branches );
    }
    FiniLabels( 0 );
    FiniTmps();
    if( ( sym->ns.flags & SY_SUBPROG_TYPE ) == SY_PROGRAM ) {
        CGReturn( NULL, T_INTEGER );
    } else if( sp_type != SY_BLOCK_DATA ) {
        if( CommonEntry == NULL ) {
            GenReturnValue( sym );
        } else {
            GenCommonReturnValue();
            DefineEntries();
        }
    }
    BEFlushSeg( CurrCodeSegId );
    FreeLocalBacks( TRUE );
    FreeGlobalBacks();
}


bool    ChkForAltRets( entry_pt *ep ) {
//=====================================

// Check to see if the specified entry point has an alternate return.

    parameter   *args;

    args = ep->parms;
    for(;;) {
        if( args == NULL ) break;
        if( args->flags & ARG_STMTNO ) return( TRUE );
        args = args->link;
    }
    return( FALSE );
}


bool    EntryWithAltRets( void ) {
//==========================

// Check to see if there's at least one entry with an alternate return.

    entry_pt    *ep;

    ep = Entries;
    while( ep != NULL ) {
        if( ChkForAltRets( ep ) ) return( TRUE );
        ep = ep->link;
    }
    return( FALSE );
}


static  void    GenReturnValue( sym_id sym ) {
//============================================

// Generate return value.

    cg_type     typ;

    typ = SPType( sym );
    if( ( sym->ns.flags & SY_SUBPROG_TYPE ) == SY_SUBROUTINE ) {
        if( !EntryWithAltRets() ) {
            CGReturn( NULL, T_INTEGER );
            return;
        }
    } else { // must be a function
        if( sym->ns.typ == TY_CHAR ) {
            CGReturn( NULL, T_INTEGER );
            return;
        }
    }
    CGReturn( CGUnary( O_POINTS, CGFEName( ReturnValue, typ ), typ ), typ );
}


static  void    GenCommonReturnValue( void ) {
//======================================

// Generate return value for common entry point.

    if( EntryWithAltRets() ) {
        CGReturn( CGUnary( O_POINTS, CGFEName( ReturnValue, T_INTEGER ),
                           T_INTEGER ), T_INTEGER );
    } else {
        CGReturn( NULL, T_INTEGER );
    }
}


static  void    DefineEntries( void ) {
//===============================

// Define entry points into subprogram.

    entry_pt    *ep;