fcstack.c

来自「开放源码的编译器open watcom 1.6.0版的源代码」· C语言 代码 · 共 672 行 · 第 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:  Stack F-Code processor.
*
****************************************************************************/


#include "ftnstd.h"
#include "global.h"
#include "fcgbls.h"
#include "wf77defs.h"
#include "cg.h"
#include "tmpdefs.h"
#include "ecflags.h"
#include "cpopt.h"
#include "fltcnv.h"
#include "emitobj.h"
#include "fctypes.h"

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

extern  cg_name         CGFEName(sym_handle,cg_type);
extern  cg_name         CGBackName(back_handle,cg_type);
extern  cg_name         CGAssign(cg_name,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         CGInteger(signed_32,cg_type);
extern  cg_name         CGFloat(char*,cg_type);
extern  cg_name         CGVolatile(cg_name);
extern  cg_type         CGType(cg_name);

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

extern  pointer         ConstBack(sym_id);
extern  void            CnvS2S(float *,char *);
extern  void            CnvD2S(double *,char *);
extern  void            CnvX2S(extended *,char *);
extern  cg_name         StructRef(cg_name,int);
extern  segment_id      GetGlobalSeg(unsigned_32);
extern  bool            TypeCmplx(TYPE);
extern  intstar4        GetComBlkSize(sym_id);
extern  seg_offset      GetComOffset(unsigned_32);
extern  cg_name         SCBPointer(cg_name);
extern  void            CmplxAssign(sym_id,cg_type,cg_type);
extern  void            PushCmplxConst(sym_id);
extern  void            PushComplex(sym_id);
extern  void            Cmplx2Scalar( void );
extern  cg_type         CmplxBaseType(cg_type);
extern  cg_name         VarAltSCB(sym_id);
extern  cg_name         SubAltSCB(sym_id);
extern  bool            SCBRequired(sym_id);
extern  sym_id          FindEqSetShadow(sym_id);
extern  sym_id          FindArgShadow(sym_id);
extern  bool            ForceStatic(unsigned_16);


void    InitStack( void ) {
//===================

// Initialize stack.

    StkPtr = &TokenBuff;
}


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

    if( sym->ns.si.va.dim_ext->dim_flags & DIM_EXTENDED ) {
#if _CPU == 8086
        if( CGOpts & CGOPT_M_LARGE ) {
            return( T_HUGE_POINTER );
        } else { // if( CGOpts & CGOPT_M_MEDIUM ) {
            return( T_LONG_POINTER );
        }
#elif _CPU == 386
        return( T_LONG_POINTER );
#endif
    }
    return( T_POINTER );
}


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

// Get type of pointer required to address given symbol.

    sym_id      leader;
    cg_type     p_type;
    signed_32   offset;
    com_eq      *ce_ext;
    unsigned_32 item_size;
    segment_id  leader_seg;
    unsigned_16 flags;

    flags = sym->ns.flags;
    if( flags & SY_SUB_PARM ) {
        // subprogram argument
        if( ( flags & SY_CLASS ) == SY_SUBPROGRAM ) {
            p_type = T_CODE_PTR;
        } else if( flags & SY_SUBSCRIPTED ) {
            p_type = ArrayPtrType( sym );
        } else {
            p_type = T_GLOBAL_POINTER;
        }
    } else if( flags & SY_IN_EQUIV ) {
        leader = sym;
        offset = 0;
        for(;;) {
            ce_ext = leader->ns.si.va.vi.ec_ext;
            if( ce_ext->ec_flags & LEADER ) break;
            offset += ce_ext->offset;
            leader = ce_ext->link_eqv;
        }
        if( ce_ext->ec_flags & MEMBER_IN_COMMON ) {
            offset += ce_ext->offset;
            if( GetComBlkSize( ce_ext->com_blk ) <= MaxSegSize ) {
                // common block fits in a segment
                p_type = T_GLOBAL_POINTER;
            } else {
                item_size = _SymSize( sym );
                if( flags & SY_SUBSCRIPTED ) {
                    item_size *= sym->ns.si.va.dim_ext->num_elts;
                }
                if( offset + item_size <= MaxSegSize ) {
                    // object fits in first segment of common block
                    // (common block label is at start of first segment)
                    p_type = T_GLOBAL_POINTER;
                } else {
                    p_type = T_HUGE_POINTER;
                }
            }
        } else {
            if( ce_ext->high - ce_ext->low <= MaxSegSize ) {
                // equivalence set fits in a segment
                p_type = T_GLOBAL_POINTER;
            } else {
                item_size = _SymSize( sym );
                if( flags & SY_SUBSCRIPTED ) {
                    item_size *= sym->ns.si.va.dim_ext->num_elts;
                }
                leader_seg = GetGlobalSeg( ce_ext->offset );
                offset += ce_ext->offset;
                if( ( GetGlobalSeg( offset ) == leader_seg ) &&
                    ( GetGlobalSeg( offset + item_size ) == leader_seg ) ) {
                    // the entire item is in the same segment as the leader
                    p_type = T_GLOBAL_POINTER;
                } else {
                    p_type = T_HUGE_POINTER;
                }
            }
        }
    } else if( flags & SY_IN_COMMON ) {
        ce_ext = sym->ns.si.va.vi.ec_ext;
        if( GetComBlkSize( ce_ext->com_blk ) <= MaxSegSize ) {
            // common block fits in a segment
            p_type = T_GLOBAL_POINTER;
        } else {
            item_size = _SymSize( sym );
            if( flags & SY_SUBSCRIPTED ) {
                item_size *= sym->ns.si.va.dim_ext->num_elts;
            }
            if( ce_ext->com_blk->ns.flags & SY_EQUIVED_NAME ) {
                if( ce_ext->offset + item_size <= MaxSegSize ) {
                    // object fits in first segment of common block
                    // (common block label is at start of first segment)
                    p_type = T_GLOBAL_POINTER;
                } else {
                    p_type = T_HUGE_POINTER;
                }
            } else {
                // each symbol in common block gets a label at the offset into
                // the common block
                if( GetComOffset( ce_ext->offset ) + item_size <= MaxSegSize ) {
                    // object fits in a segment
                    p_type = T_GLOBAL_POINTER;
                } else {
                    p_type = T_HUGE_POINTER;
                }
            }
        }
    } else if( ( flags & SY_SUBSCRIPTED ) && _Allocatable( sym ) ) {
        p_type = ArrayPtrType( sym );
    } else if( ( flags & SY_SUBSCRIPTED ) || ( sym->ns.typ == TY_STRUCTURE ) ) {
        item_size = _SymSize( sym );
        if( flags & SY_SUBSCRIPTED ) {
            item_size *= sym->ns.si.va.dim_ext->num_elts;
        }
        if( item_size > MaxSegSize ) {
            p_type = T_HUGE_POINTER;
        } else if( item_size <= DataThreshold ) {
            p_type = T_LOCAL_POINTER;
        } else {
            p_type = T_GLOBAL_POINTER;
        }
    } else {
        p_type = T_LOCAL_POINTER;
    }
    return( p_type );
}


cg_name SymIndex( sym_id sym, cg_name i ) {
//=========================================

// Get address of symbol plus an index.
// Merges offset of symbols in common or equivalence with index so that
// we don't get two run-time calls for huge pointer arithmetic.

    sym_id      leader;
    cg_name     addr;
    signed_32   offset;
    com_eq      *ce_ext;
    cg_type     p_type;
    bool        data_reference;

    data_reference = TRUE;
    if( ( sym->ns.flags & SY_CLASS ) == SY_SUBPROGRAM ) {
        if( ( sym->ns.flags & SY_SUBPROG_TYPE ) == SY_STMT_FUNC ) {
            addr = CGFEName( sym, F772CGType( sym ) );
        } else {
            addr = CGFEName( sym, T_CODE_PTR );
            if( sym->ns.flags & SY_SUB_PARM ) {
                addr = CGUnary( O_POINTS, addr, T_CODE_PTR );
            }
            data_reference = FALSE;
        }
    } else if( sym->ns.flags & SY_PS_ENTRY ) {
        // it's the shadow symbol for function return value
        if( CommonEntry == NULL ) {
            if( sym->ns.typ == TY_CHAR ) {
                if( Options & OPT_DESCRIPTOR ) {
                    addr = CGFEName( ReturnValue, F772CGType( sym ) );
                    addr = CGUnary( O_POINTS, addr, T_POINTER );
                } else {
                    addr = SubAltSCB( sym->ns.si.ms.sym );
                }
            } else {
                addr = CGFEName( ReturnValue, F772CGType( sym ) );
            }
        } else {
            if( (sym->ns.typ == TY_CHAR) && !(Options & OPT_DESCRIPTOR) ) {
                addr = SubAltSCB( CommonEntry );
            } else {
                addr = CGUnary( O_POINTS, CGFEName( ReturnValue, T_POINTER ),
                                T_POINTER );
            }
        }
    } else if( sym->ns.flags & SY_SUB_PARM ) {
        // subprogram argument
        if( sym->ns.flags & SY_SUBSCRIPTED ) {
            p_type = ArrayPtrType( sym );
            if( sym->ns.typ == TY_CHAR ) {
                addr = CGUnary( O_POINTS, CGFEName( sym, p_type ), p_type );
                if( !(sym->ns.flags & SY_VALUE_PARM) ) {
                    if( Options & OPT_DESCRIPTOR ) {
                        addr = SCBPointer( addr );
                    }
                }
            } else {
                addr = CGUnary( O_POINTS, CGFEName( sym, p_type ), p_type );
            }
        } else {
            p_type = T_POINTER;
            if( sym->ns.typ == TY_CHAR ) {
                if( SCBRequired( sym ) ) {
                    addr = VarAltSCB( sym );
                } else {
                    addr = CGUnary( O_POINTS, CGFEName( sym, p_type ), p_type );
                }
            } else if( sym->ns.flags & SY_VALUE_PARM ) {
                p_type = F772CGType( sym );
                if( TypeCmplx( sym->ns.typ ) ) {
                    p_type = CmplxBaseType( p_type );
                    addr = CGFEName( sym, p_type );
                    XPush( CGUnary( O_POINTS,
                                    CGFEName( FindArgShadow( sym ), p_type ),
                                    p_type ) );
                    addr = CGUnary( O_POINTS, addr, p_type );
                } else {
                    addr = CGFEName( sym, p_type );
                }
            } else {
                addr = CGUnary( O_POINTS, CGFEName( sym, p_type ), p_type );
            }
        }
    } else if( sym->ns.flags & SY_IN_EQUIV ) {
        leader = sym;
        offset = 0;
        for(;;) {
            if( leader->ns.si.va.vi.ec_ext->ec_flags & LEADER ) break;
            offset += leader->ns.si.va.vi.ec_ext->offset;
            leader = leader->ns.si.va.vi.ec_ext->link_eqv;
        }
        if( leader->ns.si.va.vi.ec_ext->ec_flags & MEMBER_IN_COMMON ) {
            addr = CGFEName( leader->ns.si.va.vi.ec_ext->com_blk,
                             F772CGType( sym ) );
            offset += leader->ns.si.va.vi.ec_ext->offset;
        } else {
            sym_id      shadow;

            shadow = FindEqSetShadow( leader );
            if( shadow != NULL ) {
                addr = CGFEName( shadow, shadow->ns.si.ms.cg_typ );
                offset -= leader->ns.si.va.vi.ec_ext->low;
            } else if( (leader->ns.typ == TY_CHAR) &&
                       !(leader->ns.flags & SY_SUBSCRIPTED) ) {
                addr = CGBackName( leader->ns.si.va.bck_hdl, F772CGType( sym ) );
            } else {
                addr = CGFEName( leader, F772CGType( sym ) );
            }